]>
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; | |
c53efc6e | 9 | use Encode; |
7066e935 DM |
10 | use File::Sync; |
11 | use File::Basename; | |
12 | use File::Path; | |
13 | use File::stat; | |
30e080a7 | 14 | use Time::HiRes qw(gettimeofday); |
7066e935 DM |
15 | use Mail::Header; |
16 | ||
30e080a7 | 17 | use PMG::LDAPSet; |
18598b2c | 18 | use PMG::MIMEUtils; |
7066e935 | 19 | |
be10d7c1 | 20 | our $spooldir = "/var/spool/pmg"; |
7066e935 DM |
21 | |
22 | my $fileseq = rand 1000; | |
23 | ||
da954a90 DM |
24 | sub create_spooldirs { |
25 | my ($lcid, $cleanup) = @_; | |
26 | ||
27 | # if requested, remove any stale date | |
922e6f74 | 28 | rmtree([ |
8c7250c3 DC |
29 | "$spooldir/cluster", |
30 | "$spooldir/active", | |
31 | "$spooldir/virus", | |
32 | "$spooldir/spam", | |
33 | "$spooldir/attachment", | |
922e6f74 | 34 | ]) if $cleanup; |
da954a90 | 35 | |
922e6f74 | 36 | mkpath([ |
8c7250c3 DC |
37 | "$spooldir/active", |
38 | "$spooldir/spam", | |
39 | "$spooldir/virus", | |
40 | "$spooldir/attachment", | |
922e6f74 | 41 | ]); |
da954a90 DM |
42 | |
43 | if ($lcid) { | |
44 | mkpath "$spooldir/cluster/$lcid/virus"; | |
45 | mkpath "$spooldir/cluster/$lcid/spam"; | |
8c7250c3 | 46 | mkpath "$spooldir/cluster/$lcid/attachment"; |
da954a90 | 47 | } |
be10d7c1 DM |
48 | } |
49 | ||
7066e935 DM |
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))) { | |
9ef3f143 | 72 | die "unable to create file '$path': $! : ERROR"; |
30e080a7 | 73 | } |
7066e935 | 74 | |
30e080a7 | 75 | if (my $st = stat ($fh)) { |
7066e935 DM |
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; | |
9ef3f143 | 82 | die "unable to stat file: $! : ERROR"; |
7066e935 DM |
83 | } |
84 | ||
85 | mkdir "$dir/$subdir/$subsubdir"; | |
86 | ||
87 | my $subpath = "$subdir/$subsubdir$uid"; | |
88 | ||
89 | if (!rename ($path, "$dir/$subpath")) { | |
90 | unlink $path; | |
9ef3f143 | 91 | die "unable to rename file: ERROR"; |
7066e935 DM |
92 | } |
93 | ||
30e080a7 | 94 | return ($fh, $uid, $subpath); |
7066e935 DM |
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 { | |
c53efc6e | 145 | $sender = encode('UTF-8', $sender); |
7066e935 DM |
146 | my $dbh = $ruledb->{dbh}; |
147 | ||
148 | my $insert_cmds = "SELECT nextval ('cmailstore_id_seq'); INSERT INTO CMailStore " . | |
30e080a7 | 149 | "(CID, RID, ID, Time, QType, Bytes, Spamlevel, Info, Header, Sender, File) VALUES (" . |
7066e935 DM |
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 | ||
7066e935 DM |
183 | my $now = time(); |
184 | ||
afb4584b DM |
185 | my $tid = int(rand(0x0fffffff)); |
186 | ||
7066e935 DM |
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 { | |
c53efc6e | 193 | $receiver = $dbh->quote (encode('UTF-8', $r)); |
7066e935 DM |
194 | } |
195 | ||
196 | ||
c53efc6e | 197 | $pmail = $dbh->quote (encode('UTF-8', $pmail)); |
30e080a7 | 198 | $insert_cmds .= "INSERT INTO CMSReceivers " . |
afb4584b DM |
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; | |
7066e935 DM |
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}; | |
30e080a7 | 223 | } |
7066e935 DM |
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 | ||
8c7250c3 DC |
268 | my $subpath_map = { |
269 | 'V' => 'virus', | |
270 | 'S' => 'spam', | |
271 | 'A' => 'attachment', | |
272 | }; | |
273 | ||
7066e935 DM |
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 | ||
8c7250c3 | 281 | my $subpath = $subpath_map->{$qtype} // 'spam'; |
7066e935 DM |
282 | |
283 | my $lcid = $msginfo->{lcid}; | |
284 | ||
285 | my ($fh, $uid, $path); | |
286 | ||
287 | eval { | |
288 | if ($lcid) { | |
da954a90 | 289 | my $subdir = "cluster/$lcid/$subpath"; |
da954a90 | 290 | ($fh, $uid, $path) = new_fileid ($spooldir, $subdir); |
7066e935 DM |
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) | |
c53efc6e SI |
299 | $entity->head->add ('Return-Path', encode('UTF-8', join (',', $sender)), 0); |
300 | $entity->head->add ('Delivered-To', encode('UTF-8', join (',', @$tg)), 0); | |
7066e935 DM |
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 | ||
30e080a7 DM |
341 | sub msgid { |
342 | my ($self, $msgid) = @_; | |
7066e935 DM |
343 | |
344 | if (defined ($msgid)) { | |
345 | $self->{msgid} = $msgid; | |
346 | } | |
347 | ||
30e080a7 | 348 | $self->{msgid}; |
7066e935 DM |
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 | ||
18598b2c DC |
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 | }); | |
7066e935 DM |
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); | |
30e080a7 | 383 | |
7066e935 DM |
384 | $self->{fh}->seek (0, 0); |
385 | ||
386 | eval { | |
387 | if (!($entity = $parser->read($self->{fh}))) { | |
9ef3f143 | 388 | die "$self->{logid}: unable to parse message: ERROR"; |
7066e935 DM |
389 | } |
390 | }; | |
391 | ||
392 | die "$self->{logid}: unable to parse message - $@" if $@; | |
393 | ||
18598b2c | 394 | PMG::MIMEUtils::fixup_multipart($entity); |
7066e935 DM |
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 | ||
30e080a7 | 406 | # we also remove all proxmox-marks from the mail and add an unique |
7066e935 DM |
407 | # id to each attachment. |
408 | ||
20f69ed0 | 409 | my $max_aid = PMG::Utils::remove_marks ($entity, 1); |
743f89f2 | 410 | PMG::Utils::add_ct_marks ($entity); |
30e080a7 | 411 | |
20f69ed0 | 412 | return ($entity, $max_aid); |
7066e935 DM |
413 | } |
414 | ||
415 | sub decode_entities { | |
416 | my ($parser, $logid, $entity) = @_; | |
417 | ||
18598b2c DC |
418 | PMG::MIMEUtils::traverse_mime_parts($entity, sub { |
419 | my ($part) = @_; | |
420 | if ($part->bodyhandle && (my $path = $part->bodyhandle->path)) { | |
7066e935 | 421 | |
18598b2c DC |
422 | eval { |
423 | my $head = $part->head; | |
424 | my $encoding = $head->mime_encoding; | |
425 | my $decoder = new MIME::Decoder $encoding; | |
7066e935 | 426 | |
18598b2c | 427 | if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) { |
7066e935 | 428 | |
18598b2c | 429 | $part->{PMX_decoded_path} = $path; # no need to decode |
7066e935 | 430 | |
18598b2c | 431 | } else { |
7066e935 | 432 | |
18598b2c DC |
433 | my $body = $parser->new_body_for ($head); |
434 | $body->binmode(1); | |
435 | $body->is_encoded(0); | |
7066e935 | 436 | |
18598b2c | 437 | my $in = $part->bodyhandle->open ("r") || |
7066e935 DM |
438 | die "unable to read raw data '$path'"; |
439 | ||
18598b2c | 440 | my $decfh = $body->open ("w") || |
7066e935 DM |
441 | die "unable to open body: $!"; |
442 | ||
18598b2c | 443 | $decoder->decode ($in, $decfh); |
7066e935 | 444 | |
18598b2c | 445 | $in->close; |
30e080a7 | 446 | |
18598b2c | 447 | $decfh->close || |
7066e935 DM |
448 | die "can't close bodyhandle: $!"; |
449 | ||
18598b2c DC |
450 | $part->{PMX_decoded_path} = $body->path; |
451 | } | |
452 | }; | |
7066e935 | 453 | |
18598b2c | 454 | my $err = $@; |
30e080a7 | 455 | |
18598b2c DC |
456 | if ($err) { |
457 | syslog ('err', "$logid: $err"); | |
458 | } | |
7066e935 | 459 | |
18598b2c DC |
460 | } |
461 | }); | |
7066e935 DM |
462 | } |
463 | ||
464 | 1; | |
465 | ||
466 | __END__ |