sballot/cgi

   1 #!/usr/bin/perl -w
   2
   3 use strict qw(refs vars);
   4
   5 use CGI qw/:standard/;
   6 use Cwd qw/realpath/;
   7
   8 BEGIN {
   9     my $self= $ENV{'SCRIPT_FILENAME'};
  10     $self= $0 unless defined $self;
  11     $self= realpath $self;
  12     my $sballotdir= $self;
  13     $sballotdir =~ s,/[^/]*$,,;
  14
  15     chdir $sballotdir or die "$sballotdir $!";
  16     unshift @INC, "..";
  17 };
  18
  19 use ModerationCommon;
  20
  21 readsettings();
  22
  23 sub fail ($) {
  24     my ($m)= @_;
  25     print header(-status=>500), start_html('Secret ballot - error'),
  26         h1("error"), strong($m), end_html();
  27     exit 0;
  28 }
  29
  30 my $issueid= param('issue');
  31 fail('bad issueid') if $issueid =~ m/[^-0-9a-z]/ or $issueid =~ m/^[^0-9a-z]/;
  32
  33 open T, "issues/$issueid/title" or fail("unknown issue $!");
  34 my $title= <T>;  chomp $title or die $!;
  35 my $regexp= <T>;  chomp $regexp or die $!;
  36 close T or die $!;
  37
  38 my $vote= param('vote');
  39 my $ident= param('ident');
  40 my $pw= param('password');
  41
  42 sub read_vfile ($) {
  43     my ($vfile)= @_;
  44     open M, $vfile or fail("unknown psuedonym $!");
  45     my $m= <M>;  chomp $m or die $!;
  46     close M or die $!;
  47
  48     $m =~ m/^(\S+) (\S.*)$/ or die;
  49     return ($1,$2);
  50 }
  51
  52 sub issue_and_title () {
  53     return (
  54         dt('Issue ID'), dd(escapeHTML($issueid)),
  55         dt('Title'), dd(escapeHTML($title))
  56     );
  57 }
  58
  59 if (length $vote or length $ident or length $pw) {
  60     fail('bad pseudonym') if !defined $ident or $ident =~ m/[^0-9a-z]/;
  61
  62     fail('bad password') if !defined $pw or $pw =~ m/[^0-9a-z]/;
  63     my $pwhash= hash($pw);
  64
  65     fail('bad vote') if $vote =~ m/[^0-9a-z]/i;
  66     $vote =~ y/a-z/A-Z/;
  67
  68     fail("invalid vote - consult administrator's instructions")
  69         unless $vote =~ /^(?:$regexp)$/io;
  70
  71     my $vfile= "issues/$issueid/v.$ident";
  72     my ($exp_pwhash, $oldvote) = read_vfile($vfile);
  73     $exp_pwhash eq $pwhash or fail("wrong password");
  74
  75     open N, "> $vfile.new" or die $!;
  76     print N "$pwhash $vote\n" or die $!;
  77     close N or die $!;
  78
  79     rename "$vfile.new", $vfile or die "$vfile $!";
  80
  81     print(header(), start_html('Secret ballot - vote recorded'),
  82           h1('Vote recorded'), '<dl>',
  83           issue_and_title(),
  84           dt('Old vote'), dd($oldvote),
  85           dt('New vote'), dd($vote), '</dl>',
  86           end_html()) or die $!;
  87     exit 0;
  88 }
  89
  90 if (param('results') or param('email_results')) {
  91     my $txt= <<END;
  92 The moderators' votes (so far) are as follows:
  93 END
  94     foreach my $vfile (sort <issues/$issueid/v.*>) {
  95         $vfile =~ m,/v\.([0-9a-f]+)([^/]*)$, or die;
  96         next if $2 eq 'new';
  97         die "$vfile $2" if length $2;
  98         $ident= $1;
  99         my ($dummy_pwhash, $vote) = read_vfile($vfile);
 100         $txt .= " $ident $vote\n";
 101     }
 102     $txt .= <<END;
 103
 104 See the email from the administrator for the meanings of the above
 105 votes.  There is no automatic counting; the above is just a list
 106 of the entries provided by the voting moderators.
 107 END
 108
 109     if (param('email_results')) {
 110         sendmail_start();
 111         print P <<END or die $!;
 112 To: $setting{ABBREV} moderators <$setting{MODEMAIL}>
 113 Subject: Secret ballot results for $setting{ABBREV}
 114
 115 One of the moderators for $setting{GROUP}
 116 has requested that the results of the following ballot be sent out:
 117   Issue ID: $issueid
 118   Title: $title
 119
 120 $txt
 121
 122 Regards
 123 moderation system robot
 124 END
 125         print(header(), start_html('Secret ballot - email sent'),
 126               h1('Done'),
 127               p('The email has been sent and should arrive shortly'),
 128               end_html())
 129             or die $!;
 130         exit 0;
 131     }
 132     print(header(), start_html('Secret ballot - results'),
 133           h1('Results so far'),
 134           '<dl>',issue_and_title(),'</dl>',
 135           pre(escapeHTML($txt)),
 136           end_html())
 137         or die $!;
 138     exit 0;
 139 }
 140
 141 print(header(), start_html('Secret ballot - voting page'),
 142       h1('Instructions'),
 143       p('Wait for the email from the administrator confirming '.
 144         'that this is the actual live ballot before voting.  '.
 145         "The administrator's email will tell you what to put in".
 146         " the vote box."),
 147       h1('Voting form'), '<dl>',
 148       start_form(-method=>'POST'),
 149       hidden('issue',$issueid),
 150       issue_and_title(),
 151       dt('Pseudonym'), dd(textfield(-name=>'ident', -size=>($hashlen+10))),
 152       dt('Password'), dd(textfield(-name=>'password', -size=>($hashlen+10))),
 153       dt('Vote'), dd(textfield(-name=>'vote', -size=>40)),
 154       '</dl>',
 155       submit('Cast your vote'),
 156       end_form(),
 157       h1('Results'),
 158       p('This allows you to view the results (so far)'),
 159       start_form(-method=>'GET'), hidden('issue',$issueid),
 160       p(submit(-name=>'results',
 161                -value=>'Show results')),
 162       p(submit(-name=>'email_results',
 163                -value=>"Send results to moderators' list")),
 164       end_form(),
 165       end_html())
 166     or die $!;
 167
 168 exit 0;