Drop commonly used accounts from mailpatterns.
[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   my $voting = "";             # voting (should be votename)
228
229   # found address?
230   if ($voter_addr) {
231     # search for suspicious addresses
232     foreach my $element (@bad_addr) {
233       if ($voter_addr =~ /^$element/) {
234         push (@errors, 'SuspiciousAccount');
235         last;
236       }
237     }
238   } else {
239     # found no address in mail (perhaps violates RFC?)
240     push (@errors, 'InvalidAddress');
241   }
242
243   # correct voting?
244   if ($$body =~ /\Q$config{ballotintro}\E\s+(.+?)\s*\n([>:|]*?[\t ]+(\S+.+)\s*$)?/m) {
245     $voting = $1;
246     $voting .= " $3" if (defined($3) and $3 !~ /\Q$config{nametext}\E/);
247     push (@errors, 'WrongVoting') if ($config{votename} !~ /^\s*\Q$voting\E\s*$/);
248   } else {
249     push (@errors, 'NoVoting');
250   }
251
252   # personalized ballots?
253   if ($config{personal}) {
254     if ($$body =~ /$config{ballotidtext}\s+([a-z0-9]+)/) {
255       $ballot_id = $1;
256       # Address registered? ($ids is set in UVconfig.pm)
257       if ($ids{$voter_addr}) {
258         push (@errors, 'WrongBallotID') if ($ids{$voter_addr} ne $ballot_id);
259       } else {
260         push (@errors, 'AddressNotRegistered');
261       }
262     } else {
263       push (@errors, 'NoBallotID');
264     }
265   }
266       
267   # evaluate vote strings
268   for (my $n=0; $n<@groups; $n++) {
269
270     # counter starts at 1 in ballot
271     my $votenum = $n+1;
272     my $vote = "";
273     
274     # a line looks like this: #1 [ VOTE ] Group
275     # matching only on number and vote, because of line breaks likely
276     # inserted by mail programs
277
278     # duplicate vote?
279     if ($$body =~ /#$votenum\W*?\[\s*?(\w+)\s*?\].+?#$votenum\W*?\[\s*?(\w+)\s*?\]/s) {
280       push (@errors, "DuplicateVote") if ($1 ne $2);
281     }
282
283     # this matches on a single appearance:
284     if ($$body =~ /#$votenum\W*?\[(.+)\]/) {
285       # one or more vote strings were found
286       $onevote = 1;
287       my $votestring = $1;
288       if ($votestring =~ /^\W*$config{ja_stimme}\W*$/i) {
289         $vote = "J";
290       } elsif ($votestring =~ /^\W*$config{nein_stimme}\W*$/i) {
291         $vote = "N";
292       } elsif ($votestring =~ /^\W*$config{enth_stimme}\W*$/i) {
293         $vote = "E";
294       } elsif ($votestring =~ /^\s*$/) {
295         # nothing has been entered between the [ ]
296         $vote = "E";
297       } elsif ($votestring =~ /^\W*$config{ann_stimme}\W*$/i) {
298         $vote = "A";
299         $onevote = 2;        # Cancelled vote: set $onevote to 2
300       } elsif (!$votes[$n]) {
301         # vote not recognized
302         $vote = "E";
303         push (@errors, 'UnrecognizedVote #' . $votenum . "#$votestring");
304       }
305       push (@votes, $vote);
306     } else {
307       # vote not found
308       push (@votes, 'E');
309       push (@errors, 'UnrecognizedVote #' . $votenum . '#(keine Stimmabgabe fuer "'
310            . $groups[$n] . '" gefunden)');
311     }
312   }
313
314   if ($onevote == 0) {
315     push (@errors, "NoVote") unless ($onevote);
316   } elsif ($onevote == 1) {
317     # check rules
318     my $rule = UVrules::rule_check(\@votes);
319     push (@errors, "ViolatedRule #$rule") if ($rule);
320   } else {
321     # cancelled vote: replace all votes with an A
322     @votes = split(//, 'A' x scalar @votes);
323   }
324
325   # Evaluate Data Protection Law clause (not on cancelled votes)
326   if ($config{bdsg} && $onevote<2) {
327
328     # Text in ballot complete and clause accepted?
329     # Should read like this: #a [ STIMME ] Text
330     # (Text is configurable in usevote.cfg)
331     unless ($$body =~ /$bdsg_regexp/s &&
332             $$body =~ /#a\W*?\[\W*?$config{bdsg_confirm}\W*?\]\W*?$bdsg2_regexp/is) {
333
334       push (@errors, 'InvalidBDSG');
335     }
336   }
337
338   # Name in body?
339   if ($$body =~ /($config{nametext}|$config{nametext2})( |\t)*(\S.+?)$/m) {
340     $voter_name = $3;
341     $voter_name =~ s/^\s+//; # strip leading spaces
342     $voter_name =~ s/\s+$//; # strip trailing spaces
343   }
344
345   if ($voter_name) {
346     # Name invalid?
347     push (@errors, 'InvalidName') unless ($voter_name =~ /$config{name_re}/);
348   } else {
349     # no name found:
350     push (@errors, 'NoName') unless ($voter_name);
351   }
352
353   # Errors encountered?
354   if (@errors) {
355     my $res = UVmenu::menu(\@votes, \@header, $body, \$voter_addr, \$voter_name,
356                            \$ballot_id, \$voting, \@set, \@errors);
357     return 0 if ($res eq 'i');      # "Ignore": Ignore vote, don't save
358
359     my $tpl;
360
361     # Check Ballot ID stuff
362     if ($config{personal}) {
363       if ($ballot_id) {
364         if ($ids{$voter_addr}) {
365           if ($ids{$voter_addr} ne $ballot_id) {
366             $voteerror = UVmessage::get("VOTE_INVALID_BALLOTID");
367             $tpl = $config{tpl_wrong_ballotid};
368           }
369         } else {
370           $voteerror = UVmessage::get("VOTE_UNREGISTERED_ADDRESS");
371           $tpl = $config{tpl_addr_reg};
372         }
373       } else {
374         $voteerror = UVmessage::get("VOTE_MISSING_BALLOTID");
375         $tpl = $config{tpl_no_ballotid};
376       }
377   
378       # generate error mail (if error occurred)
379       if ($tpl) {
380         my $template = UVtemplate->new();
381         $template->setKey('head' => $entity->stringify_header);
382         $template->setKey('body' => $$body);
383         my $msg = $template->processTemplate($tpl);
384         UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
385       }
386     }
387   }
388   
389   # Check rules and send error mail unless rule violation was ignored in the use menu
390   # or another error was detected
391   if (grep(/ViolatedRule/, @errors) && !$voteerror && (my $rule = UVrules::rule_check(\@votes))) {
392     $voteerror = UVmessage::get("VOTE_VIOLATED_RULE", (RULE=>$rule));
393     my $template = UVtemplate->new();
394     $template->setKey('body'  => $$body);
395     $template->setKey('rules' => UVrules::rule_print($rule-1));
396     my $msg = $template->processTemplate($config{tpl_rule_violated});
397     UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
398   }
399
400   if (!$voteerror && @errors) {
401
402     # turn errors array into hash
403
404     my %error;
405     foreach my $error (@errors) {
406       $error{$error} = 1;
407     }
408
409     # Check uncorrected errors
410     if ($error{InvalidBDSG}) {
411       my $template = UVtemplate->new();
412       my $msg = $template->processTemplate($config{tpl_bdsg_error});
413       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
414       return 0;
415     } elsif ($error{NoVoting} or $error{WrongVoting}) {
416       $voteerror = UVmessage::get("VOTE_WRONG_VOTING");
417       my $template = UVtemplate->new();
418       $template->setKey('body'  => $$body);
419       my $msg = $template->processTemplate($config{tpl_wrong_voting});
420       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
421     } elsif ($error{NoVote}) {
422       $voteerror = UVmessage::get("VOTE_NO_VOTES");
423       my $template = UVtemplate->new();
424       $template->setKey('body'  => $$body);
425       my $msg = $template->processTemplate($config{tpl_no_votes});
426       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
427     } elsif ($error{SuspiciousAccount}) {
428       $voteerror = UVmessage::get("VOTE_INVALID_ACCOUNT");
429       my $template = UVtemplate->new();
430       $template->setKey('head' => $entity->stringify_header);
431       $template->setKey('body'  => $$body);
432       my $msg = $template->processTemplate($config{tpl_invalid_account});
433       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
434     } elsif ($error{InvalidAddress}) {
435       $voteerror = UVmessage::get("VOTE_INVALID_ADDRESS");
436     } elsif ($error{InvalidName}) {
437       $voteerror = UVmessage::get("VOTE_INVALID_REALNAME");
438       my $template = UVtemplate->new();
439       $template->setKey('head' => $entity->stringify_header);
440       $template->setKey('body'  => $$body);
441       my $msg = $template->processTemplate($config{tpl_invalid_name});
442       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
443     } elsif ($error{DuplicateVote}) {
444       $voteerror = UVmessage::get("VOTE_DUPLICATES");
445       my $template = UVtemplate->new();
446       $template->setKey('head' => $entity->stringify_header);
447       $template->setKey('body'  => $$body);
448       my $msg = $template->processTemplate($config{tpl_multiple_votes});
449       UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
450     }
451   }
452
453   # check voter name
454   unless ($voter_name || $voteerror) {
455     $voteerror = UVmessage::get("VOTE_MISSING_NAME");
456     my $template = UVtemplate->new();
457     $template->setKey('head' => $entity->stringify_header);
458     $template->setKey('body'  => $$body);
459     my $msg = $template->processTemplate($config{tpl_invalid_name});
460     UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
461   }
462
463   # set mark for cancelled vote
464   $onevote = 2 if ($votes[0] eq 'A');
465
466   # create comment line for result file
467   my $comment;
468   if ($config{personal}) {
469     # Personalized Ballots: insert ballot id
470     $comment = "($ballot_id)";
471   } else {
472     $comment = "()";
473   }
474
475   if (@set) {
476     $comment .= ' '.UVmessage::get("VOTE_FILE_COMMENT", (FIELDS => join(', ', @set)));
477   }
478
479   # write result file
480   print RESULT "A: $voter_addr\n";
481   print RESULT "N: $voter_name\n";
482   print RESULT "D: $h_date\n";
483   print RESULT "K: $comment\n";
484
485   # invalid vote?
486   if ($voteerror) {
487     print RESULT "S: ! $voteerror\n";
488
489   # cancelled vote?
490   } elsif ($onevote == 2) {
491     print RESULT "S: * Annulliert\n";
492
493     if ($config{voteack}) {
494       # send cancellation acknowledge
495       my $template = UVtemplate->new();
496       my $msg = $template->processTemplate($config{tpl_cancelled});
497       UVsendmail::mail($voter_addr, "Bestaetigung", $msg, $msgid);
498     }
499
500   } else {
501     print RESULT "S: ", join ("", @votes), "\n";
502
503     # send acknowledge mail?
504     if ($config{voteack}) {
505
506       my $template = UVtemplate->new();
507       $template->setKey(ballotid        => $ballot_id);
508       $template->setKey(address         => $voter_addr);
509       $template->setKey(name            => $voter_name);
510
511       for (my $n=0; $n<@groups; $n++) {
512         my $vote = $votes[$n];
513         $vote =~ s/^J$/JA/;
514         $vote =~ s/^N$/NEIN/;
515         $vote =~ s/^E$/ENTHALTUNG/;
516         $template->addListItem('groups', pos=>$n+1, vote=>$vote, group=>$groups[$n]);
517       }
518    
519       my $msg = $template->processTemplate($config{'tpl_ack_mail'});
520       UVsendmail::mail($voter_addr, "Bestaetigung", $msg, $msgid);
521     }
522   }
523 }
524
525
526 ##############################################################################
527 # Send out acknowledge mails and tidy up (we're called as "uvvote.pl clean") #
528 ##############################################################################
529
530 sub make_clean {
531
532   # send mails
533   UVsendmail::send();
534
535   print UVmessage::get("INFO_TIDY_UP"), "\n";
536
537   # search unprocessed files
538   opendir (DIR, $config{tmpdir});
539   my @files = readdir DIR;
540   closedir (DIR);
541
542   my @resultfiles = grep (/^ergebnis-/, @files);
543   my @votefiles = grep (/^stimmen-/, @files);
544
545   unless (@resultfiles) {
546     print wrap('', '', UVmessage::get("VOTE_NO_NEW_RESULTS")), "\n\n";
547     return 0;
548   }   
549
550   foreach my $thisresult (@resultfiles) {
551     chmod (0400, "$config{tmpdir}/$thisresult");
552     rename "$config{tmpdir}/$thisresult", "$config{archivedir}/$thisresult"
553       or die UVmessage::get("VOTE_MOVE_RESULTFILE", (FILE=>$thisresult)) . "$!\n\n";
554   }
555
556   foreach my $thisvotes (@votefiles) {
557     chmod (0400, "$config{tmpdir}/$thisvotes");
558     rename "$config{tmpdir}/$thisvotes", "$config{archivedir}/$thisvotes"
559       or die UVmessage::get("VOTE_MOVE_VOTEFILE", (FILE=>$thisvotes)) . "$!\n\n";
560   }
561
562   print UVmessage::get("VOTE_CREATING_RESULTS", (FILENAME=>$config{resultfile})), "\n";
563
564   # search all result files
565   opendir (DIR, "$config{archivedir}/");
566   @files = grep (/^ergebnis-/, readdir (DIR));
567   closedir (DIR);
568
569   # Create complete result from all single result files.
570   # The resulting file (ergebnis.alle) is overwritten as there could have been
571   # made changes in the single result files
572   open(RESULT, ">$config{resultfile}");
573   foreach my $file (sort @files) {
574     open(THISRESULT, "<$config{archivedir}/$file");
575     print RESULT join('', <THISRESULT>);
576     close(THISRESULT);
577   }
578   close(RESULT);
579
580   print "\n";
581
582 }
583
584
585 ##############################################################################
586 # Print help text (options and syntax) on -h or --help                       #
587 ##############################################################################
588
589 sub help {
590   print <<EOF;
591 Usage: uvvote.pl [-c config_file] [-t]
592        uvvote.pl [-c config_file] clean
593        uvvote.pl -h
594
595 Liest Mailboxen aus einer Datei oder per POP3 ein wertet die Mails
596 als Stimmzettel aus. Erst beim Aufruf mit der Option "clean" werden
597 die Ergebnisse endgueltig gespeichert und die Bestaetigungsmails
598 verschickt.
599
600   -c config_file   liest die Konfiguration aus config_file
601                    (usevote.cfg falls nicht angegeben)
602
603   -t, --test       fuehrt einen Test der Konfiguration durch und
604                    gibt das ermittelte Ergebnis aus.
605
606   -h, --help       zeigt diesen Hilfetext an
607
608 EOF
609
610   exit 0;
611 }
This page took 0.025629 seconds and 3 git commands to generate.