#!/usr/bin/perl -w

use strict;
my $libdir = '/usr/local/lib/elections';

# handles giving loads of blind signatures to authenticated users.

#####################################################
# determine format of signed stuff

my $format = qr/^Ballot number: [0-9A-F]{16}$/i;

#####################################################

sub message_check {
    my $msg = shift;

    $msg =~ /$format/;
}

# how many messages per blind sig
my $totalpersig = 10;

# what is the basename of the files containing the public/private keys
my $keyfile = "1024bit";

# put base dir of $0 in @INC
BEGIN {
    if ( $0 =~ m-^(.*)/[^/]*- ) {
        unshift(@INC, $1);
    }
    $ENV{PATH} = "/bin:/usr/bin:/usr/local/bin";
}

use ModToolkit qw(
    readkey
    rsa_decode
    brand
    mod_inverse
    n2str
    str2n
    exp_mod
    $bignumlib
    npretty
);
use DBI;
use Socket;
use FileHandle;

my $crlf = "\015\012";

# redirect errors and warnings to a logfile
my $logfile = "$libdir/blindsigd.log";
open STDERR, ">>$logfile";
STDERR->autoflush(1);

my $user;
sub Log {
    my @y = localtime;
    $y[5] += 1900;
    $y[4]++;
    # seek to end of logfile
    seek(STDERR, 2, 0);
    printf STDERR "%04d/%02d/%02d %02d:%02d:%02d blindsigd [$$]%s: %s\n",
	@y[5,4,3,2,1,0], (defined $user ? " $user" : ""), "@_";
};

my $peername = getpeername STDIN;
if ( $peername ) {
    my($port, $iaddr) = sockaddr_in($peername);
    Log("Connection from " . inet_ntoa($iaddr) . ":$port");
}
else {
    Log("Connection from " . `tty`);
}

my $dsn = "DBI:Pg:dbname=vote";
my $dbusername = undef;
my $dbpasswd = undef;

my $dbh = DBI->connect( $dsn, $dbusername, $dbpasswd,
    { RaiseError => 1, AutoCommit => 0 } )
    or die "Cannot connect to db: $DBI::errstr\n";

# hot pipes, as we are interactive over a socket
$|++;

# command dispatch table
my %cmds = (
    HELP => \&help,
    IAM => \&authenticate,
    QUIT => \&quit,
    BLINDSIG => \&blindsig_prep,
);

# main program

# read key
my($n, $e, $d) = readkey("$libdir/$keyfile");
$d or die "Sorry, I really need access to the secret key\n";

# display our public key and ask user to authenticate
print "200-blindsigd$crlf";
print "200-My public key is:$crlf";
print npretty("200-n: ", $n, $crlf), $crlf;
print npretty("200-e: ", $e, $crlf), $crlf;
print "200-Please RSA encode your credentials!$crlf";

my $challenge = brand( $bignumlib->new('1000000000') );
print npretty("200 Challenge: ", $challenge, $crlf), $crlf;

# state
my $state = 'unauthenticated';
# some states have specialised handling of input lines
my %statehandler = (
    'blindrcv' => \&blindrcv,
    'needsync' => \&needsync,
    'unblindrcv' => \&unblindrcv,
);

# process lines on STDIN
# automatically concatenate continuation lines, and dispatch to the
# correct handler for the current state, or to the correct command.
my $line = '';
while ( <STDIN> ) {
    # remove any line ending, including CRLF
    s/\s+$//;
    # remove continuation char, and if a continuation, remove leading
    # spaces from current line.
    s/^\s+// if $line =~ s/\\$//;
    $line .= $_;
    # get next input line if it's a continuation
    next if $line =~ /\\$/;

    Log("> $line");
    # dispatch to handler for state if in a specific state
    if ( $statehandler{$state} ) {
	$statehandler{$state}->($line);
    }
    else {
	# command-dispatcher
	my($cmd, $args) = split ' ', $line, 2;
	next unless $cmd;
	if ( $cmds{uc $cmd} ) {
	    $cmds{uc $cmd}->($args);
	}
	else {
	    print "500 No such command \U$cmd\E$crlf";
	    Log("invalid command");
	}
    }

    $line = '';
}

