path: root/Votify.pm

#!/usr/bin/perl
# Copyright 1999-2024 Gentoo Authors
# Distributed under the terms of the GNU General Public License v2
#
# votify.pm: common classes for votify and countify
#

package Votify;

use Carp::Always;
use Cwd qw(abs_path);
use Data::Dumper;
use File::Basename;
use File::Spec::Functions;
use List::Util;
use POSIX;
use strict;
use warnings;

our $datefmt = '%Y-%m-%d %H:%M:%S UTC';
our ($basedir) = List::Util::first { -d $_ } ('/etc/elections', dirname(abs_path(__FILE__)));
(our $zero = $0) =~ s,.*/,,;
our $version = '1.6';

sub import {
    my ($class, $mode) = @_;
    $Votify::mode = $mode;
}

my @REQUIRED_FILES = qw(ballot officials start stop voters);

# Takes the name of an election and ensure it's validate under the basedir,
# returning the full path to the election if valid, and undef if not valid.
# Where valid is:
# A directory containing ALL of the files in @REQUIRED_FILES, either either
# their direct names, or the name of the election on the end of the files.
# Eg 'ballot' or 'ballot-election1234'.
sub validate_election_dir {
    my $election_rawdir = shift;
    return 0 unless defined $election_rawdir;
    return 0 if substr($election_rawdir,0,1) eq ".";

    my $election_name = $election_rawdir;
    $election_name =~ s/.*\///;
    my $election_dir = abs_path(catfile($Votify::basedir, $election_name));

    # Fail if it's not a directory in the basedir
    return 0 unless -d $election_dir;

    # Do not try to validate hidden directories.
    return 0 if substr($election_name,0,1) eq ".";

    # Validate that the required files exist in the dir
    # Part 1, convert the array to a map
    my %REQUIRED_FILES_valid = map {
        my $file_valid = 0;
        # Legacy naming:
        $file_valid = 1 if -r sprintf("%s/%s-%s", $election_dir, $_, $election_name);
        # New naming:
        $file_valid = 1 if -r sprintf("%s/%s", $election_dir, $_);
        #printf "File %s valid=%d\n", $_, $file_valid;
        ($_, $file_valid);
    } @REQUIRED_FILES;

    # Part 2, ensure all of the map is true
    my $valid = List::Util::reduce {
        $a or $b ? 1 : 0;
    } values(%REQUIRED_FILES_valid);

    # Now return.
    return $election_dir if $valid;
    return undef;
}

sub get_elections_list {
    my @elections;

    # Raw data:
    opendir(D, $Votify::basedir) or die;
    @elections = readdir D;
    closedir D;

    # Pass 1:
    # Get rid of some definetly non-elections
    @elections = grep {
        my $state = List::Util::reduce { $a and $b } [
            # All of these must be true:
            -d(catfile($Votify::basedir, $_)),
            ($_ ne "."), # Exclude current dir
            ($_ ne ".."), # Exclude parent
            ($_ ne ""), # Exclude bugs
            substr($_, 0, 1) ne ".", # No hidden items
            1, # Fallback for when the items are commented out
        ];
        #printf "2: %s %d\n", $_, ($state);
        $state;
    } @elections;

    # Pass 2:
    # Full validation
    @elections = grep {
        my $valid_election_dir = validate_election_dir($_);
        my $state = (defined $valid_election_dir) && $valid_election_dir;
        #printf "1: validate_election_dir(%s) = %s, state=%d\n", $_, $valid_election_dir, $state;
        $state;
    } @elections;

    return sort @elections;
}

sub grabfile_int {
    my $f = shift;
    #print "Checking $f\n";
    my $i = 0;
    open my $fh, '<', $f or return -1;
    local $/ = undef;
    $i = <$fh> if defined($fh);
    close $fh;
    #print "Raw file: $i\n";
    chomp $i if $i;
    return $i;
}


