#! /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
### .
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 <= ?)", $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'";
}