#!/usr/bin/perl -w
-#
-# usage: ../fyvzl [-lLENGTH] [-mMAXPERUSER] [-dDEFDOM] DATABASE-FILE ACTION ARG
-# actions
-# create [REDIRECT-TO]
-# update LOCAL-PART REDIRECT-TO
-# reject LOCAL-PART
-# show LOCAL-PART
-# list
-# privileged actions
-# list-user USER
-# insert-exact LOCAL-PART USER REDIRECT
-# donate LOCAL-PART USER
-# enable-user|disable-user USER
+our $usage1 = <<'END';
+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] [#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 COMMENT
+ donate LOCAL-PART USER
+ enable-user|disable-user USER
+END
use strict;
our $randlength = 6;
our $maxperuser = 10000;
-our $defdom;
+our $qualdom;
our $dbh;
+our $dom;
our $user;
our $priv;
+our $showcomment;
sub nextarg () {
die "too few arguments\n" unless @ARGV;
print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n";
$last_u = $u;
}
+ my $pa = $row->{'localpart'};
+ $pa .= '@'.$dom if defined $dom;
if (defined $row->{'redirect'}) {
- print "$row->{'localpart'}: $row->{'redirect'}\n";
+ print "$pa: $row->{'redirect'}" or die $!;
} else {
- print "# reject $row->{'localpart'}\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 $defdom;
- return $t.'@'.$defdom;
+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=?");
+ $countq->execute($user);
+ my ($count) = $countq->fetchrow_array();
+ die unless defined $count;
+ die "too many aliases for this user\n" if $count >= $maxperuser;
my $q = $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?");
my $s;
for (;;) {
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 {
$dbh->commit;
}
+sub action_list_actions {
+ print $usage2 or die $!;
+}
+
while (@ARGV) {
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+)$/) {
- $defdom = $1;
- } 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";
+ }
}
}
$user = ((getpwuid $<)[0]) or die;
}
+$usage2 .= "LOCAL-PART is implicitly qualified with \@$dom\n"
+ if defined $qualdom;
+$usage2 .= "REDIRECT is implicitly qualified with \@$qualdom if it has no \@\n"
+ if defined $qualdom;
+
$dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",
{ PrintError => 0, AutoCommit => 0, RaiseError => 1 })
or die "$dbfile $!";
~ijackson / d.git / blobdiff