sub get_single_election_hashref {
    my $election_name = shift;
    my $election_dir = validate_election_dir($election_name);
    return undef unless defined $election_dir;
    my %election;
    foreach my $fn (@REQUIRED_FILES){
        #print STDERR "Scan $fn\n";
        my @filenames = (sprintf("%s/%s", "$basedir/$election_name", $fn), sprintf("%s/%s-%s", "$basedir/$election_name", $fn, $election_name));
        #print STDERR Dumper(@filenames);
        my $filename = List::Util::first { $_ && -r $_ && -s $_ && ! -d $_ } @filenames;
        my $absfilename = abs_path($filename) if $filename;
        $election{"${fn}file"} = $absfilename if $absfilename;
    };
    #print Dumper(%election);
    $election{starttime} = grabfile_int($election{'startfile'});
    $election{stoptime} = grabfile_int($election{'stopfile'});
    return \%election;
}

sub get_elections_hash {
    my %elections;
    my @elections_list = get_elections_list();
    #print Dumper(\@elections_list);
    %elections = map { $_ => get_single_election_hashref($_) } @elections_list;
    return %elections;
}

sub get_open_elections_hash {
    my %elections = get_elections_hash();
    my @open_elections = grep {
      my $starttime = $elections{$_}{'starttime'};
      my $stoptime = $elections{$_}{'stoptime'};
      my $valid = ((not defined $starttime or $starttime < time) and
            (not defined $stoptime or $stoptime > time));
      $valid;
    } keys %elections;
    return map { $_ => $elections{$_} } @open_elections;
}

######################################################################
# OfficialList
######################################################################

package OfficialList;

sub new {
    my ($class, $election_name) = @_;
    my ($self) = {
        election => $election_name,
        officials => [],
    };

    my $election = Votify::get_single_election_hashref($self->{'election'});
    # no point in waiting to load
    open(F, '<', $election->{'officialsfile'})
        or die("failed to open officials file");
    chomp(@{$self->{'officials'}} = <F>);
    close(F);

    bless $self, $class;
    return $self;
}

sub officials {
    my ($self) = @_;
    @{$self->{'officials'}};
}

######################################################################
# VoterList
######################################################################

package VoterList;
use File::Spec::Functions;

sub new {
    my ($class, $election_name) = @_;
    my (@voterlist, $r);
    my $datadir = Votify::validate_election_dir($election_name);
    die "Unable to get election dir for name $election_name" unless defined $datadir;
    my ($self) = {
        election => $election_name,
        default_filename => catfile($datadir, "confs-$election_name"),
        filename => '',
        voters => {},   # confnum => voter
        confs => {},    # voter => confnum
    };

    # no point in waiting to load
    my $election = Votify::get_single_election_hashref($self->{'election'});
    open(F, '<', $election->{'votersfile'})
        or die("failed to open voters file");
    chomp(@voterlist = <F>);
    close(F);

    # assign confirmation numbers randomly
    for my $v (List::Util::shuffle(@voterlist)) {
        do { $r = int rand 0xffffffff } while exists $self->{'voters'}{$r};
        $self->{'voters'}{$r} = $v;
        $self->{'confs'}{$v} = $r;
    }

    unless (keys %{$self->{'voters'}} == keys %{$self->{'confs'}}) {
        die("discrepancy deteced in VoterList");
    }

    bless $self, $class;
    return $self;
}

sub confs {
    my ($self) = @_;
    sort keys %{$self->{'voters'}};
}

sub voters {
    my ($self) = @_;
    return sort keys %{$self->{'confs'}};
}

sub getvoter {
    my ($self, $conf) = @_;
    return $self->{'voters'}{$conf};
}

sub getconf {
    my ($self, $voter) = @_;
    return $self->{'confs'}{$voter};
}

sub write_confs {
    my ($self, $filename) = @_;

    $filename ||= $self->{'default_filename'};
    $self->{'filename'} = $filename;

    if (-e $filename) {
        die "$filename already exists; please remove it first";
    }

    open(F, ">$filename") or die("can't write to $filename");
    for my $c (sort { $a <=> $b } map { int $_ } $self->confs) {
        printf F "%08x %s\n", $c, $self->getvoter($c);
    }
    close F;
}

######################################################################
# MasterBallot
######################################################################

package MasterBallot;

use Data::Dumper;
use File::Spec::Functions;

