chiark - git - mdw - odin-cgi/blob - bin/mailredir.userv

   1 #! /usr/bin/perl
   2
   3 use lib 'lib';
   4
   5 use Odin;
   6
   7 use DBI;
   8 use Encode;
   9 use Encode::Locale;
  10 use Getopt::Long;
  11 use POSIX;
  12
  13 ###--------------------------------------------------------------------------
  14 ### Main program.
  15
  16 my $dom = $Odin::MAIL_DEFDOMAIN;
  17 Odin::cmdline_who;
  18
  19 sub record_opt (\%$$) {
  20   my ($r, $o, $op) = @_;
  21
  22   if ($o eq "c") { $r->{comment} = $op->arg; }
  23   elsif ($o eq "x") { $r->{expire} = Odin::parse_time $op->arg; }
  24   elsif ($o eq "r") { $r->{recip} = $op->arg; }
  25   else { return undef; }
  26   return 1;
  27 }
  28
  29 sub gen_opt ($\$\%$$) {
  30   my ($dom, $g, $gp, $o, $op) = @_;
  31
  32   if ($o eq "g") {
  33     my $a = $op->arg; next OPT unless defined $a;
  34     $$g = Odin::get_generator_class $dom, $a;
  35   } elsif ($o eq "p") {
  36     defined (my $p = $op->arg) or next OPT;
  37     if ($p =~ /^([-\w]+)=(.*)$/) { $gp->{$1} = $2; }
  38     else { $op->err("invalid parameter `$p'"); }
  39   } else {
  40     return undef;
  41   }
  42   return 1;
  43 }
  44
  45 my $op = Odin::OptParse->new(@ARGV);
  46 OPT: while (my $o = $op->get) {
  47   if ($o eq "d") {
  48     $dom = $op->arg or next OPT;
  49     exists $Odin::MAILDOM_POLICY{$dom} or $op->err("unknown domain `$dom'");
  50   } else {
  51     $op->unk;
  52   }
  53 }
  54 unless ($op->ok) {
  55   print STDERR "usage: $Odin::PROG [-d DOMAIN] COMMAND [ARGUMENT ...]\n";
  56   exit 1;
  57 }
  58 @ARGV = $op->rest;
  59
  60 my $op = shift(@ARGV) // "help";
  61 if ($op eq "help") {
  62   print <<EOF;
  63 Usage: $Odin::PROG [-d DOMAIN] COMMAND [ARGUMENTS ...]
  64
  65 Commands available:
  66
  67         disable LPART ...
  68         dormant
  69         help
  70         list
  71         new [-n COUNT] [-GENOPTS] [-RECOPTS] [RECIP]
  72         release LPART ...
  73         reserve [-GENOPTS] N
  74         reserved
  75         set [-RECOPTS] LPART
  76
  77 GENOPTS ::= [-g GENERATOR] [-p PARAM=VALUE]
  78 RECOPTS ::= [-c COMMENT] [-r RECIP] [-x EXPIRES]
  79 EOF
  80 } elsif ($op eq "list") {
  81   @ARGV and Odin::fail "usage: list";
  82   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
  83                "st = 'live' AND (expire = -1 OR expire >= ?)", $Odin::NOW) {
  84     my ($lpart, $expire, $recip, $comment) = @$r;
  85     Odin::print_columns
  86       Odin::fmt_time $expire => 25,
  87       $lpart => 24, $recip => 32, $comment => 0;
  88   }
  89 } elsif ($op eq "dormant") {
  90   @ARGV and Odin::fail "usage: list";
  91   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
  92                "(st = 'dormant' OR
  93                  (st = 'live' AND expire <> -1 AND expire < ?))",
  94              $Odin::NOW) {
  95     my ($lpart, $expire, $recip, $comment) = @$r;
  96     Odin::print_columns $lpart => 24, $recip => 32, $comment => 0;
  97   }
  98 } elsif ($op eq "reserved") {
  99   @ARGV and Odin::fail "usage: reserved";
 100   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
 101                "st = 'reserved' AND expire >= ?", $Odin::NOW) {
 102     my ($lpart, $expire, $recip, $comment) = @$r;
 103     Odin::print_columns Odin::fmt_time $expire => 25, $lpart => 0;
 104   }
 105 } elsif ($op eq "new") {
 106   my $op = Odin::OptParse->new(@ARGV);
 107   my $gencls = Odin::default_generator_class $dom;
 108   my %gp = ();
 109   my %r = ();
 110   my $n = 1;
 111   while (my $o = $op->get) {
 112     if ($o eq "n") { $n = $op->intarg(undef, 0) }
 113     else {
 114       gen_opt $dom, $gencls, %gp, $o, $op
 115         or record_opt %r, $o, $op
 116         or $op->unk;
 117     }
 118   }
 119   my @a = $op->rest;
 120   if (@a) { $r{recip} = shift @a; }
 121   !@a or $op->bad;
 122   $op->ok or
 123     Odin::fail "usage: new [-n COUNT] [-GENOPTS] [-RECOPTS] [RECIP]";
 124   my $gen = $gencls->new($dom, \%gp);
 125   my @l = Odin::new_redir $dom, $gen, %r, $n;
 126   print map { $_ . "\n" } @l;
 127 } elsif ($op eq "reserve") {
 128   my $op = Odin::OptParse->new(@ARGV);
 129   my $gencls = Odin::default_generator_class $dom;
 130   my %gp = ();
 131   while (my $o = $op->get) {
 132     gen_opt $dom, $gencls, %gp, $o, $op
 133       or $op->unk;
 134   }
 135   my @a = $op->rest;
 136   my $n = 1;
 137   if (@a) {
 138     $n = shift @a;
 139     $n =~ /^\d+$/ or $op->err("invalid count `$n'");
 140   }
 141   @a and $op->bad;
 142   $op->ok or Odin::fail "usage: reserve [-GENOPTS] N";
 143   my $gen = $gencls->new($dom, \%gp);
 144   for my $l (Odin::reserve_redir $dom, $gen, $n) { print $l, "\n"; }
 145 } elsif ($op eq "release") {
 146   my $op = Odin::OptParse->new(@ARGV);
 147   my $all = 0;
 148   while (my $o = $op->get) {
 149     if ($o eq "a") { $all = 1; }
 150     else { $op->unk; }
 151   }
 152   my @a = $op->rest;
 153   !!$all == !@a or $op->bad;
 154   $op->ok or Odin::fail "usage: release {-a | LPART ...}";
 155   if ($all) { Odin::release_all_redir $dom; }
 156   else { Odin::release_redir $dom, @a; }
 157 } elsif ($op eq "disable") {
 158   @ARGV or Odin::fail "usage: disable LPART ...";
 159   Odin::disable_redir $dom, @ARGV;
 160 } elsif ($op eq "set") {
 161   my $op = Odin::OptParse->new(@ARGV);
 162   my %r = ();
 163   while (my $o = $op->get) {
 164     record_opt %r, $o, $op
 165       or $op->unk;
 166   }
 167   my @a = $op->rest;
 168   my $l = shift @a or $op->bad;
 169   @a and $op->bad;
 170   $op->ok or Odin::fail "usage: set [-RECOPTS] LPART";
 171   Odin::modify_redir $dom, $l, %r;
 172 } else {
 173   Odin::fail "unknown operation `$op'";
 174 }