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         giveaway LPART OWNER
  70         help
  71         list
  72         new [-n COUNT] [-GENOPTS] [-RECOPTS] [RECIP]
  73         release LPART ...
  74         reserve [-GENOPTS] N
  75         reserved
  76         set [-RECOPTS] LPART ...
  77
  78 GENOPTS ::= [-g GENERATOR] [-p PARAM=VALUE]
  79 RECOPTS ::= [-c COMMENT] [-r RECIP] [-x EXPIRES]
  80 EOF
  81 } elsif ($op eq "list") {
  82   @ARGV and Odin::fail "usage: list";
  83   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
  84                "st = 'live' AND (expire = -1 OR expire >= ?)", $Odin::NOW) {
  85     my ($lpart, $expire, $recip, $comment) = @$r;
  86     Odin::print_columns
  87       Odin::fmt_time $expire => 25,
  88       $lpart => 24, $recip => 32, $comment => 0;
  89   }
  90 } elsif ($op eq "dormant") {
  91   @ARGV and Odin::fail "usage: list";
  92   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
  93                "(st = 'dormant' OR
  94                  (st = 'live' AND expire <> -1 AND expire < ?))",
  95              $Odin::NOW) {
  96     my ($lpart, $expire, $recip, $comment) = @$r;
  97     Odin::print_columns $lpart => 24, $recip => 32, $comment => 0;
  98   }
  99 } elsif ($op eq "giveaway") {
 100   @ARGV >= 2 or Odin::fail "usage: giveaway OWNER LPART ...";
 101   my $owner = shift @ARGV;
 102   my @l = @ARGV;
 103   getpwnam $owner or Odin::fail "unknown user `$owner'";
 104   my %r = (owner => $owner);
 105   Odin::modify_redir $dom, %r, @l;
 106 } elsif ($op eq "reserved") {
 107   @ARGV and Odin::fail "usage: reserved";
 108   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
 109                "st = 'reserved' AND expire >= ?", $Odin::NOW) {
 110     my ($lpart, $expire, $recip, $comment) = @$r;
 111     Odin::print_columns Odin::fmt_time $expire => 25, $lpart => 0;
 112   }
 113 } elsif ($op eq "new") {
 114   my $op = Odin::OptParse->new(@ARGV);
 115   my $gencls = Odin::default_generator_class $dom;
 116   my %gp = ();
 117   my %r = ();
 118   my $n = 1;
 119   while (my $o = $op->get) {
 120     if ($o eq "n") { $n = $op->intarg(undef, 0) }
 121     else {
 122       gen_opt $dom, $gencls, %gp, $o, $op
 123         or record_opt %r, $o, $op
 124         or $op->unk;
 125     }
 126   }
 127   my @a = $op->rest;
 128   if (@a) { $r{recip} = shift @a; }
 129   !@a or $op->bad;
 130   $op->ok or
 131     Odin::fail "usage: new [-n COUNT] [-GENOPTS] [-RECOPTS] [RECIP]";
 132   my $gen = $gencls->new($dom, \%gp);
 133   my @l = Odin::new_redir $dom, $gen, %r, $n;
 134   print map { $_ . "\n" } @l;
 135 } elsif ($op eq "reserve") {
 136   my $op = Odin::OptParse->new(@ARGV);
 137   my $gencls = Odin::default_generator_class $dom;
 138   my %gp = ();
 139   while (my $o = $op->get) {
 140     gen_opt $dom, $gencls, %gp, $o, $op
 141       or $op->unk;
 142   }
 143   my @a = $op->rest;
 144   my $n = 1;
 145   if (@a) {
 146     $n = shift @a;
 147     $n =~ /^\d+$/ or $op->err("invalid count `$n'");
 148   }
 149   @a and $op->bad;
 150   $op->ok or Odin::fail "usage: reserve [-GENOPTS] N";
 151   my $gen = $gencls->new($dom, \%gp);
 152   for my $l (Odin::reserve_redir $dom, $gen, $n) { print $l, "\n"; }
 153 } elsif ($op eq "release") {
 154   my $op = Odin::OptParse->new(@ARGV);
 155   my $all = 0;
 156   while (my $o = $op->get) {
 157     if ($o eq "a") { $all = 1; }
 158     else { $op->unk; }
 159   }
 160   my @a = $op->rest;
 161   !!$all == !@a or $op->bad;
 162   $op->ok or Odin::fail "usage: release {-a | LPART ...}";
 163   if ($all) { Odin::release_all_redir $dom; }
 164   else { Odin::release_redir $dom, @a; }
 165 } elsif ($op eq "disable") {
 166   @ARGV or Odin::fail "usage: disable LPART ...";
 167   Odin::disable_redir $dom, @ARGV;
 168 } elsif ($op eq "set") {
 169   my $op = Odin::OptParse->new(@ARGV);
 170   my %r = ();
 171   while (my $o = $op->get) {
 172     record_opt %r, $o, $op
 173       or $op->unk;
 174   }
 175   my @a = $op->rest;
 176   @a or $op->bad;
 177   $op->ok or Odin::fail "usage: set [-RECOPTS] LPART ...";
 178   Odin::modify_redir $dom, %r, @a;
 179 } else {
 180   Odin::fail "unknown operation `$op'";
 181 }