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