fyvzl

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