sub new {
    my ($class, $election_name, $vl) = @_;
    my $datadir = Votify::validate_election_dir($election_name);
    die "Unable to get election dir for name $election_name" unless defined $datadir;
    my ($self) = {
        election => $election_name,
        default_filename => catfile($datadir, "master-$election_name"),
        filename => '',
        voterlist => $vl,
        casting_voters => {},   # indexed by voter
        ballots => {},          # indexed by conf num
        candidates => undef,    # indexed by long name
        table => undef,         # indexed by row+column
    };

    bless $self, $class;
    return $self;
}

sub collect {
    my ($self, @voters) = @_;
    my ($c, $v, $home, @pwentry);

    for my $v (@voters) {
        unless (defined ($c = $self->{'voterlist'}->getconf($v))) {
            die "$v does not correspond to any confirmation number";
        }

        @pwentry = getpwnam($v);
        if(@pwentry) {
            $home = $pwentry[7];
        } else {
            print STDERR "Warning: Assuming /home/$v/ for unknown user: $v\n";
            $home = sprintf '/home/%s/',$v;
        }

        unless (-d $home) {
            print STDERR "Warning: no directory: $home\n";
            next;
        }

        my $submitted_filename = "$home/.ballot-$self->{election}-submitted";
        if (-d $submitted_filename) {
            print STDERR "Warning: $v has a directory instead of a ballot\n";
        }
        elsif (-e $submitted_filename && -r $submitted_filename) {
            my ($b) = Ballot->new($self->{'election'});
            $b->read("$home/.ballot-$self->{election}-submitted");
            if ($b->verify) {
                print STDERR "Errors found in ballot: $v\n";
                next;
            }
            $self->{'ballots'}{$c} = $b;
            $self->{'casting_voters'}{$v} = 1;
        }
        elsif (-e "$home/.ballot-$self->{election}") {
            print STDERR "Warning: $v did not submit their ballot\n";
        }
    }
}

sub write_master {
    my ($self, $filename) = @_;

    $filename ||= $self->{'default_filename'};
    $self->{'filename'} = $filename;

    if (-e $filename) {
        die "$filename already exists; please remove it first";
    }

    open(F, ">$filename") or die("can't write to $filename");
    for my $c (sort { $a <=> $b } map { int $_ } keys %{$self->{'ballots'}}) {
        my $confid = sprintf("%08x",$c);
        printf F "--------- confirmation %s ---------\n", $confid;
        print F $self->{'ballots'}{$c}->to_s
    }
    close F;
}

sub read_master {
    my ($self, $filename) = @_;
    my ($election, $entries) = $self->{'election'};

    $filename ||= $self->{'default_filename'};
    $self->{'filename'} = $filename;

    open(F, "<$filename") or die("can't read $filename");
    { local $/ = undef; $entries = <F>; }
    for my $e (split /^--------- confirmation /m, $entries) {
        next unless $e; # skip the first zero-length record
        unless ($e =~ /^([[:xdigit:]]{4,12}) ---------\n(.*)$/s) {
            die "error parsing entry:\n$e";
        }
        my ($c, $s, $b) = ($1, $2, Ballot->new($election));
        $b->from_s($s);
        $self->{'ballots'}{hex($c)} = $b;
    }
}

sub write_casting_voters {
    my ($self, $filename) = @_;

    $filename ||= $self->{'default_filename'};
    $self->{'filename'} = $filename;

    if (-e $filename) {
        die "$filename already exists; please remove it first";
    }

    open(F, ">$filename") or die("can't write to $filename");
    for my $v (sort keys %{$self->{'casting_voters'}}) {
        printf F "%s\n", $v;
    }
    close F;
}


sub generate_candidates {
    my ($self) = @_;
    my ($B, @C, $s);

    # nb: would need to scan all the ballots to support write-ins
    $B = Ballot->new($self->{'election'});
    $B->populate;
    @C = sort map $_->[0], @{$B->choices};
    for my $c (@C) {
        $s = $c; # in case $c is shorter than 5 chars
        for (my $i=5; $i<=length($c); $i++) {
            $s = substr $c, 0, $i;
            print join(" ", grep(/^$s/, @C)), "\n";
            last unless grep(/^$s/, @C) > 1;
        }
        $self->{'candidates'}{$c} = $s;
    }
}

