[usenet/usevote.git] / uvvote.pl

#!/usr/bin/perl -w

###############################################################################
# UseVoteGer 4.09 Wahldurchfuehrung
# (c) 2001-2005 Marc Langer <uv@marclanger.de>
# 
# This script package is free software; you can redistribute it and/or
# modify it under the terms of the GNU Public License as published by the
# Free Software Foundation.
#
# The script reads usenet vote ballots from mailbox files. The format
# can be set by changing the option "mailstart".
#
# Many thanks to:
# - Ron Dippold (Usevote 3.0, 1993/94)
# - Frederik Ramm (German translation, 1994)
# - Wolfgang Behrens (UseVoteGer 3.1, based on Frederik's translation, 1998/99)
# - Cornell Binder for some good advice and code fragments
#
# This is a complete rewrite of UseVoteGer 3.1 in Perl (former versions were
# written in C). Not all functions of Usevote/UseVoteGer 3.x are implemented!
###############################################################################

use strict;
use Getopt::Long;
use Text::Wrap qw(wrap $columns);
use FindBin qw($Bin);
use lib $Bin;
use UVconfig;
use UVmenu;
use UVmessage;
use UVreadmail;
use UVsendmail;
use UVrules;
use UVtemplate;

my $clean = 0;
my %opt_ctl = ();

print "\n$usevote_version Wahldurchfuehrung - (c) 2001-2005 Marc Langer\n\n";

# unknown parameters remain in @ARGV (for "help")
Getopt::Long::Configure(qw(pass_through bundling));

# Put known parameters in %opt_ctl
GetOptions(\%opt_ctl, qw(test t config-file=s c=s));

# Get name auf config file (default: usevote.cfg) and read it
my $cfgfile   = $opt_ctl{'config-file'} || $opt_ctl{c} || "usevote.cfg";

# test mode? (default: no)
my $test_only = $opt_ctl{test}          || $opt_ctl{t} || 0;

if (@ARGV){
  # additional parameters passed

  if ($ARGV[0] eq "clean") {
    $clean = 1;
  } else {
    # print help and exit program
    help();
  }
}

UVconfig::read_config($cfgfile, 1);  # read config file, redirect errors to log
UVrules::read_rulefile();            # read rules from file

# read list of suspicious mail addresses from file
my @bad_addr = UVconfig::read_badaddr();

# option -t used?
if ($test_only) {
  UVconfig::test_config();
  exit 0;
}

# check for lock file
if (-e $config{lockfile}) {
  my $lockfile = $config{lockfile};

  # don't delete lockfile in END block ;-)
  $config{lockfile} = '';

  # exit
  die UVmessage::get("ERR_LOCK", (FILE=>$lockfile)) . "\n\n";
}

# safe exit (delete lockfile)
$SIG{QUIT} = 'sighandler';
$SIG{INT} = 'sighandler';
$SIG{KILL} = 'sighandler';
$SIG{TERM} = 'sighandler';
$SIG{HUP} = 'sighandler';

# create lock file
open (LOCKFILE, ">$config{lockfile}");
close (LOCKFILE);

# Set columns for Text::Wrap
$columns = $config{rightmargin};

# check for tmp and archive directory
unless (-d $config{archivedir}) {
  mkdir ($config{archivedir}, 0700)
    or die UVmessage::get("ERR_MKDIR", (DIR=>$config{archivedir})) . "$!\n\n";
}

unless (-d $config{tmpdir}) {
  mkdir ($config{tmpdir}, 0700)
    or die UVmessage::get("ERR_MKDIR", (DIR=>$config{tmpdir})) . "$!\n\n";
}

