From 3b8b28fc6a09bf548bd04555474644a42640c973 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 5 Sep 2013 01:02:04 +0100 Subject: [PATCH] genericise for evade.org.uk --- evade-mail | 4 + evade-mail-admin | 538 +++++++++++++++++++++++++++++++ evade-mail-generic | 10 + fyvzl.userv => evade-mail.userv | 3 +- service | 545 +------------------------------- service-evade.org.uk | 5 + service-fyvzl.net | 3 + slimy-rot13-mail | 8 +- 8 files changed, 570 insertions(+), 546 deletions(-) create mode 100755 evade-mail create mode 100755 evade-mail-admin create mode 100755 evade-mail-generic rename fyvzl.userv => evade-mail.userv (59%) create mode 100755 service-evade.org.uk create mode 100755 service-fyvzl.net diff --git a/evade-mail b/evade-mail new file mode 100755 index 0000000..e78bf7e --- /dev/null +++ b/evade-mail @@ -0,0 +1,4 @@ +#!/bin/sh +set -e +exec /usr/local/lib/evade-mail/evade-mail-generic \ + evade-mail evade.org.uk "$@" diff --git a/evade-mail-admin b/evade-mail-admin new file mode 100755 index 0000000..5b997bd --- /dev/null +++ b/evade-mail-admin @@ -0,0 +1,538 @@ +#!/usr/bin/perl -w +our $usage1 = <<'END'; +usage: ../fyvzl [] ... +options + -m + -d + -q + -C (show comments in output) + -h (display help) +options for alphanum generation + -l (for create/choose alphanum, minimum randlength) +options for wordlist generation + -Wf (switches generation method to wordlist) + -WF } (for wordlist generation + -Wl } method only) + -WL } + -Wd } (first char is default; comma = none) +END +our $usage2 = <<'END'; +actions + create [] [] [#] (default redirect is username) + choose [] [] [#] (interactively allocate) + update [] [#] + show + list + list-actions +empty string for redirect means reject +END +our $usage3 = <<'END'; +privileged actions + list-user + insert-exact + donate + enable-user|disable-user +default generation method is alphanum +END +our %usage_genopts = ( +'alphanum' => < (number of letters+digits) +END +'wordlist' => < (number of words in output) + -d (delimiter character, "," means none) + -F (pick from up to different words, 0 means all) + -m (restrict total length of generated addrs, 0 = unlimited) +END +); +#/ + +use strict; + +use DBI; +use POSIX; + +our $maxperuser = 10000; +our $qualdom; +our $dbh; +our $dom; +our $user; +our $priv; +our $showcomment; +our $genmethod = 'alphanum'; + +# for alphanum +# options +our $minrandlength = 6; +our $maxrandlength = 100; +# genopts +our $randlength; + +# for wordlist +# options +our $wordlist; +our $minwordlistlen = 1000; +our $minmaxmeanwordlen = 6.2; +our $minnumwords = 3; +our $maxnumwords = 10; +our $worddelims = '.-_,'; +# genopts +our $numwords; +our $worddelim; +our $wordlistlen = 3000; +our $maxdomainlen = 40; + +sub nextarg () { + die "too few arguments\n" unless @ARGV; + my $v = shift @ARGV; + die "option too late on command line\n" if $v =~ m/^-/; + return $v; +} + +sub addr2localpart ($) { + my ($addr) = @_; + return $addr if $addr !~ m/\@/; + die "address not in correct domain (\@$dom)\n" unless $' eq $dom; #'; + return $`; #`; +} + +sub nextarg_addr () { + return addr2localpart nextarg; +} + +sub nomoreargs () { + die "too many arguments\n" if @ARGV; +} + +sub isdisabled ($) { + my ($u) = @_; + our $dis_q; + $dis_q ||= $dbh->prepare("SELECT * FROM disabled_users WHERE user=?"); + $dis_q->execute($u); + my $row = $dis_q->fetchrow_arrayref(); + return !!$row; +} + +sub puser ($) { + my ($u) = @_; + our $last_u; + if (!defined $last_u or $last_u ne $u) { + print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n"; + $last_u = $u; + } +} + +sub prow ($) { + my ($row) = @_; + my $u = $row->{'user'}; + puser($u); + my $pa = $row->{'localpart'}; + $pa .= '@'.$dom if defined $dom; + if (length $row->{'redirect'}) { + print "$pa: $row->{'redirect'}" or die $!; + } else { + print "# reject $pa" or die $!; + } + if ($showcomment || !$priv) { + print " #$row->{'comment'}" or die $!; + } + print "\n" or die $!; +} + +sub goodrand ($) { + my ($lim) = @_; + for (;;) { + my $ch; + read(R, $ch, 1) == 1 or die $!; + my $o = ord $ch; + my $v = $o % $lim; + next unless $o-$v+$lim < 256; +# print STDERR "goodrand($lim)=$v\n"; + return $v; + } +} + +sub qualify (\$) { + my ($ref) = @_; + if (defined $$ref && $$ref =~ m/[^\041-\177]/) { + die "bad characters in redirection target\n"; + } + if (defined $$ref && length $$ref && $$ref !~ m/\@/) { + die "unqualified redirection target\n" unless defined $qualdom; + $$ref .= '@'.$qualdom; + } +} + +sub insertrow ($) { + my ($row) = @_; + my $stmt = + "INSERT INTO addrs (". + (join ",", sort keys %$row). + ") VALUES (". + (join ",", map { "?" } sort keys %$row). + ") "; + $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row); +} + +sub rhsargs ($) { + my ($defrow) = @_; + my $row = { }; + while (@ARGV) { + $_ = shift @ARGV; + my $f = (s/^\#// ? 'comment' : 'redirect'); + die "$f supplied twice\n" if exists $row->{$f}; + $row->{$f} = $_; + } + foreach my $f (keys %$defrow) { + next if defined $row->{$f}; + $row->{$f} = $defrow->{$f}; + } + qualify $row->{'redirect'}; + return $row; +} + +sub local_part_inuse ($) { + my ($s) = @_; + our $checkexist_q ||= + $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?"); + $checkexist_q->execute($s); + my $row = $checkexist_q->fetchrow_arrayref(); + return !!$row; +} + +sub gen_local_part_alphanum { + my $s = chr(ord('a')+goodrand(26)); + while (length $s < $randlength) { + my $v = goodrand(36); + $s .= chr($v < 26 + ? ord('a')+($v) + : ord('0')+($v-26)); + } + return $s; +} + +sub generate_local_part () { + my $s; + for (;;) { + { no strict qw(refs); $s = &{"gen_local_part_$genmethod"}; } +# print STDERR "$s\n"; + last if !local_part_inuse($s); + } + return $s; +} + +sub prepare_create () { + my $countq = $dbh->prepare("SELECT count(*) FROM addrs WHERE user=?"); + $countq->execute($user); + my ($count) = $countq->fetchrow_array(); + die unless defined $count; + die "too many aliases for this user\n" if $count >= $maxperuser; + open R, "/dev/urandom" or die $!; + binmode R; +} + +sub genopt_alphanum { + local ($_) = @_; + if (m/^-l(\d+)$/) { + $randlength = 0+$1; + die "length out of range $minrandlength..$maxrandlength\n" + unless ($minrandlength<=$randlength && + $randlength<=$maxrandlength); + } else { + die "unknown alphanumeric generation option\n"; + } +} + +sub gendefaults_alphanum { + $randlength ||= $minrandlength; +} + +sub gen_local_part_wordlist { + my @cmd = (qw(random-word), "-f$wordlist","-n$numwords"); + push @cmd, "-F$wordlistlen" if $wordlistlen < 1e9; + for (;;) { + open P, "-|", @cmd or die $!; + my $s =

