New things for a mail redirection service, with randomized local parts.

[odin-cgi] / bin / mailredir.userv

diff --git a/bin/mailredir.userv b/bin/mailredir.userv
new file mode 100755 (executable)
index 0000000..ab8b54d
--- /dev/null
+++ b/bin/mailredir.userv
@@ -0,0 +1,169 @@
+#! /usr/bin/perl
+
+use lib 'lib';
+
+use Odin;
+
+use DBI;
+use Encode;
+use Encode::Locale;
+use Getopt::Long;
+use POSIX;
+
+###--------------------------------------------------------------------------
+### Main program.
+
+my $dom = $Odin::MAIL_DEFDOMAIN;
+Odin::cmdline_who;
+
+sub record_opt (\%$$) {
+  my ($r, $o, $op) = @_;
+
+  if ($o eq "c") { $r->{comment} = $op->arg; }
+  elsif ($o eq "x") { $r->{expire} = Odin::parse_time $op->arg; }
+  elsif ($o eq "r") { $r->{recip} = $op->arg; }
+  else { return undef; }
+  return 1;
+}
+
+sub gen_opt ($\$\%$$) {
+  my ($dom, $g, $gp, $o, $op) = @_;
+
+  if ($o eq "g") {
+    my $a = $op->arg; next OPT unless defined $a;
+    $$g = Odin::get_generator_class $dom, $a;
+  } elsif ($o eq "p") {
+    defined (my $p = $op->arg) or next OPT;
+    if ($p =~ /^([-\w]+)=(.*)$/) { $gp->{$1} = $2; }
+    else { $op->err("invalid parameter `$p'"); }
+  } else {
+    return undef;
+  }
+  return 1;
+}
+
+my $op = Odin::OptParse->new(@ARGV);
+OPT: while (my $o = $op->get) {
+  if ($o eq "d") {
+    $dom = $op->arg or next OPT;
+    exists $Odin::MAILDOM_POLICY{$dom} or $op->err("unknown domain `$dom'");
+  } else {
+    $op->unk;
+  }
+}
+unless ($op->ok) {
+  print STDERR "usage: $Odin::PROG [-d DOMAIN] COMMAND [ARGUMENT ...]\n";
+  exit 1;
+}
+@ARGV = $op->rest;
+
+my $op = shift(@ARGV) // "help";
+if ($op eq "help") {
+  print <<EOF;
+Usage: $Odin::PROG [-d DOMAIN] COMMAND [ARGUMENTS ...]
+
+Commands available:
+
+       disable LPART ...
+       dormant
+       help
+       list
+       new [-GENOPTS] [-RECOPTS] RECIP
+       release LPART ...
+       reserve [-GENOPTS] N
+       reserved
+       set [-RECOPTS] LPART
+
+GENOPTS ::= [-g GENERATOR] [-p PARAM=VALUE]
+RECOPTS ::= [-c COMMENT] [-r RECIP] [-x EXPIRES]
+EOF
+} elsif ($op eq "list") {
+  @ARGV and Odin::fail "usage: list";
+  for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
+              "st = 'live' AND (expire = -1 OR expire >= ?)", $Odin::NOW) {
+    my ($lpart, $expire, $recip, $comment) = @$r;
+    Odin::print_columns
+      Odin::fmt_time $expire => 25,
+      $lpart => 24, $recip => 32, $comment => 0;
+  }
+} elsif ($op eq "dormant") {
+  @ARGV and Odin::fail "usage: list";
+  for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
+              "(st = 'dormant' OR
+                (st = 'live' AND expire <> -1 AND expire < ?))",
+            $Odin::NOW) {
+    my ($lpart, $expire, $recip, $comment) = @$r;
+    Odin::print_columns $lpart => 24, $recip => 32, $comment => 0;
+  }
+} elsif ($op eq "reserved") {
+  @ARGV and Odin::fail "usage: reserved";
+  for my $r (Odin::redir_query Odin::open_db, $dom, $Odin::WHO,
+              "st = 'reserved' AND expire >= ?", $Odin::NOW) {
+    my ($lpart, $expire, $recip, $comment) = @$r;
+    Odin::print_columns Odin::fmt_time $expire => 25, $lpart => 0;
+  }
+} elsif ($op eq "new") {
+  my $op = Odin::OptParse->new(@ARGV);
+  my $gencls = Odin::default_generator_class $dom;
+  my %gp = ();
+  my %r = ();
+  while (my $o = $op->get) {
+    gen_opt $dom, $gencls, %gp, $o, $op
+      or record_opt %r, $o, $op
+      or $op->unk;
+  }
+  my @a = $op->rest;
+  if (@a) { $r{recip} = shift @a; }
+  !@a or $op->bad;
+  $op->ok or Odin::fail "usage: new [-GENOPTS] [-RECOPTS] RECIP";
+  my $gen = $gencls->new($dom, \%gp);
+  my $l = Odin::new_redir $dom, $gen, %r;
+  print $l, "\n";
+} elsif ($op eq "reserve") {
+  my $op = Odin::OptParse->new(@ARGV);
+  my $gencls = Odin::default_generator_class $dom;
+  my %gp = ();
+  while (my $o = $op->get) {
+    gen_opt $dom, $gencls, %gp, $o, $op
+      or $op->unk;
+  }
+  my @a = $op->rest;
+  my $n = 1;
+  if (@a) {
+    $n = shift @a;
+    $n =~ /^\d+$/ or $op->err("invalid count `$n'");
+  }
+  @a and $op->bad;
+  $op->ok or Odin::fail "usage: reserve [-GENOPTS] N";
+  my $gen = $gencls->new($dom, \%gp);
+  for my $l (Odin::reserve_redir $dom, $gen, $n) { print $l, "\n"; }
+} elsif ($op eq "release") {
+  my $op = Odin::OptParse->new(@ARGV);
+  my $all = 0;
+  while (my $o = $op->get) {
+    if ($o eq "a") { $all = 1; }
+    else { $op->unk; }
+  }
+  my @a = $op->rest;
+  !!$all == !@a or $op->bad;
+  $op->ok or Odin::fail "usage: release {-a | LPART ...}";
+  if ($all) { Odin::release_all_redir $dom; }
+  else { Odin::release_redir $dom, @a; }
+} elsif ($op eq "disable") {
+  @ARGV or Odin::fail "usage: disable LPART ...";
+  Odin::disable_redir $dom, @ARGV;
+} elsif ($op eq "set") {
+  my $op = Odin::OptParse->new(@ARGV);
+  my %r = ();
+  while (my $o = $op->get) {
+    record_opt %r, $o, $op
+      or $op->unk;
+  }
+  my @a = $op->rest;
+  my $l = shift @a or $op->bad;
+  @a and $op->bad;
+  $op->ok or Odin::fail "usage: set [-RECOPTS] LPART";
+  Odin::modify_redir $dom, $l, %r;
+} else {
+  Odin::fail "unknown operation `$op'";
+}