$dbh->disconnect;

# authenticate the user against the database, and make sure they are
# (still) allowed to vote.
# Argument is the argument to the "IAM" command, RSA-encoded string
# containing "challenge username:password"
sub authenticate {
    my $codedid = shift;

    unless ( $state eq 'unauthenticated' ) {
	print "500 Why are you authenticating yourself again?$crlf";
	Log("extra authentication?");
	return;
    }
    unless ( $codedid =~ /^\+?\d+$/ ) {
	print "500 Need RSA encoded credentials$crlf";
	Log("Invalid authentication format");
	return;
    }
    my $cid = $bignumlib->new($codedid);
    my $id = rsa_decode($n, $d, $cid);
    my $passwd;
    if ( ($user, $passwd) = $id =~ /^\Q$challenge\E (\w+):(.*)$/ and
	my $name = auth_user($user, $passwd) )
    {
	Log("authenticated $user ($name)");
	# verify that user can vote.
	my($vote) = $dbh->selectrow_array( q{
		SELECT vote FROM voters WHERE username = ?
	    }, undef, $user );
	if ( !defined $vote ) {
	    print "500 Sorry, you are not allowed to vote, $name.$crlf";
	    Log("Cannot vote");
	}
	elsif ( $vote < 1 ) {
	    print "500 Sorry, you've already used up your vote, $name$crlf";
	    Log("Already used vote");
	}
	else {
	    print "200 Welcome, $name$crlf";
	    $dbh->do( q{
		    UPDATE voters SET state = 'anon-login' WHERE username = ?
		}, undef, $user );
	    $state = 'authenticated';
	}
    }
    else {
	print "500 Sorry, you are not allowed to vote.$crlf";
	Log("Cannot vote");
    }
    # finish database transaction
    $dbh->commit;
}

# authenticate user and password against the database.
sub auth_user {
    my($user, $pass) = @_;

    # get passwd and full name from database
    my($passwd, $name) = $dbh->selectrow_array(q{
	    SELECT passwd, name FROM voters WHERE username = ?
	}, undef, $user);
    return unless $passwd;

    # verify password
    if ( crypt($pass, $passwd) eq $passwd ) {
	return $name;
    }
    return;
}

# variables to collect blinded messages
my $expect;
my @msgs;
my $signnum;
my $pos;
my $signed;

# blindsig_prep prepares receiving the blinded messages.
# it checks if the user is authenticated, informs the user how
# many blinded messages we expect, and what the expected format is.
sub blindsig_prep {
    if ( $state eq 'done' ) {
	print "500 Yes well thanks bye now!$crlf";
	Log("Already did blindsig");
	return;
    }
    if ( $state ne 'authenticated' ) {
	print "500 You should authenticate first$crlf";
	Log("blindsig without authentication");
	return;
    }

    # how many messages do we expect
    $expect = $totalpersig;
    print "201-$totalpersig blinded messages should be sent$crlf";
    print "201-Message format should be:$crlf";
    print "201 $format$crlf";

    # prepare to receive blinded messages
    $state = 'blindrcv';
    @msgs = ();
}

# if something goes wrong, the sender usually was busy sending a bunch
# of commands. To get back in sync, the sender needs to send the "SYNC"
# command, after which you are able to give regular commands again.
sub needsync {
    my $line = shift;

    if ( $line eq "SYNC" ) {
	print "200 Synched$crlf";
	$state = 'authenticated';
    }
    else {
	print "500 Ignored $line$crlf";
    }
}

