source: trunk/lib/Vote/DB/Poll.pm @ 193

package Vote::DB::Poll;

# $Id$

use strict;
use warnings;
use Vote;
use Crypt::RSA;
use Crypt::RSA::Key::Public::SSH;
use Crypt::RSA::Key::Private::SSH;
use Crypt::CBC;
use XML::Simple;
use MIME::Base64;
use base 'Vote::DB::common';
use Vote::DB::Ballot;
use Vote::DB::Voting;
use Vote::DB::Choice;

=head1 NAME

Vote::Model::Vote - Catalyst Model

=head1 DESCRIPTION

Catalyst Model.

=cut

sub new {
    my ($class, $dbstring, $voteid) = @_;
    
    bless {
        voteid => $voteid,
        dbstring => $dbstring,
        db => Vote::DB::common::_newdb($dbstring),
    }, $class;
}

sub voteid { $_[0]->{voteid} }

sub setup {
    my ($self) = @_;
    $self->param(
        free_choice => 0,
        choice_count => 1,
    );
}

sub param {
    my ($self, %attr) = @_;

    keys %attr or return;
    my @online_f = qw(label start end owner password);

    if (grep { exists($attr{$_}) } @online_f) {
        my $sth = $self->db->prepare_cached(
            q{update poll set } .
            join(',', map { qq("$_" = ?) } grep { exists $attr{$_} } @online_f) .
            q{ where id = ?}
        );
        $sth->execute((map { $attr{$_} } grep { exists $attr{$_} } @online_f), $self->voteid)
            or do {
            $self->db->rollback;
            return;
        };
    }

    # vote settings in settings table
    foreach my $var (keys %attr) {
        grep { $var eq $_ } @online_f and next;
        $self->set_settings($var, $attr{$var});
    }
    1
}

sub status {
    my ($self) = @_;
    
    my $sth = $self->db->prepare_cached(
        q{
        select (start > now() or start is null) as before,
               "end" < now() as after
        from poll
        where id = ?
        }
    );
    $sth->execute($self->voteid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res or return;
    if ($res->{before}) {
        return 'BEFORE';
    } elsif ($res->{after}) {
        return 'AFTER';
    } else {
        return 'RUNNING';
    }
}

sub info {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select *,
        to_char("start", 'DD/MM/YYYY') as dstart,
        to_char("start", 'HH24:MI:SS') as hstart,
        to_char("end", 'DD/MM/YYYY') as dend,
        to_char("end", 'HH24:MI:SS') as hend
        from poll where id = ?
        }
    );

    $sth->execute($self->voteid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    if ($res) {
        my $get = $self->db->prepare_cached(
            q{select var, val from settings where poll = ?}
        );
        $get->execute($self->voteid);
        while (my $set = $get->fetchrow_hashref) {
            $res->{$set->{var}} = $set->{val};
        }
    }
    $res->{free_choice} ||= 0; # avoiding undef
    $res
}

sub set_settings {
    my ($self, $var, $val) = @_;

    my $upd = $self->db->prepare_cached(
        q{update settings set val = ? where poll = ? and var = ?}
    );

    if ($upd->execute($val, $self->voteid, $var) == 0) {
        my $add = $self->db->prepare_cached(
            q{insert into settings (poll, var, val) values (?,?,?)}
        );

        $add->execute($self->voteid, $var, $val);
    }
}

sub signing {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select *, voting.key as vkey from voting left join signing
        on signing.key = voting.key
        where poll = ? order by voting.mail
        }
    );
    $sth->execute($self->voteid);
    my @people;
    while (my $res = $sth->fetchrow_hashref) {
        push(@people, $res);
    }
    @people
}

sub voting {
    my ($self, $votingkey) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select key from voting where poll = ? and key = ?
        }
    );

    $sth->execute($self->voteid, $votingkey);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    return $res ? Vote::DB::Voting->new($self->{dbstring}, $votingkey) : undef;
}

sub voting_from_mail {
    my ($self, $mail) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select key from voting where poll = ? and mail = ?
        }
    );

    $sth->execute($self->voteid, $mail);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    return $res ? Vote::DB::Voting->new($self->{dbstring}, $res->{key}) : undef;
}

sub voting_keys {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select key from voting
        where poll = ? order by voting.mail
        }
    );
    $sth->execute($self->voteid);
    my @people;
    while (my $res = $sth->fetchrow_hashref) {
        push(@people, $res->{key});
    }
    @people
}

sub voting_info {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select *, voting.key as vkey from voting left join signing
        on signing.key = voting.key
        where voting.key = ?
        }
    );
    $sth->execute($self->voteid);

    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res
}

