src/PMG/RuleDB/Accept.pm

   1 package PMG::RuleDB::Accept;
   2
   3 use strict;
   4 use warnings;
   5 use DBI;
   6 use Encode;
   7
   8 use PVE::SafeSyslog;
   9 use Digest::SHA;
  10
  11 use PMG::Utils;
  12 use PMG::ModGroup;
  13 use PMG::DKIMSign;
  14 use PMG::RuleDB::Object;
  15
  16 use base qw(PMG::RuleDB::Object);
  17
  18 sub otype {
  19     return 4000;
  20 }
  21
  22 sub oclass {
  23     return 'action';
  24 }
  25
  26 sub otype_text {
  27     return 'Accept';
  28 }
  29
  30 sub oisedit {
  31     return 0;
  32 }
  33
  34 sub final {
  35     return 1;
  36 }
  37
  38 sub priority {
  39     return 99;
  40 }
  41
  42 sub new {
  43     my ($type, $ogroup) = @_;
  44
  45     my $class = ref($type) || $type;
  46
  47     my $self = $class->SUPER::new($class->otype(), $ogroup);
  48
  49     return $self;
  50 }
  51
  52 sub load_attr {
  53     my ($type, $ruledb, $id, $ogroup, $value) = @_;
  54
  55     my $class = ref($type) || $type;
  56
  57     my $obj = $class->new($ogroup);
  58     $obj->{id} = $id;
  59
  60     $obj->{digest} = Digest::SHA::sha1_hex($id, $ogroup);
  61
  62     return $obj;
  63 }
  64
  65 sub save {
  66     my ($self, $ruledb) = @_;
  67
  68     defined($self->{ogroup}) || return undef;
  69
  70     if (defined($self->{id})) {
  71         # update
  72
  73         # nothing to update
  74
  75     } else {
  76         # insert
  77
  78         my $sth = $ruledb->{dbh}->prepare(
  79             "INSERT INTO Object (Objectgroup_ID, ObjectType) VALUES (?, ?);");
  80
  81         $sth->execute($self->ogroup, $self->otype);
  82
  83         $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
  84     }
  85
  86     return $self->{id};
  87 }
  88
  89 sub execute {
  90     my ($self, $queue, $ruledb, $mod_group, $targets,
  91         $msginfo, $vars, $marks) = @_;
  92
  93     my $dkim = $msginfo->{dkim} // {};
  94     my $subgroups = $mod_group->subgroups($targets, !$dkim->{sign});
  95
  96     my $rulename = encode('UTF-8', $vars->{RULE} // 'unknown');
  97
  98     foreach my $ta (@$subgroups) {
  99         my ($tg, $entity) = (@$ta[0], @$ta[1]);
 100
 101         PMG::Utils::remove_marks($entity);
 102
 103         if ($dkim->{sign}) {
 104             eval {
 105                 $entity = PMG::DKIMSign::sign_entity($entity, $dkim, $msginfo->{sender});
 106             };
 107             if ($@) {
 108                 syslog('warning',
 109                     "%s: Could not create DKIM-Signature - disabling Signing: $@",
 110                     $queue->{logid}
 111                 );
 112             }
 113         }
 114
 115
 116         if ($msginfo->{testmode}) {
 117             my $fh = $msginfo->{test_fh};
 118             print $fh "accept from: $msginfo->{sender}\n";
 119             printf $fh "accept   to: %s\n", join (',', @$tg);
 120             print $fh "accept content:\n";
 121
 122             $entity->print($fh);
 123             print $fh "accept end\n";
 124             $queue->set_status($tg, 'delivered');
 125         } else {
 126             my ($qid, $code, $mess) = PMG::Utils::reinject_mail(
 127                 $entity, $msginfo->{sender}, $tg,
 128                 $msginfo->{xforward}, $msginfo->{fqdn}, $msginfo->{param});
 129             if ($qid) {
 130                 foreach (@$tg) {
 131                     syslog('info', "%s: accept mail to <%s> (%s) (rule: %s)", $queue->{logid}, encode('UTF-8', $_), $qid, $rulename);
 132                 }
 133                 $queue->set_status ($tg, 'delivered', $qid);
 134             } else {
 135                 foreach (@$tg) {
 136                     syslog('err', "%s: reinject mail to <%s> (rule: %s) failed", $queue->{logid}, encode('UTF-8', $_), $rulename);
 137                 }
 138                 if ($code) {
 139                     my $resp = substr($code, 0, 1);
 140                     if ($resp eq '4' || $resp eq '5') {
 141                         $queue->set_status($tg, 'error', $code, $mess);
 142                     }
 143                 }
 144             }
 145         }
 146     }
 147
 148     # warn if no subgroups
 149 }
 150
 151 sub short_desc {
 152     my $self = shift;
 153
 154     return "accept message";
 155 }
 156
 157 1;
 158
 159 __END__
 160
 161 =head1 PMG::RuleDB::Accept
 162
 163 Accept a message.