# UVreadmail: functions for reading and processing mailfiles # Used by uvvote.pl, uvcfv.pl, uvbounce.pl package UVreadmail; use strict; use UVconfig; use UVmessage; use MIME::QuotedPrint; use MIME::Base64; use MIME::Parser; use Mail::Box::Manager; use POSIX qw(strftime); use vars qw($VERSION); # Module version $VERSION = "0.11"; sub process { # $filename: file containing bounces or (if POP3 is enabled) where # mails should be saved # $callsub: reference to a sub which should be called for each mail # $caller: 0 = uvvote.pl, 1 = uvcfv.pl, 2 = uvbounce.pl # 3 = uvbounce.pl but POP3 disabled (overrides $config{pop3} # my ($filename, $callsub, $caller) = @_; my ($voter_addr, $voter_name, $body); my $count = 0; my ($pop3server, $pop3user, $pop3pass, $pop3delete, $pop3uidlcache); my @mails = (); $caller ||= 0; if ($config{pop3} && $caller<3) { if ($caller == 1) { # Ballot request (personal = 1 set in usevote.cfg) from uvcfv.pl $pop3server = $config{pop3server_req} . ':' . $config{pop3port_req}; $pop3user = $config{pop3user_req}; $pop3pass = $config{pop3pass_req}; $pop3delete = $config{pop3delete_req}; $pop3uidlcache = $config{pop3uidlcache_req}; } elsif ($caller == 2) { # called from uvbounce.pl $pop3server = $config{pop3server_bounce} . ':' . $config{pop3port_bounce}; $pop3user = $config{pop3user_bounce}; $pop3pass = $config{pop3pass_bounce}; $pop3delete = $config{pop3delete_bounce}; $pop3uidlcache = $config{pop3uidlcache_bounce}; } else { $pop3server = $config{pop3server} . ':' . $config{pop3port}; $pop3user = $config{pop3user}; $pop3pass = $config{pop3pass}; $pop3delete = $config{pop3delete}; $pop3uidlcache = $config{pop3uidlcache}; } # read list of seen mails (UIDLs) my %uidls = (); # hash for quick searching my @uidls = (); # array to preserve order my $cacheexist = 1; open (UIDLCACHE, "<$pop3uidlcache") or $cacheexist = 0; if ($cacheexist) { while (my $uidl = ) { chomp ($uidl); $uidls{$uidl} = 1; push (@uidls, $uidl); } close (UIDLCACHE); } print UVmessage::get("READMAIL_STATUS"), "\n" unless ($caller == 2); # open POP3 connection and get new mails use Net::POP3; my $pop = Net::POP3->new($pop3server) or die UVmessage::get("READMAIL_NOCONNECTION") . "\n\n"; my $mailcount = $pop->login($pop3user, $pop3pass); die UVmessage::get("READMAIL_NOLOGIN") . "\n\n" unless ($mailcount); for (my $n=1; $n<=$mailcount; $n++) { my $uidl = $pop->uidl($n); if ($uidl) { next if ($uidls{$uidl}); $uidls{$uidl} = 1; push (@uidls, $uidl); } my $mailref = $pop->get($n) or print STDERR UVmessage::get("READMAIL_GET_PROBLEM", (NR => $n)) . "\n"; my $mail = join ('', @$mailref); my $fromline = 'From '; if ($mail =~ /From: .*?<(.+?)>/) { $fromline .= $1; } elsif ($mail =~ /From:\s+?(\S+?\@\S+?)\s/) { $fromline .= $1; } else { $fromline .= 'foo@bar.invalid'; } $fromline .= ' ' . strftime ('%a %b %d %H:%M:%S %Y', localtime) . "\n"; push (@mails, $fromline . $mail); if ($pop3delete) { $pop->delete($n) or print STDERR UVmessage::get("READMAIL_DEL_PROBLEM", (NR => $n)) . "\n"; } } # save UIDLs my $uidlerr = 0; open (UIDLCACHE, ">$pop3uidlcache") or $uidlerr = 1; if ($uidlerr) { print STDERR UVmessage::get("READMAIL_UIDL_PROBLEM") . "\n"; print STDERR UVmessage::get("READMAIL_UIDL_PROBLEM2") . "\n"; } else { print UIDLCACHE join("\n", @uidls); close (UIDLCACHE) or print STDERR UVmessage::get("READMAIL_UIDL_CLOSE") . "\n"; } $pop->quit(); # Mailbox / Maildir } else { my $mgr = Mail::Box::Manager->new; my $folder; eval{ $folder = $mgr->open( folder => $config{votefile}, create => 0, access => 'rw', type => $config{mailboxtype}, expand => 'LAZY', ); }; die UVmessage::get("READMAIL_NOMAILFILE", (FILE => $config{votefile})) . "\n\n" if $@; # Iterate over the messages. foreach (@$folder) { my $mail = $_->string; $_->delete(); my $fromline = 'From '; if ($mail =~ /From: .*?<(.+?)>/) { $fromline .= $1; } elsif ($mail =~ /From:\s+?(\S+?\@\S+?)\s/) { $fromline .= $1; } else { $fromline .= 'foo@bar.invalid'; } $fromline .= ' ' . localtime() . "\n"; #strftime ('%a %b %d %H:%M:%S %Y', localtime) . "\n"; push (@mails, $fromline . $mail); } } # make archive of all mails my $fileproblem = 0; open (VOTES, ">$filename") or $fileproblem = 1; if ($fileproblem) { print STDERR UVmessage::get("READMAIL_ARCHIVE_PROBLEM", (FILE => $filename)) . "\n"; } else { print VOTES join ("\n", @mails); close (VOTES) or print STDERR UVmessage::get("READMAIL_ARCHIVE_CLOSE", (FILE => $filename)) . "\n"; } foreach my $mail (@mails) { next unless $mail; # split mail into array and remove first line (from line) my @mail = split(/\n/, $mail); shift (@mail) if ($mail[0] =~ /^From /); # generate MIME-Parser object for the mail my $parser = new MIME::Parser; # headers are to be decoded $parser->decode_headers(1); # don't write into file $parser->output_to_core(1); # read mail my $entity = $parser->parse_data(join("\n", @mail)); my $head = $entity->head; # extract address and name my $from = $head->get('From') || ''; if ($from =~ /\s*([^<]\S+\@\S+[^>]) \((.+)\)/) { ($voter_addr, $voter_name) = ($1, $2); } elsif ($from =~ /\s*\"?([^\"]+)\"?\s*<(\S+\@\S+)>/) { ($voter_name, $voter_addr) = ($1, $2); $voter_name =~ s/\s+$//; # kill spaces at the end } elsif ($from =~ /\s*]+)>?[^\(\)]*/) { ($voter_addr, $voter_name) = ($1, ''); } else { # initialize with empty value $voter_addr = ''; $voter_name = ''; } # look at reply-to? if ($config{replyto}) { my $replyto = Mail::Field->new('Reply-To', $head->get('Reply-To')); # Address in Reply-To? ($voter_addr) = $replyto->addresses() if ($replyto->addresses()); # Name in reply-to? if ($replyto->names()) { my ($nametmp) = $replyto->names(); $voter_name = $nametmp unless ($nametmp =~ /^\s*$/); } } # decode body my $encoding = $head->get('Content-Transfer-Encoding') || ''; if ($encoding =~ /quoted-printable/i) { $body = decode_qp($entity->stringify_body); } elsif ($encoding =~ /base64/i) { $body = decode_base64($entity->stringify_body); } else { $body = $entity->stringify_body; } my $h_date = $head->get('Date') || ''; chomp $h_date; # call referred sub and increase counter &$callsub($voter_addr, $voter_name, $h_date, $entity, \$body); $count++; } return $count; } 1;