fyvzl

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