]>
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_sppoldirs
{
23 File
::Path
::make_path
(
24 "$spooldir/active", "$spooldir/spam", "$spooldir/virus");
27 # called on service startup to remove any stale files
30 while (my $file = <$spooldir/active/*>) {
37 my ($dir, $subdir) = @_;
39 # try to create a unique data file
41 my ($sec, $usec) = gettimeofday
();
42 my $fname = "$sec.$usec.$$." . $fileseq++;
43 my $path = "$dir/$subdir/$fname";
48 if (!($fh = IO
::File-
>new ($path, 'w+', 0600))) {
49 die "unable to create file '$path': $! : ERROR";
52 if (my $st = stat ($fh)) {
53 $uid = sprintf ("%X%X%05X", $st->ino, $sec, $usec);
54 if ($subdir ne 'active') {
55 $subsubdir .= sprintf ("%02X/", $usec % 256);
59 die "unable to stat file: $! : ERROR";
62 mkdir "$dir/$subdir/$subsubdir";
64 my $subpath = "$subdir/$subsubdir$uid";
66 if (!rename ($path, "$dir/$subpath")) {
68 die "unable to rename file: ERROR";
71 return ($fh, $uid, $subpath);
75 my ($type, $from, $to) = @_;
80 $self->{from
} = $from;
83 $self->{sa_score
} = undef;
84 $self->{sa_max
} = undef;
85 $self->{sa_data
} = undef;
87 $self->{vinfo
} = undef;
89 $self->{rtime
} = time;
90 $self->{ptime_spam
} = 0;
91 $self->{ptime_virus
} = 0;
93 my ($fh, $uid, $path) = new_fileid
($spooldir, 'active');
97 $self->{logid
} = $uid;
98 #$self->{logid} = sprintf ("%05X${uid}", $self->{rtime});
99 $self->{dataname
} = "$spooldir/$path";
101 $self->{dumpdir
} = "/tmp/.proxdump_${$}_$uid";
103 $self->set_status ($to, 'undelivered');
109 my ($self, $targets, $state, $code, $message) = @_;
111 foreach my $r (@$targets) {
112 $self->{status
}->{$r} = $state;
113 $self->{status_code
}->{$r} = $code;
114 $self->{status_message
}->{$r} = $message;
118 sub quarantinedb_insert
{
119 my ($self, $ruledb, $lcid, $ldap, $qtype, $header, $sender, $file, $targets, $vars) = @_;
122 my $dbh = $ruledb->{dbh
};
124 my $insert_cmds = "SELECT nextval ('cmailstore_id_seq'); INSERT INTO CMailStore " .
125 "(CID, RID, ID, Time, QType, Bytes, Spamlevel, Info, Header, Sender, File) VALUES (" .
126 "$lcid, currval ('cmailstore_id_seq'), currval ('cmailstore_id_seq'), ";
128 my $spaminfo = $vars->{__spaminfo
};
129 my $sa_score = $spaminfo->{sa_score
} || 0;
131 $insert_cmds .= $self->{rtime
} . ',';
132 $insert_cmds .= $dbh->quote ($qtype) . ',';
133 $insert_cmds .= $self->{bytes
} . ',';
134 $insert_cmds .= $sa_score . ',';
137 $insert_cmds .= $dbh->quote ($self->{vinfo
}) . ',';
140 my $sscores = $spaminfo->{sa_data
};
142 if (defined ($sscores) && @$sscores != -1) {
144 foreach my $s (@$sscores) {
145 $sainfo .= ',' if $sainfo;
146 $sainfo .= sprintf ("%s:%s", $s->{rule
}, $s->{score
});
148 $sainfo = $dbh->quote ($sainfo);
151 $insert_cmds .= $sainfo . ',';
154 $insert_cmds .= $dbh->quote ($header) . ',';
156 $insert_cmds .= $dbh->quote ($sender) . ',';
157 $insert_cmds .= $dbh->quote ($file) . ');';
159 my $tid = int (rand (0x0fffffff));
163 foreach my $r (@$targets) {
164 my $pmail = get_primary_mail
($ldap, $r);
166 if ($pmail eq lc ($r)) {
169 $receiver = $dbh->quote ($r);
173 $pmail = $dbh->quote ($pmail);
174 $insert_cmds .= "INSERT INTO CMSReceivers " .
175 "(CMailStore_CID, CMailStore_RID, PMail, Receiver, TicketID, Status, MTime) " .
176 "VALUES ($lcid, currval ('cmailstore_id_seq'), $pmail, $receiver, $tid, 'N', $now); ";
178 # (Mailstore_ID, TicketID) must be unique
179 $tid = ($tid + 1) & 0x0fffffff;
182 $dbh->do ($insert_cmds);
187 syslog
('err', "ERROR: $err") if $err;
190 sub get_primary_mail
{
191 my ($ldap, $mail) = @_;
195 return $mail if !$ldap;
197 if (my $info = $ldap->account_info ($mail)) {
198 return $info->{pmail
};
205 sub extract_header_text
{
208 my $subject = $entity->head->get ('subject', 0);
209 my $from = $entity->head->get ('from', 0);
210 my $sender = $entity->head->get ('sender', 0);
212 my $head = new Mail
::Header
;
213 $head->add ('subject', $subject) if $subject;
214 $head->add ('from', $from) if $from;
215 $head->add ('sender', $sender) if $sender;
217 my $header = $head->as_string();
222 sub fsync_file_and_dir
{
223 my $filename = shift;
226 my $fh = IO
::File-
>new($filename) || die "unable to open file '$filename'";
227 File
::Sync
::fsync
($fh) || die "fsync file '$filename' failed";
230 my $dirname = dirname
($filename);
231 my $dir = IO
::File-
>new($dirname) || die "open dir '$dirname' failed";
232 File
::Sync
::fsync
($dir) || die "fsync dir '$dirname' failed";
239 syslog
('err', "ERROR: $err");
244 sub quarantine_mail
{
245 my ($self, $ruledb, $qtype, $entity, $tg, $msginfo, $vars, $ldap) = @_;
247 my $sender = $msginfo->{sender
};
249 my $header = extract_header_text
($entity);
251 my $subpath = $qtype eq 'V' ?
'virus' : 'spam';
253 my $lcid = $msginfo->{lcid
};
255 my ($fh, $uid, $path);
260 mkpath
"$spooldir/cluster/$lcid/virus";
262 mkpath
"$spooldir/cluster/$lcid/spam";
264 ($fh, $uid, $path) = new_fileid
($spooldir, "cluster/$lcid/$subpath");
266 ($fh, $uid, $path) = new_fileid
($spooldir, $subpath);
269 # there must be only one Return-Path
270 $entity->head->delete ('Return-Path');
272 # prepend Delivered-To and Return-Path (like QMAIL MAILDIR FORMAT)
273 $entity->head->add ('Return-Path', join (',', $sender), 0);
274 $entity->head->add ('Delivered-To', join (',', @$tg), 0);
276 $entity->print ($fh);
280 fsync_file_and_dir
("$spooldir/$path"); # make sure the file is on disk
282 $self->quarantinedb_insert ($ruledb, $lcid, $ldap, $qtype, $header, $sender, $path, $tg, $vars);
289 unlink "$spooldir/$path" if $path;
290 syslog
('err', "ERROR: $err");
298 # my ($self, $targets);
300 # $self->set_status ($targets, 'quarantine');
304 # my ($self, $targets);
306 # $self->set_status ($targets, 'spam:report');
310 # my ($self, $targets, $hm);
312 # $self->set_status ($targets, "delay|$hm");
316 my ($self, $msgid) = @_;
318 if (defined ($msgid)) {
319 $self->{msgid
} = $msgid;
330 rmtree
$self->{dumpdir
};
332 unlink $self->{dataname
};
335 sub _new_mime_parser
{
336 my ($self, $maxfiles) = shift;
338 # Create a new MIME parser:
339 my $parser = new MIME
::Parser
;
340 #$parser->decode_headers(1);
341 $parser->extract_nested_messages (1);
342 $parser->ignore_errors (1);
343 $parser->extract_uuencode (0);
344 $parser->decode_bodies (0);
346 $parser->max_parts ($maxfiles) if $maxfiles;
348 rmtree
$self->{dumpdir
};
350 # Create and set the output directory:
351 (-d
$self->{dumpdir
} || mkdir ($self->{dumpdir
} ,0755)) ||
352 die "can't create $self->{dumpdir}: $! : ERROR";
353 (-w
$self->{dumpdir
}) ||
354 die "can't write to directory $self->{dumpdir}: $! : ERROR";
356 $parser->output_dir($self->{dumpdir
});
362 my ($self, $maxfiles) = shift;
367 my $parser = $self->_new_mime_parser ($maxfiles);
369 $self->{fh
}->seek (0, 0);
372 if (!($entity = $parser->read($self->{fh
}))) {
373 die "$self->{logid}: unable to parse message: ERROR";
377 die "$self->{logid}: unable to parse message - $@" if $@;
379 # bug fix for bin/tests/content/mimeparser.txt
380 if ($entity->mime_type =~ m
|multipart
/|i
&& !$entity->head->multipart_boundary) {
381 $entity->head->mime_attr('Content-type' => "application/x-unparseable-multipart");
384 if ((my $idcount = $entity->head->count ('Message-Id')) > 0) {
385 $self->msgid ($entity->head->get ('Message-Id', $idcount - 1));
388 # fixme: add parse_time to statistic database
389 my $parse_time = time() - $ctime;
391 # also save decoded data
392 decode_entities
($parser, $self->{logid
}, $entity);
394 # we also remove all proxmox-marks from the mail and add an unique
395 # id to each attachment.
397 PMG
::Utils
::remove_marks
($entity, 1);
398 PMG
::Utils
::add_ct_marks
($entity);
403 sub decode_entities
{
404 my ($parser, $logid, $entity) = @_;
406 if ($entity->bodyhandle && (my $path = $entity->bodyhandle->path)) {
409 my $head = $entity->head;
410 my $encoding = $head->mime_encoding;
411 my $decoder = new MIME
::Decoder
$encoding;
413 if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) {
415 $entity->{PMX_decoded_path
} = $path; # no need to decode
419 my $body = $parser->new_body_for ($head);
421 $body->is_encoded(0);
423 my $in = $entity->bodyhandle->open ("r") ||
424 die "unable to read raw data '$path'";
426 my $decfh = $body->open ("w") ||
427 die "unable to open body: $!";
429 $decoder->decode ($in, $decfh);
434 die "can't close bodyhandle: $!";
436 $entity->{PMX_decoded_path
} = $body->path;
443 syslog
('err', "$logid: $err");
448 foreach my $part ($entity->parts) {
449 decode_entities
($parser, $logid, $part);