Merge branch 'pu/fixdupnovote'
[usenet/usevote.git] / 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 }
This page took 0.025556 seconds and 4 git commands to generate.