]> git.proxmox.com Git - pmg-api.git/blame - PMG/MailQueue.pm
delete/deliver_quarantined_mail: use receiver instead of pmail
[pmg-api.git] / PMG / MailQueue.pm
CommitLineData
30e080a7 1package PMG::MailQueue;
7066e935
DM
2
3use strict;
30e080a7 4use warnings;
30e080a7
DM
5
6use PVE::SafeSyslog;
7066e935
DM
7use MIME::Parser;
8use IO::File;
9use File::Sync;
10use File::Basename;
11use File::Path;
12use File::stat;
30e080a7 13use Time::HiRes qw(gettimeofday);
7066e935
DM
14use Mail::Header;
15
30e080a7 16use PMG::LDAPSet;
7066e935 17
be10d7c1 18our $spooldir = "/var/spool/pmg";
7066e935
DM
19
20my $fileseq = rand 1000;
21
da954a90
DM
22sub 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
40sub cleanup_active {
41
42 while (my $file = <$spooldir/active/*>) {
43 unlink $file;
44 }
45
46}
47
48sub 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
86sub 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
120sub 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
130sub 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
197sub 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
212sub 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
229sub 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
251sub 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
319sub 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
329sub close {
330 my $self = shift;
331
332 close ($self->{fh});
333
334 rmtree $self->{dumpdir};
335
336 unlink $self->{dataname};
337}
338
339sub _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
365sub 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
407sub 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
4571;
458
459__END__