X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=blobdiff_plain;f=evade-mail-pregen;h=4369ec1ebf735e93c5587d9cc0d999872158b201;hb=4de38bf975e8d283253e3164e470c3cd05dee4e1;hp=d98337b8aec5beb4046edeadd1e6e86ea9ffcc59;hpb=9f27abf72e2073892d154322329eeb1e43c75427;p=evade-mail-usrlocal.git

diff --git a/evade-mail-pregen b/evade-mail-pregen
index d98337b..4369ec1 100755
--- a/evade-mail-pregen
+++ b/evade-mail-pregen
@@ -1,15 +1,18 @@
 #!/usr/bin/perl -w
 use strict;
+use Carp;
 our $us = $0; $us =~ s#.*/##;
 our $usage = <<'END';
 usage:
  $us [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
  $us [<opts>] assign <number>|<localpart>@[domain] <comment>
- $us [<opts>] show <count>              } will generate more aliases
- $us [<opts>] range [<from>-[<to>]]     }  if necessary
+ $us [<opts>] list
+ $us [<opts>] some <count>                     } will generate aliases
+ $us [<opts>] range <min>-<max>|<min>+<count>  }  as necessary
 opts:
  -G<generator>           generator/lister program
  -N                      do not generate more aliases
+ -q                      do not show domain, just local part
  -l.., -d.., -F.., -m..  passed to generator
 notes:
  Always use $us to edit the comment of a pregen alias;
@@ -19,34 +22,64 @@ 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 $show_domain=1;
 our @genopts;
 
 our %by_localpart;
 our @by_number;
+our $min_number;
 
 our $comment_pattern = '### PREGEN <number>';
 our $comment_re;
 
