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