]>
Commit | Line | Data |
---|---|---|
1 | package PMG::MailQueue; | |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use PVE::SafeSyslog; | |
7 | use MIME::Parser; | |
8 | use IO::File; | |
9 | use Encode; | |
10 | use File::Sync; | |
11 | use File::Basename; | |
12 | use File::Path; | |
13 | use File::stat; | |
14 | use Time::HiRes qw(gettimeofday); | |
15 | use Mail::Header; | |
16 | ||
17 | use PMG::LDAPSet; | |
18 | use PMG::MIMEUtils; | |
19 | ||
20 | our $spooldir = "/var/spool/pmg"; | |
21 | ||
22 | my $fileseq = rand 1000; | |
23 | ||
24 | sub create_spooldirs { | |
25 | my ($lcid, $cleanup) = @_; | |
26 | ||
27 | # if requested, remove any stale date | |
28 | rmtree([ | |
29 | "$spooldir/cluster", | |
30 | "$spooldir/active", | |
31 | "$spooldir/virus", | |
32 | "$spooldir/spam", | |
33 | "$spooldir/attachment", | |
34 | ]) if $cleanup; | |
35 | ||
36 | mkpath([ | |
37 | "$spooldir/active", | |
38 | "$spooldir/spam", | |
39 | "$spooldir/virus", | |
40 | "$spooldir/attachment", | |
41 | ]); | |
42 | ||
43 | if ($lcid) { | |
44 | mkpath "$spooldir/cluster/$lcid/virus"; | |
45 | mkpath "$spooldir/cluster/$lcid/spam"; | |
46 | mkpath "$spooldir/cluster/$lcid/attachment"; | |
47 | } | |
48 | } | |
49 | ||
50 | # called on service startup to remove any stale files | |
51 | sub cleanup_active { | |
52 | ||
53 | while (my $file = <$spooldir/active/*>) { | |
54 | unlink $file; | |
55 | } | |
56 | ||
57 | } | |
58 | ||
59 | sub new_fileid { | |
60 | my ($dir, $subdir) = @_; | |
61 | ||
62 | # try to create a unique data file | |
63 | ||
64 | my ($sec, $usec) = gettimeofday (); | |
65 | my $fname = "$sec.$usec.$$." . $fileseq++; | |
66 | my $path = "$dir/$subdir/$fname"; | |
67 | my $fh; | |
68 | my $uid; | |
69 | my $subsubdir = ''; | |
70 | ||
71 | if (!($fh = IO::File->new ($path, 'w+', 0600))) { | |
72 | die "unable to create file '$path': $! : ERROR"; | |
73 | } | |
74 | ||
75 | if (my $st = stat ($fh)) { | |
76 | $uid = sprintf ("%X%X%05X", $st->ino, $sec, $usec); | |
77 | if ($subdir ne 'active') { | |
78 | $subsubdir .= sprintf ("%02X/", $usec % 256); | |
79 | } | |
80 | } else { | |
81 | unlink $path; | |
82 | die "unable to stat file: $! : ERROR"; | |
83 | } | |
84 | ||
85 | mkdir "$dir/$subdir/$subsubdir"; | |
86 | ||
87 | my $subpath = "$subdir/$subsubdir$uid"; | |
88 | ||
89 | if (!rename ($path, "$dir/$subpath")) { | |
90 | unlink $path; | |
91 | die "unable to rename file: ERROR"; | |
92 | } | |
93 | ||
94 | return ($fh, $uid, $subpath); | |
95 | } | |
96 | ||
97 | sub new { | |
98 | my ($type, $from, $to) = @_; | |
99 | ||
100 | my $self = {}; | |
101 | bless $self, $type; | |
102 | ||
103 | $self->{from} = $from; | |
104 | $self->{msgid} = ""; | |
105 | ||
106 | $self->{sa_score} = undef; | |
107 | $self->{sa_max} = undef; | |
108 | $self->{sa_data} = undef; | |
109 | ||
110 | $self->{vinfo} = undef; | |
111 | $self->{bytes} = 0; | |
112 | $self->{rtime} = time; | |
113 | $self->{ptime_spam} = 0; | |
114 | $self->{ptime_virus} = 0; | |
115 | ||
116 | my ($fh, $uid, $path) = new_fileid ($spooldir, 'active'); | |
117 | ||
118 | $self->{fh} = $fh; | |
119 | $self->{uid} = $uid; | |
120 | $self->{logid} = $uid; | |
121 | #$self->{logid} = sprintf ("%05X${uid}", $self->{rtime}); | |
122 | $self->{dataname} = "$spooldir/$path"; | |
123 | ||
124 | $self->{dumpdir} = "/tmp/.proxdump_${$}_$uid"; | |
125 | ||
126 | $self->set_status ($to, 'undelivered'); | |
127 | ||
128 | return $self; | |
129 | } | |
130 | ||
131 | sub set_status { | |
132 | my ($self, $targets, $state, $code, $message) = @_; | |
133 | ||
134 | foreach my $r (@$targets) { | |
135 | $self->{status}->{$r} = $state; | |
136 | $self->{status_code}->{$r} = $code; | |
137 | $self->{status_message}->{$r} = $message; | |
138 | } | |
139 | } | |
140 | ||
141 | sub quarantinedb_insert { | |
142 | my ($self, $ruledb, $lcid, $ldap, $qtype, $header, $sender, $file, $targets, $vars) = @_; | |
143 | ||
144 | eval { | |
145 | $sender = encode('UTF-8', $sender); | |
146 | my $dbh = $ruledb->{dbh}; | |
147 | ||
148 | my $insert_cmds = "SELECT nextval ('cmailstore_id_seq'); INSERT INTO CMailStore " . | |
149 | "(CID, RID, ID, Time, QType, Bytes, Spamlevel, Info, Header, Sender, File) VALUES (" . | |
150 | "$lcid, currval ('cmailstore_id_seq'), currval ('cmailstore_id_seq'), "; | |
151 | ||
152 | my $spaminfo = $vars->{__spaminfo}; | |
153 | my $sa_score = $spaminfo->{sa_score} || 0; | |
154 | ||
155 | $insert_cmds .= $self->{rtime} . ','; | |
156 | $insert_cmds .= $dbh->quote ($qtype) . ','; | |
157 | $insert_cmds .= $self->{bytes} . ','; | |
158 | $insert_cmds .= $sa_score . ','; | |
159 | ||
160 | if ($qtype eq 'V') { | |
161 | $insert_cmds .= $dbh->quote ($self->{vinfo}) . ','; | |
162 | } else { | |
163 | ||
164 | my $sscores = $spaminfo->{sa_data}; | |
165 | my $sainfo = 'NULL'; | |
166 | if (defined ($sscores) && @$sscores != -1) { | |
167 | $sainfo = ''; | |
168 | foreach my $s (@$sscores) { | |
169 | $sainfo .= ',' if $sainfo; | |
170 | $sainfo .= sprintf ("%s:%s", $s->{rule}, $s->{score}); | |
171 | } | |
172 | $sainfo = $dbh->quote ($sainfo); | |
173 | } | |
174 | ||
175 | $insert_cmds .= $sainfo . ','; | |
176 | } | |
177 | ||
178 | $insert_cmds .= $dbh->quote ($header) . ','; | |
179 | ||
180 | $insert_cmds .= $dbh->quote ($sender) . ','; | |
181 | $insert_cmds .= $dbh->quote ($file) . ');'; | |
182 | ||
183 | my $now = time(); | |
184 | ||
185 | my $tid = int(rand(0x0fffffff)); | |
186 | ||
187 | foreach my $r (@$targets) { | |
188 | my $pmail = get_primary_mail ($ldap, $r); | |
189 | my $receiver; | |
190 | if ($pmail eq lc ($r)) { | |
191 | $receiver = "NULL"; | |
192 | } else { | |
193 | $receiver = $dbh->quote (encode('UTF-8', $r)); | |
194 | } | |
195 | ||
196 | ||
197 | $pmail = $dbh->quote (encode('UTF-8', $pmail)); | |
198 | $insert_cmds .= "INSERT INTO CMSReceivers " . | |
199 | "(CMailStore_CID, CMailStore_RID, PMail, Receiver, TicketID, Status, MTime) " . | |
200 | "VALUES ($lcid, currval ('cmailstore_id_seq'), $pmail, $receiver, $tid, 'N', $now); "; | |
201 | ||
202 | # Note: Tuple (CID, RID, TicketID) must be unique | |
203 | $tid = ($tid + 1) & 0x0fffffff; | |
204 | } | |
205 | ||
206 | $dbh->do ($insert_cmds); | |
207 | }; | |
208 | ||
209 | my $err = $@; | |
210 | ||
211 | syslog ('err', "ERROR: $err") if $err; | |
212 | } | |
213 | ||
214 | sub get_primary_mail { | |
215 | my ($ldap, $mail) = @_; | |
216 | ||
217 | $mail = lc ($mail); | |
218 | ||
219 | return $mail if !$ldap; | |
220 | ||
221 | if (my $info = $ldap->account_info ($mail)) { | |
222 | return $info->{pmail}; | |
223 | } | |
224 | ||
225 | return $mail; | |
226 | } | |
227 | ||
228 | ||
229 | sub extract_header_text { | |
230 | my ($entity) = @_; | |
231 | ||
232 | my $subject = $entity->head->get ('subject', 0); | |
233 | my $from = $entity->head->get ('from', 0); | |
234 | my $sender = $entity->head->get ('sender', 0); | |
235 | ||
236 | my $head = new Mail::Header; | |
237 | $head->add ('subject', $subject) if $subject; | |
238 | $head->add ('from', $from) if $from; | |
239 | $head->add ('sender', $sender) if $sender; | |
240 | ||
241 | my $header = $head->as_string(); | |
242 | ||
243 | return $header; | |
244 | } | |
245 | ||
246 | sub fsync_file_and_dir { | |
247 | my $filename = shift; | |
248 | ||
249 | eval { | |
250 | my $fh = IO::File->new($filename) || die "unable to open file '$filename'"; | |
251 | File::Sync::fsync ($fh) || die "fsync file '$filename' failed"; | |
252 | close ($fh); | |
253 | ||
254 | my $dirname = dirname ($filename); | |
255 | my $dir = IO::File->new($dirname) || die "open dir '$dirname' failed"; | |
256 | File::Sync::fsync ($dir) || die "fsync dir '$dirname' failed"; | |
257 | close ($dir); | |
258 | }; | |
259 | ||
260 | my $err = $@; | |
261 | ||
262 | if ($err) { | |
263 | syslog ('err', "ERROR: $err"); | |
264 | } | |
265 | ||
266 | } | |
267 | ||
268 | my $subpath_map = { | |
269 | 'V' => 'virus', | |
270 | 'S' => 'spam', | |
271 | 'A' => 'attachment', | |
272 | }; | |
273 | ||
274 | sub quarantine_mail { | |
275 | my ($self, $ruledb, $qtype, $entity, $tg, $msginfo, $vars, $ldap) = @_; | |
276 | ||
277 | my $sender = $msginfo->{sender}; | |
278 | ||
279 | my $header = extract_header_text ($entity); | |
280 | ||
281 | my $subpath = $subpath_map->{$qtype} // 'spam'; | |
282 | ||
283 | my $lcid = $msginfo->{lcid}; | |
284 | ||
285 | my ($fh, $uid, $path); | |
286 | ||
287 | eval { | |
288 | if ($lcid) { | |
289 | my $subdir = "cluster/$lcid/$subpath"; | |
290 | ($fh, $uid, $path) = new_fileid ($spooldir, $subdir); | |
291 | } else { | |
292 | ($fh, $uid, $path) = new_fileid ($spooldir, $subpath); | |
293 | } | |
294 | ||
295 | # there must be only one Return-Path | |
296 | $entity->head->delete ('Return-Path'); | |
297 | ||
298 | # prepend Delivered-To and Return-Path (like QMAIL MAILDIR FORMAT) | |
299 | $entity->head->add ('Return-Path', encode('UTF-8', join (',', $sender)), 0); | |
300 | $entity->head->add ('Delivered-To', encode('UTF-8', join (',', @$tg)), 0); | |
301 | ||
302 | $entity->print ($fh); | |
303 | ||
304 | close ($fh); | |
305 | ||
306 | fsync_file_and_dir ("$spooldir/$path"); # make sure the file is on disk | |
307 | ||
308 | $self->quarantinedb_insert ($ruledb, $lcid, $ldap, $qtype, $header, $sender, $path, $tg, $vars); | |
309 | }; | |
310 | ||
311 | my $err = $@; | |
312 | ||
313 | if ($err) { | |
314 | close ($fh) if $fh; | |
315 | unlink "$spooldir/$path" if $path; | |
316 | syslog ('err', "ERROR: $err"); | |
317 | return undef; | |
318 | } | |
319 | ||
320 | return $uid; | |
321 | } | |
322 | ||
323 | #sub quarantine { | |
324 | # my ($self, $targets); | |
325 | # | |
326 | # $self->set_status ($targets, 'quarantine'); | |
327 | #} | |
328 | ||
329 | #sub spamreport { | |
330 | # my ($self, $targets); | |
331 | # | |
332 | # $self->set_status ($targets, 'spam:report'); | |
333 | #} | |
334 | ||
335 | #sub delay { | |
336 | # my ($self, $targets, $hm); | |
337 | # | |
338 | # $self->set_status ($targets, "delay|$hm"); | |
339 | #} | |
340 | ||
341 | sub msgid { | |
342 | my ($self, $msgid) = @_; | |
343 | ||
344 | if (defined ($msgid)) { | |
345 | $self->{msgid} = $msgid; | |
346 | } | |
347 | ||
348 | $self->{msgid}; | |
349 | } | |
350 | ||
351 | sub close { | |
352 | my $self = shift; | |
353 | ||
354 | close ($self->{fh}); | |
355 | ||
356 | rmtree $self->{dumpdir}; | |
357 | ||
358 | unlink $self->{dataname}; | |
359 | } | |
360 | ||
361 | sub _new_mime_parser { | |
362 | my ($self, $maxfiles) = shift; | |
363 | ||
364 | my $parser = PMG::MIMEUtils::new_mime_parser({ | |
365 | nested => 1, | |
366 | ignore_errors => 1, | |
367 | extract_uuencode => 0, | |
368 | decode_bodies => 0, | |
369 | maxfiles => $maxfiles, | |
370 | dumpdir => $self->{dumpdir}, | |
371 | }); | |
372 | ||
373 | return $parser; | |
374 | } | |
375 | ||
376 | sub parse_mail { | |
377 | my ($self, $maxfiles) = shift; | |
378 | ||
379 | my $entity; | |
380 | my $ctime = time; | |
381 | ||
382 | my $parser = $self->_new_mime_parser ($maxfiles); | |
383 | ||
384 | $self->{fh}->seek (0, 0); | |
385 | ||
386 | eval { | |
387 | if (!($entity = $parser->read($self->{fh}))) { | |
388 | die "$self->{logid}: unable to parse message: ERROR"; | |
389 | } | |
390 | }; | |
391 | ||
392 | die "$self->{logid}: unable to parse message - $@" if $@; | |
393 | ||
394 | PMG::MIMEUtils::fixup_multipart($entity); | |
395 | ||
396 | if ((my $idcount = $entity->head->count ('Message-Id')) > 0) { | |
397 | $self->msgid ($entity->head->get ('Message-Id', $idcount - 1)); | |
398 | } | |
399 | ||
400 | # fixme: add parse_time to statistic database | |
401 | my $parse_time = time() - $ctime; | |
402 | ||
403 | # also save decoded data | |
404 | decode_entities ($parser, $self->{logid}, $entity); | |
405 | ||
406 | # we also remove all proxmox-marks from the mail and add an unique | |
407 | # id to each attachment. | |
408 | ||
409 | my $max_aid = PMG::Utils::remove_marks ($entity, 1); | |
410 | PMG::Utils::add_ct_marks ($entity); | |
411 | ||
412 | return ($entity, $max_aid); | |
413 | } | |
414 | ||
415 | sub decode_entities { | |
416 | my ($parser, $logid, $entity) = @_; | |
417 | ||
418 | PMG::MIMEUtils::traverse_mime_parts($entity, sub { | |
419 | my ($part) = @_; | |
420 | if ($part->bodyhandle && (my $path = $part->bodyhandle->path)) { | |
421 | ||
422 | eval { | |
423 | my $head = $part->head; | |
424 | my $encoding = $head->mime_encoding; | |
425 | my $decoder = new MIME::Decoder $encoding; | |
426 | ||
427 | if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) { | |
428 | ||
429 | $part->{PMX_decoded_path} = $path; # no need to decode | |
430 | ||
431 | } else { | |
432 | ||
433 | my $body = $parser->new_body_for ($head); | |
434 | $body->binmode(1); | |
435 | $body->is_encoded(0); | |
436 | ||
437 | my $in = $part->bodyhandle->open ("r") || | |
438 | die "unable to read raw data '$path'"; | |
439 | ||
440 | my $decfh = $body->open ("w") || | |
441 | die "unable to open body: $!"; | |
442 | ||
443 | $decoder->decode ($in, $decfh); | |
444 | ||
445 | $in->close; | |
446 | ||
447 | $decfh->close || | |
448 | die "can't close bodyhandle: $!"; | |
449 | ||
450 | $part->{PMX_decoded_path} = $body->path; | |
451 | } | |
452 | }; | |
453 | ||
454 | my $err = $@; | |
455 | ||
456 | if ($err) { | |
457 | syslog ('err', "$logid: $err"); | |
458 | } | |
459 | ||
460 | } | |
461 | }); | |
462 | } | |
463 | ||
464 | 1; | |
465 | ||
466 | __END__ |