Update documentation.
[usenet/usevote.git] / uvvote.pl
1 #!/usr/bin/perl -w
2
3 ###############################################################################
4 # UseVoteGer 4.12 Wahldurchfuehrung
5 # (c) 2001-2014 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 }
This page took 0.024513 seconds and 4 git commands to generate.