| 1 | # UVreadmail: functions for reading and processing mailfiles |
| 2 | # Used by uvvote.pl, uvcfv.pl, uvbounce.pl |
| 3 | |
| 4 | package UVreadmail; |
| 5 | |
| 6 | use strict; |
| 7 | use UVconfig; |
| 8 | use UVmessage; |
| 9 | use MIME::QuotedPrint; |
| 10 | use MIME::Base64; |
| 11 | use MIME::Parser; |
| 12 | use POSIX qw(strftime); |
| 13 | |
| 14 | use vars qw($VERSION); |
| 15 | |
| 16 | # Module version |
| 17 | $VERSION = "0.11"; |
| 18 | |
| 19 | sub process { |
| 20 | |
| 21 | # $filename: file containing bounces or (if POP3 is enabled) where |
| 22 | # mails should be saved |
| 23 | # $callsub: reference to a sub which should be called for each mail |
| 24 | # $caller: 0 = uvvote.pl, 1 = uvcfv.pl, 2 = uvbounce.pl |
| 25 | # 3 = uvbounce.pl but POP3 disabled (overrides $config{pop3} |
| 26 | # |
| 27 | |
| 28 | my ($filename, $callsub, $caller) = @_; |
| 29 | my ($voter_addr, $voter_name, $body); |
| 30 | my $count = 0; |
| 31 | my ($pop3server, $pop3user, $pop3pass, $pop3delete, $pop3uidlcache); |
| 32 | my @mails = (); |
| 33 | $caller ||= 0; |
| 34 | |
| 35 | if ($config{pop3} && $caller<3) { |
| 36 | |
| 37 | if ($caller == 1) { |
| 38 | # Ballot request (personal = 1 set in usevote.cfg) from uvcfv.pl |
| 39 | $pop3server = $config{pop3server_req} . ':' . $config{pop3port_req}; |
| 40 | $pop3user = $config{pop3user_req}; |
| 41 | $pop3pass = $config{pop3pass_req}; |
| 42 | $pop3delete = $config{pop3delete_req}; |
| 43 | $pop3uidlcache = $config{pop3uidlcache_req}; |
| 44 | } elsif ($caller == 2) { |
| 45 | # called from uvbounce.pl |
| 46 | $pop3server = $config{pop3server_bounce} . ':' . $config{pop3port_bounce}; |
| 47 | $pop3user = $config{pop3user_bounce}; |
| 48 | $pop3pass = $config{pop3pass_bounce}; |
| 49 | $pop3delete = $config{pop3delete_bounce}; |
| 50 | $pop3uidlcache = $config{pop3uidlcache_bounce}; |
| 51 | } else { |
| 52 | $pop3server = $config{pop3server} . ':' . $config{pop3port}; |
| 53 | $pop3user = $config{pop3user}; |
| 54 | $pop3pass = $config{pop3pass}; |
| 55 | $pop3delete = $config{pop3delete}; |
| 56 | $pop3uidlcache = $config{pop3uidlcache}; |
| 57 | } |
| 58 | |
| 59 | # read list of seen mails (UIDLs) |
| 60 | my %uidls = (); # hash for quick searching |
| 61 | my @uidls = (); # array to preserve order |
| 62 | my $cacheexist = 1; |
| 63 | open (UIDLCACHE, "<$pop3uidlcache") or $cacheexist = 0; |
| 64 | if ($cacheexist) { |
| 65 | while (my $uidl = <UIDLCACHE>) { |
| 66 | chomp ($uidl); |
| 67 | $uidls{$uidl} = 1; |
| 68 | push (@uidls, $uidl); |
| 69 | } |
| 70 | close (UIDLCACHE); |
| 71 | } |
| 72 | |
| 73 | print UVmessage::get("READMAIL_STATUS"), "\n" unless ($caller == 2); |
| 74 | |
| 75 | # open POP3 connection and get new mails |
| 76 | use Net::POP3; |
| 77 | my $pop = Net::POP3->new($pop3server) |
| 78 | or die UVmessage::get("READMAIL_NOCONNECTION") . "\n\n"; |
| 79 | |
| 80 | my $mailcount = $pop->login($pop3user, $pop3pass); |
| 81 | |
| 82 | die UVmessage::get("READMAIL_NOLOGIN") . "\n\n" unless ($mailcount); |
| 83 | |
| 84 | for (my $n=1; $n<=$mailcount; $n++) { |
| 85 | my $uidl = $pop->uidl($n); |
| 86 | if ($uidl) { |
| 87 | next if ($uidls{$uidl}); |
| 88 | $uidls{$uidl} = 1; |
| 89 | push (@uidls, $uidl); |
| 90 | } |
| 91 | my $mailref = $pop->get($n) |
| 92 | or print STDERR UVmessage::get("READMAIL_GET_PROBLEM", (NR => $n)) . "\n"; |
| 93 | my $mail = join ('', @$mailref); |
| 94 | my $fromline = 'From '; |
| 95 | if ($mail =~ /From: .*?<(.+?)>/) { |
| 96 | $fromline .= $1; |
| 97 | } elsif ($mail =~ /From:\s+?(\S+?\@\S+?)\s/) { |
| 98 | $fromline .= $1; |
| 99 | } else { |
| 100 | $fromline .= 'foo@bar.invalid'; |
| 101 | } |
| 102 | $fromline .= ' ' . strftime ('%a %b %d %H:%M:%S %Y', localtime) . "\n"; |
| 103 | push (@mails, $fromline . $mail); |
| 104 | if ($pop3delete) { |
| 105 | $pop->delete($n) |
| 106 | or print STDERR UVmessage::get("READMAIL_DEL_PROBLEM", (NR => $n)) . "\n"; |
| 107 | } |
| 108 | } |
| 109 | |
| 110 | # save UIDLs |
| 111 | my $uidlerr = 0; |
| 112 | open (UIDLCACHE, ">$pop3uidlcache") or $uidlerr = 1; |
| 113 | if ($uidlerr) { |
| 114 | print STDERR UVmessage::get("READMAIL_UIDL_PROBLEM") . "\n"; |
| 115 | print STDERR UVmessage::get("READMAIL_UIDL_PROBLEM2") . "\n"; |
| 116 | } else { |
| 117 | print UIDLCACHE join("\n", @uidls); |
| 118 | close (UIDLCACHE) or print STDERR UVmessage::get("READMAIL_UIDL_CLOSE") . "\n"; |
| 119 | } |
| 120 | |
| 121 | # make archive of all mails |
| 122 | my $fileproblem = 0; |
| 123 | open (VOTES, ">$filename") or $fileproblem = 1; |
| 124 | if ($fileproblem) { |
| 125 | print STDERR UVmessage::get("READMAIL_ARCHIVE_PROBLEM", |
| 126 | (FILE => $filename)) . "\n"; |
| 127 | } else { |
| 128 | print VOTES join ("\n", @mails); |
| 129 | close (VOTES) |
| 130 | or print STDERR UVmessage::get("READMAIL_ARCHIVE_CLOSE", |
| 131 | (FILE => $filename)) . "\n"; |
| 132 | } |
| 133 | |
| 134 | $pop->quit(); |
| 135 | |
| 136 | } else { |
| 137 | # open mail file |
| 138 | open(VOTES, "<$filename") |
| 139 | or die UVmessage::get("READMAIL_NOMAILFILE", (FILE => $filename)) . "\n\n"; |
| 140 | |
| 141 | # read all mails |
| 142 | my $i = 0; |
| 143 | while (<VOTES>) { |
| 144 | if (/$config{mailstart}/) { |
| 145 | $i++; |
| 146 | } |
| 147 | $mails[$i] = ($mails[$i] || "") . $_; |
| 148 | } |
| 149 | |
| 150 | # close mail file |
| 151 | close(VOTES); |
| 152 | } |
| 153 | |
| 154 | foreach my $mail (@mails) { |
| 155 | next unless $mail; |
| 156 | |
| 157 | # split mail into array and remove first line (from line) |
| 158 | my @mail = split(/\n/, $mail); |
| 159 | shift (@mail) if ($mail[0] =~ /^From /); |
| 160 | |
| 161 | # generate MIME-Parser object for the mail |
| 162 | my $parser = new MIME::Parser; |
| 163 | # headers are to be decoded |
| 164 | $parser->decode_headers(1); |
| 165 | # don't write into file |
| 166 | $parser->output_to_core(1); |
| 167 | |
| 168 | # read mail |
| 169 | my $entity = $parser->parse_data(join("\n", @mail)); |
| 170 | my $head = $entity->head; |
| 171 | |
| 172 | # extract address and name |
| 173 | my $from = $head->get('From') || ''; |
| 174 | |
| 175 | if ($from =~ /\s*([^<]\S+\@\S+[^>]) \((.+)\)/) { |
| 176 | ($voter_addr, $voter_name) = ($1, $2); |
| 177 | } elsif ($from =~ /\s*\"?([^\"]+)\"?\s*<(\S+\@\S+)>/) { |
| 178 | ($voter_name, $voter_addr) = ($1, $2); |
| 179 | $voter_name =~ s/\s+$//; # kill spaces at the end |
| 180 | } elsif ($from =~ /\s*<?(\S+\@[^\s>]+)>?[^\(\)]*/) { |
| 181 | ($voter_addr, $voter_name) = ($1, ''); |
| 182 | } else { |
| 183 | # initialize with empty value |
| 184 | $voter_addr = ''; |
| 185 | $voter_name = ''; |
| 186 | } |
| 187 | |
| 188 | # look at reply-to? |
| 189 | if ($config{replyto}) { |
| 190 | |
| 191 | my $replyto = Mail::Field->new('Reply-To', $head->get('Reply-To')); |
| 192 | |
| 193 | # Address in Reply-To? |
| 194 | ($voter_addr) = $replyto->addresses() if ($replyto->addresses()); |
| 195 | |
| 196 | # Name in reply-to? |
| 197 | if ($replyto->names()) { |
| 198 | my ($nametmp) = $replyto->names(); |
| 199 | $voter_name = $nametmp unless ($nametmp =~ /^\s*$/); |
| 200 | } |
| 201 | |
| 202 | } |
| 203 | |
| 204 | # decode body |
| 205 | my $encoding = $head->get('Content-Transfer-Encoding') || ''; |
| 206 | if ($encoding =~ /quoted-printable/i) { |
| 207 | $body = decode_qp($entity->stringify_body); |
| 208 | } elsif ($encoding =~ /base64/i) { |
| 209 | $body = decode_base64($entity->stringify_body); |
| 210 | } else { |
| 211 | $body = $entity->stringify_body; |
| 212 | } |
| 213 | |
| 214 | my $h_date = $head->get('Date') || ''; |
| 215 | chomp $h_date; |
| 216 | |
| 217 | # call referred sub and increase counter |
| 218 | &$callsub($voter_addr, $voter_name, $h_date, $entity, \$body); |
| 219 | $count++; |
| 220 | } |
| 221 | |
| 222 | return $count; |
| 223 | } |
| 224 | |
| 225 | 1; |