3 usage: ../fyvzl [OPTIONS DATABASE-FILE ACTION ARG
9 -C (show comments in output)
12 our $usage2 = <<'END';
14 create [REDIRECT-TO] [#comment]
15 update LOCAL-PART [REDIRECT-TO] [#comment]
22 insert-exact LOCAL-PART USER REDIRECT COMMENT
23 donate LOCAL-PART USER
24 enable-user|disable-user USER
33 our $maxperuser = 10000;
42 die "too few arguments\n" unless @ARGV;
44 die "option too late on command line\n" if $v =~ m/^-/;
49 die "too many arguments\n" if @ARGV;
55 $dis_q ||= $dbh->prepare("SELECT * FROM disabled_users WHERE user=?");
57 my $row = $dis_q->fetchrow_arrayref();
63 my $u = $row->{'user'};
65 if (!defined $last_u or $last_u ne $u) {
66 print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n";
69 my $pa = $row->{'localpart'};
70 $pa .= '@'.$dom if defined $dom;
71 if (defined $row->{'redirect'}) {
72 print "$pa: $row->{'redirect'}" or die $!;
74 print "# reject $pa" or die $!;
76 if ($showcomment || !$priv) {
77 print " #$row->{'comment'}" or die $!;
86 read(R, $ch, 1) == 1 or die $!;
89 next unless $o-$v+$lim < 256;
90 # print STDERR "goodrand($lim)=$v\n";
97 if (defined $$ref && $$ref !~ m/\@/) {
98 die "unqualified redirection target\n" unless defined $qualdom;
99 $$ref .= '@'.$qualdom;
106 "INSERT INTO addrs (".
107 (join ",", sort keys %$row).
109 (join ",", map { "?" } sort keys %$row).
111 $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row);
118 my $f = (s/^\#// ? 'comment' : 'redirect');
119 die "$f supplied twice\n" if exists $row->{$f};
122 qualify $row->{'redirect'};
127 my $newrow = rhsargs({'redirect'=>$user, 'comment'=>''});
128 open R, "/dev/urandom" or die $!;
130 my $countq = $dbh->prepare("SELECT count(*) FROM addrs WHERE user=?");
131 $countq->execute($user);
132 my ($count) = $countq->fetchrow_array();
133 die unless defined $count;
134 die "too many aliases for this user\n" if $count >= $maxperuser;
135 my $q = $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?");
138 $s = chr(ord('a')+goodrand(26));
139 while (length $s < $randlength) {
140 my $v = goodrand(36);
145 # print STDERR "$s\n";
147 my $row = $q->fetchrow_arrayref();
151 $newrow->{'user'} = $user;
152 $newrow->{'localpart'} = $s;
159 my ($localpart) = @_;
160 our $row_q ||= $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
161 $row_q->execute($localpart);
162 return $row_q->fetchrow_hashref();
166 my ($localpart) = @_;
167 my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
168 my $row = selectrow $localpart;
169 die "unknown localpart\n" unless defined $row;
170 die "not owned by you\n" unless $priv || $row->{user} eq $user;
175 my $localpart = nextarg;
176 my $updrow = rhsargs({});
178 begin_row($localpart);
179 foreach my $f (qw(redirect comment)) {
180 my $v = $updrow->{$f};
181 next unless defined $v;
182 $dbh->do("UPDATE addrs SET $f=? WHERE localpart=?",
185 my $row = selectrow $localpart;
191 my $localpart = nextarg;
193 begin_row($localpart);
194 $dbh->do("UPDATE addrs SET redirect=NULL WHERE localpart=?",
200 my $localpart = nextarg;
202 my $row = begin_row($localpart);
208 my $q = $dbh->prepare("SELECT * FROM addrs WHERE user=?".
209 " ORDER BY localpart");
211 while (my $row = $q->fetchrow_hashref()) {
216 sub action_list_user {
223 sub action_insert_exact {
225 my $localpart = nextarg;
227 my $redirect = nextarg;
229 my $row = {'localpart'=>$localpart, 'user'=>$user, 'redirect'=>$redirect};
236 my $localpart = nextarg;
237 my $newuser = nextarg;
239 begin_row($localpart);
240 $dbh->do('UPDATE addrs SET user=? WHERE localpart=?',
241 {}, $newuser, $localpart);
245 sub action_enable_user {
249 $dbh->do('DELETE FROM disabled_users WHERE user=?',{},$user);
253 sub action_disable_user {
257 $dbh->do('INSERT INTO disabled_users VALUES user (?)',{},$user);
261 sub action_list_actions {
262 print $usage2 or die $!;
266 last unless $ARGV[0] =~ m/^-/;
273 } elsif (s/^-m(\d+)$//) {
275 } elsif (s/^-d(\S+)$//) {
277 } elsif (s/^-q(\S+)$//) {
282 print $usage1.$usage2 or die $!;
285 die "unknown option \`$_'\n";
290 my $dbfile = nextarg();
292 if (defined $ENV{'USERV_USER'}) {
294 $user = $ENV{'USERV_USER'};
297 $user = ((getpwuid $<)[0]) or die;
300 $usage2 .= "LOCAL-PART is implicitly qualified with \@$dom\n"
302 $usage2 .= "REDIRECT is implicitly qualified with \@$qualdom if it has no \@\n"
305 $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",
306 { PrintError => 0, AutoCommit => 0, RaiseError => 1 })
309 my $action = nextarg();
311 { no strict qw(refs); &{"action_$action"}(); }