]>
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 | ||
173 | foreach my $r (@$targets) { | |
174 | my $pmail = get_primary_mail ($ldap, $r); | |
175 | my $receiver; | |
176 | if ($pmail eq lc ($r)) { | |
177 | $receiver = "NULL"; | |
178 | } else { | |
179 | $receiver = $dbh->quote ($r); | |
180 | } | |
181 | ||
182 | ||
183 | $pmail = $dbh->quote ($pmail); | |
30e080a7 | 184 | $insert_cmds .= "INSERT INTO CMSReceivers " . |
39d91358 DM |
185 | "(CMailStore_CID, CMailStore_RID, PMail, Receiver, Status, MTime) " . |
186 | "VALUES ($lcid, currval ('cmailstore_id_seq'), $pmail, $receiver, 'N', $now); "; | |
7066e935 DM |
187 | } |
188 | ||
189 | $dbh->do ($insert_cmds); | |
190 | }; | |
191 | ||
192 | my $err = $@; | |
193 | ||
194 | syslog ('err', "ERROR: $err") if $err; | |
195 | } | |
196 | ||
197 | sub get_primary_mail { | |
198 | my ($ldap, $mail) = @_; | |
199 | ||
200 | $mail = lc ($mail); | |
201 | ||
202 | return $mail if !$ldap; | |
203 | ||
204 | if (my $info = $ldap->account_info ($mail)) { | |
205 | return $info->{pmail}; | |
30e080a7 | 206 | } |
7066e935 DM |
207 | |
208 | return $mail; | |
209 | } | |
210 | ||
211 | ||
212 | sub extract_header_text { | |
213 | my ($entity) = @_; | |
214 | ||
215 | my $subject = $entity->head->get ('subject', 0); | |
216 | my $from = $entity->head->get ('from', 0); | |
217 | my $sender = $entity->head->get ('sender', 0); | |
218 | ||
219 | my $head = new Mail::Header; | |
220 | $head->add ('subject', $subject) if $subject; | |
221 | $head->add ('from', $from) if $from; | |
222 | $head->add ('sender', $sender) if $sender; | |
223 | ||
224 | my $header = $head->as_string(); | |
225 | ||
226 | return $header; | |
227 | } | |
228 | ||
229 | sub fsync_file_and_dir { | |
230 | my $filename = shift; | |
231 | ||
232 | eval { | |
233 | my $fh = IO::File->new($filename) || die "unable to open file '$filename'"; | |
234 | File::Sync::fsync ($fh) || die "fsync file '$filename' failed"; | |
235 | close ($fh); | |
236 | ||
237 | my $dirname = dirname ($filename); | |
238 | my $dir = IO::File->new($dirname) || die "open dir '$dirname' failed"; | |
239 | File::Sync::fsync ($dir) || die "fsync dir '$dirname' failed"; | |
240 | close ($dir); | |
241 | }; | |
242 | ||
243 | my $err = $@; | |
244 | ||
245 | if ($err) { | |
246 | syslog ('err', "ERROR: $err"); | |
247 | } | |
248 | ||
249 | } | |
250 | ||
251 | sub quarantine_mail { | |
252 | my ($self, $ruledb, $qtype, $entity, $tg, $msginfo, $vars, $ldap) = @_; | |
253 | ||
254 | my $sender = $msginfo->{sender}; | |
255 | ||
256 | my $header = extract_header_text ($entity); | |
257 | ||
258 | my $subpath = $qtype eq 'V' ? 'virus' : 'spam'; | |
259 | ||
260 | my $lcid = $msginfo->{lcid}; | |
261 | ||
262 | my ($fh, $uid, $path); | |
263 | ||
264 | eval { | |
265 | if ($lcid) { | |
da954a90 DM |
266 | my $subdir = "cluster/$lcid/$subpath"; |
267 | mkpath $subdir; | |
268 | ($fh, $uid, $path) = new_fileid ($spooldir, $subdir); | |
7066e935 DM |
269 | } else { |
270 | ($fh, $uid, $path) = new_fileid ($spooldir, $subpath); | |
271 | } | |
272 | ||
273 | # there must be only one Return-Path | |
274 | $entity->head->delete ('Return-Path'); | |
275 | ||
276 | # prepend Delivered-To and Return-Path (like QMAIL MAILDIR FORMAT) | |
277 | $entity->head->add ('Return-Path', join (',', $sender), 0); | |
278 | $entity->head->add ('Delivered-To', join (',', @$tg), 0); | |
279 | ||
280 | $entity->print ($fh); | |
281 | ||
282 | close ($fh); | |
283 | ||
284 | fsync_file_and_dir ("$spooldir/$path"); # make sure the file is on disk | |
285 | ||
286 | $self->quarantinedb_insert ($ruledb, $lcid, $ldap, $qtype, $header, $sender, $path, $tg, $vars); | |
287 | }; | |
288 | ||
289 | my $err = $@; | |
290 | ||
291 | if ($err) { | |
292 | close ($fh) if $fh; | |
293 | unlink "$spooldir/$path" if $path; | |
294 | syslog ('err', "ERROR: $err"); | |
295 | return undef; | |
296 | } | |
297 | ||
298 | return $uid; | |
299 | } | |
300 | ||
301 | #sub quarantine { | |
302 | # my ($self, $targets); | |
303 | # | |
304 | # $self->set_status ($targets, 'quarantine'); | |
305 | #} | |
306 | ||
307 | #sub spamreport { | |
308 | # my ($self, $targets); | |
309 | # | |
310 | # $self->set_status ($targets, 'spam:report'); | |
311 | #} | |
312 | ||
313 | #sub delay { | |
314 | # my ($self, $targets, $hm); | |
315 | # | |
316 | # $self->set_status ($targets, "delay|$hm"); | |
317 | #} | |
318 | ||
30e080a7 DM |
319 | sub msgid { |
320 | my ($self, $msgid) = @_; | |
7066e935 DM |
321 | |
322 | if (defined ($msgid)) { | |
323 | $self->{msgid} = $msgid; | |
324 | } | |
325 | ||
30e080a7 | 326 | $self->{msgid}; |
7066e935 DM |
327 | } |
328 | ||
329 | sub close { | |
330 | my $self = shift; | |
331 | ||
332 | close ($self->{fh}); | |
333 | ||
334 | rmtree $self->{dumpdir}; | |
335 | ||
336 | unlink $self->{dataname}; | |
337 | } | |
338 | ||
339 | sub _new_mime_parser { | |
340 | my ($self, $maxfiles) = shift; | |
341 | ||
342 | # Create a new MIME parser: | |
343 | my $parser = new MIME::Parser; | |
344 | #$parser->decode_headers(1); | |
30e080a7 | 345 | $parser->extract_nested_messages (1); |
7066e935 DM |
346 | $parser->ignore_errors (1); |
347 | $parser->extract_uuencode (0); | |
348 | $parser->decode_bodies (0); | |
349 | ||
350 | $parser->max_parts ($maxfiles) if $maxfiles; | |
351 | ||
352 | rmtree $self->{dumpdir}; | |
353 | ||
354 | # Create and set the output directory: | |
30e080a7 | 355 | (-d $self->{dumpdir} || mkdir ($self->{dumpdir} ,0755)) || |
9ef3f143 | 356 | die "can't create $self->{dumpdir}: $! : ERROR"; |
7066e935 | 357 | (-w $self->{dumpdir}) || |
9ef3f143 | 358 | die "can't write to directory $self->{dumpdir}: $! : ERROR"; |
7066e935 DM |
359 | |
360 | $parser->output_dir($self->{dumpdir}); | |
361 | ||
362 | return $parser; | |
363 | } | |
364 | ||
365 | sub parse_mail { | |
366 | my ($self, $maxfiles) = shift; | |
367 | ||
368 | my $entity; | |
369 | my $ctime = time; | |
370 | ||
371 | my $parser = $self->_new_mime_parser ($maxfiles); | |
30e080a7 | 372 | |
7066e935 DM |
373 | $self->{fh}->seek (0, 0); |
374 | ||
375 | eval { | |
376 | if (!($entity = $parser->read($self->{fh}))) { | |
9ef3f143 | 377 | die "$self->{logid}: unable to parse message: ERROR"; |
7066e935 DM |
378 | } |
379 | }; | |
380 | ||
381 | die "$self->{logid}: unable to parse message - $@" if $@; | |
382 | ||
383 | # bug fix for bin/tests/content/mimeparser.txt | |
384 | if ($entity->mime_type =~ m|multipart/|i && !$entity->head->multipart_boundary) { | |
385 | $entity->head->mime_attr('Content-type' => "application/x-unparseable-multipart"); | |
30e080a7 | 386 | } |
7066e935 DM |
387 | |
388 | if ((my $idcount = $entity->head->count ('Message-Id')) > 0) { | |
389 | $self->msgid ($entity->head->get ('Message-Id', $idcount - 1)); | |
390 | } | |
391 | ||
392 | # fixme: add parse_time to statistic database | |
393 | my $parse_time = time() - $ctime; | |
394 | ||
395 | # also save decoded data | |
396 | decode_entities ($parser, $self->{logid}, $entity); | |
397 | ||
30e080a7 | 398 | # we also remove all proxmox-marks from the mail and add an unique |
7066e935 DM |
399 | # id to each attachment. |
400 | ||
743f89f2 DM |
401 | PMG::Utils::remove_marks ($entity, 1); |
402 | PMG::Utils::add_ct_marks ($entity); | |
30e080a7 | 403 | |
7066e935 DM |
404 | return $entity; |
405 | } | |
406 | ||
407 | sub decode_entities { | |
408 | my ($parser, $logid, $entity) = @_; | |
409 | ||
410 | if ($entity->bodyhandle && (my $path = $entity->bodyhandle->path)) { | |
411 | ||
412 | eval { | |
413 | my $head = $entity->head; | |
414 | my $encoding = $head->mime_encoding; | |
415 | my $decoder = new MIME::Decoder $encoding; | |
416 | ||
417 | if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) { | |
418 | ||
419 | $entity->{PMX_decoded_path} = $path; # no need to decode | |
420 | ||
421 | } else { | |
422 | ||
423 | my $body = $parser->new_body_for ($head); | |
424 | $body->binmode(1); | |
425 | $body->is_encoded(0); | |
426 | ||
427 | my $in = $entity->bodyhandle->open ("r") || | |
428 | die "unable to read raw data '$path'"; | |
429 | ||
30e080a7 | 430 | my $decfh = $body->open ("w") || |
7066e935 DM |
431 | die "unable to open body: $!"; |
432 | ||
433 | $decoder->decode ($in, $decfh); | |
434 | ||
435 | $in->close; | |
30e080a7 DM |
436 | |
437 | $decfh->close || | |
7066e935 DM |
438 | die "can't close bodyhandle: $!"; |
439 | ||
440 | $entity->{PMX_decoded_path} = $body->path; | |
441 | } | |
442 | }; | |
443 | ||
444 | my $err = $@; | |
445 | ||
446 | if ($err) { | |
447 | syslog ('err', "$logid: $err"); | |
448 | } | |
30e080a7 | 449 | |
7066e935 DM |
450 | } |
451 | ||
452 | foreach my $part ($entity->parts) { | |
453 | decode_entities ($parser, $logid, $part); | |
454 | } | |
455 | } | |
456 | ||
457 | 1; | |
458 | ||
459 | __END__ |