3 # usage: ../fyvzl [-lLENGTH] [-mMAXPERUSER] [-dDOM] [-qQUALDOM] DATABASE-FILE ACTION ARG
6 # update LOCAL-PART REDIRECT-TO
12 # insert-exact LOCAL-PART USER REDIRECT
13 # donate LOCAL-PART USER
14 # enable-user|disable-user USER
22 our $maxperuser = 10000;
30 die "too few arguments\n" unless @ARGV;
32 die "option too late on command line\n" if $v =~ m/^-/;
37 die "too many arguments\n" if @ARGV;
43 $dis_q ||= $dbh->prepare("SELECT * FROM disabled_users WHERE user=?");
45 my $row = $dis_q->fetchrow_arrayref();
51 my $u = $row->{'user'};
53 if (!defined $last_u or $last_u ne $u) {
54 print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n";
57 my $pa = $row->{'localpart'};
58 $pa .= '@'.$dom if defined $dom;
59 if (defined $row->{'redirect'}) {
60 print "$pa: $row->{'redirect'}\n";
62 print "# reject $pa\n";
70 read(R, $ch, 1) == 1 or die $!;
73 next unless $o-$v+$lim < 256;
74 # print STDERR "goodrand($lim)=$v\n";
81 return $t if $t =~ m/\@/;
82 die "unqualified redirection target\n" unless defined $qualdom;
83 return $t.'@'.$qualdom;
89 "INSERT INTO addrs (".
90 (join ",", sort keys %$row).
91 ") VALUES (?, ?, ?) ";
92 $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row);
97 if (@ARGV) { $redirect = nextarg; nomoreargs; } else { $redirect = $user; }
98 $redirect = qualify $redirect;
99 open R, "/dev/urandom" or die $!;
101 my $q = $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?");
104 $s = chr(ord('a')+goodrand(26));
105 while (length $s < $randlength) {
106 my $v = goodrand(36);
111 # print STDERR "$s\n";
113 my $row = $q->fetchrow_arrayref();
117 my $row = {'localpart'=>$s, 'user'=>$user, 'redirect'=>$redirect};
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;
134 my $localpart = nextarg;
135 my $redirect = qualify nextarg;
137 begin_row($localpart);
138 $dbh->do("UPDATE addrs SET redirect=? WHERE localpart=?",
139 {}, $redirect, $localpart);
144 my $localpart = nextarg;
146 begin_row($localpart);
147 $dbh->do("UPDATE addrs SET redirect=NULL WHERE localpart=?",
153 my $localpart = nextarg;
155 my $row = begin_row($localpart);
161 my $q = $dbh->prepare("SELECT * FROM addrs WHERE user=?".
162 " ORDER BY localpart");
164 while (my $row = $q->fetchrow_hashref()) {
169 sub action_list_user {
176 sub action_insert_exact {
178 my $localpart = nextarg;
180 my $redirect = nextarg;
182 my $row = {'localpart'=>$localpart, 'user'=>$user, 'redirect'=>$redirect};
189 my $localpart = nextarg;
190 my $newuser = nextarg;
192 begin_row($localpart);
193 $dbh->do('UPDATE addrs SET user=? WHERE localpart=?',
194 {}, $newuser, $localpart);
198 sub action_enable_user {
202 $dbh->do('DELETE FROM disabled_users WHERE user=?',{},$user);
206 sub action_disable_user {
210 $dbh->do('INSERT INTO disabled_users VALUES user (?)',{},$user);
215 last unless $ARGV[0] =~ m/^-/;
220 } elsif (m/^-m(\d+)$/) {
222 } elsif (m/^-d(\S+)$/) {
224 } elsif (m/^-q(\S+)$/) {
227 die "unknown option \`$_'\n";
231 my $dbfile = nextarg();
233 if (defined $ENV{'USERV_USER'}) {
235 $user = $ENV{'USERV_USER'};
238 $user = ((getpwuid $<)[0]) or die;
241 $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",
242 { PrintError => 0, AutoCommit => 0, RaiseError => 1 })
245 my $action = nextarg();
247 { no strict qw(refs); &{"action_$action"}(); }