UVreadmail.pm

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