if ($clean) {
  # Program has been startet with "clean" option:
  # save votes and send out acknowledge mails
  make_clean();

} else {
  # normal processing

  # generate file names for result file
  # normally unixtime is sufficient, if it is not unique append our PID
  my $ext = time;

  opendir (TMP, $config{tmpdir});
  my @tmpfiles = readdir (DIR);
  closedir (TMP);
  opendir (FERTIG, $config{archivedir});
  my @fertigfiles = readdir (FERTIG);
  closedir (FERTIG);

  # append PID if necessary
  $ext .= "-$$" if (grep (/$ext/, @tmpfiles) || grep (/$ext/, @fertigfiles));

  my $thisresult = "ergebnis-" . $ext;
  my $thisvotes = "stimmen-" . $ext;
  
  # POP3 not activated: rename votes file
  unless ($config{pop3}) {
    print UVmessage::get("VOTE_RENAMING_MAILBOX"), "\n";
    rename ($config{votefile}, "$config{tmpdir}/$thisvotes")
       or die UVmessage::get("ERR_RENAME_MAILFILE") . "$!\n\n";
  
    #  wait, so that current mail deliveries can finalize
    sleep 2;
  }

  # open results file
  open (RESULT, ">>$config{tmpdir}/$thisresult")
     or die UVmessage::get("VOTE_WRITE_RESULTS", (FILE=>$thisresult)) . "\n\n";

  # read votes and process them
  # for each mail pass a reference to the sub to be called
  my $count = UVreadmail::process("$config{tmpdir}/$thisvotes", \&process_vote, 0);

  close (RESULT)
     or print STDERR UVmessage::get("VOTE_CLOSE_RESULTS", (FILE=>$thisresult)) . "\n";

  # no mails: exit here
  unless ($count) {
    print UVmessage::get("VOTE_NO_VOTES") . "\n\n";
    exit 0;
  }

  if ($config{onestep}) {
    # everything should be done in one step
    print "\n" . UVmessage::get("VOTE_NUM_VOTES", (COUNT=>$count)) . "\n";
    make_clean();

  } else {

    print "\n", UVmessage::get("VOTE_NOT_SAVED", (COUNT=>$count)), "\n",
          wrap('', '', UVmessage::get("VOTE_FIRSTRUN")), "\n\n";
  }
}

exit 0;

END {
  close (STDERR);

  # delete lockfile
  unlink $config{lockfile} if ($config{lockfile});

  if (-s $config{errorfile}) {
    # errors ocurred
    print '*' x $config{rightmargin}, "\n",
          UVmessage::get("VOTE_ERRORS",(FILE => $config{errorfile})), "\n",
          '*' x $config{rightmargin}, "\n\n";
    open (ERRFILE, "<$config{errorfile}");
    print <ERRFILE>;
    close (ERRFILE);
    print "\n";
  } else {
    unlink ($config{errorfile});
  }
}


sub sighandler {
  my ($sig) = @_;
  die "\n\nSIG$sig: deleting lockfile and exiting\n\n";
} 


##############################################################################
# Evaluation of a vote mail                                                  #
# Called from UVreadmail::process() for each mail.                           #
# Parameters: voter address and name, date header of the vote mail (strings) #
#             complete header (reference to array), body (ref. to strings)   #
##############################################################################

