Update documentation from upstream.
[usenet/usevote.git] / UVreadmail.pm
CommitLineData
ac7e2c54
TH
1# UVreadmail: functions for reading and processing mailfiles
2# Used by uvvote.pl, uvcfv.pl, uvbounce.pl
3
4package UVreadmail;
5
6use strict;
7use UVconfig;
8use UVmessage;
9use MIME::QuotedPrint;
10use MIME::Base64;
11use MIME::Parser;
34809a2a 12use Mail::Box::Manager;
ac7e2c54
TH
13use POSIX qw(strftime);
14
15use vars qw($VERSION);
16
17# Module version
18$VERSION = "0.11";
19
20sub 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
34809a2a 124 # Mailbox / Maildir
ac7e2c54 125 } else {
34809a2a 126
98343f22
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
34809a2a
TH
139 my $mgr = Mail::Box::Manager->new;
140 my $folder;
141
142 eval{
98343f22 143 $folder = $mgr->open( folder => $readfilename,
34809a2a
TH
144 create => 0,
145 access => 'rw',
146 type => $config{mailboxtype},
147 expand => 'LAZY',
52a699fd 148 remove_when_empty => 0,
34809a2a
TH
149 );
150 };
98343f22 151 die UVmessage::get("READMAIL_NOMAILFILE", (FILE => $readfilename)) . "\n\n" if $@;
34809a2a
TH
152
153 # Iterate over the messages.
154 foreach (@$folder) {
155 my $mail = $_->string;
156 $_->delete();
157 my $fromline = 'From ';
158 if ($mail =~ /From: .*?<(.+?)>/) {
159 $fromline .= $1;
160 } elsif ($mail =~ /From:\s+?(\S+?\@\S+?)\s/) {
161 $fromline .= $1;
162 } else {
163 $fromline .= 'foo@bar.invalid';
ac7e2c54 164 }
3cb13d5a 165 $fromline .= ' ' . localtime($_->timestamp()) . "\n";
34809a2a 166 push (@mails, $fromline . $mail);
ac7e2c54 167 }
34809a2a 168 }
ac7e2c54 169
34809a2a
TH
170 # make archive of all mails
171 my $fileproblem = 0;
172 open (VOTES, ">$filename") or $fileproblem = 1;
173 if ($fileproblem) {
174 print STDERR UVmessage::get("READMAIL_ARCHIVE_PROBLEM",
175 (FILE => $filename)) . "\n";
176 } else {
177 print VOTES join ("\n", @mails);
178 close (VOTES)
179 or print STDERR UVmessage::get("READMAIL_ARCHIVE_CLOSE",
180 (FILE => $filename)) . "\n";
ac7e2c54
TH
181 }
182
183 foreach my $mail (@mails) {
184 next unless $mail;
185
186 # split mail into array and remove first line (from line)
187 my @mail = split(/\n/, $mail);
188 shift (@mail) if ($mail[0] =~ /^From /);
189
190 # generate MIME-Parser object for the mail
191 my $parser = new MIME::Parser;
192 # headers are to be decoded
193 $parser->decode_headers(1);
194 # don't write into file
195 $parser->output_to_core(1);
196
197 # read mail
198 my $entity = $parser->parse_data(join("\n", @mail));
199 my $head = $entity->head;
200
201 # extract address and name
202 my $from = $head->get('From') || '';
203
204 if ($from =~ /\s*([^<]\S+\@\S+[^>]) \((.+)\)/) {
205 ($voter_addr, $voter_name) = ($1, $2);
206 } elsif ($from =~ /\s*\"?([^\"]+)\"?\s*<(\S+\@\S+)>/) {
207 ($voter_name, $voter_addr) = ($1, $2);
208 $voter_name =~ s/\s+$//; # kill spaces at the end
209 } elsif ($from =~ /\s*<?(\S+\@[^\s>]+)>?[^\(\)]*/) {
210 ($voter_addr, $voter_name) = ($1, '');
211 } else {
212 # initialize with empty value
213 $voter_addr = '';
214 $voter_name = '';
215 }
216
217 # look at reply-to?
218 if ($config{replyto}) {
219
220 my $replyto = Mail::Field->new('Reply-To', $head->get('Reply-To'));
221
222 # Address in Reply-To?
223 ($voter_addr) = $replyto->addresses() if ($replyto->addresses());
224
225 # Name in reply-to?
226 if ($replyto->names()) {
227 my ($nametmp) = $replyto->names();
228 $voter_name = $nametmp unless ($nametmp =~ /^\s*$/);
229 }
230
231 }
232
233 # decode body
234 my $encoding = $head->get('Content-Transfer-Encoding') || '';
235 if ($encoding =~ /quoted-printable/i) {
236 $body = decode_qp($entity->stringify_body);
237 } elsif ($encoding =~ /base64/i) {
238 $body = decode_base64($entity->stringify_body);
239 } else {
240 $body = $entity->stringify_body;
241 }
242
243 my $h_date = $head->get('Date') || '';
244 chomp $h_date;
245
246 # call referred sub and increase counter
247 &$callsub($voter_addr, $voter_name, $h_date, $entity, \$body);
248 $count++;
249 }
250
251 return $count;
252}
253
2541;
This page took 0.020841 seconds and 4 git commands to generate.