sub choice {
    my ($self, $chid) = @_;
    
    my $sth = $self->db->prepare_cached(
        q{
        select key from choice where poll = ? and key = ?
        }
    );
    $sth->execute($self->voteid, $chid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    return $res ? Vote::DB::Choice->new($self->{dbstring}, $chid) : undef;
}

sub choices {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select key from choice where poll = ?
        order by label
        }
    );
    $sth->execute($self->voteid);
    my @ch;
    while (my $res = $sth->fetchrow_hashref) {
        push(@ch, $res->{key});
    }
    @ch
}

sub add_choice {
    my ($self, $label) = @_;

    my $sth = $self->db->prepare_cached(
        q{insert into choice (poll, label) values (?,?)}
    );

    $sth->execute($self->voteid, $label) or do {
        $self->db->rollback;
        return;
    };

    1
}

sub delete_choice {
    my ($self, $chid) = @_;

    my $sth = $self->db->prepare_cached(
        q{delete from choice where key = ?}
    );

    $sth->execute($chid);
}

sub _register_signing {
    my ($self, $mail, $referal) = @_;

    my $vinfo = $self->voting_info_id($mail) or return;

    my $sth = $self->db->prepare_cached(
        q{
        insert into signing (key, referal) values (?,?)
        }
    );
    $sth->execute($vinfo->{key}, $referal) or do {
        $self->db->rollback;
        return;
    };

    1;
}

sub _register_ballot {
    my ($self, $choice, $fchoice) = @_;

    my $uid = ($self->is_crypted
        ? $self->_register_ballot_crypted($choice, $fchoice)
        : $self->_register_ballot_clear($choice, $fchoice))
        or do {
            self->db->rollback;
            return;
        };

    $uid
}

sub _register_ballot_clear {
    my ($self, $choice, $fchoice, $uid) = @_;

    my $addb = $self->db->prepare_cached(
        q{
        insert into ballot (id, poll, invalid) values (?,?,?)
        }
    );
    $uid ||= Vote::DB::common::gen_uid();
    $addb->execute($uid, $self->voteid, scalar(@{$fchoice || []}) ? undef : 'f') or do {
        self->db->rollback;
        return;
    };

    $self->_register_ballot_items($uid, $choice, $fchoice) or do {
        self->db->rollback;
        return;
    };

    $uid
}

sub find_choice_key {
    my ($self, $value) = @_;

    my $sth = $self->prepare_cached(
        q{select key from choice where lower(label) = ? and poll = ?}
    );
    $sth->execute(lc($value), $self->pollid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{key}
}

sub _register_ballot_items {
    my ($self, $uid, $choice, $fchoice) = @_;

    my $addbc = $self->db->prepare_cached(
        q{
        insert into ballot_item (id, value, fromlist) values (?,?,?)
        }
    );
    foreach (@{ $choice || []}) {
        $addbc->execute($uid, $_, 't') or do {
            $self->db->rollback;
            return;
        };
    }
    foreach (@{ $fchoice || []}) {
        $_ or next;
        my $chkey = $self->find_choice_key($_);
        $addbc->execute($uid, $_, $chkey ? 't' : 'f') or do {
            $self->db->rollback;
            return;
        };
    }

    $uid;
}

sub _register_ballot_crypted {
    my ($self, $choice, $fchoice) = @_;
    my $xml = XML::Simple->new(ForceArray => 1, RootName => 'ballot');
    my $symkey = map{ chr(rand(256)) } (1 .. (256 / 8));
    my $cipher = new Crypt::CBC($symkey, 'DES');
    my $ballotuid = Vote::DB::common::gen_uid();
    my $encryptedballot = $cipher->encrypt_hex(
        $xml->XMLout({
            id => $ballotuid,
            sbal => $choice,
            fsbal => $fchoice
        })
    );
    my $encsymkey = $self->rsa->encrypt (
        Message    => $symkey,
        Key        => $self->public_key,
        Armour     => 1,
    ) || die $self->rsa->errstr();

    my $addenc = $self->db->prepare_cached(
        q{insert into ballot_enc (id, data, enckey, poll) values (?,?,?,?)}
    );

    my $uid = Vote::DB::common::gen_uid();
    $addenc->execute($uid, $encryptedballot, $encsymkey, $self->voteid);
    $ballotuid;
}

sub _decrypted_ballot {
    my ($self, $ballotid, $privkey) = @_;
    my $sth = $self->db->prepare_cached(
        q{select * from ballot_enc where id = ? for update}
    );
    $sth->execute($ballotid);
    my $ballot = $sth->fetchrow_hashref;
    $sth->finish;
    my $encsymkey = $ballot->{enckey};
    my $data = $ballot->{data};
    my $symkey = $self->rsa->decrypt (
        Cyphertext => $encsymkey,
        Key        => $privkey,
        Armour     => 1,
    ) || die $self->rsa->errstr();
    my $cipher = new Crypt::CBC($symkey, 'DES');
    my $xmldata = XMLin($cipher->decrypt_hex($data), ForceArray => 1);
    $self->_register_ballot_clear($xmldata->{sbal}, $xmldata->{fsbal}, $xmldata->{id});
    my $upd = $self->db->prepare_cached(q{update ballot_enc set decrypted = true where id = ?});
    if ($upd->execute($ballotid)) {
        $self->db->commit;
        return;
    } else {
        $self->db->rollback;
        return 1;
    }
}    

sub decrypted_ballots {
    my ($self, $password) = @_;
    my $privkey = $self->private_key($password);
    foreach ($self->list_ballot_need_dec) {
        $self->_decrypted_ballot($_, $privkey);
    }
}

sub register_ballot {
    my ($self, $vid, $choice, $fchoice, $referal) = @_;

    my $uid;
    for (0..2) { # 3 try
    # First we register voting has voted
    $self->_register_signing($vid, $referal) or return; # TODO error ?

    # registring choices
    $uid = $self->_register_ballot($choice, $fchoice);
    defined($uid) and last;

    }
    # everything went fine, saving!
    $self->db->commit;

    
    $uid
}

sub voting_count {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select count(*) from voting
        where poll = ?
        }
    );
    $sth->execute($self->voteid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{count}
}

