]>
git.proxmox.com Git - pmg-api.git/blob - 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 foreach my $r (@$targets) {
174 my $pmail = get_primary_mail
($ldap, $r);
176 if ($pmail eq lc ($r)) {
179 $receiver = $dbh->quote ($r);
183 $pmail = $dbh->quote ($pmail);
184 $insert_cmds .= "INSERT INTO CMSReceivers " .
185 "(CMailStore_CID, CMailStore_RID, PMail, Receiver, Status, MTime) " .
186 "VALUES ($lcid, currval ('cmailstore_id_seq'), $pmail, $receiver, 'N', $now); ";
189 $dbh->do ($insert_cmds);
194 syslog
('err', "ERROR: $err") if $err;
197 sub get_primary_mail
{
198 my ($ldap, $mail) = @_;
202 return $mail if !$ldap;
204 if (my $info = $ldap->account_info ($mail)) {
205 return $info->{pmail
};
212 sub extract_header_text
{
215 my $subject = $entity->head->get ('subject', 0);
216 my $from = $entity->head->get ('from', 0);
217 my $sender = $entity->head->get ('sender', 0);
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;
224 my $header = $head->as_string();
229 sub fsync_file_and_dir
{
230 my $filename = shift;
233 my $fh = IO
::File-
>new($filename) || die "unable to open file '$filename'";
234 File
::Sync
::fsync
($fh) || die "fsync file '$filename' failed";
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";
246 syslog
('err', "ERROR: $err");
251 sub quarantine_mail
{
252 my ($self, $ruledb, $qtype, $entity, $tg, $msginfo, $vars, $ldap) = @_;
254 my $sender = $msginfo->{sender
};
256 my $header = extract_header_text
($entity);
258 my $subpath = $qtype eq 'V' ?
'virus' : 'spam';
260 my $lcid = $msginfo->{lcid
};
262 my ($fh, $uid, $path);
266 my $subdir = "cluster/$lcid/$subpath";
268 ($fh, $uid, $path) = new_fileid
($spooldir, $subdir);
270 ($fh, $uid, $path) = new_fileid
($spooldir, $subpath);
273 # there must be only one Return-Path
274 $entity->head->delete ('Return-Path');
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);
280 $entity->print ($fh);
284 fsync_file_and_dir
("$spooldir/$path"); # make sure the file is on disk
286 $self->quarantinedb_insert ($ruledb, $lcid, $ldap, $qtype, $header, $sender, $path, $tg, $vars);
293 unlink "$spooldir/$path" if $path;
294 syslog
('err', "ERROR: $err");
302 # my ($self, $targets);
304 # $self->set_status ($targets, 'quarantine');
308 # my ($self, $targets);
310 # $self->set_status ($targets, 'spam:report');
314 # my ($self, $targets, $hm);
316 # $self->set_status ($targets, "delay|$hm");
320 my ($self, $msgid) = @_;
322 if (defined ($msgid)) {
323 $self->{msgid
} = $msgid;
334 rmtree
$self->{dumpdir
};
336 unlink $self->{dataname
};
339 sub _new_mime_parser
{
340 my ($self, $maxfiles) = shift;
342 # Create a new MIME parser:
343 my $parser = new MIME
::Parser
;
344 #$parser->decode_headers(1);
345 $parser->extract_nested_messages (1);
346 $parser->ignore_errors (1);
347 $parser->extract_uuencode (0);
348 $parser->decode_bodies (0);
350 $parser->max_parts ($maxfiles) if $maxfiles;
352 rmtree
$self->{dumpdir
};
354 # Create and set the output directory:
355 (-d
$self->{dumpdir
} || mkdir ($self->{dumpdir
} ,0755)) ||
356 die "can't create $self->{dumpdir}: $! : ERROR";
357 (-w
$self->{dumpdir
}) ||
358 die "can't write to directory $self->{dumpdir}: $! : ERROR";
360 $parser->output_dir($self->{dumpdir
});
366 my ($self, $maxfiles) = shift;
371 my $parser = $self->_new_mime_parser ($maxfiles);
373 $self->{fh
}->seek (0, 0);
376 if (!($entity = $parser->read($self->{fh
}))) {
377 die "$self->{logid}: unable to parse message: ERROR";
381 die "$self->{logid}: unable to parse message - $@" if $@;
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");
388 if ((my $idcount = $entity->head->count ('Message-Id')) > 0) {
389 $self->msgid ($entity->head->get ('Message-Id', $idcount - 1));
392 # fixme: add parse_time to statistic database
393 my $parse_time = time() - $ctime;
395 # also save decoded data
396 decode_entities
($parser, $self->{logid
}, $entity);
398 # we also remove all proxmox-marks from the mail and add an unique
399 # id to each attachment.
401 PMG
::Utils
::remove_marks
($entity, 1);
402 PMG
::Utils
::add_ct_marks
($entity);
407 sub decode_entities
{
408 my ($parser, $logid, $entity) = @_;
410 if ($entity->bodyhandle && (my $path = $entity->bodyhandle->path)) {
413 my $head = $entity->head;
414 my $encoding = $head->mime_encoding;
415 my $decoder = new MIME
::Decoder
$encoding;
417 if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) {
419 $entity->{PMX_decoded_path
} = $path; # no need to decode
423 my $body = $parser->new_body_for ($head);
425 $body->is_encoded(0);
427 my $in = $entity->bodyhandle->open ("r") ||
428 die "unable to read raw data '$path'";
430 my $decfh = $body->open ("w") ||
431 die "unable to open body: $!";
433 $decoder->decode ($in, $decfh);
438 die "can't close bodyhandle: $!";
440 $entity->{PMX_decoded_path
} = $body->path;
447 syslog
('err', "$logid: $err");
452 foreach my $part ($entity->parts) {
453 decode_entities
($parser, $logid, $part);