sub tabulate {
    my ($self) = @_;
    my (@candidates);   # full candidate list
    my (%table);        # resulting table, row.colum where row defeats column
    $self->{'table'} = \%table;

    $self->generate_candidates unless $self->{'candidates'};
    @candidates = keys %{$self->{'candidates'}};
    for my $c1 (@candidates) {
        for my $c2 (@candidates) {
            $table{"$c1+$c2"} = 0;
        }
        $table{"$c1+$c1"} = '***';
    }

    # generate the table first;
    # walk through the ballots, tallying the rankings expressed by each ballot
    for my $b (values %{$self->{'ballots'}}) {
        my (@choices, %ranks);

        #print "looking at ballot:\n", $b->to_s, "\n";

        # first determine the ranking of each candidate.  default ranking is
        # scalar @candidates.
        @choices = @{$b->choices};
        @ranks{@candidates} = (scalar @candidates) x @candidates;
        #print "ranks before determining:\n", Dumper(\%ranks);
        for (my $i = 0; $i < @choices; $i++) {
            @ranks{@{$choices[$i]}} = ($i) x @{$choices[$i]};
        }
        #print "ranks after determining:\n", Dumper(\%ranks);

        # second add the results of all the pairwise races into our table
        for my $c1 (@candidates) {
            for my $c2 (@candidates) {
                next if $c1 eq $c2;
                $table{"$c1+$c2"}++ if $ranks{$c1} < $ranks{$c2};
            }
        }
        #print "table after adding:\n";
        #$self->display_table;
    }
}

sub display_table {
    my ($self) = @_;
    my (@longnames, @shortnames);
    my ($minlen, $maxlen, $formatstr) = (0, 4, '');

    $self->generate_candidates unless $self->{'candidates'};
    @longnames = sort keys %{$self->{'candidates'}};
    @shortnames = sort values %{$self->{'candidates'}};
    $minlen = length scalar keys %{$self->{'ballots'}};
    $minlen = 5 if $minlen < 5;

    # build the format string
    for my $s (@shortnames) {
        if (length($s) > $minlen) {
            $formatstr .= "  %" . length($s) . "s";
        } else {
            $formatstr .= "  %${minlen}s";
        }
    }
    map { $maxlen = length($_) if length($_) > $maxlen } @longnames;

    # prepend the row header; append newline
    $formatstr = "%${maxlen}s" . $formatstr . "\n";

    # column headers
    printf $formatstr, '', @shortnames;

    # rows
    for my $l (@longnames) {
        printf $formatstr, $l, @{$self->{'table'}}{map "$l+$_", @longnames};
    }
}

# utility for cssd
sub defeats {
    my ($self, $o1, $o2) = @_;
    return 0 if $o1 eq $o2;
    $self->{'table'}{"$o1+$o2"} > $self->{'table'}{"$o2+$o1"};
}

# utility for cssd
sub is_weaker_defeat {
    my ($self, $A, $X, $B, $Y) = @_;
    die unless $self->defeats($A, $X);
    die unless $self->defeats($B, $Y);
    return (
        $self->{'table'}{"$A+$X"} < $self->{'table'}{"$B+$Y"} or
        (
            $self->{'table'}{"$A+$X"} == $self->{'table'}{"$B+$Y"} and
            $self->{'table'}{"$X+$A"} > $self->{'table'}{"$Y+$B"}
        )
    );
}

