]> git.proxmox.com Git - pmg-api.git/blob - src/PMG/RuleDB/BCC.pm
fix #2971: DKIM: add setting to use From header when signing
[pmg-api.git] / src / PMG / RuleDB / BCC.pm
1 package PMG::RuleDB::BCC;
2
3 use strict;
4 use warnings;
5 use DBI;
6 use Encode qw(encode);
7
8 use PVE::SafeSyslog;
9
10 use PMG::Utils;
11 use PMG::ModGroup;
12 use PMG::DKIMSign;
13 use PMG::RuleDB::Object;
14
15 use base qw(PMG::RuleDB::Object);
16
17 sub otype {
18 return 4005;
19 }
20
21 sub oclass {
22 return 'action';
23 }
24
25 sub otype_text {
26 return 'BCC';
27 }
28
29 sub oisedit {
30 return 1;
31 }
32
33 sub final {
34 return 0;
35 }
36
37 sub priority {
38 return 80;
39 }
40
41 sub new {
42 my ($type, $target, $original, $ogroup) = @_;
43
44 my $class = ref($type) || $type;
45
46 my $self = $class->SUPER::new($class->otype(), $ogroup);
47
48 $self->{target} = $target || 'receiver@domain.tld';
49
50 defined ($original) || ($original = 1);
51
52 $self->{original} = $original;
53
54 return $self;
55 }
56
57 sub load_attr {
58 my ($type, $ruledb, $id, $ogroup, $value) = @_;
59
60 my $class = ref($type) || $type;
61
62 defined($value) || return undef;
63
64 $value =~ m/^([01]):(.*)/ || return undef;
65
66 my ($target, $original) = ($2, $1);
67
68 my $obj = $class->new($target, $original, $ogroup);
69 $obj->{id} = $id;
70
71 $obj->{digest} = Digest::SHA::sha1_hex($id, $target, $original, $ogroup);
72
73 return $obj;
74 }
75
76 sub save {
77 my ($self, $ruledb) = @_;
78
79 defined($self->{ogroup}) || die "undefined object attribute: ERROR";
80 defined($self->{target}) || die "undefined object attribute: ERROR";
81 defined($self->{original}) || die "undefined object attribute: ERROR";
82
83 if ($self->{original}) {
84 $self->{original} = 1;
85 } else {
86 $self->{original} = 0;
87 }
88
89 my $value = "$self->{original}:$self->{target}";
90
91 if (defined($self->{id})) {
92 # update
93
94 $ruledb->{dbh}->do(
95 "UPDATE Object SET Value = ? WHERE ID = ?",
96 undef, $value, $self->{id});
97
98 } else {
99 # insert
100
101 my $sth = $ruledb->{dbh}->prepare(
102 "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
103 "VALUES (?, ?, ?);");
104
105 $sth->execute($self->{ogroup}, $self->otype, $value);
106
107 $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
108 }
109
110 return $self->{id};
111 }
112
113 sub execute {
114 my ($self, $queue, $ruledb, $mod_group, $targets,
115 $msginfo, $vars, $marks) = @_;
116
117 my $subgroups = $mod_group->subgroups($targets, 1);
118
119 my $rulename = encode('UTF-8', $vars->{RULE} // 'unknown');
120
121 my $bcc_to = PMG::Utils::subst_values_for_header($self->{target}, $vars);
122
123 if ($bcc_to =~ m/^\s*$/) {
124 # this happens if a notification is triggered by bounce mails
125 # which notifies the sender <> - we just log and then ignore it
126 syslog('info', "%s: bcc to <> (rule: %s, ignored)", $queue->{logid}, $rulename);
127 return;
128 }
129
130 my @bcc_targets = split (/\s*,\s*/, $bcc_to);
131
132 if ($self->{original}) {
133 $subgroups = [[\@bcc_targets, $mod_group->{entity}]];
134 }
135
136 foreach my $ta (@$subgroups) {
137 my ($tg, $entity) = (@$ta[0], @$ta[1]);
138
139 $entity = $entity->dup();
140 PMG::Utils::remove_marks($entity);
141
142 my $dkim = $msginfo->{dkim} // {};
143 if ($dkim->{sign}) {
144 eval {
145 $entity = PMG::DKIMSign::sign_entity($entity, $dkim, $msginfo->{sender});
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 my $target = encode('UTF-8', $_);
168 if ($qid) {
169 syslog(
170 'info',
171 "%s: bcc to <%s> (rule: %s, %s)",
172 $queue->{logid},
173 $target,
174 $rulename,
175 $qid,
176 );
177 } else {
178 syslog(
179 'err',
180 "%s: bcc to <%s> (rule: %s) failed",
181 $queue->{logid},
182 $target,
183 $rulename,
184 );
185 }
186 }
187 }
188 }
189
190 # warn if no subgroups
191 }
192
193 sub short_desc {
194 my $self = shift;
195
196 my $descr = "send bcc to: $self->{target}";
197
198 $descr .= " (original)" if $self->{original};
199
200 return $descr;
201 }
202
203 sub properties {
204 my ($class) = @_;
205
206 return {
207 target => {
208 description => "Send a Blind Carbon Copy to this email address.",
209 type => 'string', format => 'email',
210 },
211 original =>{
212 description => "Send the original, unmodified mail.",
213 type => 'boolean',
214 optional => 1,
215 default => 1,
216 },
217 };
218 }
219
220 sub get {
221 my ($self) = @_;
222
223 return {
224 target => $self->{target},
225 original => $self->{original},
226 };
227 }
228
229 sub update {
230 my ($self, $param) = @_;
231
232 $self->{target} = $param->{target};
233 $self->{original} = $param->{original} ? 1 : 0;
234 }
235
236 1;
237
238 __END__
239
240 =head1 PMG::RuleDB::BCC
241
242 Send BCC.