projects / usenet / usevote.git / blame_incremental
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
Update documentation from upstream.
[usenet/usevote.git] / uvvote.pl
... / ...
CommitLineData
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
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
40print "\n$usevote_version Wahldurchfuehrung - (c) 2001-2005 Marc Langer\n\n";
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
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
167exit 0;
168
169END {
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
190sub 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
203sub 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
520sub 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
579sub help {
580 print <<EOF;
581Usage: uvvote.pl [-c config_file] [-t]
582 uvvote.pl [-c config_file] clean
583 uvvote.pl -h
584
585Liest Mailboxen aus einer Datei oder per POP3 ein wertet die Mails
586als Stimmzettel aus. Erst beim Aufruf mit der Option "clean" werden
587die Ergebnisse endgueltig gespeichert und die Bestaetigungsmails
588verschickt.
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
598EOF
599
600 exit 0;
601}
UseVoteGer is a voting software for usenet votes.
This page took 0.012069 seconds and 4 git commands to generate.