evade-mail-pregen

   1 #!/usr/bin/perl -w
   2 use strict;
   3 our $pgm = $0; $pgm =~ s#.*/##;
   4 our $usage = <<'END';
   5 usage:
   6  $pgm [<opts>] update <number>|<localpart>@[domain] [<reason>] [<comment>]
   7  $pgm [<opts>] assign <number>|<localpart>@[domain] <comment>
   8  $pgm [<opts>] show <count>              } will generate more aliases
   9  $pgm [<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 $pgm 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 @genopts;
  24
  25 sub fetch_list {
  26     open P, "-!", $generator, qw(list) or die $!;
  27     while (<P>) {
  28         my ($alias,$user);
  29         if (m/^\# user/) {
  30             next;
  31         } elsif (m/^\# reject (\S+) (\#.*)$/) {
  32             ($alias,$comment) = ($1,$2);
  33         } elsif (m/^\#/) {
  34             next; # future extension
  35         } elsif (m/^([^#: ])\: [^#]* (\#.*)$/) {
  36             ($alias,$comment) = ($1,$2);
  37         } else {
  38             die "generator output $_ ?";
  39         }
  40         my $localpart = $alias;
  41         $localpart =~ s/\@.*//;
  42         my $row = { Alias => $alias, LocalPart => $localpart };
  43         if ($comment =~ m/^### PREGEN ([1-9]\d{0,8})$/) {
  44             $row->{Number}= $1;
  45         }
  46         $by_localpart{$row->{LocalPart}} = $row;
  47         $by_number[$row->{Number}] = $row if defined $row->{Number};
  48     }
  49     $?=0; $!=0; close P or die "$generator $! $?";
  50
  51 }
  52
  53 sub parse_target {
  54     @ARGV or badusage "missing specification for alias to change";
  55     my $spec = shift @ARGV;
  56     my $target;
  57     if ($spec =~ m/^(\d{1,9})$/) {
  58         $target = $by_number[$spec];
  59         die "no alias number $target\n" unless $target;
  60     } elsif ($spec =~ m/^(.*)\@[^\@]*/) {
  61         $target = $by_localpart{$1};
  62         die "no alias with local part \`$1'\n" unless $target;
  63         die "incorrect or unchecked domain: \`$target->{Alias}' != \`$spec'\n"
  64             unless $spec eq $target->{Alias} ||
  65                    $spec eq $target->{LocalPart}.'@';
  66     } else {
  67         badusage "bad specification for alias to change";
  68     }
  69 }
  70
  71 sub action_update {
  72     my $target = parse_target;
  73     @ARGV or badusage "missing update info\n";
  74     if (defined $target->{Number} && $target->{Number} == $#by_number) {
  75         generate $target->{Number}+1;
  76     }
  77     exec $generator, qw(update), $target->{Alias}, @ARGV;
  78     die "$generator: $!";
  79 }
  80
  81 sub action_assign {
  82     (@ARGV==2 &&
  83      $ARGV[1] =~ m/^#/) or
  84      badusage "invalid arguments to assign - forgot to quote it properly?";
  85     action_update;
  86 }
  87
  88
  89     (@ARGV==1 && $ARGV[0] =~  or badusage "missing assignment info (new comment)";
  90     $ARGV[0]=~
  91
  92 for (;;) {
  93     last unless @ARGV;
  94     last unless $ARGV[0] =~ m/^-/;
  95     my $arg = shift @ARGV;
  96     last if $arg =~ m/^--?$/;
  97     if ($arg =~ m/^-[ldFm]/) {
  98         push @genopts, $arg;
  99     } elsif ($arg =~ m/^-G/) {
 100         $generator = $'; #';
 101     } else {
 102         badusage "unknown option \`$arg'";
 103     }
 104 }
 105
 106 our $child = $pgm;
 107 $child =~ s/-pregen/; fixme fixme this should be defaulting generator
 108
 109 @ARGV or badusage "missing action\n";
 110 my $action = shift @ARGV;
 111 $action =~ y/-/_/;
 112 { no strict qw(refs); &{"action_$action"}; }