#!/usr/bin/perl -w
our $usage1 = <<'END';
-usage: ../fyvzl [-lLENGTH] [-mMAXPERUSER] [-dDOM] [-qQUALDOM] DATABASE-FILE ACTION ARG
+usage: ../fyvzl [OPTIONS DATABASE-FILE ACTION ARG
+options
+ -lLENGTH (for create)
+ -mMAXPERUSER
+ -dDOM
+ -qQUALDOM
+ -C (show comments in output)
+ -h (display help)
END
our $usage2 = <<'END';
actions
- create [REDIRECT-TO]
- update LOCAL-PART REDIRECT-TO
+ create [REDIRECT-TO] [#comment]
+ update LOCAL-PART [REDIRECT-TO] [#comment]
reject LOCAL-PART
show LOCAL-PART
list
list-actions
privileged actions
list-user USER
- insert-exact LOCAL-PART USER REDIRECT
+ insert-exact LOCAL-PART USER REDIRECT COMMENT
donate LOCAL-PART USER
enable-user|disable-user USER
END
our $dom;
our $user;
our $priv;
+our $showcomment;
sub nextarg () {
die "too few arguments\n" unless @ARGV;
my $pa = $row->{'localpart'};
$pa .= '@'.$dom if defined $dom;
if (defined $row->{'redirect'}) {
- print "$pa: $row->{'redirect'}\n";
+ print "$pa: $row->{'redirect'}" or die $!;
} else {
- print "# reject $pa\n";
+ print "# reject $pa" or die $!;
}
+ if ($showcomment || !$priv) {
+ print " #$row->{'comment'}" or die $!;
+ }
+ print "\n" or die $!;
}
sub goodrand ($) {
}
}
-sub qualify ($) {
- my ($t) = @_;
- return $t if $t =~ m/\@/;
- die "unqualified redirection target\n" unless defined $qualdom;
- return $t.'@'.$qualdom;
+sub qualify (\$) {
+ my ($ref) = @_;
+ if (defined $$ref && $$ref !~ m/\@/) {
+ die "unqualified redirection target\n" unless defined $qualdom;
+ $$ref .= '@'.$qualdom;
+ }
}
sub insertrow ($) {
my $stmt =
"INSERT INTO addrs (".
(join ",", sort keys %$row).
- ") VALUES (?, ?, ?) ";
+ ") VALUES (".
+ (join ",", map { "?" } sort keys %$row).
+ ") ";
$dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row);
}
+sub rhsargs ($) {
+ my ($row) = @_;
+ while (@ARGV) {
+ $_ = shift @ARGV;
+ my $f = (s/^\#// ? 'comment' : 'redirect');
+ die "$f supplied twice\n" if exists $row->{$f};
+ $row->{$f} = $_;
+ }
+ qualify $row->{'redirect'};
+ return $row;
+}
+
sub action_create {
- my $redirect;
- if (@ARGV) { $redirect = nextarg; nomoreargs; } else { $redirect = $user; }
- $redirect = qualify $redirect;
+ my $newrow = rhsargs({'redirect'=>$user, 'comment'=>''});
open R, "/dev/urandom" or die $!;
binmode R;
my $countq = $dbh->prepare("SELECT count(*) FROM addrs WHERE user=?");
last if !$row;
$dbh->abort();
}
- my $row = {'localpart'=>$s, 'user'=>$user, 'redirect'=>$redirect};
- insertrow($row);
+ $newrow->{'user'} = $user;
+ $newrow->{'localpart'} = $s;
+ insertrow($newrow);
$dbh->commit();
- prow($row);
+ prow($newrow);
+}
+
+sub selectrow ($) {
+ my ($localpart) = @_;
+ our $row_q ||= $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
+ $row_q->execute($localpart);
+ return $row_q->fetchrow_hashref();
}
sub begin_row ($) {
my ($localpart) = @_;
my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
- $q->execute($localpart);
- my $row = $q->fetchrow_hashref();
+ my $row = selectrow $localpart;
die "unknown localpart\n" unless defined $row;
die "not owned by you\n" unless $priv || $row->{user} eq $user;
return $row;
- }
+}
sub action_update {
my $localpart = nextarg;
- my $redirect = qualify nextarg;
+ my $updrow = rhsargs({});
nomoreargs;
begin_row($localpart);
- $dbh->do("UPDATE addrs SET redirect=? WHERE localpart=?",
- {}, $redirect, $localpart);
+ foreach my $f (qw(redirect comment)) {
+ my $v = $updrow->{$f};
+ next unless defined $v;
+ $dbh->do("UPDATE addrs SET $f=? WHERE localpart=?",
+ {}, $v, $localpart);
+ }
+ my $row = selectrow $localpart;
$dbh->commit;
+ prow($row);
}
sub action_reject {
last unless $ARGV[0] =~ m/^-/;
$_ = shift @ARGV;
last if m/^--?$/;
- if (m/^-l(\d+)$/) {
- $randlength = $1;
- } elsif (m/^-m(\d+)$/) {
- $maxperuser = $1;
- } elsif (m/^-d(\S+)$/) {
- $dom = $1;
- } elsif (m/^-q(\S+)$/) {
- $qualdom = $1;
- } elsif (m/^-h$/) {
- print $usage1.$usage2 or die $!;
- } else {
- die "unknown option \`$_'\n";
+ for (;;) {
+ last unless m/^-./;
+ if (s/^-l(\d+)$//) {
+ $randlength = $1;
+ } elsif (s/^-m(\d+)$//) {
+ $maxperuser = $1;
+ } elsif (s/^-d(\S+)$//) {
+ $dom = $1;
+ } elsif (s/^-q(\S+)$//) {
+ $qualdom = $1;
+ } elsif (s/^-C/-/) {
+ $showcomment = 1;
+ } elsif (s/^-h/-/) {
+ print $usage1.$usage2 or die $!;
+ exit 0;
+ } else {
+ die "unknown option \`$_'\n";
+ }
}
}