ac1b84348649852fd8a2f1d5c8d5b5598bcc4cb4
[usenet/usevote.git] / 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;
This page took 0.015388 seconds and 3 git commands to generate.