]>
git.proxmox.com Git - pmg-api.git/blob - src/PMG/MailQueue.pm
1 package PMG
::MailQueue
;
13 use Time
::HiRes
qw(gettimeofday);
18 our $spooldir = "/var/spool/pmg";
20 my $fileseq = rand 1000;
22 sub create_spooldirs
{
23 my ($lcid, $cleanup) = @_;
25 # if requested, remove any stale date
26 File
::Path
::remove_tree
(
27 "$spooldir/cluster", "$spooldir/active",
28 "$spooldir/virus", "$spooldir/spam") if $cleanup;
30 File
::Path
::make_path
(
31 "$spooldir/active", "$spooldir/spam", "$spooldir/virus");
34 mkpath
"$spooldir/cluster/$lcid/virus";
35 mkpath
"$spooldir/cluster/$lcid/spam";
39 # called on service startup to remove any stale files
42 while (my $file = <$spooldir/active/*>) {
49 my ($dir, $subdir) = @_;
51 # try to create a unique data file
53 my ($sec, $usec) = gettimeofday
();
54 my $fname = "$sec.$usec.$$." . $fileseq++;
55 my $path = "$dir/$subdir/$fname";
60 if (!($fh = IO
::File-
>new ($path, 'w+', 0600))) {
61 die "unable to create file '$path': $! : ERROR";
64 if (my $st = stat ($fh)) {
65 $uid = sprintf ("%X%X%05X", $st->ino, $sec, $usec);
66 if ($subdir ne 'active') {
67 $subsubdir .= sprintf ("%02X/", $usec % 256);
71 die "unable to stat file: $! : ERROR";
74 mkdir "$dir/$subdir/$subsubdir";
76 my $subpath = "$subdir/$subsubdir$uid";
78 if (!rename ($path, "$dir/$subpath")) {
80 die "unable to rename file: ERROR";
83 return ($fh, $uid, $subpath);
87 my ($type, $from, $to) = @_;
92 $self->{from
} = $from;
95 $self->{sa_score
} = undef;
96 $self->{sa_max
} = undef;
97 $self->{sa_data
} = undef;
99 $self->{vinfo
} = undef;
101 $self->{rtime
} = time;
102 $self->{ptime_spam
} = 0;
103 $self->{ptime_virus
} = 0;
105 my ($fh, $uid, $path) = new_fileid
($spooldir, 'active');
109 $self->{logid
} = $uid;
110 #$self->{logid} = sprintf ("%05X${uid}", $self->{rtime});
111 $self->{dataname
} = "$spooldir/$path";
113 $self->{dumpdir
} = "/tmp/.proxdump_${$}_$uid";
115 $self->set_status ($to, 'undelivered');
121 my ($self, $targets, $state, $code, $message) = @_;
123 foreach my $r (@$targets) {
124 $self->{status
}->{$r} = $state;
125 $self->{status_code
}->{$r} = $code;
126 $self->{status_message
}->{$r} = $message;
130 sub quarantinedb_insert
{
131 my ($self, $ruledb, $lcid, $ldap, $qtype, $header, $sender, $file, $targets, $vars) = @_;
134 my $dbh = $ruledb->{dbh
};
136 my $insert_cmds = "SELECT nextval ('cmailstore_id_seq'); INSERT INTO CMailStore " .
137 "(CID, RID, ID, Time, QType, Bytes, Spamlevel, Info, Header, Sender, File) VALUES (" .
138 "$lcid, currval ('cmailstore_id_seq'), currval ('cmailstore_id_seq'), ";
140 my $spaminfo = $vars->{__spaminfo
};
141 my $sa_score = $spaminfo->{sa_score
} || 0;
143 $insert_cmds .= $self->{rtime
} . ',';
144 $insert_cmds .= $dbh->quote ($qtype) . ',';
145 $insert_cmds .= $self->{bytes
} . ',';
146 $insert_cmds .= $sa_score . ',';
149 $insert_cmds .= $dbh->quote ($self->{vinfo
}) . ',';
152 my $sscores = $spaminfo->{sa_data
};
154 if (defined ($sscores) && @$sscores != -1) {
156 foreach my $s (@$sscores) {
157 $sainfo .= ',' if $sainfo;
158 $sainfo .= sprintf ("%s:%s", $s->{rule
}, $s->{score
});
160 $sainfo = $dbh->quote ($sainfo);
163 $insert_cmds .= $sainfo . ',';
166 $insert_cmds .= $dbh->quote ($header) . ',';
168 $insert_cmds .= $dbh->quote ($sender) . ',';
169 $insert_cmds .= $dbh->quote ($file) . ');';
173 my $tid = int(rand(0x0fffffff));
175 foreach my $r (@$targets) {
176 my $pmail = get_primary_mail
($ldap, $r);
178 if ($pmail eq lc ($r)) {
181 $receiver = $dbh->quote ($r);
185 $pmail = $dbh->quote ($pmail);
186 $insert_cmds .= "INSERT INTO CMSReceivers " .
187 "(CMailStore_CID, CMailStore_RID, PMail, Receiver, TicketID, Status, MTime) " .
188 "VALUES ($lcid, currval ('cmailstore_id_seq'), $pmail, $receiver, $tid, 'N', $now); ";
190 # Note: Tuple (CID, RID, TicketID) must be unique
191 $tid = ($tid + 1) & 0x0fffffff;
194 $dbh->do ($insert_cmds);
199 syslog
('err', "ERROR: $err") if $err;
202 sub get_primary_mail
{
203 my ($ldap, $mail) = @_;
207 return $mail if !$ldap;
209 if (my $info = $ldap->account_info ($mail)) {
210 return $info->{pmail
};
217 sub extract_header_text
{
220 my $subject = $entity->head->get ('subject', 0);
221 my $from = $entity->head->get ('from', 0);
222 my $sender = $entity->head->get ('sender', 0);
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;
229 my $header = $head->as_string();
234 sub fsync_file_and_dir
{
235 my $filename = shift;
238 my $fh = IO
::File-
>new($filename) || die "unable to open file '$filename'";
239 File
::Sync
::fsync
($fh) || die "fsync file '$filename' failed";
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";
251 syslog
('err', "ERROR: $err");
256 sub quarantine_mail
{
257 my ($self, $ruledb, $qtype, $entity, $tg, $msginfo, $vars, $ldap) = @_;
259 my $sender = $msginfo->{sender
};
261 my $header = extract_header_text
($entity);
263 my $subpath = $qtype eq 'V' ?
'virus' : 'spam';
265 my $lcid = $msginfo->{lcid
};
267 my ($fh, $uid, $path);
271 my $subdir = "cluster/$lcid/$subpath";
273 ($fh, $uid, $path) = new_fileid
($spooldir, $subdir);
275 ($fh, $uid, $path) = new_fileid
($spooldir, $subpath);
278 # there must be only one Return-Path
279 $entity->head->delete ('Return-Path');
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);
285 $entity->print ($fh);
289 fsync_file_and_dir
("$spooldir/$path"); # make sure the file is on disk
291 $self->quarantinedb_insert ($ruledb, $lcid, $ldap, $qtype, $header, $sender, $path, $tg, $vars);
298 unlink "$spooldir/$path" if $path;
299 syslog
('err', "ERROR: $err");
307 # my ($self, $targets);
309 # $self->set_status ($targets, 'quarantine');
313 # my ($self, $targets);
315 # $self->set_status ($targets, 'spam:report');
319 # my ($self, $targets, $hm);
321 # $self->set_status ($targets, "delay|$hm");
325 my ($self, $msgid) = @_;
327 if (defined ($msgid)) {
328 $self->{msgid
} = $msgid;
339 rmtree
$self->{dumpdir
};
341 unlink $self->{dataname
};
344 sub _new_mime_parser
{
345 my ($self, $maxfiles) = shift;
347 # Create a new MIME parser:
348 my $parser = new MIME
::Parser
;
349 #$parser->decode_headers(1);
350 $parser->extract_nested_messages (1);
351 $parser->ignore_errors (1);
352 $parser->extract_uuencode (0);
353 $parser->decode_bodies (0);
355 $parser->max_parts ($maxfiles) if $maxfiles;
357 rmtree
$self->{dumpdir
};
359 # Create and set the output directory:
360 (-d
$self->{dumpdir
} || mkdir ($self->{dumpdir
} ,0755)) ||
361 die "can't create $self->{dumpdir}: $! : ERROR";
362 (-w
$self->{dumpdir
}) ||
363 die "can't write to directory $self->{dumpdir}: $! : ERROR";
365 $parser->output_dir($self->{dumpdir
});
371 my ($self, $maxfiles) = shift;
376 my $parser = $self->_new_mime_parser ($maxfiles);
378 $self->{fh
}->seek (0, 0);
381 if (!($entity = $parser->read($self->{fh
}))) {
382 die "$self->{logid}: unable to parse message: ERROR";
386 die "$self->{logid}: unable to parse message - $@" if $@;
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");
393 if ((my $idcount = $entity->head->count ('Message-Id')) > 0) {
394 $self->msgid ($entity->head->get ('Message-Id', $idcount - 1));
397 # fixme: add parse_time to statistic database
398 my $parse_time = time() - $ctime;
400 # also save decoded data
401 decode_entities
($parser, $self->{logid
}, $entity);
403 # we also remove all proxmox-marks from the mail and add an unique
404 # id to each attachment.
406 PMG
::Utils
::remove_marks
($entity, 1);
407 PMG
::Utils
::add_ct_marks
($entity);
412 sub decode_entities
{
413 my ($parser, $logid, $entity) = @_;
415 if ($entity->bodyhandle && (my $path = $entity->bodyhandle->path)) {
418 my $head = $entity->head;
419 my $encoding = $head->mime_encoding;
420 my $decoder = new MIME
::Decoder
$encoding;
422 if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) {
424 $entity->{PMX_decoded_path
} = $path; # no need to decode
428 my $body = $parser->new_body_for ($head);
430 $body->is_encoded(0);
432 my $in = $entity->bodyhandle->open ("r") ||
433 die "unable to read raw data '$path'";
435 my $decfh = $body->open ("w") ||
436 die "unable to open body: $!";
438 $decoder->decode ($in, $decfh);
443 die "can't close bodyhandle: $!";
445 $entity->{PMX_decoded_path
} = $body->path;
452 syslog
('err', "$logid: $err");
457 foreach my $part ($entity->parts) {
458 decode_entities
($parser, $logid, $part);