# check if we need to sign the current message, and if so, sign it.
sub signmsgs {
    if ( $signnum == $pos ) {
	# we have to sign this position
	$signed = exp_mod($msgs[$pos], $d, $n);
	# advance to next position
	$pos++;
    }
}

# blindrcv is called for every blinded message the user sends.
# it simply checks the received messages for validity, and stores
# them in the @msgs array.
# calls unblind_prepare if we received the expected number of messages.
sub blindrcv {
    my $num = shift;

    unless ( $num =~ /^\s*(\+?\d+)\s*$/ ) {
	print "550-Error in blinded message.$crlf";
	print "550 issue SYNC to get back in sync$crlf";
	$state = 'needsync';
	Log("blinded message format error");
	return;
    }

    push @msgs, $bignumlib->new($1);
    unblind_prepare() if --$expect == 0;
}

# unblind_prepare is called whenever we received enough blinded signatures.
# cross off the user from the list of eligible voters, choose a random
# message to sign, ask for all the other unblinding factors, and prepare
# to receive those.
sub unblind_prepare {
    # cross off user from database
    $dbh->do( q{
	    UPDATE voters SET state = 'anon-final', vote = 0
	    WHERE username = ? AND vote > 0
	}, undef, $user )
	or die "Your vote is already gone after all?\n";
    $dbh->commit;

    print "202-Thank you. This was the point of no return.$crlf";
    Log("All blinded messages received");

    # determine message we are willing to sign
    $signnum = brand($totalpersig);
    print "202-I will sign this message: $signnum$crlf";
    print "202 Give me all other unblinding factors$crlf";
    Log("Will sign $signnum");

    # prepare to receive unblinding factors
    $state = 'unblindrcv';
    $pos = 0;
    $signed = undef;

    # if we promised to sign the 0th message, do so now.
    signmsgs();
}

# receive an unblinding factor of a message we are not going to sign.
sub unblindrcv {
    my $num = shift;

    # check message format
    unless ( $num =~ /^\s*(\+?\d+)\s*$/ ) {
	print "550-Error in unblind factor.$crlf";
	print "550 issue SYNC to get back in sync$crlf";
	$state = 'needsync';
	Log("Unblind factor format error");
	return;
    }

    my $unblind = $bignumlib->new($1);

    # verify unblinded message
    my $m = ( $msgs[$pos] * mod_inverse($unblind, $n) ) % $n;
    my $mes = n2str($m);

    unless ( message_check($mes) ) {
	print "550-Unblinded message doesn't match.$crlf";
	# XXX debug
	print "550-unblind factor was $unblind$crlf";
	print "550-Got $m$crlf";
	print "550-Message was $mes$crlf";
	print "550 issue SYNC to get back in sync$crlf";
	Log("Invalid message");
	$state = 'needsync';
	return;
    }

    # XXX debug
    print "100-Message $pos OK$crlf";

    # next message
    $pos++;

    # sign this message if we promised to sign it.
    signmsgs();

    if ( $pos == @msgs ) {
	# got all unblinding factors, returned signed message
	blind_finish();
    }
}

# blind_finish is called whenever we received all unblinding factors.
# return the signed message, and close down.
sub blind_finish {
    print "300-All OK, thanks.$crlf";
    print "300 Signatures follow, terminated by CRLF.CRLF$crlf";
    Log("Unblinded messages OK");
    print npretty("$signnum: ", $signed, $crlf), $crlf;
    Log("Signature: $signed");
    print ".$crlf";

    $dbh->do( q{
	    UPDATE voters
	    SET state = 'anon-vote-rcvd'
	    WHERE username = ?
	}, undef, $user );
    $dbh->commit;

    $state = 'done';
}

sub help {
    print "200-I understand these commands:$crlf";
    print "200-", join(" ", keys %cmds), $crlf;
    print "200 Your state is now: $state$crlf";
}

sub quit {
    print "500 Bye$crlf";
    $dbh->disconnect;
    sleep 1;
    exit;
}