From upstream: Change tpl/result-single.
[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;
12use POSIX qw(strftime);
13
14use vars qw($VERSION);
15
16# Module version
17$VERSION = "0.11";
18
19sub 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
2251;
This page took 0.018613 seconds and 4 git commands to generate.