Commit | Line | Data |
---|---|---|
ac7e2c54 TH |
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; | |
c9497882 | 12 | use Mail::Box::Manager; |
ac7e2c54 TH |
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 | ||
ac7e2c54 TH |
122 | $pop->quit(); |
123 | ||
c9497882 | 124 | # Mailbox / Maildir |
ac7e2c54 | 125 | } else { |
c9497882 | 126 | |
7450382e TH |
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 | ||
c9497882 TH |
139 | my $mgr = Mail::Box::Manager->new; |
140 | my $folder; | |
141 | ||
142 | eval{ | |
7450382e | 143 | $folder = $mgr->open( folder => $readfilename, |
c9497882 TH |
144 | create => 0, |
145 | access => 'rw', | |
146 | type => $config{mailboxtype}, | |
147 | expand => 'LAZY', | |
148 | ); | |
149 | }; | |
7450382e | 150 | die UVmessage::get("READMAIL_NOMAILFILE", (FILE => $readfilename)) . "\n\n" if $@; |
c9497882 TH |
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'; | |
ac7e2c54 | 163 | } |
c9497882 TH |
164 | $fromline .= ' ' . localtime() . "\n"; #strftime ('%a %b %d %H:%M:%S %Y', localtime) . "\n"; |
165 | push (@mails, $fromline . $mail); | |
ac7e2c54 | 166 | } |
c9497882 | 167 | } |
ac7e2c54 | 168 | |
c9497882 TH |
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"; | |
ac7e2c54 TH |
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; |