sub signing_count {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select count(*) from signing join voting
        on voting.key = signing.key where poll = ?
        }
    );

    $sth->execute($self->voteid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{count}
}

sub is_crypted {
    my ($self) = @_;
    return $self->info->{public_key} ? 1 : 0;
}

sub ballot_count {
    my ($self) = @_;
    return $self->is_crypted
        ? $self->ballot_count_crypt
        : $self->ballot_count_clear;
}

sub ballot_count_clear {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{select count(*) from ballot where poll = ?}
    );

    $sth->execute($self->voteid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{count}
}

sub ballot_count_crypt {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{select count(*) from ballot_enc where poll = ?}
    );

    $sth->execute($self->voteid);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    $res->{count}
}

sub voting_info_id {
    my ($self, $mail) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select * from voting where mail = ? and poll = ?
        }
    );
    $sth->execute($mail, $self->voteid);
    my $res = $sth->fetchrow_hashref();
    $sth->finish;
    $res
}

sub auth_voting {
    my ($self, $mail, $password) = @_;
    my $userinfo = $self->voting_info_id($mail) or return;

    $userinfo->{passwd} or return;
    if (crypt($password, $userinfo->{passwd} || '') eq $userinfo->{passwd}) {
        return 1;
    } else {
        return 0;
    }
}

sub auth_poll {
    my ($self, $passwd) = @_;

    my $vinfo = $self->info or return;

    $vinfo->{password} or return;
    $passwd or return;
    if (crypt($passwd, $vinfo->{password} || '') eq $vinfo->{password}) {
        return 1;
    } else {
        return 0;
    }
}

sub voting_has_sign {
    my ($self, $user) = @_;
    warn $user;
    $self->voting_from_mail($user)->has_sign;
}

# Requete de decompte des voix:

sub can_show_result {
    my ($self) = @_;

    # If ballot are encrypted, no
    if ($self->list_ballot_need_dec) {
        return;
    }

    return 1;
}

sub ballot {
    my ($self, $id) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select id from ballot where poll = ? and id = ?
        }
    );

    $sth->execute($self->voteid, $id);
    my $res = $sth->fetchrow_hashref;
    $sth->finish;
    return $res ? Vote::DB::Ballot->new($self->{dbstring}, $id) : undef;
}

sub list_ballot {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select id from ballot where poll = ?
        order by id
        }
    );
    $sth->execute($self->voteid);
    my @ids;
    while (my $res = $sth->fetchrow_hashref) {
        push(@ids, $res->{id});
    }
    @ids
}

sub list_ballot_enc {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select id from ballot_enc where poll = ?
        order by id
        }
    );
    $sth->execute($self->voteid);
    my @ids;
    while (my $res = $sth->fetchrow_hashref) {
        push(@ids, $res->{id});
    }
    @ids
}

sub list_ballot_need_dec {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select id from ballot_enc where poll = ? and decrypted = 'false'
        order by id
        }
    );
    $sth->execute($self->voteid);
    my @ids;
    while (my $res = $sth->fetchrow_hashref) {
        push(@ids, $res->{id});
    }
    @ids
}

