uvvote.pl

   1 #!/usr/bin/perl -w
   2
   3 ###############################################################################
   4 # UseVoteGer 4.11 Wahldurchfuehrung
   5 # (c) 2001-2012 Marc Langer <uv@marclanger.de>
   6 #
   7 # This script package is free software; you can redistribute it and/or
   8 # modify it under the terms of the GNU Public License as published by the
   9 # Free Software Foundation.
  10 #
  11 # The script reads usenet vote ballots from mailbox files. The format
  12 # can be set by changing the option "mailstart".
  13 #
  14 # Many thanks to:
  15 # - Ron Dippold (Usevote 3.0, 1993/94)
  16 # - Frederik Ramm (German translation, 1994)
  17 # - Wolfgang Behrens (UseVoteGer 3.1, based on Frederik's translation, 1998/99)
  18 # - Cornell Binder for some good advice and code fragments
  19 #
  20 # This is a complete rewrite of UseVoteGer 3.1 in Perl (former versions were
  21 # written in C). Not all functions of Usevote/UseVoteGer 3.x are implemented!
  22 ###############################################################################
  23
  24 use strict;
  25 use Getopt::Long;
  26 use Text::Wrap qw(wrap $columns);
  27 use FindBin qw($Bin);
  28 use lib $Bin;
  29 use UVconfig;
  30 use UVmenu;
  31 use UVmessage;
  32 use UVreadmail;
  33 use UVsendmail;
  34 use UVrules;
  35 use UVtemplate;
  36
  37 my $clean = 0;
  38 my %opt_ctl = ();
  39
  40 print "\n$usevote_version Wahldurchfuehrung - (c) 2001-2005 Marc Langer\n\n";
  41
  42 # unknown parameters remain in @ARGV (for "help")
  43 Getopt::Long::Configure(qw(pass_through bundling));
  44
  45 # Put known parameters in %opt_ctl
  46 GetOptions(\%opt_ctl, qw(test t config-file=s c=s));
  47
  48 # Get name auf config file (default: usevote.cfg) and read it
  49 my $cfgfile   = $opt_ctl{'config-file'} || $opt_ctl{c} || "usevote.cfg";
  50
  51 # test mode? (default: no)
  52 my $test_only = $opt_ctl{test}          || $opt_ctl{t} || 0;
  53
  54 if (@ARGV){
  55   # additional parameters passed
  56
  57   if ($ARGV[0] eq "clean") {
  58     $clean = 1;
  59   } else {
  60     # print help and exit program
  61     help();
  62   }
  63 }
  64
  65 UVconfig::read_config($cfgfile, 1);  # read config file, redirect errors to log
  66 UVrules::read_rulefile();            # read rules from file
  67
  68 # read list of suspicious mail addresses from file
  69 my @bad_addr = UVconfig::read_badaddr();
  70
  71 # option -t used?
  72 if ($test_only) {
  73   UVconfig::test_config();
  74   exit 0;
  75 }
  76
  77 # check for lock file
  78 if (-e $config{lockfile}) {
  79   my $lockfile = $config{lockfile};
  80
  81   # don't delete lockfile in END block ;-)
  82   $config{lockfile} = '';
  83
  84   # exit
  85   die UVmessage::get("ERR_LOCK", (FILE=>$lockfile)) . "\n\n";
  86 }
  87
  88 # safe exit (delete lockfile)
  89 $SIG{QUIT} = 'sighandler';
  90 $SIG{INT} = 'sighandler';
  91 $SIG{KILL} = 'sighandler';
  92 $SIG{TERM} = 'sighandler';
  93 $SIG{HUP} = 'sighandler';
  94
  95 # create lock file
  96 open (LOCKFILE, ">$config{lockfile}");
  97 close (LOCKFILE);
  98
  99 # Set columns for Text::Wrap
 100 $columns = $config{rightmargin};
 101
 102 # check for tmp and archive directory
 103 unless (-d $config{archivedir}) {
 104   mkdir ($config{archivedir}, 0700)
 105     or die UVmessage::get("ERR_MKDIR", (DIR=>$config{archivedir})) . "$!\n\n";
 106 }
 107
 108 unless (-d $config{tmpdir}) {
 109   mkdir ($config{tmpdir}, 0700)
 110     or die UVmessage::get("ERR_MKDIR", (DIR=>$config{tmpdir})) . "$!\n\n";
 111 }
 112
 113 if ($clean) {
 114   # Program has been startet with "clean" option:
 115   # save votes and send out acknowledge mails
 116   make_clean();
 117
 118 } else {
 119   # normal processing
 120
 121   # generate file names for result file
 122   # normally unixtime is sufficient, if it is not unique append our PID
 123   my $ext = time;
 124
 125   opendir (TMP, $config{tmpdir});
 126   my @tmpfiles = readdir (TMP);
 127   closedir (TMP);
 128   opendir (FERTIG, $config{archivedir});
 129   my @fertigfiles = readdir (FERTIG);
 130   closedir (FERTIG);
 131
 132   # append PID if necessary
 133   $ext .= "-$$" if (grep (/$ext/, @tmpfiles) || grep (/$ext/, @fertigfiles));
 134
 135   my $thisresult = "ergebnis-" . $ext;
 136   my $thisvotes = "stimmen-" . $ext;
 137
 138   # open results file
 139   open (RESULT, ">>$config{tmpdir}/$thisresult")
 140      or die UVmessage::get("VOTE_WRITE_RESULTS", (FILE=>$thisresult)) . "\n\n";
 141
 142   # read votes and process them
 143   # for each mail pass a reference to the sub to be called
 144   my $count = UVreadmail::process("$config{tmpdir}/$thisvotes", \&process_vote, 0);
 145
 146   close (RESULT)
 147      or print STDERR UVmessage::get("VOTE_CLOSE_RESULTS", (FILE=>$thisresult)) . "\n";
 148
 149   # no mails: exit here
 150   unless ($count) {
 151     print UVmessage::get("VOTE_NO_VOTEMAILS") . "\n\n";
 152     exit 0;
 153   }
 154
 155   if ($config{onestep}) {
 156     # everything should be done in one step
 157     print "\n" . UVmessage::get("VOTE_NUM_VOTES", (COUNT=>$count)) . "\n";
 158     make_clean();
 159
 160   } else {
 161
 162     print "\n", UVmessage::get("VOTE_NOT_SAVED", (COUNT=>$count)), "\n",
 163           wrap('', '', UVmessage::get("VOTE_FIRSTRUN")), "\n\n";
 164   }
 165 }
 166
 167 exit 0;
 168
 169 END {
 170   close (STDERR);
 171
 172   # delete lockfile
 173   unlink $config{lockfile} if ($config{lockfile});
 174
 175   if (-s $config{errorfile}) {
 176     # errors ocurred
 177     print '*' x $config{rightmargin}, "\n",
 178           UVmessage::get("VOTE_ERRORS",(FILE => $config{errorfile})), "\n",
 179           '*' x $config{rightmargin}, "\n\n";
 180     open (ERRFILE, "<$config{errorfile}");
 181     print <ERRFILE>;
 182     close (ERRFILE);
 183     print "\n";
 184   } else {
 185     unlink ($config{errorfile});
 186   }
 187 }
 188
 189
 190 sub sighandler {
 191   my ($sig) = @_;
 192   die "\n\nSIG$sig: deleting lockfile and exiting\n\n";
 193 }
 194
 195
 196 ##############################################################################
 197 # Evaluation of a vote mail                                                  #
 198 # Called from UVreadmail::process() for each mail.                           #
 199 # Parameters: voter address and name, date header of the vote mail (strings) #
 200 #             complete header (reference to array), body (ref. to strings)   #
 201 ##############################################################################
 202
 203 sub process_vote {
 204   my ($voter_addr, $voter_name, $h_date, $entity, $body) = @_;
 205
 206   my @header = split(/\n/, $entity->stringify_header);
 207   my $head = $entity->head;
 208   my $msgid = $head->get('Message-ID');
 209   chomp($msgid) if ($msgid);
 210
 211   my @votes = ();              # the votes
 212   my @set;                     # interactively changed fields
 213   my @errors = ();             # recognized errors (show menu for manual action)
 214   my $onevote = 0;             # 0=no votes, 1=everything OK, 2=vote cancelled
 215   my $voteerror = "";          # error message in case of invalid vote
 216   my $ballot_id = "";          # ballot id (German: Wahlscheinkennung)
 217   my $voting = "";             # voting (should be votename)
 218
 219   # found address?
 220   if ($voter_addr) {
 221     # search for suspicious addresses
 222     foreach my $element (@bad_addr) {
 223       if ($voter_addr =~ /^$element/) {
 224         push (@errors, 'SuspiciousAccount');
 225         last;
 226       }
 227     }
 228   } else {
 229     # found no address in mail (perhaps violates RFC?)
 230     push (@errors, 'InvalidAddress');
 231   }
 232
 233   # correct voting?
 234   if ($$body =~ /\Q$config{ballotintro}\E\s+(.+?)\s*\n([>:|]*?[\t ]+(\S+.+)\s*$)?/m) {
 235     $voting = $1;
 236     $voting .= " $3" if (defined($3) and $3 !~ /\Q$config{nametext}\E/);
 237     push (@errors, 'WrongVoting') if ($config{votename} !~ /^\s*\Q$voting\E\s*$/);
 238   } else {
 239     push (@errors, 'NoVoting');
 240   }
 241
 242   # personalized ballots?
 243   if ($config{personal}) {
 244     if ($$body =~ /$config{ballotidtext}\s+([a-z0-9]+)/) {
 245       $ballot_id = $1;
 246       # Address registered? ($ids is set in UVconfig.pm)
 247       if ($ids{$voter_addr}) {
 248         push (@errors, 'WrongBallotID') if ($ids{$voter_addr} ne $ballot_id);
 249       } else {
 250         push (@errors, 'AddressNotRegistered');
 251       }
 252     } else {
 253       push (@errors, 'NoBallotID');
 254     }
 255   }
 256
 257   # evaluate vote strings
 258   for (my $n=0; $n<@groups; $n++) {
 259
 260     # counter starts at 1 in ballot
 261     my $votenum = $n+1;
 262     my $vote = "";
 263
 264     # a line looks like this: #1 [ VOTE ] Group
 265     # matching only on number and vote, because of line breaks likely
 266     # inserted by mail programs
 267
 268     # duplicate vote?
 269     if ($$body =~ /#$votenum\W*?\[\s*?(\w+)\s*?\].+?#$votenum\W*?\[\s*?(\w+)\s*?\]/s) {
 270       push (@errors, "DuplicateVote") if ($1 ne $2);
 271     }
 272
 273     # this matches on a single appearance:
 274     if ($$body =~ /#$votenum\W*?\[(.+)\]/) {
 275       # one or more vote strings were found
 276       $onevote ||= 1; # set $onevote to 1 if it was 0
 277       my $votestring = $1;
 278       if ($votestring =~ /^\W*$config{ja_stimme}\W*$/i) {
 279         $vote = "J";
 280       } elsif ($votestring =~ /^\W*$config{nein_stimme}\W*$/i) {
 281         $vote = "N";
 282       } elsif ($votestring =~ /^\W*$config{enth_stimme}\W*$/i) {
 283         $vote = "E";
 284       } elsif ($votestring =~ /^\s*$/) {
 285         # nothing has been entered between the [ ]
 286         $vote = "E";
 287       } elsif ($votestring =~ /^\W*$config{ann_stimme}\W*$/i) {
 288         $vote = "A";
 289         $onevote = 2;        # Cancelled vote: set $onevote to 2
 290       } elsif (!$votes[$n]) {
 291         # vote not recognized
 292         $vote = "E";
 293         push (@errors, 'UnrecognizedVote #' . $votenum . "#$votestring");
 294       }
 295       push (@votes, $vote);
 296     } else {
 297       # vote not found
 298       push (@votes, 'E');
 299       push (@errors, 'UnrecognizedVote #' . $votenum . '#(keine Stimmabgabe fuer "'
 300            . $groups[$n] . '" gefunden)');
 301     }
 302   }
 303
 304   if ($onevote == 0) {
 305     push (@errors, "NoVote") unless ($onevote);
 306   } elsif ($onevote == 1) {
 307     # check rules
 308     my $rule = UVrules::rule_check(\@votes);
 309     push (@errors, "ViolatedRule #$rule") if ($rule);
 310   } else {
 311     # cancelled vote: replace all votes with an A
 312     @votes = split(//, 'A' x scalar @votes);
 313   }
 314
 315   # Evaluate Data Protection Law clause (not on cancelled votes)
 316   if ($config{bdsg} && $onevote<2) {
 317
 318     # Text in ballot complete and clause accepted?
 319     # Should read like this: #a [ STIMME ] Text
 320     # (Text is configurable in usevote.cfg)
 321     unless ($$body =~ /$bdsg_regexp/s &&
 322             $$body =~ /#a\W*?\[\W*?$config{bdsg_confirm}\W*?\]\W*?$bdsg2_regexp/is) {
 323
 324       push (@errors, 'InvalidBDSG');
 325     }
 326   }
 327
 328   # Name in body?
 329   if ($$body =~ /($config{nametext}|$config{nametext2})( |\t)*(\S.+?)$/m) {
 330     $voter_name = $3;
 331     $voter_name =~ s/^\s+//; # strip leading spaces
 332     $voter_name =~ s/\s+$//; # strip trailing spaces
 333   }
 334
 335   if ($voter_name) {
 336     # Name invalid?
 337     push (@errors, 'InvalidName') unless ($voter_name =~ /$config{name_re}/);
 338   } else {
 339     # no name found:
 340     push (@errors, 'NoName') unless ($voter_name);
 341   }
 342
 343   # Errors encountered?
 344   if (@errors) {
 345     my $res = UVmenu::menu(\@votes, \@header, $body, \$voter_addr, \$voter_name,
 346                            \$ballot_id, \$voting, \@set, \@errors);
 347     return 0 if ($res eq 'i');      # "Ignore": Ignore vote, don't save
 348
 349     my $tpl;
 350
 351     # Check Ballot ID stuff
 352     if ($config{personal}) {
 353       if ($ballot_id) {
 354         if ($ids{$voter_addr}) {
 355           if ($ids{$voter_addr} ne $ballot_id) {
 356             $voteerror = UVmessage::get("VOTE_INVALID_BALLOTID");
 357             $tpl = $config{tpl_wrong_ballotid};
 358           }
 359         } else {
 360           $voteerror = UVmessage::get("VOTE_UNREGISTERED_ADDRESS");
 361           $tpl = $config{tpl_addr_reg};
 362         }
 363       } else {
 364         $voteerror = UVmessage::get("VOTE_MISSING_BALLOTID");
 365         $tpl = $config{tpl_no_ballotid};
 366       }
 367
 368       # generate error mail (if error occurred)
 369       if ($tpl) {
 370         my $template = UVtemplate->new();
 371         $template->setKey('head' => $entity->stringify_header);
 372         $template->setKey('body' => $$body);
 373         my $msg = $template->processTemplate($tpl);
 374         UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 375       }
 376     }
 377   }
 378
 379   # Check rules and send error mail unless rule violation was ignored in the use menu
 380   # or another error was detected
 381   if (grep(/ViolatedRule/, @errors) && !$voteerror && (my $rule = UVrules::rule_check(\@votes))) {
 382     $voteerror = UVmessage::get("VOTE_VIOLATED_RULE", (RULE=>$rule));
 383     my $template = UVtemplate->new();
 384     $template->setKey('body'  => $$body);
 385     $template->setKey('rules' => UVrules::rule_print($rule-1));
 386     my $msg = $template->processTemplate($config{tpl_rule_violated});
 387     UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 388   }
 389
 390   if (!$voteerror && @errors) {
 391
 392     # turn errors array into hash
 393
 394     my %error;
 395     foreach my $error (@errors) {
 396       $error{$error} = 1;
 397     }
 398
 399     # Check uncorrected errors
 400     if ($error{InvalidBDSG}) {
 401       my $template = UVtemplate->new();
 402       my $msg = $template->processTemplate($config{tpl_bdsg_error});
 403       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 404       return 0;
 405     } elsif ($error{NoVoting} or $error{WrongVoting}) {
 406       $voteerror = UVmessage::get("VOTE_WRONG_VOTING");
 407       my $template = UVtemplate->new();
 408       $template->setKey('body'  => $$body);
 409       my $msg = $template->processTemplate($config{tpl_wrong_voting});
 410       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 411     } elsif ($error{NoVote}) {
 412       $voteerror = UVmessage::get("VOTE_NO_VOTES");
 413       my $template = UVtemplate->new();
 414       $template->setKey('body'  => $$body);
 415       my $msg = $template->processTemplate($config{tpl_no_votes});
 416       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 417     } elsif ($error{SuspiciousAccount}) {
 418       $voteerror = UVmessage::get("VOTE_INVALID_ACCOUNT");
 419       my $template = UVtemplate->new();
 420       $template->setKey('head' => $entity->stringify_header);
 421       $template->setKey('body'  => $$body);
 422       my $msg = $template->processTemplate($config{tpl_invalid_account});
 423       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 424     } elsif ($error{InvalidAddress}) {
 425       $voteerror = UVmessage::get("VOTE_INVALID_ADDRESS");
 426     } elsif ($error{InvalidName}) {
 427       $voteerror = UVmessage::get("VOTE_INVALID_REALNAME");
 428       my $template = UVtemplate->new();
 429       $template->setKey('head' => $entity->stringify_header);
 430       $template->setKey('body'  => $$body);
 431       my $msg = $template->processTemplate($config{tpl_invalid_name});
 432       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 433     } elsif ($error{DuplicateVote}) {
 434       $voteerror = UVmessage::get("VOTE_DUPLICATES");
 435       my $template = UVtemplate->new();
 436       $template->setKey('head' => $entity->stringify_header);
 437       $template->setKey('body'  => $$body);
 438       my $msg = $template->processTemplate($config{tpl_multiple_votes});
 439       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 440     }
 441   }
 442
 443   # check voter name
 444   unless ($voter_name || $voteerror) {
 445     $voteerror = UVmessage::get("VOTE_MISSING_NAME");
 446     my $template = UVtemplate->new();
 447     $template->setKey('head' => $entity->stringify_header);
 448     $template->setKey('body'  => $$body);
 449     my $msg = $template->processTemplate($config{tpl_invalid_name});
 450     UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 451   }
 452
 453   # set mark for cancelled vote
 454   $onevote = 2 if ($votes[0] eq 'A');
 455
 456   # create comment line for result file
 457   my $comment;
 458   if ($config{personal}) {
 459     # Personalized Ballots: insert ballot id
 460     $comment = "($ballot_id)";
 461   } else {
 462     $comment = "()";
 463   }
 464
 465   if (@set) {
 466     $comment .= ' '.UVmessage::get("VOTE_FILE_COMMENT", (FIELDS => join(', ', @set)));
 467   }
 468
 469   # write result file
 470   print RESULT "A: $voter_addr\n";
 471   print RESULT "N: $voter_name\n";
 472   print RESULT "D: $h_date\n";
 473   print RESULT "K: $comment\n";
 474
 475   # invalid vote?
 476   if ($voteerror) {
 477     print RESULT "S: ! $voteerror\n";
 478
 479   # cancelled vote?
 480   } elsif ($onevote == 2) {
 481     print RESULT "S: * Annulliert\n";
 482
 483     if ($config{voteack}) {
 484       # send cancellation acknowledge
 485       my $template = UVtemplate->new();
 486       my $msg = $template->processTemplate($config{tpl_cancelled});
 487       UVsendmail::mail($voter_addr, "Bestaetigung", $msg, $msgid);
 488     }
 489
 490   } else {
 491     print RESULT "S: ", join ("", @votes), "\n";
 492
 493     # send acknowledge mail?
 494     if ($config{voteack}) {
 495
 496       my $template = UVtemplate->new();
 497       $template->setKey(ballotid        => $ballot_id);
 498       $template->setKey(address         => $voter_addr);
 499       $template->setKey(name            => $voter_name);
 500
 501       for (my $n=0; $n<@groups; $n++) {
 502         my $vote = $votes[$n];
 503         $vote =~ s/^J$/JA/;
 504         $vote =~ s/^N$/NEIN/;
 505         $vote =~ s/^E$/ENTHALTUNG/;
 506         $template->addListItem('groups', pos=>$n+1, vote=>$vote, group=>$groups[$n]);
 507       }
 508
 509       my $msg = $template->processTemplate($config{'tpl_ack_mail'});
 510       UVsendmail::mail($voter_addr, "Bestaetigung", $msg, $msgid);
 511     }
 512   }
 513 }
 514
 515
 516 ##############################################################################
 517 # Send out acknowledge mails and tidy up (we're called as "uvvote.pl clean") #
 518 ##############################################################################
 519
 520 sub make_clean {
 521
 522   # send mails
 523   UVsendmail::send();
 524
 525   print UVmessage::get("INFO_TIDY_UP"), "\n";
 526
 527   # search unprocessed files
 528   opendir (DIR, $config{tmpdir});
 529   my @files = readdir DIR;
 530   closedir (DIR);
 531
 532   my @resultfiles = grep (/^ergebnis-/, @files);
 533   my @votefiles = grep (/^stimmen-/, @files);
 534
 535   unless (@resultfiles) {
 536     print wrap('', '', UVmessage::get("VOTE_NO_NEW_RESULTS")), "\n\n";
 537     return 0;
 538   }
 539
 540   foreach my $thisresult (@resultfiles) {
 541     chmod (0400, "$config{tmpdir}/$thisresult");
 542     rename "$config{tmpdir}/$thisresult", "$config{archivedir}/$thisresult"
 543       or die UVmessage::get("VOTE_MOVE_RESULTFILE", (FILE=>$thisresult)) . "$!\n\n";
 544   }
 545
 546   foreach my $thisvotes (@votefiles) {
 547     chmod (0400, "$config{tmpdir}/$thisvotes");
 548     rename "$config{tmpdir}/$thisvotes", "$config{archivedir}/$thisvotes"
 549       or die UVmessage::get("VOTE_MOVE_VOTEFILE", (FILE=>$thisvotes)) . "$!\n\n";
 550   }
 551
 552   print UVmessage::get("VOTE_CREATING_RESULTS", (FILENAME=>$config{resultfile})), "\n";
 553
 554   # search all result files
 555   opendir (DIR, "$config{archivedir}/");
 556   @files = grep (/^ergebnis-/, readdir (DIR));
 557   closedir (DIR);
 558
 559   # Create complete result from all single result files.
 560   # The resulting file (ergebnis.alle) is overwritten as there could have been
 561   # made changes in the single result files
 562   open(RESULT, ">$config{resultfile}");
 563   foreach my $file (sort @files) {
 564     open(THISRESULT, "<$config{archivedir}/$file");
 565     print RESULT join('', <THISRESULT>);
 566     close(THISRESULT);
 567   }
 568   close(RESULT);
 569
 570   print "\n";
 571
 572 }
 573
 574
 575 ##############################################################################
 576 # Print help text (options and syntax) on -h or --help                       #
 577 ##############################################################################
 578
 579 sub help {
 580   print <<EOF;
 581 Usage: uvvote.pl [-c config_file] [-t]
 582        uvvote.pl [-c config_file] clean
 583        uvvote.pl -h
 584
 585 Liest Mailboxen aus einer Datei oder per POP3 ein wertet die Mails
 586 als Stimmzettel aus. Erst beim Aufruf mit der Option "clean" werden
 587 die Ergebnisse endgueltig gespeichert und die Bestaetigungsmails
 588 verschickt.
 589
 590   -c config_file   liest die Konfiguration aus config_file
 591                    (usevote.cfg falls nicht angegeben)
 592
 593   -t, --test       fuehrt einen Test der Konfiguration durch und
 594                    gibt das ermittelte Ergebnis aus.
 595
 596   -h, --help       zeigt diesen Hilfetext an
 597
 598 EOF
 599
 600   exit 0;
 601 }