]>
git.proxmox.com Git - pmg-api.git/blob - src/PMG/MailQueue.pm
4e37cb989fdbf86a44466914d5f6e25a756f5a90
1 package PMG
::MailQueue
;
14 use Time
::HiRes
qw(gettimeofday);
20 our $spooldir = "/var/spool/pmg";
22 my $fileseq = rand 1000;
24 sub create_spooldirs
{
25 my ($lcid, $cleanup) = @_;
27 # if requested, remove any stale date
33 "$spooldir/attachment",
40 "$spooldir/attachment",
44 mkpath
"$spooldir/cluster/$lcid/virus";
45 mkpath
"$spooldir/cluster/$lcid/spam";
46 mkpath
"$spooldir/cluster/$lcid/attachment";
50 # called on service startup to remove any stale files
53 while (my $file = <$spooldir/active/*>) {
60 my ($dir, $subdir) = @_;
62 # try to create a unique data file
64 my ($sec, $usec) = gettimeofday
();
65 my $fname = "$sec.$usec.$$." . $fileseq++;
66 my $path = "$dir/$subdir/$fname";
71 if (!($fh = IO
::File-
>new ($path, 'w+', 0600))) {
72 die "unable to create file '$path': $! : ERROR";
75 if (my $st = stat ($fh)) {
76 $uid = sprintf ("%X%X%05X", $st->ino, $sec, $usec);
77 if ($subdir ne 'active') {
78 $subsubdir .= sprintf ("%02X/", $usec % 256);
82 die "unable to stat file: $! : ERROR";
85 mkdir "$dir/$subdir/$subsubdir";
87 my $subpath = "$subdir/$subsubdir$uid";
89 if (!rename ($path, "$dir/$subpath")) {
91 die "unable to rename file: ERROR";
94 return ($fh, $uid, $subpath);
98 my ($type, $from, $to) = @_;
103 $self->{from
} = $from;
106 $self->{sa_score
} = undef;
107 $self->{sa_max
} = undef;
108 $self->{sa_data
} = undef;
110 $self->{vinfo
} = undef;
112 $self->{rtime
} = time;
113 $self->{ptime_spam
} = 0;
114 $self->{ptime_virus
} = 0;
116 my ($fh, $uid, $path) = new_fileid
($spooldir, 'active');
120 $self->{logid
} = $uid;
121 #$self->{logid} = sprintf ("%05X${uid}", $self->{rtime});
122 $self->{dataname
} = "$spooldir/$path";
124 $self->{dumpdir
} = "/tmp/.proxdump_${$}_$uid";
126 $self->set_status ($to, 'undelivered');
132 my ($self, $targets, $state, $code, $message) = @_;
134 foreach my $r (@$targets) {
135 $self->{status
}->{$r} = $state;
136 $self->{status_code
}->{$r} = $code;
137 $self->{status_message
}->{$r} = $message;
141 sub quarantinedb_insert
{
142 my ($self, $ruledb, $lcid, $ldap, $qtype, $header, $sender, $file, $targets, $vars) = @_;
145 $sender = encode
('UTF-8', $sender);
146 my $dbh = $ruledb->{dbh
};
148 my $insert_cmds = "SELECT nextval ('cmailstore_id_seq'); INSERT INTO CMailStore " .
149 "(CID, RID, ID, Time, QType, Bytes, Spamlevel, Info, Header, Sender, File) VALUES (" .
150 "$lcid, currval ('cmailstore_id_seq'), currval ('cmailstore_id_seq'), ";
152 my $spaminfo = $vars->{__spaminfo
};
153 my $sa_score = $spaminfo->{sa_score
} || 0;
155 $insert_cmds .= $self->{rtime
} . ',';
156 $insert_cmds .= $dbh->quote ($qtype) . ',';
157 $insert_cmds .= $self->{bytes
} . ',';
158 $insert_cmds .= $sa_score . ',';
161 $insert_cmds .= $dbh->quote ($self->{vinfo
}) . ',';
164 my $sscores = $spaminfo->{sa_data
};
166 if (defined ($sscores) && @$sscores != -1) {
168 foreach my $s (@$sscores) {
169 $sainfo .= ',' if $sainfo;
170 $sainfo .= sprintf ("%s:%s", $s->{rule
}, $s->{score
});
172 $sainfo = $dbh->quote ($sainfo);
175 $insert_cmds .= $sainfo . ',';
178 $insert_cmds .= $dbh->quote ($header) . ',';
180 $insert_cmds .= $dbh->quote ($sender) . ',';
181 $insert_cmds .= $dbh->quote ($file) . ');';
185 my $tid = int(rand(0x0fffffff));
187 foreach my $r (@$targets) {
188 my $pmail = get_primary_mail
($ldap, $r);
190 if ($pmail eq lc ($r)) {
193 $receiver = $dbh->quote (encode
('UTF-8', $r));
197 $pmail = $dbh->quote (encode
('UTF-8', $pmail));
198 $insert_cmds .= "INSERT INTO CMSReceivers " .
199 "(CMailStore_CID, CMailStore_RID, PMail, Receiver, TicketID, Status, MTime) " .
200 "VALUES ($lcid, currval ('cmailstore_id_seq'), $pmail, $receiver, $tid, 'N', $now); ";
202 # Note: Tuple (CID, RID, TicketID) must be unique
203 $tid = ($tid + 1) & 0x0fffffff;
206 $dbh->do ($insert_cmds);
211 syslog
('err', "ERROR: $err") if $err;
214 sub get_primary_mail
{
215 my ($ldap, $mail) = @_;
219 return $mail if !$ldap;
221 if (my $info = $ldap->account_info ($mail)) {
222 return $info->{pmail
};
229 sub extract_header_text
{
232 my $subject = $entity->head->get ('subject', 0);
233 my $from = $entity->head->get ('from', 0);
234 my $sender = $entity->head->get ('sender', 0);
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;
241 my $header = $head->as_string();
246 sub fsync_file_and_dir
{
247 my $filename = shift;
250 my $fh = IO
::File-
>new($filename) || die "unable to open file '$filename'";
251 File
::Sync
::fsync
($fh) || die "fsync file '$filename' failed";
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";
263 syslog
('err', "ERROR: $err");
274 sub quarantine_mail
{
275 my ($self, $ruledb, $qtype, $entity, $tg, $msginfo, $vars, $ldap) = @_;
277 my $sender = $msginfo->{sender
};
279 my $header = extract_header_text
($entity);
281 my $subpath = $subpath_map->{$qtype} // 'spam';
283 my $lcid = $msginfo->{lcid
};
285 my ($fh, $uid, $path);
289 my $subdir = "cluster/$lcid/$subpath";
290 ($fh, $uid, $path) = new_fileid
($spooldir, $subdir);
292 ($fh, $uid, $path) = new_fileid
($spooldir, $subpath);
295 # there must be only one Return-Path
296 $entity->head->delete ('Return-Path');
298 # prepend Delivered-To and Return-Path (like QMAIL MAILDIR FORMAT)
299 $entity->head->add ('Return-Path', encode
('UTF-8', join (',', $sender)), 0);
300 $entity->head->add ('Delivered-To', encode
('UTF-8', join (',', @$tg)), 0);
302 $entity->print ($fh);
306 fsync_file_and_dir
("$spooldir/$path"); # make sure the file is on disk
308 $self->quarantinedb_insert ($ruledb, $lcid, $ldap, $qtype, $header, $sender, $path, $tg, $vars);
315 unlink "$spooldir/$path" if $path;
316 syslog
('err', "ERROR: $err");
324 # my ($self, $targets);
326 # $self->set_status ($targets, 'quarantine');
330 # my ($self, $targets);
332 # $self->set_status ($targets, 'spam:report');
336 # my ($self, $targets, $hm);
338 # $self->set_status ($targets, "delay|$hm");
342 my ($self, $msgid) = @_;
344 if (defined ($msgid)) {
345 $self->{msgid
} = $msgid;
356 rmtree
$self->{dumpdir
};
358 unlink $self->{dataname
};
361 sub _new_mime_parser
{
362 my ($self, $maxfiles) = shift;
364 my $parser = PMG
::MIMEUtils
::new_mime_parser
({
367 extract_uuencode
=> 0,
369 maxfiles
=> $maxfiles,
370 dumpdir
=> $self->{dumpdir
},
377 my ($self, $maxfiles) = shift;
382 my $parser = $self->_new_mime_parser ($maxfiles);
384 $self->{fh
}->seek (0, 0);
387 if (!($entity = $parser->read($self->{fh
}))) {
388 die "$self->{logid}: unable to parse message: ERROR";
392 die "$self->{logid}: unable to parse message - $@" if $@;
394 PMG
::MIMEUtils
::fixup_multipart
($entity);
396 if ((my $idcount = $entity->head->count ('Message-Id')) > 0) {
397 $self->msgid ($entity->head->get ('Message-Id', $idcount - 1));
400 # fixme: add parse_time to statistic database
401 my $parse_time = time() - $ctime;
403 # also save decoded data
404 decode_entities
($parser, $self->{logid
}, $entity);
406 # we also remove all proxmox-marks from the mail and add an unique
407 # id to each attachment.
409 my $max_aid = PMG
::Utils
::remove_marks
($entity, 1);
410 PMG
::Utils
::add_ct_marks
($entity);
412 return ($entity, $max_aid);
415 sub decode_entities
{
416 my ($parser, $logid, $entity) = @_;
418 PMG
::MIMEUtils
::traverse_mime_parts
($entity, sub {
420 if ($part->bodyhandle && (my $path = $part->bodyhandle->path)) {
423 my $head = $part->head;
424 my $encoding = $head->mime_encoding;
425 my $decoder = new MIME
::Decoder
$encoding;
427 if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) {
429 $part->{PMX_decoded_path
} = $path; # no need to decode
433 my $body = $parser->new_body_for ($head);
435 $body->is_encoded(0);
437 my $in = $part->bodyhandle->open ("r") ||
438 die "unable to read raw data '$path'";
440 my $decfh = $body->open ("w") ||
441 die "unable to open body: $!";
443 $decoder->decode ($in, $decfh);
448 die "can't close bodyhandle: $!";
450 $part->{PMX_decoded_path
} = $body->path;
457 syslog
('err', "$logid: $err");