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