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

   1 #! /usr/bin/perl
   2 ###
   3 ### Mail redirection userv interface for Odin
   4 ###
   5 ### (c) 2015 Mark Wooding
   6 ###
   7
   8 ###----- Licensing notice ---------------------------------------------------
   9 ###
  10 ### This file is part of the `odin.gg' service, `odin-cgi'.
  11 ###
  12 ### `odin-cgi' is free software; you can redistribute it and/or modify
  13 ### it under the terms of the GNU Affero General Public License as
  14 ### published by the Free Software Foundation; either version 3 of the
  15 ### License, or (at your option) any later version.
  16 ###
  17 ### `odin-cgi' is distributed in the hope that it will be useful,
  18 ### but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ### GNU Affero General Public License for more details.
  21 ###
  22 ### You should have received a copy of the GNU Affero General Public
  23 ### License along with `odin-cgi'; if not, see
  24 ### <http://www.gnu.org/licenses/>.
  25
  26 use lib 'lib';
  27
  28 use Odin;
  29
  30 use DBI;
  31 use Encode;
  32 use Encode::Locale;
  33 use Getopt::Long;
  34 use POSIX;
  35
  36 ###--------------------------------------------------------------------------
  37 ### Main program.
  38
  39 my $dom = $Odin::MAIL_DEFDOMAIN;
  40 Odin::cmdline_who;
  41
  42 sub record_opt (\%$$) {
  43   my ($r, $o, $op) = @_;
  44
  45   if ($o eq "c") { $r->{comment} = $op->arg; }
  46   elsif ($o eq "x") { $r->{expire} = Odin::parse_time $op->arg; }
  47   elsif ($o eq "r") { $r->{recip} = $op->arg; }
  48   else { return undef; }
  49   return 1;
  50 }
  51
  52 sub gen_opt ($\$\%$$) {
  53   my ($dom, $g, $gp, $o, $op) = @_;
  54
  55   if ($o eq "g") {
  56     my $a = $op->arg; next OPT unless defined $a;
  57     $$g = Odin::get_generator_class $dom, $a;
  58   } elsif ($o eq "p") {
  59     defined (my $p = $op->arg) or next OPT;
  60     if ($p =~ /^([-\w]+)=(.*)$/) { $gp->{$1} = $2; }
  61     else { $op->err("invalid parameter `$p'"); }
  62   } else {
  63     return undef;
  64   }
  65   return 1;
  66 }
  67
  68 my $op = Odin::OptParse->new(@ARGV);
  69 OPT: while (my $o = $op->get) {
  70   if ($o eq "d") {
  71     $dom = $op->arg or next OPT;
  72     exists $Odin::MAILDOM_POLICY{$dom} or $op->err("unknown domain `$dom'");
  73   } else {
  74     $op->unk;
  75   }
  76 }
  77 unless ($op->ok) {
  78   print STDERR "usage: $Odin::PROG [-d DOMAIN] COMMAND [ARGUMENT ...]\n";
  79   exit 1;
  80 }
  81 @ARGV = $op->rest;
  82
  83 my $op = shift(@ARGV) // "help";
  84 if ($op eq "help") {
  85   print <<EOF;
  86 Usage: $Odin::PROG [-d DOMAIN] COMMAND [ARGUMENTS ...]
  87
  88 Commands available:
  89
  90         disable LPART ...
  91         dormant
  92         giveaway LPART OWNER
  93         help
  94         list
  95         new [-n COUNT] [-GENOPTS] [-RECOPTS] [RECIP]
  96         release LPART ...
  97         reserve [-GENOPTS] N
  98         reserved
  99         set [-RECOPTS] LPART ...
 100
 101 GENOPTS ::= [-g GENERATOR] [-p PARAM=VALUE]
 102 RECOPTS ::= [-c COMMENT] [-r RECIP] [-x EXPIRES]
 103 EOF
 104 } elsif ($op eq "list") {
 105   @ARGV and Odin::fail "usage: list";
 106   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
 107                "st = 'live' AND (expire = -1 OR expire >= ?)", $Odin::NOW) {
 108     my ($lpart, $expire, $recip, $comment) = @$r;
 109     Odin::print_columns
 110       Odin::fmt_time $expire => 25,
 111       $lpart => 24, $recip => 32, $comment => 0;
 112   }
 113 } elsif ($op eq "dormant") {
 114   @ARGV and Odin::fail "usage: list";
 115   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
 116                "(st = 'dormant' OR
 117                  (st = 'live' AND expire <> -1 AND expire < ?))",
 118              $Odin::NOW) {
 119     my ($lpart, $expire, $recip, $comment) = @$r;
 120     Odin::print_columns $lpart => 24, $recip => 32, $comment => 0;
 121   }
 122 } elsif ($op eq "giveaway") {
 123   @ARGV >= 2 or Odin::fail "usage: giveaway OWNER LPART ...";
 124   my $owner = shift @ARGV;
 125   my @l = @ARGV;
 126   getpwnam $owner or Odin::fail "unknown user `$owner'";
 127   my %r = (owner => $owner);
 128   Odin::modify_redir $dom, %r, @l;
 129 } elsif ($op eq "reserved") {
 130   @ARGV and Odin::fail "usage: reserved";
 131   for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
 132                "st = 'reserved' AND expire >= ?", $Odin::NOW) {
 133     my ($lpart, $expire, $recip, $comment) = @$r;
 134     Odin::print_columns Odin::fmt_time $expire => 25, $lpart => 0;
 135   }
 136 } elsif ($op eq "new") {
 137   my $op = Odin::OptParse->new(@ARGV);
 138   my $gencls = Odin::default_generator_class $dom;
 139   my %gp = ();
 140   my %r = ();
 141   my $n = 1;
 142   while (my $o = $op->get) {
 143     if ($o eq "n") { $n = $op->intarg(undef, 0) }
 144     else {
 145       gen_opt $dom, $gencls, %gp, $o, $op
 146         or record_opt %r, $o, $op
 147         or $op->unk;
 148     }
 149   }
 150   my @a = $op->rest;
 151   if (@a) { $r{recip} = shift @a; }
 152   !@a or $op->bad;
 153   $op->ok or
 154     Odin::fail "usage: new [-n COUNT] [-GENOPTS] [-RECOPTS] [RECIP]";
 155   my $gen = $gencls->new($dom, \%gp);
 156   my @l = Odin::new_redir $dom, $gen, %r, $n;
 157   print map { $_ . "\n" } @l;
 158 } elsif ($op eq "reserve") {
 159   my $op = Odin::OptParse->new(@ARGV);
 160   my $gencls = Odin::default_generator_class $dom;
 161   my %gp = ();
 162   while (my $o = $op->get) {
 163     gen_opt $dom, $gencls, %gp, $o, $op
 164       or $op->unk;
 165   }
 166   my @a = $op->rest;
 167   my $n = 1;
 168   if (@a) {
 169     $n = shift @a;
 170     $n =~ /^\d+$/ or $op->err("invalid count `$n'");
 171   }
 172   @a and $op->bad;
 173   $op->ok or Odin::fail "usage: reserve [-GENOPTS] N";
 174   my $gen = $gencls->new($dom, \%gp);
 175   for my $l (Odin::reserve_redir $dom, $gen, $n) { print $l, "\n"; }
 176 } elsif ($op eq "release") {
 177   my $op = Odin::OptParse->new(@ARGV);
 178   my $all = 0;
 179   while (my $o = $op->get) {
 180     if ($o eq "a") { $all = 1; }
 181     else { $op->unk; }
 182   }
 183   my @a = $op->rest;
 184   !!$all == !@a or $op->bad;
 185   $op->ok or Odin::fail "usage: release {-a | LPART ...}";
 186   if ($all) { Odin::release_all_redir $dom; }
 187   else { Odin::release_redir $dom, @a; }
 188 } elsif ($op eq "disable") {
 189   @ARGV or Odin::fail "usage: disable LPART ...";
 190   Odin::disable_redir $dom, @ARGV;
 191 } elsif ($op eq "set") {
 192   my $op = Odin::OptParse->new(@ARGV);
 193   my %r = ();
 194   while (my $o = $op->get) {
 195     record_opt %r, $o, $op
 196       or $op->unk;
 197   }
 198   my @a = $op->rest;
 199   @a or $op->bad;
 200   $op->ok or Odin::fail "usage: set [-RECOPTS] LPART ...";
 201   Odin::modify_redir $dom, %r, @a;
 202 } else {
 203   Odin::fail "unknown operation `$op'";
 204 }