]> git.proxmox.com Git - pmg-api.git/blob - src/PMG/RuleDB/BCC.pm
ruledb: properly substitute prox_vars in headers
[pmg-api.git] / src / PMG / RuleDB / BCC.pm
1 package PMG::RuleDB::BCC;
2
3 use strict;
4 use warnings;
5 use DBI;
6
7 use PVE::SafeSyslog;
8
9 use PMG::Utils;
10 use PMG::ModGroup;
11 use PMG::DKIMSign;
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 oisedit {
29 return 1;
30 }
31
32 sub final {
33 return 0;
34 }
35
36 sub priority {
37 return 80;
38 }
39
40 sub new {
41 my ($type, $target, $original, $ogroup) = @_;
42
43 my $class = ref($type) || $type;
44
45 my $self = $class->SUPER::new($class->otype(), $ogroup);
46
47 $self->{target} = $target || 'receiver@domain.tld';
48
49 defined ($original) || ($original = 1);
50
51 $self->{original} = $original;
52
53 return $self;
54 }
55
56 sub load_attr {
57 my ($type, $ruledb, $id, $ogroup, $value) = @_;
58
59 my $class = ref($type) || $type;
60
61 defined($value) || return undef;
62
63 $value =~ m/^([01]):(.*)/ || return undef;
64
65 my ($target, $original) = ($2, $1);
66
67 my $obj = $class->new($target, $original, $ogroup);
68 $obj->{id} = $id;
69
70 $obj->{digest} = Digest::SHA::sha1_hex($id, $target, $original, $ogroup);
71
72 return $obj;
73 }
74
75 sub save {
76 my ($self, $ruledb) = @_;
77
78 defined($self->{ogroup}) || die "undefined object attribute: ERROR";
79 defined($self->{target}) || die "undefined object attribute: ERROR";
80 defined($self->{original}) || die "undefined object attribute: ERROR";
81
82 if ($self->{original}) {
83 $self->{original} = 1;
84 } else {
85 $self->{original} = 0;
86 }
87
88 my $value = "$self->{original}:$self->{target}";
89
90 if (defined($self->{id})) {
91 # update
92
93 $ruledb->{dbh}->do(
94 "UPDATE Object SET Value = ? WHERE ID = ?",
95 undef, $value, $self->{id});
96
97 } else {
98 # insert
99
100 my $sth = $ruledb->{dbh}->prepare(
101 "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
102 "VALUES (?, ?, ?);");
103
104 $sth->execute($self->{ogroup}, $self->otype, $value);
105
106 $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
107 }
108
109 return $self->{id};
110 }
111
112 sub execute {
113 my ($self, $queue, $ruledb, $mod_group, $targets,
114 $msginfo, $vars, $marks) = @_;
115
116 my $subgroups = $mod_group->subgroups($targets, 1);
117
118 my $rulename = $vars->{RULE} // 'unknown';
119
120 my $bcc_to = PMG::Utils::subst_values_for_header($self->{target}, $vars);
121
122 if ($bcc_to =~ m/^\s*$/) {
123 # this happens if a notification is triggered by bounce mails
124 # which notifies the sender <> - we just log and then ignore it
125 syslog('info', "%s: bcc to <> (rule: %s, ignored)", $queue->{logid}, $rulename);
126 return;
127 }
128
129 my @bcc_targets = split (/\s*,\s*/, $bcc_to);
130
131 if ($self->{original}) {
132 $subgroups = [[\@bcc_targets, $mod_group->{entity}]];
133 }
134
135 foreach my $ta (@$subgroups) {
136 my ($tg, $entity) = (@$ta[0], @$ta[1]);
137
138 $entity = $entity->dup();
139 PMG::Utils::remove_marks($entity);
140
141 my $dkim = $msginfo->{dkim} // {};
142 if ($dkim->{sign}) {
143 eval {
144 $entity = PMG::DKIMSign::sign_entity($entity,
145 $dkim->{selector}, $msginfo->{sender}, $dkim->{sign_all});
146 };
147 syslog('warning',
148 "Could not create DKIM-Signature - disabling Signing: $@") if $@;
149 }
150
151 if ($msginfo->{testmode}) {
152 my $fh = $msginfo->{test_fh};
153 print $fh "bcc from: $msginfo->{sender}\n";
154 printf $fh "bcc to: %s\n", join (',', @$tg);
155 print $fh "bcc content:\n";
156 $entity->print ($fh);
157 print $fh "bcc end\n";
158 } else {
159 my $param = {};
160 for my $bcc (@bcc_targets) {
161 $param->{rcpt}->{$bcc}->{notify} = "never";
162 }
163 my $qid = PMG::Utils::reinject_mail(
164 $entity, $msginfo->{sender}, \@bcc_targets,
165 $msginfo->{xforward}, $msginfo->{fqdn}, $param);
166 foreach (@bcc_targets) {
167 if ($qid) {
168 syslog('info', "%s: bcc to <%s> (rule: %s, %s)", $queue->{logid}, $_, $rulename, $qid);
169 } else {
170 syslog('err', "%s: bcc to <%s> (rule: %s) failed", $queue->{logid}, $_, $rulename);
171 }
172 }
173 }
174 }
175
176 # warn if no subgroups
177 }
178
179 sub short_desc {
180 my $self = shift;
181
182 my $descr = "send bcc to: $self->{target}";
183
184 $descr .= " (original)" if $self->{original};
185
186 return $descr;
187 }
188
189 sub properties {
190 my ($class) = @_;
191
192 return {
193 target => {
194 description => "Send a Blind Carbon Copy to this email address.",
195 type => 'string', format => 'email',
196 },
197 original =>{
198 description => "Send the original, unmodified mail.",
199 type => 'boolean',
200 optional => 1,
201 default => 1,
202 },
203 };
204 }
205
206 sub get {
207 my ($self) = @_;
208
209 return {
210 target => $self->{target},
211 original => $self->{original},
212 };
213 }
214
215 sub update {
216 my ($self, $param) = @_;
217
218 $self->{target} = $param->{target};
219 $self->{original} = $param->{original} ? 1 : 0;
220 }
221
222 1;
223
224 __END__
225
226 =head1 PMG::RuleDB::BCC
227
228 Send BCC.