#!/usr/bin/perl -w
#
# usage: ../fyvzl [-lLENGTH] [-mMAXPERUSER] [-dDOM] [-qQUALDOM] DATABASE-FILE ACTION ARG
# actions
#   create [REDIRECT-TO]
#   update LOCAL-PART REDIRECT-TO
#   reject LOCAL-PART
#   show LOCAL-PART
#   list
# privileged actions
#   list-user USER
#   insert-exact LOCAL-PART USER REDIRECT
#   donate LOCAL-PART USER
#   enable-user|disable-user USER

use strict;

use DBI;
use POSIX;

our $randlength = 6;
our $maxperuser = 10000;
our $qualdom;
our $dbh;
our $dom;
our $user;
our $priv;

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 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 prow ($) {
    my ($row) = @_;
    my $u = $row->{'user'};
    our $last_u;
    if (!defined $last_u or $last_u ne $u) {
	print "# user $u ".(isdisabled($u) ? 'disabled' : 'enabled')."\n";
	$last_u = $u;
    }
    my $pa = $row->{'localpart'};
    $pa .= '@'.$dom if defined $dom;
    if (defined $row->{'redirect'}) {
	print "$pa: $row->{'redirect'}\n";
    } else {
	print "# reject $pa\n";
    }
}

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 ($t) = @_;
    return $t if $t =~ m/\@/;
    die "unqualified redirection target\n" unless defined $qualdom;
    return $t.'@'.$qualdom;
}

sub insertrow ($) {
    my ($row) = @_;
    my $stmt =
	"INSERT INTO addrs (".
	(join ",", sort keys %$row).
	") VALUES (?, ?, ?) ";
    $dbh->do($stmt, {}, map { $row->{$_} } sort keys %$row);
}

sub action_create {
    my $redirect;
    if (@ARGV) { $redirect = nextarg; nomoreargs; } else { $redirect = $user; }
    $redirect = qualify $redirect;
    open R, "/dev/urandom" or die $!;
    binmode R;
    my $q = $dbh->prepare("SELECT localpart FROM addrs WHERE localpart=?");
    my $s;
    for (;;) {
	$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));
	}
#	print STDERR "$s\n";
	$q->execute($s);
	my $row = $q->fetchrow_arrayref();
	last if !$row;
	$dbh->abort();
    }
    my $row = {'localpart'=>$s, 'user'=>$user, 'redirect'=>$redirect};
    insertrow($row);
    $dbh->commit();
    prow($row);
}

sub begin_row ($) {
    my ($localpart) = @_;
    my $q = $dbh->prepare("SELECT * FROM addrs WHERE localpart=?");
    $q->execute($localpart);
    my $row = $q->fetchrow_hashref();
    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;
    my $redirect = qualify nextarg;
    nomoreargs;
    begin_row($localpart);
    $dbh->do("UPDATE addrs SET redirect=? WHERE localpart=?",
	     {}, $redirect, $localpart);
    $dbh->commit;
}

sub action_reject {
    my $localpart = nextarg;
    nomoreargs;
    begin_row($localpart);
    $dbh->do("UPDATE addrs SET redirect=NULL WHERE localpart=?",
	     {}, $localpart);
    $dbh->commit;
}

sub action_show {
    my $localpart = nextarg;
    nomoreargs;
    my $row = begin_row($localpart);
    prow($row);
}

sub action_list {
    nomoreargs;
    my $q = $dbh->prepare("SELECT * FROM addrs WHERE user=?".
			  " ORDER BY localpart");
    $q->execute($user);
    while (my $row = $q->fetchrow_hashref()) {
	prow($row);
    }
}

sub action_list_user {
    die unless $priv;
    $user = nextarg;
    nomoreargs;
    action_list;
}

sub action_insert_exact {
    die unless $priv;
    my $localpart = nextarg;
    $user = nextarg;
    my $redirect = nextarg;
    nomoreargs;
    my $row = {'localpart'=>$localpart, 'user'=>$user, 'redirect'=>$redirect};
    insertrow($row);
    $dbh->commit;
}

sub action_donate {
    die unless $priv;
    my $localpart = nextarg;
    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;
}

while (@ARGV) {
    last unless $ARGV[0] =~ m/^-/;
    $_ = shift @ARGV;
    last if m/^--?$/;
    if (m/^-l(\d+)$/) {
	$randlength = $1;
    } elsif (m/^-m(\d+)$/) {
	$maxperuser = $1;
    } elsif (m/^-d(\S+)$/) {
	$dom = $1;
    } elsif (m/^-q(\S+)$/) {
	$qualdom = $1;
    } 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;
}

$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"}(); }