sub cssd {
    my ($self) = @_;
    my (@candidates);

    @candidates = sort keys %{$self->{'candidates'}};

    while (1) {
        my (%transitive_defeats);
        my (@active, @plist);

        ######################################################################
        # 5. From the list of [undropped] pairwise defeats, we generate a
        #    set of transitive defeats.
        #     1. An option A transitively defeats an option C if A
        #        defeats C or if there is some other option B where A
        #        defeats B AND B transitively defeats C.
        for my $o1 (@candidates) {
            for my $o2 (@candidates) {
                $transitive_defeats{"$o1+$o2"} = 1 if $self->defeats($o1, $o2);
            }
        }
        for my $i (@candidates) {
            for my $j (@candidates) {
                for my $k (@candidates) {
                    if (exists $transitive_defeats{"$j+$i"} and
                        exists $transitive_defeats{"$i+$k"})
                    {
                        $transitive_defeats{"$j+$k"} = 1;
                    }
                }
            }
        }

        ######################################################################
        # 6. We construct the Schwartz set from the set of transitive
        #    defeats.
        #     1. An option A is in the Schwartz set if for all options B,
        #        either A transitively defeats B, or B does not
        #        transitively defeat A.
        print "\n";
        A: for my $A (@candidates) {
            for my $B (@candidates) {
                next if $transitive_defeats{"$A+$B"} or not $transitive_defeats{"$B+$A"};
                # countify marks entries +++ instead of *** when they've already
                # been ranked.
                if ($self->{'table'}{"$A+$A"} eq '***') {
                    print "option $A is eliminated ($B trans-defeats $A, and $A does not trans-defeat $B)\n";
                }
                next A;
            }
            push @active, $A;
        }
        print "the Schwartz set is {", join(", ", @active), "}\n";
        @candidates = @active;

        ######################################################################
        # 7. If there are defeats between options in the Schwartz set, we
        #    drop the weakest such defeats from the list of pairwise
        #    defeats, and return to step 5.
        #     1. A defeat (A,X) is weaker than a defeat (B,Y) if V(A,X)
        #        is less than V(B,Y). Also, (A,X) is weaker than (B,Y) if
        #        V(A,X) is equal to V(B,Y) and V(X,A) is greater than V
        #        (Y,B).
        #     2. A weakest defeat is a defeat that has no other defeat
        #        weaker than it. There may be more than one such defeat.
        for my $o1 (@candidates) {
            for my $o2 (@candidates) {
                push @plist, [ $o1, $o2 ] if $self->defeats($o1, $o2);
            }
        }
        last unless @plist;
        @plist = sort {
            return -1 if $self->is_weaker_defeat(@$a, @$b);
            return +1 if $self->is_weaker_defeat(@$b, @$a);
            return 0;
        } @plist;
        for my $dx (@plist) {
            my ($o1, $o2) = @$dx;
            print("$o1+$o2 ",
                $self->{'table'}{"$o1+$o2"}, " $o2+$o1 ",
                $self->{'table'}{"$o2+$o1"}, "\n");
        }
        my ($o1, $o2) = @{$plist[0]};
        $self->{'table'}{"$o1+$o2"} = 0;
        $self->{'table'}{"$o2+$o1"} = 0;
    }

    ######################################################################
    # 8. If there are no defeats within the Schwartz set, then the
    #    winner is chosen from the options in the Schwartz set. If
    #    there is only one such option, it is the winner. If there
    #    are multiple options, the elector with the casting vote
    #    chooses which of those options wins.
    print "\n";
    if (@candidates > 1) {
        print "result: tie between options ", join(", ", @candidates), "\n";
    } else {
        print "result: option @candidates wins\n";
    }

    return @candidates;
}

######################################################################
# Ballot
######################################################################

package Ballot;

sub new {
    my ($class, $election) = @_;
    my ($self) = {
        election => $election,
        filename => '',
        default_filename => $ENV{'HOME'}."/.ballot-$election",
        choices => [],
    };

    # Bless me, I'm a ballot!
    bless $self, $class;
    return $self;
}

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

    for (split "\n", $s) {
        s/#.*//;
        next unless /\S/;
        push @choices, [ split(' ', $_) ];
    }
    die("No data in string") unless @choices;

    $self->{'choices'} = \@choices;
}

sub read {
    my ($self, $filename) = @_;

    $filename ||= $self->{'default_filename'};
    $self->{'filename'} = $filename;

    # Load the data file
    open(F, "<$filename") or die("couldn't open $filename");
    { local $/ = undef; $self->from_s(<F>); }
    close(F);
}

sub populate {
    my ($self) = @_;
    my $election = Votify::get_single_election_hashref($self->{'election'});
    $self->read($election->{'ballotfile'});
    @{$self->{'choices'}} = List::Util::shuffle(@{$self->{'choices'}});
}

