mason/common/autohandler: Add an AGPL link to the HTML header.

[odin-cgi] / bin / mailredir.userv

#! /usr/bin/perl
###
### Mail redirection userv interface for Odin
###
### (c) 2015 Mark Wooding
###

###----- Licensing notice ---------------------------------------------------
###
### This file is part of the `odin.gg' service, `odin-cgi'.
###
### `odin-cgi' is free software; you can redistribute it and/or modify
### it under the terms of the GNU Affero General Public License as
### published by the Free Software Foundation; either version 3 of the
### License, or (at your option) any later version.
###
### `odin-cgi' is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU Affero General Public License for more details.
###
### You should have received a copy of the GNU Affero General Public
### License along with `odin-cgi'; if not, see
### <http://www.gnu.org/licenses/>.

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
	giveaway LPART OWNER
	help
	list
	new [-n COUNT] [-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 "giveaway") {
  @ARGV >= 2 or Odin::fail "usage: giveaway OWNER LPART ...";
  my $owner = shift @ARGV;
  my @l = @ARGV;
  getpwnam $owner or Odin::fail "unknown user `$owner'";
  my %r = (owner => $owner);
  Odin::modify_redir $dom, %r, @l;
} 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 = ();
  my $n = 1;
  while (my $o = $op->get) {
    if ($o eq "n") { $n = $op->intarg(undef, 0) }
    else {
      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 [-n COUNT] [-GENOPTS] [-RECOPTS] [RECIP]";
  my $gen = $gencls->new($dom, \%gp);
  my @l = Odin::new_redir $dom, $gen, %r, $n;
  print map { $_ . "\n" } @l;
} 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;
  @a or $op->bad;
  $op->ok or Odin::fail "usage: set [-RECOPTS] LPART ...";
  Odin::modify_redir $dom, %r, @a;
} else {
  Odin::fail "unknown operation `$op'";
}