src/PMG/MailQueue.pm

   1 package PMG::MailQueue;
   2
   3 use strict;
   4 use warnings;
   5
   6 use PVE::SafeSyslog;
   7 use MIME::Parser;
   8 use IO::File;
   9 use File::Sync;
  10 use File::Basename;
  11 use File::Path;
  12 use File::stat;
  13 use Time::HiRes qw(gettimeofday);
  14 use Mail::Header;
  15
  16 use PMG::LDAPSet;
  17 use PMG::MIMEUtils;
  18
  19 our $spooldir = "/var/spool/pmg";
  20
  21 my $fileseq = rand 1000;
  22
  23 sub create_spooldirs {
  24     my ($lcid, $cleanup) = @_;
  25
  26     # if requested, remove any stale date
  27     File::Path::remove_tree(
  28         "$spooldir/cluster",
  29         "$spooldir/active",
  30         "$spooldir/virus",
  31         "$spooldir/spam",
  32         "$spooldir/attachment",
  33     ) if $cleanup;
  34
  35     File::Path::make_path(
  36         "$spooldir/active",
  37         "$spooldir/spam",
  38         "$spooldir/virus",
  39         "$spooldir/attachment",
  40     );
  41
  42     if ($lcid) {
  43         mkpath "$spooldir/cluster/$lcid/virus";
  44         mkpath "$spooldir/cluster/$lcid/spam";
  45         mkpath "$spooldir/cluster/$lcid/attachment";
  46     }
  47 }
  48
  49 # called on service startup to remove any stale files
  50 sub cleanup_active {
  51
  52     while (my $file = <$spooldir/active/*>) {
  53         unlink $file;
  54     }
  55
  56 }
  57
  58 sub new_fileid {
  59     my ($dir, $subdir) = @_;
  60
  61     # try to create a unique data file
  62
  63     my ($sec, $usec) = gettimeofday ();
  64     my $fname = "$sec.$usec.$$." .  $fileseq++;
  65     my $path = "$dir/$subdir/$fname";
  66     my $fh;
  67     my $uid;
  68     my $subsubdir = '';
  69
  70     if (!($fh = IO::File->new ($path, 'w+', 0600))) {
  71         die "unable to create file '$path': $! : ERROR";
  72     }
  73
  74     if (my $st = stat ($fh)) {
  75         $uid = sprintf ("%X%X%05X", $st->ino, $sec, $usec);
  76         if ($subdir ne 'active') {
  77             $subsubdir .= sprintf ("%02X/", $usec % 256);
  78         }
  79     } else {
  80         unlink $path;
  81         die "unable to stat file: $! : ERROR";
  82     }
  83
  84     mkdir "$dir/$subdir/$subsubdir";
  85
  86     my $subpath = "$subdir/$subsubdir$uid";
  87
  88     if (!rename ($path, "$dir/$subpath")) {
  89         unlink $path;
  90         die "unable to rename file: ERROR";
  91     }
  92
  93     return ($fh, $uid, $subpath);
  94 }
  95
  96 sub new {
  97     my ($type, $from, $to) = @_;
  98
  99     my $self = {};
 100     bless $self, $type;
 101
 102     $self->{from} = $from;
 103     $self->{msgid} = "";
 104
 105     $self->{sa_score} = undef;
 106     $self->{sa_max} = undef;
 107     $self->{sa_data} = undef;
 108
 109     $self->{vinfo} = undef;
 110     $self->{bytes} = 0;
 111     $self->{rtime} = time;
 112     $self->{ptime_spam} = 0;
 113     $self->{ptime_virus} = 0;
 114
 115     my ($fh, $uid, $path) = new_fileid ($spooldir, 'active');
 116
 117     $self->{fh} = $fh;
 118     $self->{uid} = $uid;
 119     $self->{logid} = $uid;
 120     #$self->{logid} = sprintf ("%05X${uid}", $self->{rtime});
 121     $self->{dataname} = "$spooldir/$path";
 122
 123     $self->{dumpdir} = "/tmp/.proxdump_${$}_$uid";
 124
 125     $self->set_status ($to, 'undelivered');
 126
 127     return $self;
 128 }
 129
 130 sub set_status {
 131     my ($self, $targets, $state, $code, $message) = @_;
 132
 133     foreach my $r (@$targets) {
 134         $self->{status}->{$r} = $state;
 135         $self->{status_code}->{$r} = $code;
 136         $self->{status_message}->{$r} = $message;
 137     }
 138 }
 139
 140 sub quarantinedb_insert {
 141     my ($self, $ruledb, $lcid, $ldap, $qtype, $header, $sender, $file, $targets, $vars) = @_;
 142
 143     eval {
 144         my $dbh = $ruledb->{dbh};
 145
 146         my $insert_cmds = "SELECT nextval ('cmailstore_id_seq'); INSERT INTO CMailStore " .
 147             "(CID, RID, ID, Time, QType, Bytes, Spamlevel, Info, Header, Sender, File) VALUES (" .
 148             "$lcid, currval ('cmailstore_id_seq'), currval ('cmailstore_id_seq'), ";
 149
 150         my $spaminfo = $vars->{__spaminfo};
 151         my $sa_score = $spaminfo->{sa_score} || 0;
 152
 153         $insert_cmds .= $self->{rtime} . ',';
 154         $insert_cmds .= $dbh->quote ($qtype) . ',';
 155         $insert_cmds .= $self->{bytes} . ',';
 156         $insert_cmds .= $sa_score . ',';
 157
 158         if ($qtype eq 'V') {
 159             $insert_cmds .= $dbh->quote ($self->{vinfo}) . ',';
 160         } else {
 161
 162             my $sscores = $spaminfo->{sa_data};
 163             my $sainfo = 'NULL';
 164             if (defined ($sscores) && @$sscores != -1) {
 165                 $sainfo = '';
 166                 foreach my $s (@$sscores) {
 167                     $sainfo .= ',' if $sainfo;
 168                     $sainfo .= sprintf ("%s:%s", $s->{rule}, $s->{score});
 169                 }
 170                 $sainfo = $dbh->quote ($sainfo);
 171             }
 172
 173             $insert_cmds .= $sainfo . ',';
 174         }
 175
 176         $insert_cmds .= $dbh->quote ($header) . ',';
 177
 178         $insert_cmds .= $dbh->quote ($sender) . ',';
 179         $insert_cmds .= $dbh->quote ($file) . ');';
 180
 181         my $now = time();
 182
 183         my $tid = int(rand(0x0fffffff));
 184
 185         foreach my $r (@$targets) {
 186             my $pmail = get_primary_mail ($ldap, $r);
 187             my $receiver;
 188             if ($pmail eq lc ($r)) {
 189                 $receiver = "NULL";
 190             } else {
 191                 $receiver = $dbh->quote ($r);
 192             }
 193
 194
 195             $pmail = $dbh->quote ($pmail);
 196             $insert_cmds .= "INSERT INTO CMSReceivers " .
 197                 "(CMailStore_CID, CMailStore_RID, PMail, Receiver, TicketID, Status, MTime) " .
 198                 "VALUES ($lcid, currval ('cmailstore_id_seq'), $pmail, $receiver, $tid, 'N', $now); ";
 199
 200             # Note: Tuple (CID, RID, TicketID) must be unique
 201             $tid = ($tid + 1) & 0x0fffffff;
 202         }
 203
 204         $dbh->do ($insert_cmds);
 205     };
 206
 207     my $err = $@;
 208
 209     syslog ('err', "ERROR: $err") if $err;
 210 }
 211
 212 sub get_primary_mail {
 213     my ($ldap, $mail) = @_;
 214
 215     $mail = lc ($mail);
 216
 217     return $mail if !$ldap;
 218
 219     if (my $info = $ldap->account_info ($mail)) {
 220         return $info->{pmail};
 221     }
 222
 223     return $mail;
 224 }
 225
 226
 227 sub extract_header_text {
 228     my ($entity) = @_;
 229
 230     my $subject = $entity->head->get ('subject', 0);
 231     my $from = $entity->head->get ('from', 0);
 232     my $sender = $entity->head->get ('sender', 0);
 233
 234     my $head = new Mail::Header;
 235     $head->add ('subject', $subject) if $subject;
 236     $head->add ('from', $from) if $from;
 237     $head->add ('sender', $sender) if $sender;
 238
 239     my $header = $head->as_string();
 240
 241     return $header;
 242 }
 243
 244 sub fsync_file_and_dir {
 245     my $filename = shift;
 246
 247     eval {
 248         my $fh = IO::File->new($filename) || die "unable to open file '$filename'";
 249         File::Sync::fsync ($fh) || die "fsync file '$filename' failed";
 250         close ($fh);
 251
 252         my $dirname = dirname ($filename);
 253         my $dir = IO::File->new($dirname) || die "open dir '$dirname' failed";
 254         File::Sync::fsync ($dir) || die "fsync dir '$dirname' failed";
 255         close ($dir);
 256     };
 257
 258     my $err = $@;
 259
 260     if ($err) {
 261         syslog ('err', "ERROR: $err");
 262     }
 263
 264 }
 265
 266 my $subpath_map = {
 267     'V' => 'virus',
 268     'S' => 'spam',
 269     'A' => 'attachment',
 270 };
 271
 272 sub quarantine_mail {
 273     my ($self, $ruledb, $qtype, $entity, $tg, $msginfo, $vars, $ldap) = @_;
 274
 275     my $sender = $msginfo->{sender};
 276
 277     my $header = extract_header_text ($entity);
 278
 279     my $subpath = $subpath_map->{$qtype} // 'spam';
 280
 281     my $lcid = $msginfo->{lcid};
 282
 283     my ($fh, $uid, $path);
 284
 285     eval {
 286         if ($lcid) {
 287             my $subdir = "cluster/$lcid/$subpath";
 288             mkpath $subdir;
 289             ($fh, $uid, $path) = new_fileid ($spooldir, $subdir);
 290         } else {
 291             ($fh, $uid, $path) = new_fileid ($spooldir, $subpath);
 292         }
 293
 294         # there must be only one Return-Path
 295         $entity->head->delete ('Return-Path');
 296
 297         # prepend Delivered-To and Return-Path (like QMAIL MAILDIR FORMAT)
 298         $entity->head->add ('Return-Path', join (',', $sender), 0);
 299         $entity->head->add ('Delivered-To', join (',', @$tg), 0);
 300
 301         $entity->print ($fh);
 302
 303         close ($fh);
 304
 305         fsync_file_and_dir ("$spooldir/$path"); # make sure the file is on disk
 306
 307         $self->quarantinedb_insert ($ruledb, $lcid, $ldap, $qtype, $header, $sender, $path, $tg, $vars);
 308     };
 309
 310     my $err = $@;
 311
 312     if ($err) {
 313         close ($fh) if $fh;
 314         unlink "$spooldir/$path" if $path;
 315         syslog ('err', "ERROR: $err");
 316         return undef;
 317     }
 318
 319     return $uid;
 320 }
 321
 322 #sub quarantine {
 323 #    my ($self, $targets);
 324 #
 325 #    $self->set_status ($targets, 'quarantine');
 326 #}
 327
 328 #sub spamreport {
 329 #    my ($self, $targets);
 330 #
 331 #    $self->set_status ($targets, 'spam:report');
 332 #}
 333
 334 #sub delay {
 335 #    my ($self, $targets, $hm);
 336 #
 337 #    $self->set_status ($targets, "delay|$hm");
 338 #}
 339
 340 sub msgid {
 341     my ($self, $msgid) = @_;
 342
 343     if (defined ($msgid)) {
 344         $self->{msgid} = $msgid;
 345     }
 346
 347     $self->{msgid};
 348 }
 349
 350 sub close {
 351     my $self = shift;
 352
 353     close ($self->{fh});
 354
 355     rmtree $self->{dumpdir};
 356
 357     unlink $self->{dataname};
 358 }
 359
 360 sub _new_mime_parser {
 361     my ($self, $maxfiles) = shift;
 362
 363     my $parser = PMG::MIMEUtils::new_mime_parser({
 364         nested => 1,
 365         ignore_errors => 1,
 366         extract_uuencode => 0,
 367         decode_bodies => 0,
 368         maxfiles => $maxfiles,
 369         dumpdir => $self->{dumpdir},
 370     });
 371
 372     return $parser;
 373 }
 374
 375 sub parse_mail {
 376     my ($self, $maxfiles) = shift;
 377
 378     my $entity;
 379     my $ctime = time;
 380
 381     my $parser = $self->_new_mime_parser ($maxfiles);
 382
 383     $self->{fh}->seek (0, 0);
 384
 385     eval {
 386         if (!($entity = $parser->read($self->{fh}))) {
 387             die "$self->{logid}: unable to parse message: ERROR";
 388         }
 389     };
 390
 391     die "$self->{logid}: unable to parse message - $@" if $@;
 392
 393     PMG::MIMEUtils::fixup_multipart($entity);
 394
 395     if ((my $idcount = $entity->head->count ('Message-Id')) > 0) {
 396         $self->msgid ($entity->head->get ('Message-Id', $idcount - 1));
 397     }
 398
 399     # fixme: add parse_time to statistic database
 400     my $parse_time = time() - $ctime;
 401
 402     # also save decoded data
 403     decode_entities ($parser, $self->{logid}, $entity);
 404
 405     # we also remove all proxmox-marks from the mail and add an unique
 406     # id to each attachment.
 407
 408     PMG::Utils::remove_marks ($entity, 1);
 409     PMG::Utils::add_ct_marks ($entity);
 410
 411     return $entity;
 412 }
 413
 414 sub decode_entities {
 415     my ($parser, $logid, $entity) = @_;
 416
 417     PMG::MIMEUtils::traverse_mime_parts($entity, sub {
 418         my ($part) = @_;
 419         if ($part->bodyhandle && (my $path = $part->bodyhandle->path)) {
 420
 421             eval {
 422                 my $head = $part->head;
 423                 my $encoding = $head->mime_encoding;
 424                 my $decoder = new MIME::Decoder $encoding;
 425
 426                 if (!$decoder || ($decoder eq 'none' || $decoder eq 'binary')) {
 427
 428                     $part->{PMX_decoded_path} = $path; # no need to decode
 429
 430                 } else {
 431
 432                     my $body = $parser->new_body_for ($head);
 433                     $body->binmode(1);
 434                     $body->is_encoded(0);
 435
 436                     my $in = $part->bodyhandle->open ("r") ||
 437                     die "unable to read raw data '$path'";
 438
 439                     my $decfh = $body->open ("w") ||
 440                     die "unable to open body: $!";
 441
 442                     $decoder->decode ($in, $decfh);
 443
 444                     $in->close;
 445
 446                     $decfh->close ||
 447                     die "can't close bodyhandle: $!";
 448
 449                     $part->{PMX_decoded_path} = $body->path;
 450                 }
 451             };
 452
 453             my $err = $@;
 454
 455             if ($err) {
 456                 syslog ('err', "$logid: $err");
 457             }
 458
 459         }
 460     });
 461 }
 462
 463 1;
 464
 465 __END__