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 (',', sort keys %{$list->{WL}})) || '');
  63         my $blist = $dbh->quote(encode('UTF-8', join (',', sort 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 .= "INSERT INTO UserPrefs (PMail, Name, Data, MTime) " .
  76             "VALUES ($qu, 'WL', $wlist, EXTRACT (EPOCH FROM now())::INTEGER);";
  77
  78         $queries .= "INSERT INTO UserPrefs (PMail, Name, Data, MTime) " .
  79             "VALUES ($qu, 'BL', $blist, EXTRACT (EPOCH FROM now())::INTEGER);";
  80
  81         $dbh->do($queries);
  82     }
  83
  84     my $values =  [ sort keys %{$list->{$name}} ];
  85
  86     return $values;
  87 }
  88
  89 sub deliver_quarantined_mail {
  90     my ($dbh, $ref, $receiver) = @_;
  91
  92     my $filename = $ref->{file};
  93     my $spooldir = $PMG::MailQueue::spooldir;
  94     my $path = "$spooldir/$filename";
  95
  96     my $id = 'C' . $ref->{cid} . 'R' . $ref->{rid} . 'T' . $ref->{ticketid};;
  97
  98     my $parser = PMG::MIMEUtils::new_mime_parser({
  99         nested => 1,
 100         decode_bodies => 0,
 101         extract_uuencode => 0,
 102         dumpdir => "/tmp/.quarantine-$id-$receiver-$$/",
 103     });
 104
 105     my $entity = $parser->parse_open("$path");
 106     PMG::MIMEUtils::fixup_multipart($entity);
 107
 108     # delete Delivered-To and Return-Path (avoid problem with postfix
 109     # forwarding loop detection (man local))
 110     $entity->head->delete('Delivered-To');
 111     $entity->head->delete('Return-Path');
 112
 113     my $sender = 'postmaster'; # notify postmaster if something fails
 114
 115     eval {
 116         my ($qid, $code, $mess) = PMG::Utils::reinject_local_mail(
 117             $entity, $sender, [$receiver], undef, 'quarantine');
 118
 119         if (!$qid) {
 120             die "$mess\n";
 121         }
 122
 123         my $sth = $dbh->prepare(
 124             "UPDATE CMSReceivers SET Status='D', MTime = ? " .
 125             "WHERE CMailStore_CID = ? AND CMailStore_RID = ? AND TicketID = ?");
 126         $sth->execute(time(), $ref->{cid}, $ref->{rid}, $ref->{ticketid});
 127         $sth->finish;
 128     };
 129     my $err = $@;
 130     if ($err) {
 131         my $msg = "deliver quarantined mail '$id' ($path) failed: $err";
 132         syslog('err', $msg);
 133         die "$msg\n";
 134     }
 135
 136     syslog('info', "delivered quarantined mail '$id' ($path)");
 137
 138     return 1;
 139 }
 140
 141 sub delete_quarantined_mail {
 142     my ($dbh, $ref) = @_;
 143
 144     my $filename = $ref->{file};
 145     my $spooldir = $PMG::MailQueue::spooldir;
 146     my $path = "$spooldir/$filename";
 147
 148     my $id = 'C' . $ref->{cid} . 'R' . $ref->{rid} . 'T' . $ref->{ticketid};;
 149
 150     eval {
 151         my $sth = $dbh->prepare(
 152             "UPDATE CMSReceivers SET Status='D', MTime = ? WHERE " .
 153             "CMailStore_CID = ? AND CMailStore_RID = ? AND TicketID = ?");
 154         $sth->execute (time(), $ref->{cid}, $ref->{rid}, $ref->{ticketid});
 155         $sth->finish;
 156     };
 157     if (my $err = $@) {
 158         my $msg = "delete quarantined mail '$id' ($path) failed: $err";
 159         syslog ('err', $msg);
 160         die "$msg\n";
 161     }
 162
 163     syslog ('info', "marked quarantined mail '$id' as deleted ($path)");
 164
 165     return 1;
 166 }
 167
 168
 169 1;