uvvote.pl

   1 #!/usr/bin/perl -w
   2
   3 ###############################################################################
   4 # UseVoteGer 4.09 Wahldurchfuehrung
   5 # (c) 2001-2005 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 (DIR, $config{tmpdir});
 126   my @tmpfiles = readdir (DIR);
 127   closedir (DIR);
 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   # POP3 not activated: rename votes file
 139   unless ($config{pop3}) {
 140     print UVmessage::get("VOTE_RENAMING_MAILBOX"), "\n";
 141     rename ($config{votefile}, "$config{tmpdir}/$thisvotes")
 142        or die UVmessage::get("ERR_RENAME_MAILFILE") . "$!\n\n";
 143
 144     #  wait, so that current mail deliveries can finalize
 145     sleep 2;
 146   }
 147
 148   # open results file
 149   open (RESULT, ">>$config{tmpdir}/$thisresult")
 150      or die UVmessage::get("VOTE_WRITE_RESULTS", (FILE=>$thisresult)) . "\n\n";
 151
 152   # read votes and process them
 153   # for each mail pass a reference to the sub to be called
 154   my $count = UVreadmail::process("$config{tmpdir}/$thisvotes", \&process_vote, 0);
 155
 156   close (RESULT)
 157      or print STDERR UVmessage::get("VOTE_CLOSE_RESULTS", (FILE=>$thisresult)) . "\n";
 158
 159   # no mails: exit here
 160   unless ($count) {
 161     print UVmessage::get("VOTE_NO_VOTEMAILS") . "\n\n";
 162     exit 0;
 163   }
 164
 165   if ($config{onestep}) {
 166     # everything should be done in one step
 167     print "\n" . UVmessage::get("VOTE_NUM_VOTES", (COUNT=>$count)) . "\n";
 168     make_clean();
 169
 170   } else {
 171
 172     print "\n", UVmessage::get("VOTE_NOT_SAVED", (COUNT=>$count)), "\n",
 173           wrap('', '', UVmessage::get("VOTE_FIRSTRUN")), "\n\n";
 174   }
 175 }
 176
 177 exit 0;
 178
 179 END {
 180   close (STDERR);
 181
 182   # delete lockfile
 183   unlink $config{lockfile} if ($config{lockfile});
 184
 185   if (-s $config{errorfile}) {
 186     # errors ocurred
 187     print '*' x $config{rightmargin}, "\n",
 188           UVmessage::get("VOTE_ERRORS",(FILE => $config{errorfile})), "\n",
 189           '*' x $config{rightmargin}, "\n\n";
 190     open (ERRFILE, "<$config{errorfile}");
 191     print <ERRFILE>;
 192     close (ERRFILE);
 193     print "\n";
 194   } else {
 195     unlink ($config{errorfile});
 196   }
 197 }
 198
 199
 200 sub sighandler {
 201   my ($sig) = @_;
 202   die "\n\nSIG$sig: deleting lockfile and exiting\n\n";
 203 }
 204
 205
 206 ##############################################################################
 207 # Evaluation of a vote mail                                                  #
 208 # Called from UVreadmail::process() for each mail.                           #
 209 # Parameters: voter address and name, date header of the vote mail (strings) #
 210 #             complete header (reference to array), body (ref. to strings)   #
 211 ##############################################################################
 212
 213 sub process_vote {
 214   my ($voter_addr, $voter_name, $h_date, $entity, $body) = @_;
 215
 216   my @header = split(/\n/, $entity->stringify_header);
 217   my $head = $entity->head;
 218   my $msgid = $head->get('Message-ID');
 219   chomp($msgid) if ($msgid);
 220
 221   my @votes = ();              # the votes
 222   my @set;                     # interactively changed fields
 223   my @errors = ();             # recognized errors (show menu for manual action)
 224   my $onevote = 0;             # 0=no votes, 1=everything OK, 2=vote cancelled
 225   my $voteerror = "";          # error message in case of invalid vote
 226   my $ballot_id = "";          # ballot id (German: Wahlscheinkennung)
 227
 228   # found address?
 229   if ($voter_addr) {
 230     # search for suspicious addresses
 231     foreach my $element (@bad_addr) {
 232       if ($voter_addr =~ /^$element/) {
 233         push (@errors, 'SuspiciousAccount');
 234         last;
 235       }
 236     }
 237   } else {
 238     # found no address in mail (perhaps violates RFC?)
 239     push (@errors, 'InvalidAddress');
 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;
 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{ja_stimme}\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, \@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{NoVote}) {
 406       $voteerror = UVmessage::get("VOTE_NO_VOTES");
 407       my $template = UVtemplate->new();
 408       $template->setKey('body'  => $$body);
 409       my $msg = $template->processTemplate($config{tpl_no_votes});
 410       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 411     } elsif ($error{SuspiciousAccount}) {
 412       $voteerror = UVmessage::get("VOTE_INVALID_ACCOUNT");
 413       my $template = UVtemplate->new();
 414       $template->setKey('head' => $entity->stringify_header);
 415       $template->setKey('body'  => $$body);
 416       my $msg = $template->processTemplate($config{tpl_invalid_account});
 417       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 418     } elsif ($error{InvalidAddress}) {
 419       $voteerror = UVmessage::get("VOTE_INVALID_ADDRESS");
 420     } elsif ($error{InvalidName}) {
 421       $voteerror = UVmessage::get("VOTE_INVALID_REALNAME");
 422       my $template = UVtemplate->new();
 423       $template->setKey('head' => $entity->stringify_header);
 424       $template->setKey('body'  => $$body);
 425       my $msg = $template->processTemplate($config{tpl_invalid_name});
 426       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 427     } elsif ($error{DuplicateVote}) {
 428       $voteerror = UVmessage::get("VOTE_DUPLICATES");
 429       my $template = UVtemplate->new();
 430       $template->setKey('head' => $entity->stringify_header);
 431       $template->setKey('body'  => $$body);
 432       my $msg = $template->processTemplate($config{tpl_multiple_votes});
 433       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 434     }
 435   }
 436
 437   # check voter name
 438   unless ($voter_name || $voteerror) {
 439     $voteerror = UVmessage::get("VOTE_MISSING_NAME");
 440     my $template = UVtemplate->new();
 441     $template->setKey('head' => $entity->stringify_header);
 442     $template->setKey('body'  => $$body);
 443     my $msg = $template->processTemplate($config{tpl_invalid_name});
 444     UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
 445   }
 446
 447   # set mark for cancelled vote
 448   $onevote = 2 if ($votes[0] eq 'A');
 449
 450   # create comment line for result file
 451   my $comment;
 452   if ($config{personal}) {
 453     # Personalized Ballots: insert ballot id
 454     $comment = "($ballot_id)";
 455   } else {
 456     $comment = "()";
 457   }
 458
 459   if (@set) {
 460     $comment .= ' '.UVmessage::get("VOTE_FILE_COMMENT", (FIELDS => join(', ', @set)));
 461   }
 462
 463   # write result file
 464   print RESULT "A: $voter_addr\n";
 465   print RESULT "N: $voter_name\n";
 466   print RESULT "D: $h_date\n";
 467   print RESULT "K: $comment\n";
 468
 469   # invalid vote?
 470   if ($voteerror) {
 471     print RESULT "S: ! $voteerror\n";
 472
 473   # cancelled vote?
 474   } elsif ($onevote == 2) {
 475     print RESULT "S: * Annulliert\n";
 476
 477     if ($config{voteack}) {
 478       # send cancellation acknowledge
 479       my $template = UVtemplate->new();
 480       my $msg = $template->processTemplate($config{tpl_cancelled});
 481       UVsendmail::mail($voter_addr, "Bestaetigung", $msg, $msgid);
 482     }
 483
 484   } else {
 485     print RESULT "S: ", join ("", @votes), "\n";
 486
 487     # send acknowledge mail?
 488     if ($config{voteack}) {
 489
 490       my $template = UVtemplate->new();
 491       $template->setKey(ballotid        => $ballot_id);
 492       $template->setKey(address         => $voter_addr);
 493       $template->setKey(name            => $voter_name);
 494
 495       for (my $n=0; $n<@groups; $n++) {
 496         my $vote = $votes[$n];
 497         $vote =~ s/^J$/JA/;
 498         $vote =~ s/^N$/NEIN/;
 499         $vote =~ s/^E$/ENTHALTUNG/;
 500         $template->addListItem('groups', pos=>$n+1, vote=>$vote, group=>$groups[$n]);
 501       }
 502
 503       my $msg = $template->processTemplate($config{'tpl_ack_mail'});
 504       UVsendmail::mail($voter_addr, "Bestaetigung", $msg, $msgid);
 505     }
 506   }
 507 }
 508
 509
 510 ##############################################################################
 511 # Send out acknowledge mails and tidy up (we're called as "uvvote.pl clean") #
 512 ##############################################################################
 513
 514 sub make_clean {
 515
 516   # send mails
 517   UVsendmail::send();
 518
 519   print UVmessage::get("INFO_TIDY_UP"), "\n";
 520
 521   # search unprocessed files
 522   opendir (DIR, $config{tmpdir});
 523   my @files = readdir DIR;
 524   closedir (DIR);
 525
 526   my @resultfiles = grep (/^ergebnis-/, @files);
 527   my @votefiles = grep (/^stimmen-/, @files);
 528
 529   unless (@resultfiles) {
 530     print wrap('', '', UVmessage::get("VOTE_NO_NEW_RESULTS")), "\n\n";
 531     return 0;
 532   }
 533
 534   foreach my $thisresult (@resultfiles) {
 535     chmod (0400, "$config{tmpdir}/$thisresult");
 536     rename "$config{tmpdir}/$thisresult", "$config{archivedir}/$thisresult"
 537       or die UVmessage::get("VOTE_MOVE_RESULTFILE", (FILE=>$thisresult)) . "$!\n\n";
 538   }
 539
 540   foreach my $thisvotes (@votefiles) {
 541     chmod (0400, "$config{tmpdir}/$thisvotes");
 542     rename "$config{tmpdir}/$thisvotes", "$config{archivedir}/$thisvotes"
 543       or die UVmessage::get("VOTE_MOVE_VOTEFILE", (FILE=>$thisvotes)) . "$!\n\n";
 544   }
 545
 546   print UVmessage::get("VOTE_CREATING_RESULTS", (FILENAME=>$config{resultfile})), "\n";
 547
 548   # search all result files
 549   opendir (DIR, "$config{archivedir}/");
 550   @files = grep (/^ergebnis-/, readdir (DIR));
 551   closedir (DIR);
 552
 553   # Create complete result from all single result files.
 554   # The resulting file (ergebnis.alle) is overwritten as there could have been
 555   # made changes in the single result files
 556   open(RESULT, ">$config{resultfile}");
 557   foreach my $file (sort @files) {
 558     open(THISRESULT, "<$config{archivedir}/$file");
 559     print RESULT join('', <THISRESULT>);
 560     close(THISRESULT);
 561   }
 562   close(RESULT);
 563
 564   print "\n";
 565
 566 }
 567
 568
 569 ##############################################################################
 570 # Print help text (options and syntax) on -h or --help                       #
 571 ##############################################################################
 572
 573 sub help {
 574   print <<EOF;
 575 Usage: uvvote.pl [-c config_file] [-t]
 576        uvvote.pl [-c config_file] clean
 577        uvvote.pl -h
 578
 579 Liest Mailboxen aus einer Datei oder per POP3 ein wertet die Mails
 580 als Stimmzettel aus. Erst beim Aufruf mit der Option "clean" werden
 581 die Ergebnisse endgueltig gespeichert und die Bestaetigungsmails
 582 verschickt.
 583
 584   -c config_file   liest die Konfiguration aus config_file
 585                    (usevote.cfg falls nicht angegeben)
 586
 587   -t, --test       fuehrt einen Test der Konfiguration durch und
 588                    gibt das ermittelte Ergebnis aus.
 589
 590   -h, --help       zeigt diesen Hilfetext an
 591
 592 EOF
 593
 594   exit 0;
 595 }