sub process_vote {
  my ($voter_addr, $voter_name, $h_date, $entity, $body) = @_;

  my @header = split(/\n/, $entity->stringify_header);
  my $head = $entity->head;
  my $msgid = $head->get('Message-ID');
  chomp($msgid) if ($msgid);

  my @votes = ();              # the votes
  my @set;                     # interactively changed fields
  my @errors = ();             # recognized errors (show menu for manual action)
  my $onevote = 0;             # 0=no votes, 1=everything OK, 2=vote cancelled
  my $voteerror = "";          # error message in case of invalid vote
  my $ballot_id = "";          # ballot id (German: Wahlscheinkennung)

  # found address?
  if ($voter_addr) {
    # search for suspicious addresses
    foreach my $element (@bad_addr) {
      if ($voter_addr =~ /^$element/) {
        push (@errors, 'SuspiciousAccount');
        last;
      }
    }
  } else {
    # found no address in mail (perhaps violates RFC?)
    push (@errors, 'InvalidAddress');
  }

  # personalized ballots?
  if ($config{personal}) {
    if ($$body =~ /$config{ballotidtext}\s+([a-z0-9]+)/) {
      $ballot_id = $1;
      # Address registered? ($ids is set in UVconfig.pm)
      if ($ids{$voter_addr}) {
        push (@errors, 'WrongBallotID') if ($ids{$voter_addr} ne $ballot_id);
      } else {
        push (@errors, 'AddressNotRegistered');
      }
    } else {
      push (@errors, 'NoBallotID');
    }
  }
      
  # evaluate vote strings
  for (my $n=0; $n<@groups; $n++) {

    # counter starts at 1 in ballot
    my $votenum = $n+1;
    my $vote = "";
    
    # a line looks like this: #1 [ VOTE ] Group
    # matching only on number and vote, because of line breaks likely
    # inserted by mail programs

    # duplicate vote?
    if ($$body =~ /#$votenum\W*?\[\s*?(\w+)\s*?\].+?#$votenum\W*?\[\s*?(\w+)\s*?\]/s) {
      push (@errors, "DuplicateVote") if ($1 ne $2);
    }

    # this matches on a single appearance:
    if ($$body =~ /#$votenum\W*?\[(.+)\]/) {
      # one or more vote strings were found
      $onevote = 1;
      my $votestring = $1;
      if ($votestring =~ /^\W*$config{ja_stimme}\W*$/i) {
        $vote = "J";
      } elsif ($votestring =~ /^\W*$config{nein_stimme}\W*$/i) {
        $vote = "N";
      } elsif ($votestring =~ /^\W*$config{enth_stimme}\W*$/i) {
        $vote = "E";
      } elsif ($votestring =~ /^\s*$/) {
        # nothing has been entered between the [ ]
        $vote = "E";
      } elsif ($votestring =~ /^\W*$config{ann_stimme}\W*$/i) {
        $vote = "A";
        $onevote = 2;        # Cancelled vote: set $onevote to 2
      } elsif (!$votes[$n]) {
        # vote not recognized
        $vote = "E";
        push (@errors, 'UnrecognizedVote #' . $votenum . "#$votestring");
      }
      push (@votes, $vote);
    } else {
      # vote not found
      push (@votes, 'E');
      push (@errors, 'UnrecognizedVote #' . $votenum . '#(keine Stimmabgabe fuer "'
           . $groups[$n] . '" gefunden)');
    }
  }

  if ($onevote == 0) {
    push (@errors, "NoVote") unless ($onevote);
  } elsif ($onevote == 1) {
    # check rules
    my $rule = UVrules::rule_check(\@votes);
    push (@errors, "ViolatedRule #$rule") if ($rule);
  } else {
    # cancelled vote: replace all votes with an A
    @votes = split(//, 'A' x scalar @votes);
  }

  # Evaluate Data Protection Law clause (not on cancelled votes)
  if ($config{bdsg} && $onevote<2) {

    # Text in ballot complete and clause accepted?
    # Should read like this: #a [ STIMME ] Text
    # (Text is configurable in usevote.cfg)
    unless ($$body =~ /$bdsg_regexp/s &&
            $$body =~ /#a\W*?\[\W*?$config{ja_stimme}\W*?\]\W*?$bdsg2_regexp/is) {

      push (@errors, 'InvalidBDSG');
    }
  }

  # Name in body?
  if ($$body =~ /($config{nametext}|$config{nametext2})( |\t)*(\S.+?)$/m) {
    $voter_name = $3;
    $voter_name =~ s/^\s+//; # strip leading spaces
    $voter_name =~ s/\s+$//; # strip trailing spaces
  }

  if ($voter_name) {
    # Name invalid?
    push (@errors, 'InvalidName') unless ($voter_name =~ /$config{name_re}/);
  } else {
    # no name found:
    push (@errors, 'NoName') unless ($voter_name);
  }

  # Errors encountered?
  if (@errors) {
    my $res = UVmenu::menu(\@votes, \@header, $body, \$voter_addr, \$voter_name,
                           \$ballot_id, \@set, \@errors);
    return 0 if ($res eq 'i');      # "Ignore": Ignore vote, don't save

    my $tpl;

    # Check Ballot ID stuff
    if ($config{personal}) {
      if ($ballot_id) {
        if ($ids{$voter_addr}) {
          if ($ids{$voter_addr} ne $ballot_id) {
            $voteerror = UVmessage::get("VOTE_INVALID_BALLOTID");
            $tpl = $config{tpl_wrong_ballotid};
          }
        } else {
          $voteerror = UVmessage::get("VOTE_UNREGISTERED_ADDRESS");
          $tpl = $config{tpl_addr_reg};
        }
      } else {
        $voteerror = UVmessage::get("VOTE_MISSING_BALLOTID");
        $tpl = $config{tpl_no_ballotid};
      }
  
      # generate error mail (if error occurred)
      if ($tpl) {
        my $template = UVtemplate->new();
        $template->setKey('head' => $entity->stringify_header);
        $template->setKey('body' => $$body);
        my $msg = $template->processTemplate($tpl);
        UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
      }
    }
  }
  
  # Check rules and send error mail unless rule violation was ignored in the use menu
  # or another error was detected
  if (grep(/ViolatedRule/, @errors) && !$voteerror && (my $rule = UVrules::rule_check(\@votes))) {
    $voteerror = UVmessage::get("VOTE_VIOLATED_RULE", (RULE=>$rule));
    my $template = UVtemplate->new();
    $template->setKey('body'  => $$body);
    $template->setKey('rules' => UVrules::rule_print($rule-1));
    my $msg = $template->processTemplate($config{tpl_rule_violated});
    UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
  }

  if (!$voteerror && @errors) {

    # turn errors array into hash

    my %error;
    foreach my $error (@errors) {
      $error{$error} = 1;
    }

    # Check uncorrected errors
    if ($error{InvalidBDSG}) {
      my $template = UVtemplate->new();
      my $msg = $template->processTemplate($config{tpl_bdsg_error});
      UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
      return 0;
    } elsif ($error{NoVote}) {
      $voteerror = UVmessage::get("VOTE_NO_VOTES");
      my $template = UVtemplate->new();
      $template->setKey('body'  => $$body);
      my $msg = $template->processTemplate($config{tpl_no_votes});
      UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
    } elsif ($error{SuspiciousAccount}) {
      $voteerror = UVmessage::get("VOTE_INVALID_ACCOUNT");
      my $template = UVtemplate->new();
      $template->setKey('head' => $entity->stringify_header);
      $template->setKey('body'  => $$body);
      my $msg = $template->processTemplate($config{tpl_invalid_account});
      UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
    } elsif ($error{InvalidAddress}) {
      $voteerror = UVmessage::get("VOTE_INVALID_ADDRESS");
    } elsif ($error{InvalidName}) {
      $voteerror = UVmessage::get("VOTE_INVALID_REALNAME");
      my $template = UVtemplate->new();
      $template->setKey('head' => $entity->stringify_header);
      $template->setKey('body'  => $$body);
      my $msg = $template->processTemplate($config{tpl_invalid_name});
      UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
    } elsif ($error{DuplicateVote}) {
      $voteerror = UVmessage::get("VOTE_DUPLICATES");
      my $template = UVtemplate->new();
      $template->setKey('head' => $entity->stringify_header);
      $template->setKey('body'  => $$body);
      my $msg = $template->processTemplate($config{tpl_multiple_votes});
      UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
    }
  }

  # check voter name
  unless ($voter_name || $voteerror) {
    $voteerror = UVmessage::get("VOTE_MISSING_NAME");
    my $template = UVtemplate->new();
    $template->setKey('head' => $entity->stringify_header);
    $template->setKey('body'  => $$body);
    my $msg = $template->processTemplate($config{tpl_invalid_name});
    UVsendmail::mail($voter_addr, "Fehler", $msg, $msgid) if ($config{voteack});
  }

  # set mark for cancelled vote
  $onevote = 2 if ($votes[0] eq 'A');

  # create comment line for result file
  my $comment;
  if ($config{personal}) {
    # Personalized Ballots: insert ballot id
    $comment = "($ballot_id)";
  } else {
    $comment = "()";
  }

  if (@set) {
    $comment .= ' '.UVmessage::get("VOTE_FILE_COMMENT", (FIELDS => join(', ', @set)));
  }

  # write result file
  print RESULT "A: $voter_addr\n";
  print RESULT "N: $voter_name\n";
  print RESULT "D: $h_date\n";
  print RESULT "K: $comment\n";

  # invalid vote?
  if ($voteerror) {
    print RESULT "S: ! $voteerror\n";

  # cancelled vote?
  } elsif ($onevote == 2) {
    print RESULT "S: * Annulliert\n";

    if ($config{voteack}) {
      # send cancellation acknowledge
      my $template = UVtemplate->new();
      my $msg = $template->processTemplate($config{tpl_cancelled});
      UVsendmail::mail($voter_addr, "Bestaetigung", $msg, $msgid);
    }

  } else {
    print RESULT "S: ", join ("", @votes), "\n";

    # send acknowledge mail?
    if ($config{voteack}) {

      my $template = UVtemplate->new();
      $template->setKey(ballotid        => $ballot_id);
      $template->setKey(address         => $voter_addr);
      $template->setKey(name            => $voter_name);

      for (my $n=0; $n<@groups; $n++) {
        my $vote = $votes[$n];
        $vote =~ s/^J$/JA/;
        $vote =~ s/^N$/NEIN/;
        $vote =~ s/^E$/ENTHALTUNG/;
        $template->addListItem('groups', pos=>$n+1, vote=>$vote, group=>$groups[$n]);
      }
   
      my $msg = $template->processTemplate($config{'tpl_ack_mail'});
      UVsendmail::mail($voter_addr, "Bestaetigung", $msg, $msgid);
    }
  }
}


##############################################################################
# Send out acknowledge mails and tidy up (we're called as "uvvote.pl clean") #
##############################################################################

sub make_clean {

  # send mails
  UVsendmail::send();

  print UVmessage::get("INFO_TIDY_UP"), "\n";

  # search unprocessed files
  opendir (DIR, $config{tmpdir});
  my @files = readdir DIR;
  closedir (DIR);

  my @resultfiles = grep (/^ergebnis-/, @files);
  my @votefiles = grep (/^stimmen-/, @files);

  unless (@resultfiles) {
    print wrap('', '', UVmessage::get("VOTE_NO_NEW_RESULTS")), "\n\n";
    return 0;
  }   

  foreach my $thisresult (@resultfiles) {
    chmod (0400, "$config{tmpdir}/$thisresult");
    rename "$config{tmpdir}/$thisresult", "$config{archivedir}/$thisresult"
      or die UVmessage::get("VOTE_MOVE_RESULTFILE", (FILE=>$thisresult)) . "$!\n\n";
  }

  foreach my $thisvotes (@votefiles) {
    chmod (0400, "$config{tmpdir}/$thisvotes");
    rename "$config{tmpdir}/$thisvotes", "$config{archivedir}/$thisvotes"
      or die UVmessage::get("VOTE_MOVE_VOTEFILE", (FILE=>$thisvotes)) . "$!\n\n";
  }

  print UVmessage::get("VOTE_CREATING_RESULTS", (FILENAME=>$config{resultfile})), "\n";

  # search all result files
  opendir (DIR, "$config{archivedir}/");
  @files = grep (/^ergebnis-/, readdir (DIR));
  closedir (DIR);

  # Create complete result from all single result files.
  # The resulting file (ergebnis.alle) is overwritten as there could have been
  # made changes in the single result files
  open(RESULT, ">$config{resultfile}");
  foreach my $file (sort @files) {
    open(THISRESULT, "<$config{archivedir}/$file");
    print RESULT join('', <THISRESULT>);
    close(THISRESULT);
  }
  close(RESULT);

  print "\n";

}


##############################################################################
# Print help text (options and syntax) on -h or --help                       #
##############################################################################

sub help {
  print <<EOF;
Usage: uvvote.pl [-c config_file] [-t]
       uvvote.pl [-c config_file] clean
       uvvote.pl -h

Liest Mailboxen aus einer Datei oder per POP3 ein wertet die Mails
als Stimmzettel aus. Erst beim Aufruf mit der Option "clean" werden
die Ergebnisse endgueltig gespeichert und die Bestaetigungsmails
verschickt.

  -c config_file   liest die Konfiguration aus config_file
                   (usevote.cfg falls nicht angegeben)

  -t, --test       fuehrt einen Test der Konfiguration durch und
                   gibt das ermittelte Ergebnis aus.

  -h, --help       zeigt diesen Hilfetext an

EOF

  exit 0;
}
Commit	Line	Data
ac7e2c54 TH	1	#!/usr/bin/perl -w
	2
	3	###############################################################################
b00b7d6d TH	4	# UseVoteGer 4.09 Wahldurchfuehrung
b00b7d6d TH	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
	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
b00b7d6d	40	print "\n$usevote_version Wahldurchfuehrung - (c) 2001-2005 Marc Langer\n\n";
ac7e2c54 TH	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 (TMP, $config{tmpdir});
b00b7d6d	126	my @tmpfiles = readdir (DIR);
ac7e2c54 TH	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	# 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_VOTES") . "\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');
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
514	sub 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
573	sub help {
574	print <<EOF;
575	Usage: uvvote.pl [-c config_file] [-t]
576	uvvote.pl [-c config_file] clean
577	uvvote.pl -h
578
579	Liest Mailboxen aus einer Datei oder per POP3 ein wertet die Mails
580	als Stimmzettel aus. Erst beim Aufruf mit der Option "clean" werden
581	die Ergebnisse endgueltig gespeichert und die Bestaetigungsmails
582	verschickt.
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
592	EOF
593
594	exit 0;
595	}