src/PMG/Quarantine.pm

   1 package PMG::Quarantine;
   2
   3 use strict;
   4 use warnings;
   5 use Encode qw(encode);
   6
   7 use PVE::SafeSyslog;
   8 use PVE::Tools;
   9
  10 use PMG::Utils;
  11 use PMG::RuleDB;
  12 use PMG::MailQueue;
  13 use PMG::MIMEUtils;
  14
  15 sub add_to_blackwhite {
  16     my ($dbh, $username, $listname, $addrs, $delete) = @_;
  17
  18     my $name = $listname eq 'BL' ? 'BL' : 'WL';
  19     my $oname = $listname eq 'BL' ? 'WL' : 'BL';
  20     my $qu = $dbh->quote (encode('UTF-8', $username));
  21
  22     my $sth = $dbh->prepare(
  23         "SELECT * FROM UserPrefs WHERE pmail = $qu AND (Name = 'BL' OR Name = 'WL')");
  24     $sth->execute();
  25
  26     my $list = { 'WL' => {}, 'BL' => {} };
  27
  28     while (my $ref = $sth->fetchrow_hashref()) {
  29         my $data = PMG::Utils::try_decode_utf8($ref->{data});
  30         $data =~ s/[,;]/ /g;
  31         my @alist = split('\s+', $data);
  32
  33         my $tmp = {};
  34         foreach my $a (@alist) {
  35             if ($a =~ m/^[^\s\\\@]+(?:\@[^\s\/\\\@]+)?$/) {
  36                 $tmp->{$a} = 1;
  37             }
  38         }
  39
  40         $list->{$ref->{name}} = $tmp;
  41     }
  42
  43     $sth->finish;
  44
  45     if ($addrs) {
  46
  47         foreach my $v (@$addrs) {
  48             die "email address '$v' is too long (> 512 characters)\n"
  49                 if length($v) > 512;
  50
  51             if ($delete) {
  52                 delete($list->{$name}->{$v});
  53             } else {
  54                 if ($v =~ m/[\s\\]/) {
  55                     die "email address '$v' contains invalid characters\n";
  56                 }
  57                 $list->{$name}->{$v} = 1;
  58                 delete ($list->{$oname}->{$v});
  59             }
  60         }
  61
  62         my $wlist = $dbh->quote(encode('UTF-8', join (',', keys %{$list->{WL}})) || '');
  63         my $blist = $dbh->quote(encode('UTF-8', join (',', keys %{$list->{BL}})) || '');
  64
  65         if (!$delete) {
  66             my $maxlen = 200000;
  67             die "whitelist size exceeds limit (> $maxlen bytes)\n"
  68                 if length($wlist) > $maxlen;
  69             die "blacklist size exceeds limit (> $maxlen bytes)\n"
  70                 if length($blist) > $maxlen;
  71         }
  72
  73         my $queries = "DELETE FROM UserPrefs WHERE pmail = $qu AND (Name = 'WL' OR Name = 'BL');";
  74
  75         $queries .=
  76         "INSERT INTO UserPrefs (PMail, Name, Data, MTime) " .
  77         "VALUES ($qu, 'WL', $wlist, EXTRACT (EPOCH FROM now())::INTEGER);";
  78
  79         $queries .=
  80         "INSERT INTO UserPrefs (PMail, Name, Data, MTime) " .
  81         "VALUES ($qu, 'BL', $blist, EXTRACT (EPOCH FROM now())::INTEGER);";
  82
  83         $dbh->do($queries);
  84     }
  85
  86     my $values =  [ keys %{$list->{$name}} ];
  87
  88     return $values;
  89 }
  90
  91 sub deliver_quarantined_mail {
  92     my ($dbh, $ref, $receiver) = @_;
  93
  94     my $filename = $ref->{file};
  95     my $spooldir = $PMG::MailQueue::spooldir;
  96     my $path = "$spooldir/$filename";
  97
  98     my $id = 'C' . $ref->{cid} . 'R' . $ref->{rid} . 'T' . $ref->{ticketid};;
  99
 100     my $parser = PMG::MIMEUtils::new_mime_parser({
 101         nested => 1,
 102         decode_bodies => 0,
 103         extract_uuencode => 0,
 104         dumpdir => "/tmp/.quarantine-$id-$receiver-$$/",
 105     });
 106
 107     my $entity = $parser->parse_open("$path");
 108     PMG::MIMEUtils::fixup_multipart($entity);
 109
 110     # delete Delivered-To and Return-Path (avoid problem with postfix
 111     # forwarding loop detection (man local))
 112     $entity->head->delete('Delivered-To');
 113     $entity->head->delete('Return-Path');
 114
 115     my $sender = 'postmaster'; # notify postmaster if something fails
 116
 117     eval {
 118         my ($qid, $code, $mess) = PMG::Utils::reinject_local_mail(
 119             $entity, $sender, [$receiver], undef, 'quarantine');
 120
 121         if (!$qid) {
 122             die "$mess\n";
 123         }
 124
 125         my $sth = $dbh->prepare(
 126             "UPDATE CMSReceivers SET Status='D', MTime = ? " .
 127             "WHERE CMailStore_CID = ? AND CMailStore_RID = ? AND TicketID = ?");
 128         $sth->execute(time(), $ref->{cid}, $ref->{rid}, $ref->{ticketid});
 129         $sth->finish;
 130     };
 131     my $err = $@;
 132     if ($err) {
 133         my $msg = "deliver quarantined mail '$id' ($path) failed: $err";
 134         syslog('err', $msg);
 135         die "$msg\n";
 136     }
 137
 138     syslog('info', "delivered quarantined mail '$id' ($path)");
 139
 140     return 1;
 141 }
 142
 143 sub delete_quarantined_mail {
 144     my ($dbh, $ref) = @_;
 145
 146     my $filename = $ref->{file};
 147     my $spooldir = $PMG::MailQueue::spooldir;
 148     my $path = "$spooldir/$filename";
 149
 150     my $id = 'C' . $ref->{cid} . 'R' . $ref->{rid} . 'T' . $ref->{ticketid};;
 151
 152     eval {
 153         my $sth = $dbh->prepare(
 154             "UPDATE CMSReceivers SET Status='D', MTime = ? WHERE " .
 155             "CMailStore_CID = ? AND CMailStore_RID = ? AND TicketID = ?");
 156         $sth->execute (time(), $ref->{cid}, $ref->{rid}, $ref->{ticketid});
 157         $sth->finish;
 158     };
 159     if (my $err = $@) {
 160         my $msg = "delete quarantined mail '$id' ($path) failed: $err";
 161         syslog ('err', $msg);
 162         die "$msg\n";
 163     }
 164
 165     syslog ('info', "marked quarantined mail '$id' as deleted ($path)");
 166
 167     return 1;
 168 }
 169
 170
 171 1;