PMG/RuleDB/BCC.pm

   1 package PMG::RuleDB::BCC;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6 use DBI;
   7
   8 use PVE::SafeSyslog;
   9
  10 use PMG::Utils;
  11 use PMG::ModGroup;
  12 use PMG::RuleDB::Object;
  13
  14 use base qw(PMG::RuleDB::Object);
  15
  16 sub otype {
  17     return 4005;
  18 }
  19
  20 sub oclass {
  21     return 'action';
  22 }
  23
  24 sub otype_text {
  25     return 'BCC';
  26 }
  27
  28 sub oicon {
  29     return 'bcc.gif';
  30 }
  31
  32 sub oinfo {
  33     return 'Blind carbon copy.';
  34 }
  35
  36 sub oisedit {
  37     return 1;
  38 }
  39
  40 sub final {
  41     return 0;
  42 }
  43
  44 sub priority {
  45     return 80;
  46 }
  47
  48 sub new {
  49     my ($type, $target, $original, $ogroup) = @_;
  50
  51     my $class = ref($type) || $type;
  52
  53     my $self = $class->SUPER::new($class->otype(), $ogroup);
  54
  55     $self->{target} = $target || 'receiver@domain.tld';
  56
  57     defined ($original) || ($original = 1);
  58
  59     $self->{original} = $original;
  60
  61     return $self;
  62 }
  63
  64 sub load_attr {
  65     my ($type, $ruledb, $id, $ogroup, $value) = @_;
  66
  67     my $class = ref($type) || $type;
  68
  69     defined($value) || return undef;
  70
  71     $value =~ m/^([01]):(.*)/ || return undef;
  72
  73     my ($target, $original) = ($2, $1);
  74
  75     my $obj = $class->new($target, $original, $ogroup);
  76     $obj->{id} = $id;
  77
  78     $obj->{digest} = Digest::SHA::sha1_hex($id, $target, $original, $ogroup);
  79
  80     return $obj;
  81 }
  82
  83 sub save {
  84     my ($self, $ruledb) = @_;
  85
  86     defined($self->{ogroup}) || croak "undefined object attribute: ERROR";
  87     defined($self->{target}) || croak "undefined object attribute: ERROR";
  88     defined($self->{original}) || croak "undefined object attribute: ERROR";
  89
  90     if ($self->{original}) {
  91         $self->{original} = 1;
  92     } else {
  93         $self->{original} = 0;
  94     }
  95
  96     my $value = "$self->{original}:$self->{target}";
  97
  98     if (defined($self->{id})) {
  99         # update
 100
 101         $ruledb->{dbh}->do(
 102             "UPDATE Object SET Value = ? WHERE ID = ?",
 103             undef, $value, $self->{id});
 104
 105     } else {
 106         # insert
 107
 108         my $sth = $ruledb->{dbh}->prepare(
 109             "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
 110             "VALUES (?, ?, ?);");
 111
 112         $sth->execute($self->{ogroup}, $self->otype, $value);
 113
 114         $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
 115     }
 116
 117     return $self->{id};
 118 }
 119
 120 sub execute {
 121     my ($self, $queue, $ruledb, $mod_group, $targets,
 122         $msginfo, $vars, $marks) = @_;
 123
 124     my $subgroups = $mod_group->subgroups($targets, 1);
 125
 126     my $bcc_to = PMG::Utils::subst_values($self->{target}, $vars);
 127
 128     if ($bcc_to =~ m/^\s*$/) {
 129         # this happens if a notification is triggered by bounce mails
 130         # which notifies the sender <> - we just log and then ignore it
 131         syslog('info', "%s: bcc to <> (ignored)", $queue->{logid});
 132         return;
 133     }
 134
 135     my @bcc_targets = split (/\s*,\s*/, $bcc_to);
 136
 137     if ($self->{original}) {
 138         $subgroups = [[\@bcc_targets, $mod_group->{entity}]];
 139     }
 140
 141     foreach my $ta (@$subgroups) {
 142         my ($tg, $entity) = (@$ta[0], @$ta[1]);
 143
 144         $entity = $entity->dup();
 145         PMG::Utils::remove_marks($entity);
 146
 147         if ($msginfo->{testmode}) {
 148             my $fh = $msginfo->{test_fh};
 149             print $fh "bcc from: $msginfo->{sender}\n";
 150             printf $fh "bcc   to: %s\n", join (',', @$tg);
 151             print $fh "bcc content:\n";
 152             $entity->print ($fh);
 153             print $fh "bcc end\n";
 154         } else {
 155             my $qid = PMG::Utils::reinject_mail(
 156                 $entity, $msginfo->{sender}, \@bcc_targets,
 157                 $msginfo->{xforward}, $msginfo->{fqdn}, 1);
 158             foreach (@bcc_targets) {
 159                 if ($qid) {
 160                     syslog('info', "%s: bcc to <%s> (%s)", $queue->{logid}, $_, $qid);
 161                 } else {
 162                     syslog('err', "%s: bcc to <%s> failed", $queue->{logid}, $_);
 163                 }
 164             }
 165         }
 166     }
 167
 168     # warn if no subgroups
 169 }
 170
 171 sub short_desc {
 172     my $self = shift;
 173
 174     return "send bcc to: $self->{target}";
 175 }
 176
 177 1;
 178
 179 __END__
 180
 181 =head1 PMG::RuleDB::BCC
 182
 183 Send BCC.