3 ### Mail redirection userv interface for Odin
5 ### (c) 2015 Mark Wooding
8 ###----- Licensing notice ---------------------------------------------------
10 ### This file is part of the `odin.gg' service, `odin-cgi'.
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.
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.
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/>.
36 ###--------------------------------------------------------------------------
39 my $dom = $Odin::MAIL_DEFDOMAIN
;
42 sub record_opt
(\
%$$) {
43 my ($r, $o, $op) = @_;
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; }
52 sub gen_opt
($\
$\
%$$) {
53 my ($dom, $g, $gp, $o, $op) = @_;
56 my $a = $op->arg; next OPT
unless defined $a;
57 $$g = Odin
::get_generator_class
$dom, $a;
59 defined (my $p = $op->arg) or next OPT
;
60 if ($p =~ /^([-\w]+)=(.*)$/) { $gp->{$1} = $2; }
61 else { $op->err("invalid parameter `$p'"); }
68 my $op = Odin
::OptParse
->new(@ARGV);
69 OPT
: while (my $o = $op->get) {
71 $dom = $op->arg or next OPT
;
72 exists $Odin::MAILDOM_POLICY
{$dom} or $op->err("unknown domain `$dom'");
78 print STDERR
"usage: $Odin::PROG [-d DOMAIN] COMMAND [ARGUMENT ...]\n";
83 my $op = shift(@ARGV) // "help";
86 Usage: $Odin::PROG [-d DOMAIN] COMMAND [ARGUMENTS ...]
95 new [-n COUNT] [-GENOPTS] [-RECOPTS] [RECIP]
99 set [-RECOPTS] LPART ...
101 GENOPTS ::= [-g GENERATOR] [-p PARAM=VALUE]
102 RECOPTS ::= [-c COMMENT] [-r RECIP] [-x EXPIRES]
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;
110 Odin
::fmt_time
$expire => 25,
111 $lpart => 24, $recip => 32, $comment => 0;
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
,
117 (st = 'live' AND expire <> -1 AND expire < ?))",
119 my ($lpart, $expire, $recip, $comment) = @
$r;
120 Odin
::print_columns
$lpart => 24, $recip => 32, $comment => 0;
122 } elsif ($op eq "giveaway") {
123 @ARGV >= 2 or Odin
::fail
"usage: giveaway OWNER LPART ...";
124 my $owner = shift @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;
136 } elsif ($op eq "new") {
137 my $op = Odin
::OptParse
->new(@ARGV);
138 my $gencls = Odin
::default_generator_class
$dom;
142 while (my $o = $op->get) {
143 if ($o eq "n") { $n = $op->intarg(undef, 0) }
145 gen_opt
$dom, $gencls, %gp, $o, $op
146 or record_opt
%r, $o, $op
151 if (@a) { $r{recip
} = shift @a; }
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;
162 while (my $o = $op->get) {
163 gen_opt
$dom, $gencls, %gp, $o, $op
170 $n =~ /^\d+$/ or $op->err("invalid count `$n'");
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);
179 while (my $o = $op->get) {
180 if ($o eq "a") { $all = 1; }
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);
194 while (my $o = $op->get) {
195 record_opt
%r, $o, $op
200 $op->ok or Odin
::fail
"usage: set [-RECOPTS] LPART ...";
201 Odin
::modify_redir
$dom, %r, @a;
203 Odin
::fail
"unknown operation `$op'";