; + $!=0; $?=0; close P or die "$? $!"; + chomp $s or die; + $s =~ s/ /$worddelim/g; + my $efflen = length $s; + $efflen += 1 + length($dom) if defined $dom; + return $s if $efflen <= $maxdomainlen; + } +} + +sub genopt_wordlist { + local ($_) = @_; + if (m/^-l(\d+)$/) { + $numwords = $1; + die "length out of range $minnumwords..$maxnumwords\n" + unless ($minnumwords<=$numwords && + $numwords<=$maxnumwords); + } elsif (m/^-d(.)$/) { + $worddelim = $1; + die "word delimiter must be one of \`$worddelims'\n" + unless grep { $worddelim eq $_ } split //, $worddelims; + } elsif (m/^-F(\d+)$/) { + $wordlistlen = $1 ? 0+$1 : 1e9; + die "requested dictionary size too small\n" + unless $wordlistlen >= $minwordlistlen; + } elsif (m/^-m(\d+)$/) { + $maxdomainlen = $1 ? 0+$1 : 1e9; + } else { + die "unknown wordlist generation option\n"; + } +} + +sub gendefaults_wordlist { + $numwords ||= $minnumwords; + $worddelim = substr($worddelims,0,1) unless defined $worddelim; + $worddelim = '' if $worddelim eq ','; + my $expectedmindomlen = + (defined $dom ? (1 + length $dom) : 0) # @domain.name + + $minmaxmeanwordlen * $numwords # some words + + (length $worddelim) * ($numwords-1); # delimiters + die "assuming lowest reasonable mean word length $minmaxmeanwordlen". + " addrs would be $expectedmindomlen long but". + " your maximum length specified $maxdomainlen\n" + if $expectedmindomlen > $maxdomainlen; +} + +sub genopts { + while (@ARGV && $ARGV[0] =~ m/^-/) { + my $arg = shift @ARGV; + last if $arg =~ m/^--?$/; + { no strict qw(refs); &{"genopt_$genmethod"}($arg); } + } + { no strict qw(refs); &{"gendefaults_$genmethod"}(); } +} + +sub action_create { + genopts; + my $newrow = rhsargs({'redirect'=>$user, 'comment'=>''}); + prepare_create(); + $newrow->{'user'} = $user; + $newrow->{'localpart'} = generate_local_part(); + insertrow($newrow); + $dbh->commit(); + prow($newrow); +} + +sub action_choose { + genopts; + my $template = rhsargs({'redirect'=>$user, 'comment'=>''}); + $template->{'user'} = $user; + prepare_create(); + puser($user); + my %s; + while (keys %s < 10) { + my $s = generate_local_part(); + next if $s{$s}; + print $s or die $!; + print "\@$dom" or die $! if $dom; + print "\n" or die $!; + $s{$s} = 1; + } + print "# ready - enter addrs or local-parts to create,". + " then \`.' on a line by itself\n" + or die $!; + + while () { + chomp; + last if m/^\.$/; + my $s; + if (eval { + $s = addr2localpart $_; + $s{$s} or die "not an (as-yet-unused) suggestion\n"; + delete $s{$s}; + die "just taken in the meantime (bad luck!)\n" + if local_part_inuse $s; + 1; + }) { + my $newrow = { %$template, 'localpart' => $s }; + $dbh->commit(); + prow($newrow); + } else { + $dbh->rollback(); + print "! error: $@" or die $!; + } + } +} + +sub selectrow ($) { + my ($localpart) = @_; + our $row_q ||= $dbh->prepare("SELECT * FROM addrs WHERE localpart=?"); + $row_q->execute($localpart); + return $row_q->fetchrow_hashref(); +} + +sub begin_row ($) { + my ($localpart) = @_; + my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?"); + my $row = selectrow $localpart; + die "unknown localpart\n" unless defined $row; + die "not owned by you\n" unless $priv || $row->{user} eq $user; + return $row; +} + +sub action_update { + my $localpart = nextarg_addr; + my $updrow = rhsargs({}); + nomoreargs; + begin_row($localpart); + foreach my $f (qw(redirect comment)) { + my $v = $updrow->{$f}; + next unless defined $v; + $dbh->do("UPDATE addrs SET $f=? WHERE localpart=?", + {}, $v, $localpart); + } + my $row = selectrow $localpart; + $dbh->commit; + prow($row); +} + +sub action_show { + my $localpart = nextarg_addr; + nomoreargs; + my $row = begin_row($localpart); + prow($row); +} + +sub listq ($) { + my ($q) = @_; + while (my $row = $q->fetchrow_hashref()) { + prow($row); + } +} + +sub action_list { + nomoreargs; + my $q = $dbh->prepare("SELECT * FROM addrs WHERE user=?". + " ORDER BY localpart"); + $q->execute($user); + listq($q); +} + +sub action_list_user { + die unless $priv; + $user = nextarg; + nomoreargs; + action_list; +} + +sub action_list_all { + die unless $priv; + nomoreargs; + my $q = $dbh->prepare("SELECT * FROM addrs". + " ORDER BY user, localpart"); + $q->execute(); + listq($q) +} + +sub action_insert_exact { + die unless $priv; + my $row = { }; + $row->{'localpart'} = nextarg_addr; + $row->{'user'} = $user = nextarg; + $row->{'redirect'} = nextarg; + $row->{'comment'} = nextarg; + nomoreargs; + insertrow($row); + $dbh->commit; +} + +sub action_donate { + die unless $priv; + my $localpart = nextarg_addr; + my $newuser = nextarg; + nomoreargs; + begin_row($localpart); + $dbh->do('UPDATE addrs SET user=? WHERE localpart=?', + {}, $newuser, $localpart); + $dbh->commit; +} + +sub action_enable_user { + die unless $priv; + $user = nextarg; + nomoreargs; + $dbh->do('DELETE FROM disabled_users WHERE user=?',{},$user); + $dbh->commit; +} + +sub action_disable_user { + die unless $priv; + $user = nextarg; + nomoreargs; + $dbh->do('INSERT INTO disabled_users VALUES user (?)',{},$user); + $dbh->commit; +} + +sub action_list_actions { + print $usage2 or die $!; + print "genopts\n" or die $!; + print $usage_genopts{$genmethod} or die $!; +} + +while (@ARGV) { + last unless $ARGV[0] =~ m/^-/; + $_ = shift @ARGV; + last if m/^--?$/; + for (;;) { + last unless m/^-./; + if (s/^-l(\d+)$//) { + $minrandlength = $1; + } elsif (s/^-m(\d+)$//) { + $maxperuser = $1; + } elsif (s/^-d(\S+)$//) { + $dom = $1; + } elsif (s/^-q(\S+)$//) { + $qualdom = $1; + } elsif (s/^-Wf(\S+)$//) { + $wordlist = $1; + $genmethod = 'wordlist'; + } elsif (s/^-WF(\d+)$//) { + $minwordlistlen = $1; + } elsif (s/^-Wl(\d+)$//) { + $minnumwords = $1; + } elsif (s/^-WL([0-9.]+)$//) { + $minmaxmeanwordlen = $1; + } elsif (s/^-C/-/) { + $showcomment = 1; + } elsif (s/^-h/-/) { + print $usage1.$usage2.$usage3 or die $!; + foreach my $meth (qw(alphanum wordlist)) { + print "genopts for $meth generation method\n" or die $!; + print $usage_genopts{$meth} or die $!; + } + exit 0; + } else { + die "unknown option \`$_'\n"; + } + } +} + +my $dbfile = nextarg(); + +if (defined $ENV{'USERV_USER'}) { + $priv=0; + $user = $ENV{'USERV_USER'}; +} else { + $priv=1; + $user = ((getpwuid $<)[0]) or die; +} + +$usage2 .= defined $dom + ? "addr may be a local part, implicitly qualified with \@$dom\n" + : "addr must be a local part (only)\n"; +$usage2 .= "redirect is implicitly qualified with \@$qualdom". + " if it has no \@\n" + if defined $qualdom; + +$dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","", + { PrintError => 0, AutoCommit => 0, RaiseError => 1 }) + or die "$dbfile $!"; + +my $action = nextarg(); +$action =~ y/-/_/; +{ no strict qw(refs); &{"action_$action"}(); } diff --git a/evade-mail-generic b/evade-mail-generic new file mode 100755 index 0000000..0191614 --- /dev/null +++ b/evade-mail-generic @@ -0,0 +1,10 @@ +#!/bin/sh +set -e +us=$1; shift +domain=$2; shift +case "$#.$1" in +0.|1.-h) + echo "usage: $us ACTION ARG..." + set list-actions +esac +exec userv -Ddomain=$domain mail evade-mail "$@" diff --git a/fyvzl.userv b/evade-mail.userv similarity index 59% rename from fyvzl.userv rename to evade-mail.userv index 5940365..406ff1b 100644 --- a/fyvzl.userv +++ b/evade-mail.userv @@ -6,6 +6,5 @@ if ( grep calling-user-shell /etc/shells no-set-environment no-disconnect-hup no-suppress-args - execute /usr/local/lib/evade-mail/service -qchiark.greenend.org.uk \ - -dfyvzl.net /var/lib/evade-mail/fyvzl.net.sqlite3 + execute /usr/local/lib/evade-mail/service fi diff --git a/service b/service index 5b997bd..a74bb79 100755 --- a/service +++ b/service @@ -1,538 +1,7 @@ -#!/usr/bin/perl -w -our $usage1 = <<'END'; -usage: ../fyvzl [] ... -options - -m - -d - -q - -C (show comments in output) - -h (display help) -options for alphanum generation - -l (for create/choose alphanum, minimum randlength) -options for wordlist generation - -Wf (switches generation method to wordlist) - -WF } (for wordlist generation - -Wl } method only) - -WL } - -Wd } (first char is default; comma = none) -END -our $usage2 = <<'END'; -actions - create [] [] [#] (default redirect is username) - choose [] [] [#] (interactively allocate) - update [] [#] - show - list - list-actions -empty string for redirect means reject -END -our $usage3 = <<'END'; -privileged actions - list-user - insert-exact - donate - enable-user|disable-user -default generation method is alphanum -END -our %usage_genopts = ( -'alphanum' => < (number of letters+digits) -END -'wordlist' => < (number of words in output) - -d (delimiter character, "," means none) - -F (pick from up to different words, 0 means all) - -m (restrict total length of generated addrs, 0 = unlimited) -END -); -#/ - -use strict; - -use DBI; -use POSIX; - -our $maxperuser = 10000; -our $qualdom; -our $dbh; -our $dom; -our $user; -our $priv; -our $showcomment; -our $genmethod = 'alphanum'; - -# for alphanum -# options -our $minrandlength = 6; -our $maxrandlength = 100; -# genopts -our $randlength; - -# for wordlist -# options -our $wordlist; -our $minwordlistlen = 1000; -our $minmaxmeanwordlen = 6.2; -our $minnumwords = 3; -our $maxnumwords = 10; -our $worddelims = '.-_,'; -# genopts -our $numwords; -our $worddelim; -our $wordlistlen = 3000; -our $maxdomainlen = 40; - -sub nextarg () { - die "too few arguments\n" unless @ARGV; - my $v = shift @ARGV; - die "option too late on command line\n" if $v =~ m/^-/; - return $v; -} - -sub addr2localpart ($) { - my ($addr) = @_; - return $addr if $addr !~ m/\@/; - die "address not in correct domain (\@$dom)\n" unless $' eq $dom; #'; - return $`; #`; -} - -sub nextarg_addr () { - return addr2localpart nextarg; -} - -sub nomoreargs () { - die "too many arguments\n" if @ARGV; -} - -sub isdisabled ($) { - my ($u) = @_; - our $dis_q; - $dis_q ||= $dbh->prepare("SELECT * FROM disabled_users WHERE user=?"); - $dis_q->execute($u); - my $row = $dis_q->fetchrow_arrayref(); - return !!$row; -} - -sub puser ($) { - my ($u) = @_; - our $last_u; - if (!defined $last_u or $last_u ne $u) { - print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n"; - $last_u = $u; - } -} - -sub prow ($) { - my ($row) = @_; - my $u = $row->{'user'}; - puser($u); - my $pa = $row->{'localpart'}; - $pa .= '@'.$dom if defined $dom; - if (length $row->{'redirect'}) { - print "$pa: $row->{'redirect'}" or die $!; - } else { - print "# reject $pa" or die $!; - } - if ($showcomment || !$priv) { - print " #$row->{'comment'}" or die $!; - } - print "\n" or die $!; -} - -sub goodrand ($) { - my ($lim) = @_; - for (;;) { - my $ch; - read(R, $ch, 1) == 1 or die $!; - my $o = ord $ch; - my $v = $o % $lim; - next unless $o-$v+$lim < 256; -# print STDERR "goodrand($lim)=$v\n"; - return $v; - } -} - -sub qualify (\$) { - my ($ref) = @_; - if (defined $$ref && $$ref =~ m/[^\041-\177]/) { - die "bad characters in redirection target\n"; - } - if (defined $$ref && length $$ref && $$ref !~ m/\@/) { - die "unqualified redirection target\n" unless defined $qualdom; - $$ref .= '@'.$qualdom; - } -} - -sub insertrow ($) { - my ($row) = @_; - my $stmt = - "INSERT INTO addrs (". - (join ",", sort keys %$row). - ") VALUES (". - (join ",", map { "?" } sort keys %$row). - ") "; - $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row); -} - -sub rhsargs ($) { - my ($defrow) = @_; - my $row = { }; - while (@ARGV) { - $_ = shift @ARGV; - my $f = (s/^\#// ? 'comment' : 'redirect'); - die "$f supplied twice\n" if exists $row->{$f}; - $row->{$f} = $_; - } - foreach my $f (keys %$defrow) { - next if defined $row->{$f}; - $row->{$f} = $defrow->{$f}; - } - qualify $row->{'redirect'}; - return $row; -} - -sub local_part_inuse ($) { - my ($s) = @_; - our $checkexist_q ||= - $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?"); - $checkexist_q->execute($s); - my $row = $checkexist_q->fetchrow_arrayref(); - return !!$row; -} - -sub gen_local_part_alphanum { - my $s = chr(ord('a')+goodrand(26)); - while (length $s < $randlength) { - my $v = goodrand(36); - $s .= chr($v < 26 - ? ord('a')+($v) - : ord('0')+($v-26)); - } - return $s; -} - -sub generate_local_part () { - my $s; - for (;;) { - { no strict qw(refs); $s = &{"gen_local_part_$genmethod"}; } -# print STDERR "$s\n"; - last if !local_part_inuse($s); - } - return $s; -} - -sub prepare_create () { - my $countq = $dbh->prepare("SELECT count(*) FROM addrs WHERE user=?"); - $countq->execute($user); - my ($count) = $countq->fetchrow_array(); - die unless defined $count; - die "too many aliases for this user\n" if $count >= $maxperuser; - open R, "/dev/urandom" or die $!; - binmode R; -} - -sub genopt_alphanum { - local ($_) = @_; - if (m/^-l(\d+)$/) { - $randlength = 0+$1; - die "length out of range $minrandlength..$maxrandlength\n" - unless ($minrandlength<=$randlength && - $randlength<=$maxrandlength); - } else { - die "unknown alphanumeric generation option\n"; - } -} - -sub gendefaults_alphanum { - $randlength ||= $minrandlength; -} - -sub gen_local_part_wordlist { - my @cmd = (qw(random-word), "-f$wordlist","-n$numwords"); - push @cmd, "-F$wordlistlen" if $wordlistlen < 1e9; - for (;;) { - open P, "-|", @cmd or die $!; - my $s =

; - $!=0; $?=0; close P or die "$? $!"; - chomp $s or die; - $s =~ s/ /$worddelim/g; - my $efflen = length $s; - $efflen += 1 + length($dom) if defined $dom; - return $s if $efflen <= $maxdomainlen; - } -} - -sub genopt_wordlist { - local ($_) = @_; - if (m/^-l(\d+)$/) { - $numwords = $1; - die "length out of range $minnumwords..$maxnumwords\n" - unless ($minnumwords<=$numwords && - $numwords<=$maxnumwords); - } elsif (m/^-d(.)$/) { - $worddelim = $1; - die "word delimiter must be one of \`$worddelims'\n" - unless grep { $worddelim eq $_ } split //, $worddelims; - } elsif (m/^-F(\d+)$/) { - $wordlistlen = $1 ? 0+$1 : 1e9; - die "requested dictionary size too small\n" - unless $wordlistlen >= $minwordlistlen; - } elsif (m/^-m(\d+)$/) { - $maxdomainlen = $1 ? 0+$1 : 1e9; - } else { - die "unknown wordlist generation option\n"; - } -} - -sub gendefaults_wordlist { - $numwords ||= $minnumwords; - $worddelim = substr($worddelims,0,1) unless defined $worddelim; - $worddelim = '' if $worddelim eq ','; - my $expectedmindomlen = - (defined $dom ? (1 + length $dom) : 0) # @domain.name - + $minmaxmeanwordlen * $numwords # some words - + (length $worddelim) * ($numwords-1); # delimiters - die "assuming lowest reasonable mean word length $minmaxmeanwordlen". - " addrs would be $expectedmindomlen long but". - " your maximum length specified $maxdomainlen\n" - if $expectedmindomlen > $maxdomainlen; -} - -sub genopts { - while (@ARGV && $ARGV[0] =~ m/^-/) { - my $arg = shift @ARGV; - last if $arg =~ m/^--?$/; - { no strict qw(refs); &{"genopt_$genmethod"}($arg); } - } - { no strict qw(refs); &{"gendefaults_$genmethod"}(); } -} - -sub action_create { - genopts; - my $newrow = rhsargs({'redirect'=>$user, 'comment'=>''}); - prepare_create(); - $newrow->{'user'} = $user; - $newrow->{'localpart'} = generate_local_part(); - insertrow($newrow); - $dbh->commit(); - prow($newrow); -} - -sub action_choose { - genopts; - my $template = rhsargs({'redirect'=>$user, 'comment'=>''}); - $template->{'user'} = $user; - prepare_create(); - puser($user); - my %s; - while (keys %s < 10) { - my $s = generate_local_part(); - next if $s{$s}; - print $s or die $!; - print "\@$dom" or die $! if $dom; - print "\n" or die $!; - $s{$s} = 1; - } - print "# ready - enter addrs or local-parts to create,". - " then \`.' on a line by itself\n" - or die $!; - - while () { - chomp; - last if m/^\.$/; - my $s; - if (eval { - $s = addr2localpart $_; - $s{$s} or die "not an (as-yet-unused) suggestion\n"; - delete $s{$s}; - die "just taken in the meantime (bad luck!)\n" - if local_part_inuse $s; - 1; - }) { - my $newrow = { %$template, 'localpart' => $s }; - $dbh->commit(); - prow($newrow); - } else { - $dbh->rollback(); - print "! error: $@" or die $!; - } - } -} - -sub selectrow ($) { - my ($localpart) = @_; - our $row_q ||= $dbh->prepare("SELECT * FROM addrs WHERE localpart=?"); - $row_q->execute($localpart); - return $row_q->fetchrow_hashref(); -} - -sub begin_row ($) { - my ($localpart) = @_; - my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?"); - my $row = selectrow $localpart; - die "unknown localpart\n" unless defined $row; - die "not owned by you\n" unless $priv || $row->{user} eq $user; - return $row; -} - -sub action_update { - my $localpart = nextarg_addr; - my $updrow = rhsargs({}); - nomoreargs; - begin_row($localpart); - foreach my $f (qw(redirect comment)) { - my $v = $updrow->{$f}; - next unless defined $v; - $dbh->do("UPDATE addrs SET $f=? WHERE localpart=?", - {}, $v, $localpart); - } - my $row = selectrow $localpart; - $dbh->commit; - prow($row); -} - -sub action_show { - my $localpart = nextarg_addr; - nomoreargs; - my $row = begin_row($localpart); - prow($row); -} - -sub listq ($) { - my ($q) = @_; - while (my $row = $q->fetchrow_hashref()) { - prow($row); - } -} - -sub action_list { - nomoreargs; - my $q = $dbh->prepare("SELECT * FROM addrs WHERE user=?". - " ORDER BY localpart"); - $q->execute($user); - listq($q); -} - -sub action_list_user { - die unless $priv; - $user = nextarg; - nomoreargs; - action_list; -} - -sub action_list_all { - die unless $priv; - nomoreargs; - my $q = $dbh->prepare("SELECT * FROM addrs". - " ORDER BY user, localpart"); - $q->execute(); - listq($q) -} - -sub action_insert_exact { - die unless $priv; - my $row = { }; - $row->{'localpart'} = nextarg_addr; - $row->{'user'} = $user = nextarg; - $row->{'redirect'} = nextarg; - $row->{'comment'} = nextarg; - nomoreargs; - insertrow($row); - $dbh->commit; -} - -sub action_donate { - die unless $priv; - my $localpart = nextarg_addr; - my $newuser = nextarg; - nomoreargs; - begin_row($localpart); - $dbh->do('UPDATE addrs SET user=? WHERE localpart=?', - {}, $newuser, $localpart); - $dbh->commit; -} - -sub action_enable_user { - die unless $priv; - $user = nextarg; - nomoreargs; - $dbh->do('DELETE FROM disabled_users WHERE user=?',{},$user); - $dbh->commit; -} - -sub action_disable_user { - die unless $priv; - $user = nextarg; - nomoreargs; - $dbh->do('INSERT INTO disabled_users VALUES user (?)',{},$user); - $dbh->commit; -} - -sub action_list_actions { - print $usage2 or die $!; - print "genopts\n" or die $!; - print $usage_genopts{$genmethod} or die $!; -} - -while (@ARGV) { - last unless $ARGV[0] =~ m/^-/; - $_ = shift @ARGV; - last if m/^--?$/; - for (;;) { - last unless m/^-./; - if (s/^-l(\d+)$//) { - $minrandlength = $1; - } elsif (s/^-m(\d+)$//) { - $maxperuser = $1; - } elsif (s/^-d(\S+)$//) { - $dom = $1; - } elsif (s/^-q(\S+)$//) { - $qualdom = $1; - } elsif (s/^-Wf(\S+)$//) { - $wordlist = $1; - $genmethod = 'wordlist'; - } elsif (s/^-WF(\d+)$//) { - $minwordlistlen = $1; - } elsif (s/^-Wl(\d+)$//) { - $minnumwords = $1; - } elsif (s/^-WL([0-9.]+)$//) { - $minmaxmeanwordlen = $1; - } elsif (s/^-C/-/) { - $showcomment = 1; - } elsif (s/^-h/-/) { - print $usage1.$usage2.$usage3 or die $!; - foreach my $meth (qw(alphanum wordlist)) { - print "genopts for $meth generation method\n" or die $!; - print $usage_genopts{$meth} or die $!; - } - exit 0; - } else { - die "unknown option \`$_'\n"; - } - } -} - -my $dbfile = nextarg(); - -if (defined $ENV{'USERV_USER'}) { - $priv=0; - $user = $ENV{'USERV_USER'}; -} else { - $priv=1; - $user = ((getpwuid $<)[0]) or die; -} - -$usage2 .= defined $dom - ? "addr may be a local part, implicitly qualified with \@$dom\n" - : "addr must be a local part (only)\n"; -$usage2 .= "redirect is implicitly qualified with \@$qualdom". - " if it has no \@\n" - if defined $qualdom; - -$dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","", - { PrintError => 0, AutoCommit => 0, RaiseError => 1 }) - or die "$dbfile $!"; - -my $action = nextarg(); -$action =~ y/-/_/; -{ no strict qw(refs); &{"action_$action"}(); } +#!/bin/sh +set -e +cd /usr/local/lib/evade-mail +dom="$USERV_U_domain" +exec "./service-$dom" -qchiark.greenend.org.uk \ + -d"$dom" /var/lib/evade-mail/"$dom".sqlite3 \ + "$@" diff --git a/service-evade.org.uk b/service-evade.org.uk new file mode 100755 index 0000000..dc05925 --- /dev/null +++ b/service-evade.org.uk @@ -0,0 +1,5 @@ +#!/bin/sh +set -e +exec ./evade-mail-admin \ + -Wfwords.final \ + "$@" diff --git a/service-fyvzl.net b/service-fyvzl.net new file mode 100755 index 0000000..727c8f3 --- /dev/null +++ b/service-fyvzl.net @@ -0,0 +1,3 @@ +#!/bin/sh +set -e +exec ./evade-mail-admin "$@" diff --git a/slimy-rot13-mail b/slimy-rot13-mail index c7ec9f9..9f8555c 100755 --- a/slimy-rot13-mail +++ b/slimy-rot13-mail @@ -1,8 +1,4 @@ #!/bin/sh set -e -case "$#.$1" in -0.|1.-h) - echo "usage: slimy-rot13-mail ACTION ARG..." - set list-actions -esac -exec userv mail fyvzl "$@" +exec /usr/local/lib/evade-mail/evade-mail-generic \ + slimy-rot13-mail fyvzl.net "$@" -- 2.30.2