From 382df11bde8539b55674bcab537e41b211a0e64c Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 27 Oct 2013 19:54:33 +0000 Subject: [PATCH] pregen: wip --- evade-mail-pregen | 123 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 100 insertions(+), 23 deletions(-) diff --git a/evade-mail-pregen b/evade-mail-pregen index d98337b..a375437 100755 --- a/evade-mail-pregen +++ b/evade-mail-pregen @@ -1,12 +1,14 @@ #!/usr/bin/perl -w use strict; +use Carp; our $us = $0; $us =~ s#.*/##; our $usage = <<'END'; usage: $us [] update |@[domain] [] [] $us [] assign |@[domain] - $us [] show } will generate more aliases - $us [] range [-[]] } if necessary + $us [] list + $us [] some } will generate aliases + $us [] range -|+ } as necessary opts: -G generator/lister program -N do not generate more aliases @@ -19,12 +21,17 @@ notes: whole comment to protect it from your shell END +sub fail { die "$us: @_\n"; } +sub badusage { fail "bad usage: @_"; } +sub failstdout () { fail "stdout: $!"; } + our $generator; our $no_generate=0; our @genopts; our %by_localpart; our @by_number; +our $min_number; our $comment_pattern = '### PREGEN '; our $comment_re; @@ -32,14 +39,15 @@ our $comment_re; sub comment_make ($) { my ($num) = @_; my $r = $comment_pattern; - ($r =~ s/\/$num/) == 1 or die "$r ?"; + ($r =~ s/\/$num/) == 1 or confess "$r ?"; return $r; } -sub fetch_list { - open P, "-!", $generator, qw(list) or die $!; +sub run_generator { + my @genargs = @_; + open P, "-!", $generator, @genargs or fail "fork $generator: $!"; while (

) { - my ($alias,$user); + my ($alias,$comment); if (m/^\# user/) { next; } elsif (m/^\# reject (\S+) (\#.*)$/) { @@ -58,20 +66,28 @@ sub fetch_list { $row->{Number}= $1; } $by_localpart{$row->{LocalPart}} = $row; - $by_number[$row->{Number}] = $row if defined $row->{Number}; + if (defined $row->{Number}) { + $by_number[$row->{Number}] = $row; + $min_number = $row->{Number} if + (!defined $min_number) || $min_number > $row->{Number}; } - $?=0; $!=0; close P or die "$generator $! $?"; + $?=0; $!=0; close P or fail "$generator $genargs[0] failed ($! $?)\n"; +} + +sub fetch_list () { + run_generator qw(list); } -sub generate ($) { +sub perhaps_generate ($) { my ($num) = @_; return undef if $no_generate; my $alias = $by_number[$num]; return $alias if $alias; - run_generator qw(create) - $!=0; $?=0; (system $generator, qw(create), comment_make $num) - ==0 or die "$generator failed ($! $?)"; - + return undef unless $num > $#by_number; + run_generator qw(create), (comment_make $num); + $alias = $by_number[$num]; + confess "$num ?" unless $alias; + return $alias; } sub parse_target { @@ -80,11 +96,11 @@ sub parse_target { my $target; if ($spec =~ m/^(\d{1,9})$/) { $target = $by_number[$spec]; - die "no alias number $target\n" unless $target; + fail "no alias number $target" unless $target; } elsif ($spec =~ m/^(.*)\@[^\@]*/) { $target = $by_localpart{$1}; - die "no alias with local part \`$1'\n" unless $target; - die "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'\n" + fail "no alias with local part \`$1'" unless $target; + fail "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'" unless $spec eq $target->{Alias} || $spec eq $target->{LocalPart}.'@'; } else { @@ -92,19 +108,26 @@ sub parse_target { } } +sub report ($) { + my ($alias) = @_; + confess unless $alias; + print $alias->{Number}, ' ', $alias->{LocalPart}, "\n" + or failstdout; +} + sub action_update { my $target = parse_target; @ARGV or badusage "missing update info\n"; if (defined $target->{Number} && $target->{Number} == $#by_number) { - my $wanted = $target->{Number}+1; - generate $wanted - or print STDERR <{Alias}, @ARGV; - die "$generator: $!"; + fail "exec $generator: $!"; } sub action_assign { @@ -114,6 +137,49 @@ sub action_assign { action_update; } +sub action_list { + @ARGV==0 or + badusage "invalid arguments to list"; + my $num = $min_number; + while ($num <= $#by_number) { + my $alias = $by_number[$num]; + report $alias if $alias; + } +} + +sub action_some { + (@ARGV==1 && + $ARGV[0] =~ m/^(\d+)$/s) or + badusage "invalid arguments to some"; + my ($count) = $1; + my $num = $min_number; + while ($count > 0) { + my $alias = generate $num; + if ($alias) { + report $alias; + $count--; + } else { + last if $num > $#by_number; # -N + $num++; + } + } +} + +sub action_range { + (@ARGV==1 && + $ARGV[0] =~ m/^(\d+)(?:([-+])(\d+))?$/s) or + badusage "invalid arguments to range"; + my ($num,$op,$rarg) = ($1,$2,$3); + my $limit = + $op eq '+' ? $num+$rarg-1 : + $op eq '-' ? $rarg : + confess "$op ??"; + for (; $num<=$limit; $num++) { + my $alias = generate $num; + report $alias if $alias; + } +} + for (;;) { last unless @ARGV; last unless $ARGV[0] =~ m/^-/; @@ -132,8 +198,12 @@ for (;;) { } } -our $child = $us; -$child =~ s/-pregen/; fixme fixme this should be defaulting generator +if (!defined $generator) { + $generator = $us; + $generator =~ s/-pregen$// + or fail "unable to calculate default generator". + " (want to strip \`-pregen' from our program name, \`$us')"; +} $comment_pattern =~ m/^#/s or badusage "comment pattern must start with \`#'"; @@ -144,5 +214,12 @@ $comment_re =~ s/\W/\\$&/g; @ARGV or badusage "missing action\n"; my $action = shift @ARGV; + +fetch_list(); + $action =~ y/-/_/; -{ no strict qw(refs); &{"action_$action"}; } +my $actionsub = { no strict qw(refs); \&{"action_$action"}; } +defined $actionsub or badusage "unknown action $action"; +$actionsub->(); + +close STDOUT or failstdout; -- 2.30.2