Complete move to thh.votetaker.de
[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)
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
514sub 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
573sub help {
574 print <<EOF;
575Usage: uvvote.pl [-c config_file] [-t]
576 uvvote.pl [-c config_file] clean
577 uvvote.pl -h
578
579Liest Mailboxen aus einer Datei oder per POP3 ein wertet die Mails
580als Stimmzettel aus. Erst beim Aufruf mit der Option "clean" werden
581die Ergebnisse endgueltig gespeichert und die Bestaetigungsmails
582verschickt.
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
592EOF
593
594 exit 0;
595}
This page took 0.035432 seconds and 4 git commands to generate.