evade-mail-pregen

   1 #!/usr/bin/perl -w
   2 use strict;
   3 our $us = $0; $us =~ s#.*/##;
   4 our $usage = <<'END';
   5 usage:
   6  $us [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
   7  $us [<opts>] assign <number>|<localpart>@[domain] <comment>
   8  $us [<opts>] show <count>              } will generate more aliases
   9  $us [<opts>] range [<from>-[<to>]]     }  if necessary
  10 opts:
  11  -G<generator>           generator/lister program
  12  -N                      do not generate more aliases
  13  -l.., -d.., -F.., -m..  passed to generator
  14 notes:
  15  Always use $us to edit the comment of a pregen alias;
  16   otherwise we may lose track of the next number alias to pregenerate
  17   and reuse numbers.
  18  <comment> must always start with #, and you will need to quote the
  19   whole comment to protect it from your shell
  20 END
  21
  22 our $generator;
  23 our $no_generate=0;
  24 our @genopts;
  25
  26 our %by_localpart;
  27 our @by_number;
  28
  29 our $comment_pattern = '### PREGEN <number>';
  30 our $comment_re;
  31
  32 sub comment_make ($) {
  33     my ($num) = @_;
  34     my $r = $comment_pattern;
  35     ($r =~ s/\<number\>/$num/) == 1 or die "$r ?";
  36     return $r;
  37 }
  38
  39 sub fetch_list {
  40     open P, "-!", $generator, qw(list) or die $!;
  41     while (<P>) {
  42         my ($alias,$user);
  43         if (m/^\# user/) {
  44             next;
  45         } elsif (m/^\# reject (\S+) (\#.*)$/) {
  46             ($alias,$comment) = ($1,$2);
  47         } elsif (m/^\#/) {
  48             next; # future extension
  49         } elsif (m/^([^#: ])\: [^#]* (\#.*)$/) {
  50             ($alias,$comment) = ($1,$2);
  51         } else {
  52             die "generator output $_ ?";
  53         }
  54         my $localpart = $alias;
  55         $localpart =~ s/\@.*//;
  56         my $row = { Alias => $alias, LocalPart => $localpart };
  57         if ($comment =~ m/^$comment_re$/o) {
  58             $row->{Number}= $1;
  59         }
  60         $by_localpart{$row->{LocalPart}} = $row;
  61         $by_number[$row->{Number}] = $row if defined $row->{Number};
  62     }
  63     $?=0; $!=0; close P or die "$generator $! $?";
  64 }
  65
  66 sub generate ($) {
  67     my ($num) = @_;
  68     return undef if $no_generate;
  69     my $alias = $by_number[$num];
  70     return $alias if $alias;
  71     run_generator qw(create)
  72     $!=0; $?=0; (system $generator, qw(create), comment_make $num)
  73         ==0 or die "$generator failed ($! $?)";
  74
  75 }
  76
  77 sub parse_target {
  78     @ARGV or badusage "missing specification for alias to change";
  79     my $spec = shift @ARGV;
  80     my $target;
  81     if ($spec =~ m/^(\d{1,9})$/) {
  82         $target = $by_number[$spec];
  83         die "no alias number $target\n" unless $target;
  84     } elsif ($spec =~ m/^(.*)\@[^\@]*/) {
  85         $target = $by_localpart{$1};
  86         die "no alias with local part \`$1'\n" unless $target;
  87         die "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'\n"
  88             unless $spec eq $target->{Alias} ||
  89                    $spec eq $target->{LocalPart}.'@';
  90     } else {
  91         badusage "bad specification for alias to change";
  92     }
  93 }
  94
  95 sub action_update {
  96     my $target = parse_target;
  97     @ARGV or badusage "missing update info\n";
  98     if (defined $target->{Number} && $target->{Number} == $#by_number) {
  99         my $wanted = $target->{Number}+1;
 100         generate $wanted
 101             or print STDERR <<END
 102 $us: Losing track of next number ($wanted), due to use of -N;
 103 $us: will start next alias at #0, unless you say (e.g.) "range $wanted".
 104 END
 105     }
 106     exec $generator, qw(update), $target->{Alias}, @ARGV;
 107     die "$generator: $!";
 108 }
 109
 110 sub action_assign {
 111     (@ARGV==2 &&
 112      $ARGV[1] =~ m/^#/) or
 113      badusage "invalid arguments to assign - forgot to quote it properly?";
 114     action_update;
 115 }
 116
 117 for (;;) {
 118     last unless @ARGV;
 119     last unless $ARGV[0] =~ m/^-/;
 120     my $arg = shift @ARGV;
 121     last if $arg =~ m/^--?$/;
 122     while ($arg !~ m/^-$/) {
 123         if ($arg =~ s/^-[ldFm]/-/) {
 124             push @genopts, $arg;
 125         } elsif ($arg =~ s/^-G//) {
 126             $generator = $'; #';
 127         } elsif ($arg =~ s/^-N//) {
 128             $no_generate = 1;
 129         } else {
 130             badusage "unknown option \`$arg'";
 131         }
 132     }
 133 }
 134
 135 our $child = $us;
 136 $child =~ s/-pregen/; fixme fixme this should be defaulting generator
 137
 138 $comment_pattern =~ m/^#/s
 139     or badusage "comment pattern must start with \`#'";
 140 $comment_re = $comment_pattern;
 141 $comment_re =~ s/\W/\\$&/g;
 142 ($comment_re =~ s'\<number\>'([1-9]\d{0,8})'g) == 1 #'
 143     or badusage "comment pattern must contain \`<number>' exactly once";
 144
 145 @ARGV or badusage "missing action\n";
 146 my $action = shift @ARGV;
 147 $action =~ y/-/_/;
 148 { no strict qw(refs); &{"action_$action"}; }