sub choices {
    my ($self) = @_;
    $self->{'choices'};
}

sub write {
    my ($self, $filename) = @_;

    if ($Votify::mode ne 'user') {
        die("we don't write ballots in official mode");
    }

    $filename ||= $self->{'default_filename'};
    $self->{'filename'} = $filename;

    # Don't ever overwrite a ballot
    die("File already exists; please remove $filename\n") if -e $filename;

    # Write the user's ballot
    open(F, ">$filename") or die "Failed writing $filename";
    print F <<EOT;
# This is a ballot for the $self->{election} election.
# Please rank your choices in order; first choice at the top and last choice at
# the bottom.  You can put choices on the same line to indicate no preference
# between them.  Any choices you omit from this file are implicitly added at the
# end.
#
# When you're finished editing this, the next step is to verify your ballot
# with:
#
#   $Votify::zero --verify $self->{election}
#
# When that passes and you're satisfied, the final step is to submit your vote:
#
#   $Votify::zero --submit $self->{election}
#

EOT
    for (@{$self->{'choices'}}) { print F "@$_\n"; }
    close(F);
}

sub verify {
    my ($self) = @_;
    my (%h, $master, %mh);
    my (@dups, @missing, @extra);
    my ($errors_found);

    # Load %h from the user's ballot
    for my $line (@{$self->{'choices'}}) {
        for my $entry (@$line) {
            $h{$entry}++;
        }
    }

    # Load the master ballot into another hash and compare them.
    # The master ballots always do one entry per line, making this a little
    # easier.
    $master = Ballot->new($self->{'election'});
    $master->populate;
    %mh = map(($_->[0] => 1), @{$master->{'choices'}});

    # Check for extra entries (write-ins should be supported in the future)
    for (keys %h) {
        push @extra, $_ unless exists $mh{$_};
    }

    # Check for duplicate entries
    @dups = grep { $h{$_} > 1 } keys %h;

    # Check for missing entries (not necessarily an error)
    for (keys %mh) {
        push @missing, $_ unless exists $h{$_};
    }

    # Report errors and warnings
    if (@extra) {
        if ($Votify::mode eq 'user') {
            print <<EOT;
Your ballot has some extra entries that are not part of this election.  Sorry,
but write-ins are not (yet) supported.  Please remove these from your ballot:

EOT
            print map "\t$_\n", @extra;
            print "\n";
        }
        $errors_found++;
    }
    if (@dups) {
        if ($Votify::mode eq 'user') {
            print <<EOT;
Your ballot has some duplicate entries.  Please resolve these to a single entry
to avoid ambiguities:

EOT
            print map "\t$_\n", @dups;
            print "\n";
        }
        $errors_found++;
    }
    if (@{$self->{'choices'}} == 0) {
        if ($Votify::mode eq 'user') {
            print <<EOT;
Your ballot doesn't contain any entries.  You can start over by first removing
the existing ballot, then using --new to generate a new ballot.  See --help for
more information.

EOT
        }
        $errors_found++;
    }
    elsif (@missing and $Votify::mode eq 'user') {
        print <<EOT;
Your ballot is missing some entries.  This is not an error, but note that these
will be implied as a final line, with no preference between them, like this:

EOT
        print "\t", join(" ", @missing), "\n";
        print "\n";
    }
    if ($Votify::mode eq 'user' and !$errors_found and
        @{$self->{'choices'}} == 1 and
        scalar(keys %h) == scalar(keys %mh))
    {
        print <<EOT;
Your ballot contains all the candidates on a single line!  This means you have
no preference between the candidates.  This is not an error, but note that this
is a meaningless ballot that will have no effect on the election.

EOT
    }

    # Stop if there were errors
    if ($Votify::mode eq 'user' and $errors_found) {
        print("There were errors found in your ballot.\n");
        die("Please correct them and try again.\n\n");
    }
    return $errors_found;
}

sub to_s {
    my ($self) = @_;
    join '', map "@$_\n", @{$self->{'choices'}};
}

1;

__END__
# vim:sw=4 et