fyvzl

   1 #!/usr/bin/perl -w
   2 #
   3 # usage: ../fyvzl [-lLENGTH] [-mMAXPERUSER] [-qQUALDOM] DATABASE-FILE ACTION ARG
   4 # actions
   5 #   create [REDIRECT-TO]
   6 #   update LOCAL-PART REDIRECT-TO
   7 #   reject LOCAL-PART
   8 #   show LOCAL-PART
   9 #   list
  10 # privileged actions
  11 #   list-user USER
  12 #   insert-exact LOCAL-PART USER REDIRECT
  13 #   donate LOCAL-PART USER
  14 #   enable-user|disable-user USER
  15
  16 use strict;
  17
  18 use DBI;
  19 use POSIX;
  20
  21 our $randlength = 6;
  22 our $maxperuser = 10000;
  23 our $qualdom;
  24 our $dbh;
  25 our $user;
  26 our $priv;
  27
  28 sub nextarg () {
  29     die "too few arguments\n" unless @ARGV;
  30     my $v = shift @ARGV;
  31     die "option too late on command line\n" if $v =~ m/^-/;
  32     return $v;
  33 }
  34
  35 sub nomoreargs () {
  36     die "too many arguments\n" if @ARGV;
  37 }
  38
  39 sub isdisabled ($) {
  40     my ($u) = @_;
  41     our $dis_q;
  42     $dis_q ||= $dbh->prepare("SELECT * FROM disabled_users WHERE user=?");
  43     $dis_q->execute($u);
  44     my $row = $dis_q->fetchrow_arrayref();
  45     return !!$row;
  46 }
  47
  48 sub prow ($) {
  49     my ($row) = @_;
  50     my $u = $row->{'user'};
  51     our $last_u;
  52     if (!defined $last_u or $last_u ne $u) {
  53         print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n";
  54         $last_u = $u;
  55     }
  56     if (defined $row->{'redirect'}) {
  57         print "$row->{'localpart'}: $row->{'redirect'}\n";
  58     } else {
  59         print "# reject $row->{'localpart'}\n";
  60     }
  61 }
  62
  63 sub goodrand ($) {
  64     my ($lim) = @_;
  65     for (;;) {
  66         my $ch;
  67         read(R, $ch, 1) == 1 or die $!;
  68         my $o = ord $ch;
  69         my $v = $o % $lim;
  70         next unless $o-$v+$lim < 256;
  71 #       print STDERR "goodrand($lim)=$v\n";
  72         return $v;
  73     }
  74 }
  75
  76 sub qualify ($) {
  77     my ($t) = @_;
  78     return $t if $t =~ m/\@/;
  79     die "unqualified redirection target\n" unless defined $qualdom;
  80     return $t.'@'.$qualdom;
  81 }
  82
  83 sub insertrow ($) {
  84     my ($row) = @_;
  85     my $stmt =
  86         "INSERT INTO addrs (".
  87         (join ",", sort keys %$row).
  88         ") VALUES (?, ?, ?) ";
  89     $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row);
  90 }
  91
  92 sub action_create {
  93     my $redirect;
  94     if (@ARGV) { $redirect = nextarg; nomoreargs; } else { $redirect = $user; }
  95     $redirect = qualify $redirect;
  96     open R, "/dev/urandom" or die $!;
  97     binmode R;
  98     my $q = $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?");
  99     my $s;
 100     for (;;) {
 101         $s = chr(ord('a')+goodrand(26));
 102         while (length $s < $randlength) {
 103             my $v = goodrand(36);
 104             $s .= chr($v < 26
 105                       ? ord('a')+($v)
 106                       : ord('0')+($v-26));
 107         }
 108 #       print STDERR "$s\n";
 109         $q->execute($s);
 110         my $row = $q->fetchrow_arrayref();
 111         last if !$row;
 112         $dbh->abort();
 113     }
 114     my $row = {'localpart'=>$s, 'user'=>$user, 'redirect'=>$redirect};
 115     insertrow($row);
 116     $dbh->commit();
 117     prow($row);
 118 }
 119
 120 sub begin_row ($) {
 121     my ($localpart) = @_;
 122     my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
 123     $q->execute($localpart);
 124     my $row = $q->fetchrow_hashref();
 125     die "unknown localpart\n" unless defined $row;
 126     die "not owned by you\n" unless $priv || $row->{user} eq $user;
 127     return $row;
 128                  }
 129
 130 sub action_update {
 131     my $localpart = nextarg;
 132     my $redirect = qualify nextarg;
 133     nomoreargs;
 134     begin_row($localpart);
 135     $dbh->do("UPDATE addrs SET redirect=? WHERE localpart=?",
 136              {}, $redirect, $localpart);
 137     $dbh->commit;
 138 }
 139
 140 sub action_reject {
 141     my $localpart = nextarg;
 142     nomoreargs;
 143     begin_row($localpart);
 144     $dbh->do("UPDATE addrs SET redirect=NULL WHERE localpart=?",
 145              {}, $localpart);
 146     $dbh->commit;
 147 }
 148
 149 sub action_show {
 150     my $localpart = nextarg;
 151     nomoreargs;
 152     my $row = begin_row($localpart);
 153     prow($row);
 154 }
 155
 156 sub action_list {
 157     nomoreargs;
 158     my $q = $dbh->prepare("SELECT * FROM addrs WHERE user=?".
 159                           " ORDER BY localpart");
 160     $q->execute($user);
 161     while (my $row = $q->fetchrow_hashref()) {
 162         prow($row);
 163     }
 164 }
 165
 166 sub action_list_user {
 167     die unless $priv;
 168     $user = nextarg;
 169     nomoreargs;
 170     action_list;
 171 }
 172
 173 sub action_insert_exact {
 174     die unless $priv;
 175     my $localpart = nextarg;
 176     $user = nextarg;
 177     my $redirect = nextarg;
 178     nomoreargs;
 179     my $row = {'localpart'=>$localpart, 'user'=>$user, 'redirect'=>$redirect};
 180     insertrow($row);
 181     $dbh->commit;
 182 }
 183
 184 sub action_donate {
 185     die unless $priv;
 186     my $localpart = nextarg;
 187     my $newuser = nextarg;
 188     nomoreargs;
 189     begin_row($localpart);
 190     $dbh->do('UPDATE addrs SET user=? WHERE localpart=?',
 191              {}, $newuser, $localpart);
 192     $dbh->commit;
 193 }
 194
 195 sub action_enable_user {
 196     die unless $priv;
 197     $user = nextarg;
 198     nomoreargs;
 199     $dbh->do('DELETE FROM disabled_users WHERE user=?',{},$user);
 200     $dbh->commit;
 201 }
 202
 203 sub action_disable_user {
 204     die unless $priv;
 205     $user = nextarg;
 206     nomoreargs;
 207     $dbh->do('INSERT INTO disabled_users VALUES user (?)',{},$user);
 208     $dbh->commit;
 209 }
 210
 211 while (@ARGV) {
 212     last unless $ARGV[0] =~ m/^-/;
 213     $_ = shift @ARGV;
 214     last if m/^--?$/;
 215     if (m/^-l(\d+)$/) {
 216         $randlength = $1;
 217     } elsif (m/^-m(\d+)$/) {
 218         $maxperuser = $1;
 219     } elsif (m/^-q(\S+)$/) {
 220         $qualdom = $1;
 221     } else {
 222         die "unknown option \`$_'\n";
 223     }
 224 }
 225
 226 my $dbfile = nextarg();
 227
 228 if (defined $ENV{'USERV_USER'}) {
 229     $priv=0;
 230     $user = $ENV{'USERV_USER'};
 231 } else {
 232     $priv=1;
 233     $user = ((getpwuid $<)[0]) or die;
 234 }
 235
 236 $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",
 237                     { PrintError => 0, AutoCommit => 0, RaiseError => 1 })
 238     or die "$dbfile $!";
 239
 240 my $action = nextarg();
 241 $action =~ y/-/_/;
 242 { no strict qw(refs); &{"action_$action"}(); }