3 usage: ../fyvzl [OPTIONS DATABASE-FILE ACTION ARG
9 -C (show comments in output)
12 our $usage2 = <<'END';
14 create [REDIRECT] [#COMMENT] (default for REDIRECT is your username)
15 update ADDR [REDIRECT] [#COMMENT]
19 empty string for REDIRECT means reject
21 our $usage3 = <<'END';
24 insert-exact ADDR USER REDIRECT COMMENT
26 enable-user|disable-user USER
36 our $maxperuser = 10000;
45 die "too few arguments\n" unless @ARGV;
47 die "option too late on command line\n" if $v =~ m/^-/;
51 sub addr2localpart ($) {
53 return $addr if $addr !~ m/\@/;
54 die "address not in correct domain (\@$dom)\n" unless $' eq $dom; #';
59 return addr2localpart nextarg;
63 die "too many arguments\n" if @ARGV;
69 $dis_q ||= $dbh->prepare("SELECT * FROM disabled_users WHERE user=?");
71 my $row = $dis_q->fetchrow_arrayref();
77 my $u = $row->{'user'};
79 if (!defined $last_u or $last_u ne $u) {
80 print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n";
83 my $pa = $row->{'localpart'};
84 $pa .= '@'.$dom if defined $dom;
85 if (length $row->{'redirect'}) {
86 print "$pa: $row->{'redirect'}" or die $!;
88 print "# reject $pa" or die $!;
90 if ($showcomment || !$priv) {
91 print " #$row->{'comment'}" or die $!;
100 read(R, $ch, 1) == 1 or die $!;
103 next unless $o-$v+$lim < 256;
104 # print STDERR "goodrand($lim)=$v\n";
111 if (defined $$ref && $$ref =~ m/[^\041-\177]/) {
112 die "bad characters in redirection target\n";
114 if (defined $$ref && length $$ref && $$ref !~ m/\@/) {
115 die "unqualified redirection target\n" unless defined $qualdom;
116 $$ref .= '@'.$qualdom;
123 "INSERT INTO addrs (".
124 (join ",", sort keys %$row).
126 (join ",", map { "?" } sort keys %$row).
128 $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row);
136 my $f = (s/^\#// ? 'comment' : 'redirect');
137 die "$f supplied twice\n" if exists $row->{$f};
140 foreach my $f (keys %$defrow) {
141 next if defined $row->{$f};
142 $row->{$f} = $defrow->{$f};
144 qualify $row->{'redirect'};
148 sub local_part_inuse ($) {
150 our $checkexist_q ||=
151 $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?");
152 $checkexist_q->execute($s);
153 my $row = $checkexist_q->fetchrow_arrayref();
157 sub generate_local_part () {
160 $s = chr(ord('a')+goodrand(26));
161 while (length $s < $randlength) {
162 my $v = goodrand(36);
167 # print STDERR "$s\n";
168 last if !local_part_inuse($s);
173 sub prepare_create () {
174 my $countq = $dbh->prepare("SELECT count(*) FROM addrs WHERE user=?");
175 $countq->execute($user);
176 my ($count) = $countq->fetchrow_array();
177 die unless defined $count;
178 die "too many aliases for this user\n" if $count >= $maxperuser;
179 open R, "/dev/urandom" or die $!;
184 my $newrow = rhsargs({'redirect'=>$user, 'comment'=>''});
186 $newrow->{'user'} = $user;
187 $newrow->{'localpart'} = generate_local_part();
194 my ($localpart) = @_;
195 our $row_q ||= $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
196 $row_q->execute($localpart);
197 return $row_q->fetchrow_hashref();
201 my ($localpart) = @_;
202 my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
203 my $row = selectrow $localpart;
204 die "unknown localpart\n" unless defined $row;
205 die "not owned by you\n" unless $priv || $row->{user} eq $user;
210 my $localpart = nextarg_addr;
211 my $updrow = rhsargs({});
213 begin_row($localpart);
214 foreach my $f (qw(redirect comment)) {
215 my $v = $updrow->{$f};
216 next unless defined $v;
217 $dbh->do("UPDATE addrs SET $f=? WHERE localpart=?",
220 my $row = selectrow $localpart;
226 my $localpart = nextarg_addr;
228 my $row = begin_row($localpart);
234 while (my $row = $q->fetchrow_hashref()) {
241 my $q = $dbh->prepare("SELECT * FROM addrs WHERE user=?".
242 " ORDER BY localpart");
247 sub action_list_user {
254 sub action_list_all {
257 my $q = $dbh->prepare("SELECT * FROM addrs".
258 " ORDER BY user, localpart");
263 sub action_insert_exact {
266 $row->{'localpart'} = nextarg_addr;
267 $row->{'user'} = $user = nextarg;
268 $row->{'redirect'} = nextarg;
269 $row->{'comment'} = nextarg;
277 my $localpart = nextarg_addr;
278 my $newuser = nextarg;
280 begin_row($localpart);
281 $dbh->do('UPDATE addrs SET user=? WHERE localpart=?',
282 {}, $newuser, $localpart);
286 sub action_enable_user {
290 $dbh->do('DELETE FROM disabled_users WHERE user=?',{},$user);
294 sub action_disable_user {
298 $dbh->do('INSERT INTO disabled_users VALUES user (?)',{},$user);
302 sub action_list_actions {
303 print $usage2 or die $!;
307 last unless $ARGV[0] =~ m/^-/;
314 } elsif (s/^-m(\d+)$//) {
316 } elsif (s/^-d(\S+)$//) {
318 } elsif (s/^-q(\S+)$//) {
323 print $usage1.$usage2.$usage3 or die $!;
326 die "unknown option \`$_'\n";
331 my $dbfile = nextarg();
333 if (defined $ENV{'USERV_USER'}) {
335 $user = $ENV{'USERV_USER'};
338 $user = ((getpwuid $<)[0]) or die;
341 $usage2 .= defined $dom
342 ? "ADDR may be a local part, implicitly qualified with \@$dom\n"
343 : "ADDR must be a local part (only)\n";
344 $usage2 .= "REDIRECT is implicitly qualified with \@$qualdom if it has no \@\n"
347 $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",
348 { PrintError => 0, AutoCommit => 0, RaiseError => 1 })
351 my $action = nextarg();
353 { no strict qw(refs); &{"action_$action"}(); }