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 [-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   while (my $o = $op->get) {
 111     gen_opt $dom, $gencls, %gp, $o, $op
 112       or record_opt %r, $o, $op
 113       or $op->unk;
 114   }
 115   my @a = $op->rest;
 116   if (@a) { $r{recip} = shift @a; }
 117   !@a or $op->bad;
 118   $op->ok or Odin::fail "usage: new [-GENOPTS] [-RECOPTS] RECIP";
 119   my $gen = $gencls->new($dom, \%gp);
 120   my $l = Odin::new_redir $dom, $gen, %r;
 121   print $l, "\n";
 122 } elsif ($op eq "reserve") {
 123   my $op = Odin::OptParse->new(@ARGV);
 124   my $gencls = Odin::default_generator_class $dom;
 125   my %gp = ();
 126   while (my $o = $op->get) {
 127     gen_opt $dom, $gencls, %gp, $o, $op
 128       or $op->unk;
 129   }
 130   my @a = $op->rest;
 131   my $n = 1;
 132   if (@a) {
 133     $n = shift @a;
 134     $n =~ /^\d+$/ or $op->err("invalid count `$n'");
 135   }
 136   @a and $op->bad;
 137   $op->ok or Odin::fail "usage: reserve [-GENOPTS] N";
 138   my $gen = $gencls->new($dom, \%gp);
 139   for my $l (Odin::reserve_redir $dom, $gen, $n) { print $l, "\n"; }
 140 } elsif ($op eq "release") {
 141   my $op = Odin::OptParse->new(@ARGV);
 142   my $all = 0;
 143   while (my $o = $op->get) {
 144     if ($o eq "a") { $all = 1; }
 145     else { $op->unk; }
 146   }
 147   my @a = $op->rest;
 148   !!$all == !@a or $op->bad;
 149   $op->ok or Odin::fail "usage: release {-a | LPART ...}";
 150   if ($all) { Odin::release_all_redir $dom; }
 151   else { Odin::release_redir $dom, @a; }
 152 } elsif ($op eq "disable") {
 153   @ARGV or Odin::fail "usage: disable LPART ...";
 154   Odin::disable_redir $dom, @ARGV;
 155 } elsif ($op eq "set") {
 156   my $op = Odin::OptParse->new(@ARGV);
 157   my %r = ();
 158   while (my $o = $op->get) {
 159     record_opt %r, $o, $op
 160       or $op->unk;
 161   }
 162   my @a = $op->rest;
 163   my $l = shift @a or $op->bad;
 164   @a and $op->bad;
 165   $op->ok or Odin::fail "usage: set [-RECOPTS] LPART";
 166   Odin::modify_redir $dom, $l, %r;
 167 } else {
 168   Odin::fail "unknown operation `$op'";
 169 }