--- /dev/null
+#!/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
+
+use strict;
+
+use DBI;
+use POSIX;
+
+our $randlength = 6;
+our $maxperuser = 10000;
+our $defdom;
+our $dbh;
+our $user;
+our $priv;
+
+sub nextarg () {
+ die "too few arguments\n" unless @ARGV;
+ my $v = shift @ARGV;
+ die "option too late on command line\n" if $v =~ m/^-/;
+ return $v;
+}
+
+sub nomoreargs () {
+ die "too many arguments\n" if @ARGV;
+}
+
+sub isdisabled ($) {
+ my ($u) = @_;
+ our $dis_q;
+ $dis_q ||= $dbh->prepare("SELECT * FROM disabled_users WHERE user=?");
+ $dis_q->execute($u);
+ my $row = $dis_q->fetchrow_arrayref();
+ return !!$row;
+}
+
+sub prow ($) {
+ my ($row) = @_;
+ my $u = $row->{'user'};
+ our $last_u;
+ if (!defined $last_u or $last_u ne $u) {
+ print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n";
+ $last_u = $u;
+ }
+ if (defined $row->{'redirect'}) {
+ print "$row->{'localpart'}: $row->{'redirect'}\n";
+ } else {
+ print "# reject $row->{'localpart'}\n";
+ }
+}
+
+sub goodrand ($) {
+ my ($lim) = @_;
+ for (;;) {
+ my $ch;
+ read(R, $ch, 1) == 1 or die $!;
+ my $o = ord $ch;
+ my $v = $o % $lim;
+ next unless $o-$v+$lim < 256;
+# print STDERR "goodrand($lim)=$v\n";
+ return $v;
+ }
+}
+
+sub qualify ($) {
+ my ($t) = @_;
+ return $t if $t =~ m/\@/;
+ die "unqualified redirection target\n" unless defined $defdom;
+ return $t.'@'.$defdom;
+}
+
+sub insertrow ($) {
+ my ($row) = @_;
+ my $stmt =
+ "INSERT INTO addrs (".
+ (join ",", sort keys %$row).
+ ") VALUES (?, ?, ?) ";
+ $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row);
+}
+
+sub action_create {
+ my $redirect;
+ if (@ARGV) { $redirect = nextarg; nomoreargs; } else { $redirect = $user; }
+ $redirect = qualify $redirect;
+ open R, "/dev/urandom" or die $!;
+ binmode R;
+ my $q = $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?");
+ my $s;
+ for (;;) {
+ $s = chr(ord('a')+goodrand(26));
+ while (length $s < $randlength) {
+ my $v = goodrand(36);
+ $s .= chr($v < 26
+ ? ord('a')+($v)
+ : ord('0')+($v-26));
+ }
+# print STDERR "$s\n";
+ $q->execute($s);
+ my $row = $q->fetchrow_arrayref();
+ last if !$row;
+ $dbh->abort();
+ }
+ my $row = {'localpart'=>$s, 'user'=>$user, 'redirect'=>$redirect};
+ insertrow($row);
+ $dbh->commit();
+ prow($row);
+}
+
+sub begin_row ($) {
+ my ($localpart) = @_;
+ my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
+ $q->execute($localpart);
+ my $row = $q->fetchrow_hashref();
+ 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;
+ nomoreargs;
+ begin_row($localpart);
+ $dbh->do("UPDATE addrs SET redirect=? WHERE localpart=?",
+ {}, $redirect, $localpart);
+ $dbh->commit;
+}
+
+sub action_reject {
+ my $localpart = nextarg;
+ nomoreargs;
+ begin_row($localpart);
+ $dbh->do("UPDATE addrs SET redirect=NULL WHERE localpart=?",
+ {}, $localpart);
+ $dbh->commit;
+}
+
+sub action_show {
+ my $localpart = nextarg;
+ nomoreargs;
+ my $row = begin_row($localpart);
+ prow($row);
+}
+
+sub action_list {
+ nomoreargs;
+ my $q = $dbh->prepare("SELECT * FROM addrs WHERE user=?".
+ " ORDER BY localpart");
+ $q->execute($user);
+ while (my $row = $q->fetchrow_hashref()) {
+ prow($row);
+ }
+}
+
+sub action_list_user {
+ die unless $priv;
+ $user = nextarg;
+ nomoreargs;
+ action_list;
+}
+
+sub action_insert_exact {
+ die unless $priv;
+ my $localpart = nextarg;
+ $user = nextarg;
+ my $redirect = nextarg;
+ nomoreargs;
+ my $row = {'localpart'=>$localpart, 'user'=>$user, 'redirect'=>$redirect};
+ insertrow($row);
+ $dbh->commit;
+}
+
+sub action_donate {
+ die unless $priv;
+ my $localpart = nextarg;
+ my $newuser = nextarg;
+ nomoreargs;
+ begin_row($localpart);
+ $dbh->do('UPDATE addrs SET user=? WHERE localpart=?',
+ {}, $newuser, $localpart);
+ $dbh->commit;
+}
+
+sub action_enable_user {
+ die unless $priv;
+ $user = nextarg;
+ nomoreargs;
+ $dbh->do('DELETE FROM disabled_users WHERE user=?',{},$user);
+ $dbh->commit;
+}
+
+sub action_disable_user {
+ die unless $priv;
+ $user = nextarg;
+ nomoreargs;
+ $dbh->do('INSERT INTO disabled_users VALUES user (?)',{},$user);
+ $dbh->commit;
+}
+
+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";
+ }
+}
+
+my $dbfile = nextarg();
+
+if (defined $ENV{'USERV_USER'}) {
+ $priv=0;
+ $user = $ENV{'USERV_USER'};
+} else {
+ $priv=1;
+ $user = ((getpwuid $<)[0]) or die;
+}
+
+$dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",
+ { PrintError => 0, AutoCommit => 0, RaiseError => 1 })
+ or die "$dbfile $!";
+
+my $action = nextarg();
+$action =~ y/-/_/;
+{ no strict qw(refs); &{"action_$action"}(); }
~ijackson / d.git / commitdiff