+open DEBUG, ">/dev/null" or die $!;
+
+sub debug {
+    print DEBUG "$us: DEBUG: ", @_, "\n" or die $!;
+}
+
+sub debug_cmd {
+    debug "running ", join ' ',
+        map { 
+	    if (m/[^-_.=+0-9a-z]/i) {
+		my $s = $_;
+		$s =~ s/['\\]/'\\$&'/g;
+		"'$s'";
+	    } else {
+		$_;
+	    }
+	} @_;
+}
+
 sub comment_make ($) {
     my ($num) = @_;
     my $r = $comment_pattern;
-    ($r =~ s/\<number\>/$num/) == 1 or die "$r ?";
+    ($r =~ s/\<number\>/$num/) == 1 or confess "$r ?";
     return $r;
 }
 
-sub fetch_list {
-    open P, "-!", $generator, qw(list) or die $!;
+sub run_generator {
+    my @genargs = @_;
+    my @cmd = ($generator, @genargs);
+    debug_cmd @cmd;
+    open P, "-|", @cmd or fail "fork $generator: $!";
     while (<P>) {
-	my ($alias,$user);
+	my ($alias,$comment);
+	chomp or fail "$generator truncated output?";
+	debug "| ", $_;
 	if (m/^\# user/) {
 	    next;
 	} elsif (m/^\# reject (\S+) (\#.*)$/) {
 	    ($alias,$comment) = ($1,$2);
 	} elsif (m/^\#/) {
 	    next; # future extension
-	} elsif (m/^([^#: ])\: [^#]* (\#.*)$/) {
+	} elsif (m/^([^#: ]+)\: [^#]* (\#.*)$/) {
 	    ($alias,$comment) = ($1,$2);
 	} else {
 	    die "generator output $_ ?";
@@ -58,53 +91,72 @@ 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 generate ($) {
+sub fetch_list () {
+    run_generator qw(list);
+}
+
+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 if $no_generate;
+    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 {
+sub parse_target () {
     @ARGV or badusage "missing specification for alias to change";
     my $spec = shift @ARGV;
     my $target;
     if ($spec =~ m/^(\d{1,9})$/) {
 	$target = $by_number[$spec];
-	die "no alias number $target\n" unless $target;
+	fail "no alias number $spec (already assigned perhaps?)" 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 {
 	badusage "bad specification for alias to change";
     }
+    return $target;
+}
+
+sub report ($) {
+    my ($alias) = @_;
+    confess unless $alias;
+    print $alias->{Number}, ' ',
+        $alias->{ $show_domain ? 'Alias' : 'LocalPart' }, "\n"
+	or failstdout;
 }
 
 sub action_update {
-    my $target = parse_target;
+    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 <<END
+	my $wanted = $#by_number + 1;
+	perhaps_generate $wanted
+	    or print STDERR <<END or fail "stderr: $!"
 $us: Losing track of next number ($wanted), due to use of -N;
 $us: will start next alias at #0, unless you say (e.g.) "range $wanted".
 END
     }
-    exec $generator, qw(update), $target->{Alias}, @ARGV;
-    die "$generator: $!";
+    my @cmd = ($generator, qw(update), $target->{Alias}, @ARGV);
+    debug_cmd @cmd;
+    exec @cmd or fail "exec $generator: $!";
 }
 
 sub action_assign {
@@ -114,17 +166,70 @@ sub action_assign {
     action_update;
 }
 
+sub action_list {
+    @ARGV==0 or
+	badusage "invalid arguments to list";
+    my $num = $min_number;
+    $num ||= 0;
+    for (; $num <= $#by_number; $num++) {
+	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;
+    $num ||= 0;
+    for (; $count > 0; $num++) {
+	my $alias = perhaps_generate $num;
+	if ($alias) {
+	    report $alias;
+	    $count--;
+	} else {
+	    if ($num > $#by_number) {
+		print STDERR <<END or fail "stderr: $!";
+$us: fewer than requested aliases printed, due to -N
+END
+		last;
+	    }
+	}
+    }
+}
+
+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 = perhaps_generate $num;
+	report $alias if $alias;
+    }
+}    
+
 for (;;) {
     last unless @ARGV;
     last unless $ARGV[0] =~ m/^-/;
     my $arg = shift @ARGV;
     last if $arg =~ m/^--?$/;
-    while ($arg !~ m/^-$/) {
+    while ($arg =~ m/^-./) {
 	if ($arg =~ s/^-[ldFm]/-/) {
 	    push @genopts, $arg;
-	} elsif ($arg =~ s/^-G//) {
-	    $generator = $'; #';
-	} elsif ($arg =~ s/^-N//) {
+	} elsif ($arg =~ s/^-G(.*)//) {
+	    $generator = $1;
+	} elsif ($arg =~ s/^-D/-/) {
+	    open DEBUG, ">&STDERR" or die $!;
+	} elsif ($arg =~ s/^-q/-/) {
+	    $show_domain = 0;
+	} elsif ($arg =~ s/^-N/-/) {
 	    $no_generate = 1;
 	} else {
 	    badusage "unknown option \`$arg'";
@@ -132,17 +237,33 @@ 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 \`#'";
 $comment_re = $comment_pattern;
 $comment_re =~ s/\W/\\$&/g;
-($comment_re =~ s'\<number\>'([1-9]\d{0,8})'g) == 1 #'
-    or badusage "comment pattern must contain \`<number>' exactly once";
+($comment_re =~ s'\\<number\\>'(0|[1-9]\d{0,8})'g) == 1 #'
+    or badusage "comment pattern (\`$comment_pattern')".
+         " must contain \`<number>' exactly once";
 
-@ARGV or badusage "missing action\n";
+if (!@ARGV) {
+    print STDERR $usage or die $!;
+    exit 1;
+}
 my $action = shift @ARGV;
+
+fetch_list();
+
 $action =~ y/-/_/;
-{ no strict qw(refs); &{"action_$action"}; }
+my $actionsub;
+{ no strict qw(refs); $actionsub = \&{"action_$action"}; }
+defined $actionsub or badusage "unknown action $action";
+$actionsub->();
+
+close STDOUT or failstdout;