Fix regular expression.
[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 243 # correct voting?
f908d8a1 244 if ($$body =~ /\Q$config{ballotintro}\E\s+(.+?)\s*\n(.*?[\t ]+(\S+.+)\s*$)?/m) {
b9f52014 245 $voting = $1;
f908d8a1 246 $voting .= " $3" if defined($3);
b9f52014
TH
247 push (@errors, 'WrongVoting') if ($config{votename} !~ /^\s*\Q$voting\E\s*$/);
248 } else {
249 push (@errors, 'NoVoting');
250 }
251
ac7e2c54
TH
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{ja_stimme}\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,
b9f52014 356 \$ballot_id, \$voting, \@set, \@errors);
ac7e2c54
TH
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;
b9f52014
TH
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});
ac7e2c54
TH
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
530sub 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
589sub help {
590 print <<EOF;
591Usage: uvvote.pl [-c config_file] [-t]
592 uvvote.pl [-c config_file] clean
593 uvvote.pl -h
594
595Liest Mailboxen aus einer Datei oder per POP3 ein wertet die Mails
596als Stimmzettel aus. Erst beim Aufruf mit der Option "clean" werden
597die Ergebnisse endgueltig gespeichert und die Bestaetigungsmails
598verschickt.
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
608EOF
609
610 exit 0;
611}
This page took 0.036568 seconds and 4 git commands to generate.