sub list_ballot_needvalid {
    my ($self) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        select id from ballot where poll = ?
        and invalid is null order by id
        }
    );
    $sth->execute($self->voteid);
    my @ids;
    while (my $res = $sth->fetchrow_hashref) {
        push(@ids, $res->{id});
    }
    @ids
}

sub ballot_untrusted_values {
    my ($self) = @_;

    my $getval = $self->db->prepare_cached(
        q{
        select value from ballot join ballot_item
        on ballot.id = ballot_item.id
        where poll = ? and fromlist = false and corrected is null
        group by value order by value
        }
    );
    $getval->execute($self->voteid);
    my @vals;
    while (my $res = $getval->fetchrow_hashref) {
        push(@vals, $res->{value});
    }
    @vals
}

sub ballot_values {
    my ($self) = @_;

    my $getval = $self->db->prepare_cached(
        q{
        select coalesce(corrected, value) as value from ballot join ballot_item
        on ballot.id = ballot_item.id
        where poll = ?
        group by coalesce(corrected, value) order by coalesce(corrected, value)
        }
    );
    $getval->execute($self->voteid);
    my @vals;
    while (my $res = $getval->fetchrow_hashref) {
        push(@vals, $res->{value});
    }
    @vals
}

sub map_value {
    my ($self, $from, $to) = @_;

    my $sth = $self->db->prepare_cached(
        q{
        update ballot_item set corrected = ? where
        id in (select id from ballot where poll = ?)
        and (value = ? or corrected = ?)
        }
    );

    $sth->execute($to, $self->voteid, $from, $from) or $self->db->rollback;
    $self->db->commit;
}

sub addupd_voting {
    my ($self, $mail, $id) = @_;

    $mail =~ s/\s*$//;
    $mail =~ s/^\s*//;
    $mail = lc($mail);
    $id =~ s/\s*$//;
    $id =~ s/^\s//;
    my $upd = $self->db->prepare_cached(
        q{
        update voting set label = ? where mail = ? and poll = ?
        }
    );

    if ($upd->execute($id || '', $mail, $self->voteid) == 0) {
        my $add = $self->db->prepare_cached(q{
            insert into voting (poll, label, mail) values (?,?,?)
        });

        $add->execute($self->voteid, $id || '', $mail);
    }
}

sub voting_from_file {
    my ($self, $fh, $delete) = @_;

    if ($delete) {
        my $sth = $self->db->prepare(q{delete from voting where poll = ?});
        $sth->execute($self->voteid);
    }

    while (my $line = <$fh>) {
        chomp($line);
        my ($mail, $name) = split(';', $line);
        $mail or do {
            $self->db->rollback;
            return;
        };
        $self->addupd_voting($self->voteid, $mail, $name || '');
    }
    1;
}

sub list_voting_no_passwd {
    my ($self) = @_;

    my $list_voting = $self->db->prepare_cached(
        q{select key from voting where poll = ? and passwd is null or passwd = ''}
    );

    $list_voting->execute($self->voteid);
    my @ids;
    while (my $res = $list_voting->fetchrow_hashref) {
        push(@ids, $res->{key});
    }
    @ids
}

sub mail_voting_passwd {
    my ($self, $id, $mailinfo) = @_;
    $self->voting($id)->mail_voting_passwd($mailinfo); 
}

# crypto part

sub rsa {
    my ($self) = @_;
    $self->{rsa} ||= new Crypt::RSA ES => 'PKCS1v15';
}

sub gen_poll_keys {
    my ($self, $password) = @_;
    my ($public, $private) = $self->rsa->keygen (
        Identity  => 'Epoll Vote ' . $self->voteid,
        Size      => 768,
        Password  => $password,
        Verbosity => 0,
        KF=>'SSH',
    ) or die $self->rsa->errstr(); # TODO avoid die
    $self->param(
        public_key => $public->serialize,
        private_key => encode_base64($private->serialize),
    );
}

sub public_key {
    my ($self) = @_;
    my $serialize = $self->info->{public_key} or return;
    my $pubkey = Crypt::RSA::Key::Public::SSH->new;
    $pubkey->deserialize(String => [ $serialize ]);
    $pubkey
}

sub private_key {
    my ($self, $password) = @_;
    my $serialize = $self->info->{private_key} or return;
    my $privkey = Crypt::RSA::Key::Private::SSH->new;
    $privkey->deserialize(String => [ decode_base64($serialize) ], Passphrase => $password);
    $privkey
}
=head1 AUTHOR

Thauvin Olivier

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself or CeCILL.

=cut

1;