]>
Commit | Line | Data |
---|---|---|
3164123a | 1 | #!/usr/bin/perl |
ddaec666 DM |
2 | |
3 | use strict; | |
3164123a | 4 | use warnings; |
ddaec666 | 5 | use Getopt::Long; |
ddaec666 DM |
6 | use POSIX qw(errno_h signal_h); |
7 | ||
8 | use Net::Server::PreForkSimple; | |
9 | use Net::DNS::Resolver; | |
10 | use Mail::SPF; | |
11 | use Fcntl; | |
12 | use Fcntl ':flock'; | |
13 | use IO::Multiplex; | |
3164123a | 14 | use Time::HiRes qw(gettimeofday); |
e189e2d2 | 15 | use Time::Zone; |
ddaec666 | 16 | |
3164123a | 17 | use PVE::INotify; |
e159c0fd | 18 | use PVE::Tools qw($IPV4RE $IPV6RE); |
3164123a | 19 | use PVE::SafeSyslog; |
ddaec666 | 20 | |
3164123a DM |
21 | use PMG::Utils; |
22 | use PMG::RuleDB; | |
23 | use PMG::DBTools; | |
24 | use PMG::RuleCache; | |
25 | use PMG::Config; | |
26 | use PMG::ClusterConfig; | |
27 | ||
28 | use base qw(Net::Server::PreForkSimple); | |
ddaec666 | 29 | |
c2c21ccf SI |
30 | $ENV{'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin'; |
31 | ||
32 | delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; | |
33 | ||
ddaec666 DM |
34 | my $greylist_delay = 3*60; # greylist window |
35 | my $greylist_lifetime = 3600*24*2; # retry window | |
36 | my $greylist_awlifetime = 3600*24*36; # expire window | |
37 | ||
38 | my $opt_commandline = [$0, @ARGV]; | |
7e293a63 | 39 | |
ddaec666 DM |
40 | my $opt_max_dequeue = 1; |
41 | my $opt_dequeue_time = 60*2; | |
42 | ||
43 | my $opt_testmode; | |
44 | my $opt_pidfile; | |
45 | my $opt_database; | |
7e293a63 | 46 | my $opt_policy_port = 10022; |
ddaec666 | 47 | |
7e293a63 TL |
48 | my %_opts = ( |
49 | 'pidfile=s' => \$opt_pidfile, | |
50 | 'testmode' => \$opt_testmode, | |
51 | 'database=s' => \$opt_database, | |
52 | 'port=i' => \$opt_policy_port, | |
53 | ); | |
54 | if (!GetOptions(%_opts)) { | |
ddaec666 DM |
55 | die "usage error\n"; |
56 | exit (-1); | |
57 | } | |
58 | ||
83e9f427 | 59 | $opt_pidfile = "/run/pmgpolicy.pid" if !$opt_pidfile; |
ddaec666 DM |
60 | $opt_max_dequeue = 0 if $opt_testmode; |
61 | ||
3164123a DM |
62 | initlog('pmgpolicy', 'mail'); |
63 | ||
64 | my $max_servers = 5; | |
ddaec666 DM |
65 | |
66 | if (!$opt_testmode) { | |
67 | ||
3164123a DM |
68 | my $pmg_cfg = PMG::Config->new (); |
69 | my $demo = $pmg_cfg->get('admin', 'demo'); | |
70 | $max_servers = $pmg_cfg->get('mail', 'max_policy'); | |
ddaec666 DM |
71 | |
72 | if ($demo) { | |
3164123a DM |
73 | syslog('info', 'demo mode detected - not starting server'); |
74 | exit(0); | |
ddaec666 DM |
75 | } |
76 | } | |
77 | ||
78 | my $daemonize = 1; | |
79 | if (defined ($ENV{BOUND_SOCKETS})) { | |
80 | $daemonize = undef; | |
81 | } | |
82 | ||
ddaec666 DM |
83 | |
84 | my $server_attr = { | |
85 | port => [ $opt_policy_port ], | |
86 | host => '127.0.0.1', | |
87 | max_servers => $max_servers, | |
88 | max_dequeue => $opt_max_dequeue, | |
89 | check_for_dequeue => $opt_dequeue_time, | |
90 | log_level => 3, | |
91 | pid_file => $opt_pidfile, | |
92 | commandline => $opt_commandline, | |
93 | no_close_by_child => 1, | |
94 | setsid => $daemonize, | |
95 | }; | |
96 | ||
97 | my $database; | |
98 | if (defined($opt_database)) { | |
99 | $database = $opt_database; | |
100 | } else { | |
101 | $database = "Proxmox_ruledb"; | |
102 | } | |
103 | ||
104 | $SIG{'__WARN__'} = sub { | |
105 | my $err = $@; | |
106 | my $t = $_[0]; | |
107 | chomp $t; | |
108 | syslog('warning', "WARNING: %s", $t); | |
109 | $@ = $err; | |
110 | }; | |
111 | ||
e189e2d2 DM |
112 | sub update_rbl_stats { |
113 | my ($dbh, $lcid) = @_; | |
114 | ||
2e0e3415 DM |
115 | my ($rbl_count, $pregreet_count) = PMG::Utils::scan_journal_for_rbl_rejects(); |
116 | return if !$rbl_count && !$pregreet_count; | |
e189e2d2 DM |
117 | |
118 | my $timezone = tz_local_offset();; | |
119 | my $hour = int((time() + $timezone)/3600) * 3600; | |
120 | ||
121 | my $sth = $dbh->prepare( | |
2e0e3415 | 122 | 'INSERT INTO LocalStat (Time, RBLCount, PregreetCount, CID, MTime) ' . |
9972a7ce | 123 | 'VALUES (?, ?, ?, ?, EXTRACT(EPOCH FROM now())::INTEGER) ' . |
e189e2d2 DM |
124 | 'ON CONFLICT (Time, CID) DO UPDATE SET ' . |
125 | 'RBLCount = LocalStat.RBLCount + excluded.RBLCount, ' . | |
2e0e3415 | 126 | 'PregreetCount = LocalStat.PregreetCount + excluded.PregreetCount, ' . |
e189e2d2 DM |
127 | 'MTime = excluded.MTime'); |
128 | ||
2e0e3415 | 129 | $sth->execute($hour, $rbl_count, $pregreet_count, $lcid); |
e189e2d2 DM |
130 | $sth->finish(); |
131 | }; | |
132 | ||
ddaec666 DM |
133 | sub run_dequeue { |
134 | my $self = shift; | |
135 | ||
1359baef | 136 | $self->log(2, "starting policy database maintenance (greylist, rbl)"); |
ddaec666 | 137 | |
cff666e6 | 138 | my $cinfo = PMG::ClusterConfig->new(); |
ddaec666 | 139 | my $lcid = $cinfo->{local}->{cid}; |
3164123a DM |
140 | my $role = $cinfo->{local}->{type} // '-'; |
141 | ||
ddaec666 | 142 | my $dbh; |
3164123a | 143 | |
ddaec666 | 144 | eval { |
3164123a | 145 | $dbh = PMG::DBTools::open_ruledb($database); |
ddaec666 DM |
146 | }; |
147 | my $err = $@; | |
148 | ||
149 | if ($err) { | |
b902c0b8 | 150 | $self->log(0, "ERROR: $err"); |
ddaec666 DM |
151 | return; |
152 | } | |
153 | ||
e189e2d2 DM |
154 | my ($csec, $usec) = gettimeofday (); |
155 | ||
156 | eval { update_rbl_stats($dbh, $lcid); }; | |
157 | $err = $@; | |
158 | ||
159 | my ($csec_end, $usec_end) = gettimeofday (); | |
160 | my $rbltime = int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000); | |
161 | ($csec, $usec) = ($csec_end, $usec_end); | |
162 | ||
163 | if ($err) { | |
164 | $self->log(0, "rbl update error: $err"); | |
165 | # continue; | |
166 | } | |
167 | ||
3164123a | 168 | my $now = time(); |
ddaec666 DM |
169 | |
170 | my $ecount = 0; | |
171 | ||
ddaec666 DM |
172 | eval { |
173 | ||
174 | $dbh->begin_work; | |
175 | ||
176 | # we do not lock the table here to avoid delays | |
177 | # but that is OK, because we only touch expired records | |
178 | # which do not change nornmally | |
179 | ## $dbh->do ("LOCK TABLE CGreylist IN ROW EXCLUSIVE MODE"); | |
180 | ||
181 | # move expired and undelivered records from Greylist to Statistic | |
3164123a | 182 | |
ddaec666 | 183 | my $rntxt = ''; |
3164123a | 184 | if (!$lcid) { |
ddaec666 DM |
185 | $rntxt = "AND CID = 0"; |
186 | } else { | |
3164123a | 187 | if ($role eq 'master') { |
ddaec666 DM |
188 | # master is responsible for all non-cluster (deleted) nodes |
189 | foreach my $rcid (@{$cinfo->{remnodes}}) { | |
190 | $rntxt .= $rntxt ? " AND CID != $rcid" : "AND (CID != $rcid"; | |
191 | } | |
192 | $rntxt .= ")" if $rntxt; | |
193 | } else { | |
194 | $rntxt = "AND (CID = 0 OR CID = $lcid)"; | |
195 | } | |
196 | } | |
197 | ||
198 | ||
199 | my $cmds = ''; | |
200 | ||
3164123a DM |
201 | my $sth = $dbh->prepare( |
202 | "SELECT distinct instance, sender FROM CGreylist " . | |
203 | "WHERE passed = 0 AND extime < ? $rntxt"); | |
ddaec666 DM |
204 | |
205 | $sth->execute ($now); | |
206 | ||
207 | ||
208 | while (my $ref = $sth->fetchrow_hashref()) { | |
3164123a DM |
209 | my $sth2 = $dbh->prepare( |
210 | "SELECT * FROM CGreylist WHERE instance = ? AND sender = ?"); | |
ddaec666 DM |
211 | $sth2->execute ($ref->{instance}, $ref->{sender}); |
212 | my $rctime; | |
213 | my @rcvrs; | |
214 | my $bc = 0; | |
215 | ||
216 | while (my $ref2 = $sth2->fetchrow_hashref()) { | |
217 | $rctime = $ref2->{rctime} if !$rctime; | |
218 | $bc += $ref2->{blocked}; | |
219 | push @rcvrs, $ref2->{receiver}; | |
220 | } | |
221 | ||
222 | $sth2->finish(); | |
223 | ||
224 | # hack: sometimes query sth2 does not return anything - maybe a | |
225 | # postgres bug? We simply ignore (when rctime is undefined) it | |
226 | # to avoid problems. | |
227 | ||
228 | if ($rctime) { | |
3164123a DM |
229 | $cmds .= "SELECT nextval ('cstatistic_id_seq');" . |
230 | "INSERT INTO CStatistic " . | |
ddaec666 DM |
231 | "(CID, RID, ID, Time, Bytes, Direction, Spamlevel, VirusInfo, PTime, Sender) VALUES (" . |
232 | "$lcid, currval ('cstatistic_id_seq'), currval ('cstatistic_id_seq'), "; | |
233 | ||
234 | my $sl = $bc >= 100000 ? 4 : 5; | |
235 | $cmds .= $rctime . ", 0, '1', $sl, NULL, 0, "; | |
236 | $cmds .= $dbh->quote ($ref->{sender}) . ');'; | |
237 | ||
238 | foreach my $r (@rcvrs) { | |
239 | my $tmp = $dbh->quote ($r); | |
240 | $cmds .= "INSERT INTO CReceivers (CStatistic_CID, CStatistic_RID, Receiver, Blocked) ". | |
241 | "VALUES ($lcid, currval ('cstatistic_id_seq'), $tmp, '1'); "; | |
242 | } | |
243 | } | |
244 | ||
245 | if (length ($cmds) > 100000) { | |
246 | $dbh->do ($cmds); | |
247 | $cmds = ''; | |
248 | } | |
249 | ||
ddaec666 DM |
250 | $ecount++; |
251 | ||
252 | # this produces too much log traffic | |
253 | # my $targets = join (", ", @rcvrs); | |
254 | #my $msg = "expire mail $ref->{instance} from $ref->{sender} to $targets"; | |
b902c0b8 | 255 | #$self->log (0, $msg); |
ddaec666 DM |
256 | } |
257 | ||
258 | $dbh->do ($cmds) if $cmds; | |
259 | ||
260 | $sth->finish(); | |
261 | ||
262 | if ($ecount > 0) { | |
263 | my $msg = "found $ecount expired mails in greylisting database"; | |
264 | $self->log (0, $msg); | |
265 | } | |
266 | ||
267 | $dbh->do ("DELETE FROM CGreylist WHERE extime < $now"); | |
268 | ||
269 | $dbh->commit; | |
270 | }; | |
ddaec666 DM |
271 | $err = $@; |
272 | ||
e189e2d2 | 273 | ($csec_end, $usec_end) = gettimeofday (); |
ddaec666 DM |
274 | my $ptime = int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000); |
275 | ||
276 | if ($err) { | |
277 | $dbh->rollback if $dbh; | |
e189e2d2 | 278 | $self->log(0, "greylist database update error: $err"); |
ddaec666 DM |
279 | } |
280 | ||
1359baef | 281 | $self->log(2, "end policy database maintenance ($rbltime ms, $ptime ms)"); |
e189e2d2 | 282 | |
ddaec666 DM |
283 | $dbh->disconnect() if $dbh; |
284 | } | |
285 | ||
286 | sub pre_loop_hook { | |
3164123a | 287 | my $self = shift; |
ddaec666 | 288 | |
3164123a | 289 | my $prop = $self->{server}; |
ddaec666 | 290 | |
3164123a | 291 | $prop->{log_level} = 3; |
ddaec666 | 292 | |
76bf5338 | 293 | $self->log('info', "Policy daemon (re)started"); |
ddaec666 | 294 | |
3164123a DM |
295 | $SIG{'USR1'} = sub { |
296 | # reloading server configuration | |
297 | if (defined $prop->{children}) { | |
298 | foreach my $pid (keys %{$prop->{children}}) { | |
1359baef | 299 | kill(10, $pid); # SIGUSR1 children |
3164123a DM |
300 | } |
301 | } | |
302 | }; | |
ddaec666 | 303 | |
3164123a DM |
304 | my $sig_set = POSIX::SigSet->new; |
305 | $sig_set->addset (&POSIX::SIGHUP); | |
306 | $sig_set->addset (&POSIX::SIGCHLD); | |
307 | my $old_sig_set = POSIX::SigSet->new(); | |
308 | ||
309 | sigprocmask (SIG_UNBLOCK, $sig_set, $old_sig_set); | |
ddaec666 DM |
310 | } |
311 | ||
312 | sub load_config { | |
3164123a | 313 | my $self = shift; |
ddaec666 | 314 | |
3164123a | 315 | my $prop = $self->{server}; |
ddaec666 | 316 | |
3164123a | 317 | if ($self->{ruledb}) { |
76bf5338 | 318 | $self->log('info', "reloading configuration $database"); |
3164123a DM |
319 | $self->{ruledb}->close(); |
320 | } | |
ddaec666 | 321 | |
3164123a | 322 | my $pmg_cfg = PMG::Config->new (); |
3164123a DM |
323 | $self->{use_spf} = $pmg_cfg->get('mail', 'spf'); |
324 | $self->{use_greylist} = $pmg_cfg->get('mail', 'greylist'); | |
e159c0fd | 325 | $self->{use_greylist6} = $pmg_cfg->get('mail', 'greylist6'); |
a01b071c SI |
326 | $self->{greylistmask4} = $pmg_cfg->get('mail', 'greylistmask4'); |
327 | $self->{greylistmask6} = $pmg_cfg->get('mail', 'greylistmask6'); | |
ddaec666 | 328 | |
1dc67c8f DM |
329 | if ($opt_testmode) { |
330 | $self->{use_spf} = 1; | |
331 | $self->{use_greylist} = 1; | |
e159c0fd | 332 | $self->{use_greylist6} = 1; |
1dc67c8f DM |
333 | } |
334 | ||
3164123a | 335 | my $nodename = PVE::INotify::nodename(); |
4bb79830 | 336 | $self->{fqdn} = PVE::Tools::get_fqdn($nodename); |
ddaec666 | 337 | |
cff666e6 | 338 | my $cinfo = PMG::ClusterConfig->new(); |
3164123a DM |
339 | my $lcid = $cinfo->{local}->{cid}; |
340 | $self->{cinfo} = $cinfo; | |
341 | $self->{lcid} = $lcid; | |
ddaec666 | 342 | |
3164123a | 343 | my $dbh; |
ddaec666 | 344 | |
3164123a DM |
345 | eval { |
346 | $dbh = PMG::DBTools::open_ruledb($database); | |
347 | $self->{ruledb} = PMG::RuleDB->new($dbh); | |
348 | $self->{rulecache} = PMG::RuleCache->new($self->{ruledb}); | |
349 | }; | |
350 | if (my $err = $@) { | |
b902c0b8 | 351 | $self->log(0, "ERROR: unable to load database : $err"); |
3164123a | 352 | } |
ddaec666 | 353 | |
3164123a DM |
354 | $self->{reload_config} = 0; |
355 | } | |
ddaec666 | 356 | |
3164123a DM |
357 | sub child_init_hook { |
358 | my $self = shift; | |
359 | ||
360 | my $prop = $self->{server}; | |
ddaec666 | 361 | |
3164123a | 362 | $0 = 'pmgpolicy child'; |
ddaec666 | 363 | |
3164123a DM |
364 | setup_fork_signal_mask(0); # unblocking signals for children |
365 | ||
366 | eval { | |
367 | $self->load_config(); | |
368 | ||
369 | $self->{mux} = IO::Multiplex->new(); | |
370 | $self->{mux}->set_callback_object($self); | |
371 | ||
372 | my %dnsargs = ( | |
373 | tcp_timeout => 3, | |
374 | udp_timeout => 3, | |
375 | retry => 1, | |
376 | retrans => 0, | |
377 | dnsrch => 0, | |
378 | defnames => 0, | |
379 | ); | |
380 | ||
381 | if ($opt_testmode) { | |
382 | # $dnsargs{nameservers} = [ qw (213.129.232.1 213.129.226.2) ]; | |
383 | } | |
ddaec666 | 384 | |
3164123a DM |
385 | $self->{dns_resolver} = Net::DNS::Resolver->new(%dnsargs); |
386 | ||
387 | $self->{spf_server} = Mail::SPF::Server->new( | |
59b64376 SI |
388 | hostname => $self->{fqdn}, dns_resolver => $self->{dns_resolver}, |
389 | default_authority_explanation => 'Rejected by SPF: %{C} is not a designated mailserver for %{S} (context %{_scope}, on %{R})'); | |
3164123a DM |
390 | }; |
391 | if (my $err = $@) { | |
b902c0b8 | 392 | $self->log(0, $err); |
3164123a DM |
393 | $self->child_finish_hook; |
394 | exit(-1); | |
395 | } | |
396 | ||
397 | $SIG{'USR1'} = sub { | |
398 | $self->{reload_config} = 1; | |
399 | } | |
ddaec666 DM |
400 | } |
401 | ||
402 | sub child_finish_hook { | |
3164123a | 403 | my $self = shift; |
ddaec666 | 404 | |
3164123a | 405 | my $prop = $self->{server}; |
ddaec666 | 406 | |
3164123a DM |
407 | $self->{ruledb}->close() if $self->{ruledb}; |
408 | } | |
ddaec666 DM |
409 | |
410 | sub get_spf_result { | |
411 | my ($self, $instance, $ip, $helo, $sender) = @_; | |
412 | ||
413 | my $result; | |
414 | my $spf_header; | |
415 | my $local_expl; | |
416 | my $auth_expl; | |
417 | ||
418 | # we only use helo tests when we have no sender, | |
1359baef | 419 | # helo is sometimes empty, so we can't use SPF helo tests |
ddaec666 DM |
420 | # in that case - strange |
421 | if ($helo && !$sender) { | |
422 | my $query; | |
423 | ||
3164123a | 424 | if (defined ($self->{cache}->{$instance}) && |
ddaec666 DM |
425 | defined ($self->{cache}->{$instance}->{spf_helo_result})) { |
426 | ||
427 | $query = $self->{cache}->{$instance}->{spf_helo_result}; | |
428 | ||
429 | } else { | |
3164123a DM |
430 | my $request = Mail::SPF::Request->new( |
431 | scope => 'helo', identity => $helo, ip_address => $ip); | |
432 | ||
433 | $query = $self->{cache}->{$instance}->{spf_helo_result} = | |
ddaec666 DM |
434 | $self->{spf_server}->process ($request); |
435 | } | |
436 | ||
437 | $result = $query->code; | |
438 | $spf_header = $query->received_spf_header; | |
439 | $local_expl = $query->local_explanation; | |
440 | $auth_expl = $query->authority_explanation if $query->is_code('fail'); | |
441 | ||
442 | # return if we get a definitive result | |
443 | if ($result eq 'pass' || $result eq 'fail' || $result eq 'temperror') { | |
444 | return ($result, $spf_header, $local_expl, $auth_expl); | |
445 | } | |
446 | } | |
447 | ||
448 | if ($sender) { | |
449 | ||
450 | my $query; | |
451 | ||
3164123a | 452 | if (defined ($self->{cache}->{$instance}) && |
ddaec666 | 453 | defined ($self->{cache}->{$instance}->{spf_mfrom_result})) { |
3164123a | 454 | |
ddaec666 DM |
455 | $query = $self->{cache}->{$instance}->{spf_mfrom_result}; |
456 | ||
457 | } else { | |
458 | ||
3164123a DM |
459 | my $request = Mail::SPF::Request->new( |
460 | scope => 'mfrom', identity => $sender, | |
461 | ip_address => $ip, helo_identity => $helo); | |
462 | ||
ddaec666 DM |
463 | $query = $self->{cache}->{$instance}->{spf_mfrom_result} = |
464 | $self->{spf_server}->process($request); | |
465 | } | |
466 | ||
467 | $result = $query->code; | |
468 | $spf_header = $query->received_spf_header; | |
469 | $local_expl = $query->local_explanation; | |
470 | $auth_expl = $query->authority_explanation if $query->is_code('fail'); | |
471 | ||
472 | return ($result, $spf_header, $local_expl, $auth_expl); | |
473 | } | |
474 | ||
475 | return undef; | |
476 | } | |
477 | ||
478 | sub is_backup_mx { | |
479 | my ($self, $ip, $receiver) = @_; | |
480 | ||
481 | my ($rdomain) = $receiver =~ /([^@]+)$/; | |
482 | ||
483 | my $dkey = "BKMX:$rdomain"; | |
484 | ||
485 | if (defined ($self->{cache}->{$dkey}) && | |
486 | ($self->{cache}->{$dkey}->{status} == 1)) { | |
487 | return $self->{cache}->{$dkey}->{$ip}; | |
488 | } | |
489 | ||
490 | my $resolver = $self->{dns_resolver}; | |
491 | ||
3164123a | 492 | if (my $mx = $resolver->send($rdomain, 'MX')) { |
ddaec666 DM |
493 | $self->{cache}->{$dkey}->{status} = 1; |
494 | my @mxa = grep { $_->type eq 'MX' } $mx->answer; | |
495 | my @mxl = sort { $a->preference <=> $b->preference } @mxa; | |
1359baef | 496 | # shift @mxl; # optionally skip primary MX ? |
ddaec666 DM |
497 | foreach my $rr (@mxl) { |
498 | my $a = $resolver->send ($rr->exchange, 'A'); | |
499 | if ($a) { | |
500 | foreach my $rra ($a->answer) { | |
501 | if ($rra->type eq 'A') { | |
502 | $self->{cache}->{$dkey}->{$rra->address} = 1; | |
503 | } | |
504 | } | |
505 | } | |
506 | } | |
507 | } else { | |
508 | $self->{cache}->{$dkey}->{status} = 0; | |
509 | } | |
510 | ||
511 | return $self->{cache}->{$dkey}->{$ip}; | |
512 | } | |
513 | ||
514 | sub greylist_value { | |
515 | my ($self, $ctime, $helo, $ip, $sender, $rcpt, $instance) = @_; | |
516 | ||
517 | my $rulecache = $self->{rulecache}; | |
518 | ||
519 | my $dbh = $self->{ruledb}->{dbh}; | |
520 | ||
521 | # try to reconnect if database connection is broken | |
522 | if (!$dbh->ping) { | |
3164123a | 523 | $self->log(0, 'Database connection broken - trying to reconnect'); |
ddaec666 DM |
524 | my $dbh; |
525 | eval { | |
3164123a | 526 | $dbh = PMG::DBTools::open_ruledb($database); |
ddaec666 DM |
527 | }; |
528 | my $err = $@; | |
529 | if ($err) { | |
b902c0b8 | 530 | $self->log(0, "unable to reconnect to database server: $err"); |
ddaec666 DM |
531 | return 'dunno'; |
532 | } | |
3164123a | 533 | $self->{ruledb} = PMG::RuleDB->new($dbh); |
ddaec666 DM |
534 | } |
535 | ||
536 | # some sender substitutions | |
537 | my ($user, $domain) = split('@', $sender, 2); | |
538 | if (defined ($user) && defined ($domain)) { | |
539 | # see http://cr.yp.to/proto/verp.txt | |
540 | $user =~ s/\+.*//; # strip extensions (mailing-list VERP) | |
1359baef | 541 | $user =~ s/\b\d+\b/#/g; #replace numbers in VERP address |
ddaec666 DM |
542 | $sender = "$user\@$domain"; |
543 | } | |
544 | ||
3164123a DM |
545 | if ($self->is_backup_mx($ip, $rcpt)) { |
546 | $self->log(3, "accept mails from backup MX host - $ip"); | |
ddaec666 DM |
547 | return 'dunno'; |
548 | } | |
549 | ||
550 | # greylist exclusion (sender whitelist) | |
551 | if ($rulecache->greylist_match ($sender, $ip)) { | |
3164123a | 552 | $self->log(3, "accept mails from whitelist - $ip"); |
ddaec666 DM |
553 | return 'dunno'; |
554 | } | |
555 | ||
ddaec666 DM |
556 | # greylist exclusion (receiver whitelist) |
557 | if ($rulecache->greylist_match_receiver ($rcpt)) { | |
3164123a | 558 | $self->log(3, "accept mails to whitelist - <$rcpt>"); |
ddaec666 DM |
559 | return 'dunno'; |
560 | } | |
561 | ||
e159c0fd SI |
562 | my $masklen; |
563 | my $do_greylist = 0; | |
564 | if ($ip =~ m/$IPV4RE/) { | |
a01b071c | 565 | $masklen = $self->{greylistmask4}; |
e159c0fd SI |
566 | $do_greylist = $self->{use_greylist}; |
567 | } elsif ($ip =~ m/$IPV6RE/) { | |
a01b071c | 568 | $masklen = $self->{greylistmask6}; |
e159c0fd SI |
569 | $do_greylist = $self->{use_greylist6}; |
570 | } else { | |
571 | return 'dunno'; | |
572 | } | |
8a35c2e4 | 573 | |
ddaec666 DM |
574 | my $spf_header; |
575 | ||
3164123a | 576 | if ((!$opt_testmode && $self->{use_spf}) || |
ddaec666 DM |
577 | ($opt_testmode && ($rcpt =~ m/^testspf/))) { |
578 | ||
579 | # ask SPF | |
580 | my $spf_result; | |
581 | my $local_expl, | |
582 | my $auth_expl; | |
583 | ||
584 | my $previous_alarm; | |
585 | ||
586 | my ($result, $smtp_comment, $header_comment); | |
587 | ||
588 | eval { | |
3164123a | 589 | $previous_alarm = alarm(10); |
ddaec666 | 590 | local $SIG{ALRM} = sub { die "SPF timeout\n" }; |
3164123a DM |
591 | |
592 | ($result, $spf_header, $local_expl, $auth_expl) = | |
593 | $self->get_spf_result($instance, $ip, $helo, $sender); | |
594 | ||
595 | alarm(0); # avoid race condition | |
ddaec666 | 596 | }; |
ddaec666 DM |
597 | my $err = $@; |
598 | ||
3164123a | 599 | alarm($previous_alarm) if defined($previous_alarm); |
ddaec666 DM |
600 | |
601 | if ($err) { | |
602 | $err = $err->text if UNIVERSAL::isa ($err, 'Mail::SPF::Exception'); | |
b902c0b8 | 603 | $self->log (0, $err); |
ddaec666 DM |
604 | } else { |
605 | ||
606 | if ($result && $result eq 'pass') { | |
3164123a | 607 | $self->log(3, "SPF says $result"); |
ddaec666 DM |
608 | $spf_result = $spf_header ? "prepend $spf_header" : 'dunno'; |
609 | } | |
3164123a | 610 | |
ddaec666 | 611 | if ($result && $result eq 'fail') { |
3164123a DM |
612 | $self->log(3, "SPF says $result"); |
613 | $spf_result = "reject ${auth_expl}"; | |
614 | ||
ddaec666 DM |
615 | eval { |
616 | ||
617 | $dbh->begin_work; | |
618 | ||
619 | # try to avoid locks everywhere - we use merge instead of insert | |
620 | #$dbh->do ("LOCK TABLE CGreylist IN ROW EXCLUSIVE MODE"); | |
3164123a | 621 | |
ddaec666 | 622 | # check if there is already a record in the GL database |
3164123a DM |
623 | my $sth = $dbh->prepare( |
624 | "SELECT * FROM CGreylist " . | |
f61d5489 SI |
625 | "WHERE IPNet::cidr = network(set_masklen(?, ?)) AND ". |
626 | "Sender = ? AND Receiver = ?"); | |
ddaec666 | 627 | |
f61d5489 | 628 | $sth->execute($ip, $masklen, $sender, $rcpt); |
ddaec666 DM |
629 | my $ref = $sth->fetchrow_hashref(); |
630 | $sth->finish(); | |
631 | ||
632 | # else add an entry to the GL Database with short | |
3164123a | 633 | # expiration time. run_dequeue() moves those entries into the statistic |
ddaec666 DM |
634 | # table later. We set 'blocked' to 100000 to identify those entries. |
635 | ||
3164123a | 636 | if (!defined($ref->{rctime})) { |
f61d5489 | 637 | $dbh->do(PMG::DBTools::cgreylist_merge_sql(1), undef, |
4e5d7fd8 | 638 | $ip, $masklen, $sender, $rcpt, $instance, |
3164123a | 639 | $ctime, $ctime + 10, 0, 100000, 0, $ctime, $self->{lcid}); |
ddaec666 DM |
640 | } |
641 | ||
642 | $dbh->commit; | |
643 | }; | |
3164123a | 644 | if (my $err = $@) { |
ddaec666 | 645 | $dbh->rollback; |
b902c0b8 | 646 | $self->log(0, $err); |
ddaec666 DM |
647 | } |
648 | } | |
649 | } | |
650 | ||
651 | return $spf_result if $spf_result; | |
652 | } | |
653 | ||
654 | ||
fd218150 DM |
655 | my $res = 'dunno'; |
656 | ||
657 | # add spf_header once - SA can re-use this information | |
658 | if (!defined($self->{cache}->{$instance}) || | |
659 | !$self->{cache}->{$instance}->{spf_header_added}) { | |
660 | $res = "prepend $spf_header" if $spf_header; | |
661 | $self->{cache}->{$instance}->{spf_header_added} = 1; | |
662 | } | |
ddaec666 | 663 | |
e159c0fd | 664 | return $res if !$do_greylist; |
ddaec666 | 665 | |
3164123a DM |
666 | my $defer_res = "defer_if_permit Service is unavailable (try later)"; |
667 | ||
ddaec666 DM |
668 | eval { |
669 | ||
1359baef | 670 | # we don't use alarm here, because it does not work with DBI |
ddaec666 DM |
671 | |
672 | $dbh->begin_work; | |
673 | ||
674 | # try to avoid locks everywhere - we use merge instead of insert | |
675 | #$dbh->do ("LOCK TABLE CGreylist IN ROW EXCLUSIVE MODE"); | |
676 | ||
3164123a DM |
677 | my $sth = $dbh->prepare( |
678 | "SELECT * FROM CGreylist " . | |
f61d5489 SI |
679 | "WHERE IPNet::cidr = network(set_masklen(?, ?)) AND ". |
680 | "Sender = ? AND Receiver = ?"); | |
3164123a | 681 | |
f61d5489 | 682 | $sth->execute($ip, $masklen, $sender, $rcpt); |
ddaec666 | 683 | |
ddaec666 DM |
684 | my $ref = $sth->fetchrow_hashref(); |
685 | ||
686 | $sth->finish(); | |
687 | ||
3164123a | 688 | if (!defined($ref->{rctime})) { |
ddaec666 | 689 | |
7767ca52 TL |
690 | $dbh->do( |
691 | PMG::DBTools::cgreylist_merge_sql(1), undef, $ip, $masklen, | |
4e5d7fd8 | 692 | $sender, $rcpt, $instance, $ctime, $ctime + $greylist_lifetime, |
7767ca52 TL |
693 | 0, 1, 0, $ctime, $self->{lcid} |
694 | ); | |
ddaec666 DM |
695 | |
696 | $res = $defer_res; | |
3164123a | 697 | $self->log(3, "defer greylisted mail"); |
ddaec666 | 698 | } else { |
3164123a | 699 | my $age = $ctime - $ref->{rctime}; |
ddaec666 DM |
700 | |
701 | if ($age < $greylist_delay) { | |
702 | # defer (resent within greylist_delay window) | |
703 | $res = $defer_res; | |
3164123a | 704 | $self->log(3, "defer greylisted mail"); |
7767ca52 TL |
705 | $dbh->do( |
706 | "UPDATE CGreylist " . | |
707 | "SET Blocked = Blocked + 1, MTime = ? " . | |
708 | "WHERE IPNet::cidr = network(set_masklen(?, ?)) ". | |
709 | " AND Sender = ? AND Receiver = ?", undef, | |
710 | $ctime, $ip, $masklen, $sender, $rcpt | |
711 | ); | |
ddaec666 DM |
712 | } else { |
713 | if ($ctime < $ref->{extime}) { | |
714 | # accept (not expired) | |
715 | my $lifetime = $sender eq "" ? 0 : $greylist_awlifetime; | |
716 | my $delay = $ref->{passed} ? "" : "Delay = $age, "; | |
7767ca52 TL |
717 | $dbh->do( |
718 | "UPDATE CGreylist " . | |
719 | "SET Passed = Passed + 1, $delay ExTime = ?, MTime = ? " . | |
720 | "WHERE IPNet::cidr = network(set_masklen(?, ?)) ". | |
721 | " AND Sender = ? AND Receiver = ?", undef, | |
722 | $ctime + $lifetime, $ctime, $ip, $masklen, $sender, $rcpt | |
723 | ); | |
ddaec666 DM |
724 | } else { |
725 | # defer (record is expired) | |
726 | $res = $defer_res; | |
7767ca52 TL |
727 | $dbh->do( |
728 | "UPDATE CGreylist " . | |
729 | "SET RCTime = ?, ExTime = ?, MTime = ?, Instance = ?, " . | |
730 | "Blocked = 1, Passed = 0 " . | |
731 | "WHERE IPNet::cidr = network(set_masklen(?, ?)) ". | |
732 | " AND Sender = ? AND Receiver = ?", undef, | |
733 | $ctime, $ctime + $greylist_lifetime, $ctime, $instance, | |
734 | $ip, $masklen, $sender, $rcpt | |
735 | ); | |
ddaec666 | 736 | } |
3164123a | 737 | } |
ddaec666 DM |
738 | } |
739 | ||
740 | $dbh->commit; | |
741 | }; | |
3164123a DM |
742 | if (my $err = $@) { |
743 | $dbh->rollback; | |
b902c0b8 | 744 | $self->log (0, $err); |
ddaec666 DM |
745 | } |
746 | ||
747 | return $res; | |
748 | } | |
749 | ||
3164123a | 750 | # shutdown connections: we need this - else file handles are |
ddaec666 DM |
751 | # not closed and we run out of handles |
752 | sub mux_eof { | |
753 | my ($self, $mux, $fh) = @_; | |
754 | ||
755 | $mux->shutdown($fh, 1); | |
756 | } | |
757 | ||
c196a54a DM |
758 | |
759 | my $last_reload_test = 0; | |
760 | my $last_confid_version; | |
761 | my (undef, $pmgconffilename) = PVE::INotify::ccache_info('pmg.conf'); | |
762 | sub test_config_version { | |
763 | ||
764 | my $ctime = time(); | |
765 | ||
766 | if (($ctime - $last_reload_test) < 5) { return 0; } | |
767 | ||
768 | $last_reload_test = $ctime; | |
769 | ||
770 | my $version = PVE::INotify::poll_changes($pmgconffilename); | |
771 | ||
772 | if (!defined($last_confid_version) || | |
773 | $last_confid_version != $version) { | |
774 | $last_confid_version = $version; | |
775 | return 1; | |
776 | } | |
777 | ||
778 | return 0; | |
779 | } | |
780 | ||
ddaec666 DM |
781 | sub mux_input { |
782 | my ($self, $mux, $fh, $dataref) = @_; | |
783 | my $prop = $self->{server}; | |
3164123a | 784 | |
ddaec666 DM |
785 | my $attribute = {}; |
786 | ||
787 | eval { | |
c196a54a | 788 | $self->{reload_config} = 1 if test_config_version(); |
3164123a | 789 | $self->load_config() if $self->{reload_config}; |
ddaec666 DM |
790 | |
791 | while ($$dataref =~ s/^([^\r\n]*)\r?\n//) { | |
792 | my $line = $1; | |
793 | next if !defined ($line); | |
794 | ||
795 | if ($line =~ m/([^=]+)=(.*)/) { | |
796 | $attribute->{substr($1, 0, 255)} = substr($2, 0, 255); | |
3164123a | 797 | } elsif ($line eq '') { |
ddaec666 DM |
798 | my $res = 'dunno'; |
799 | my $ctime = time; | |
800 | ||
801 | if ($opt_testmode) { | |
802 | die "undefined test time :ERROR" if !defined $attribute->{testtime}; | |
803 | $ctime = $attribute->{testtime}; | |
804 | } | |
805 | ||
3164123a | 806 | if ($attribute->{instance} && $attribute->{recipient} && |
ddaec666 DM |
807 | $attribute->{client_address} && $attribute->{request} && |
808 | $attribute->{request} eq 'smtpd_access_policy') { | |
3164123a | 809 | |
ddaec666 | 810 | eval { |
3164123a DM |
811 | |
812 | $res = $self->greylist_value( | |
813 | $ctime, | |
814 | lc ($attribute->{helo_name}), | |
815 | lc ($attribute->{client_address}), | |
816 | lc ($attribute->{sender}), | |
817 | lc ($attribute->{recipient}), | |
818 | lc ($attribute->{instance})); | |
ddaec666 | 819 | }; |
3164123a | 820 | if (my $err = $@) { |
b902c0b8 | 821 | $self->log(0, $err); |
3164123a | 822 | } |
ddaec666 DM |
823 | } |
824 | ||
825 | print $fh "action=$res\n\n"; | |
826 | ||
827 | $attribute = {}; | |
828 | } else { | |
3164123a | 829 | $self->log(0, "greylist policy protocol error - got '%s'", $line); |
ddaec666 DM |
830 | } |
831 | } | |
832 | }; | |
3164123a | 833 | my $err = $@; |
ddaec666 DM |
834 | |
835 | # remove remaining data, if any | |
836 | if ($$dataref ne '') { | |
3164123a | 837 | $self->log(0, "greylist policy protocol error - unused data '%s'", $$dataref); |
ddaec666 DM |
838 | $$dataref = ''; |
839 | } | |
840 | ||
b902c0b8 | 841 | $self->log(0, $err) if $err; |
ddaec666 DM |
842 | } |
843 | ||
844 | sub restart_close_hook { | |
3164123a | 845 | my $self = shift; |
ddaec666 | 846 | |
3164123a DM |
847 | my $sig_set = POSIX::SigSet->new; |
848 | $sig_set->addset(&POSIX::SIGHUP); | |
849 | $sig_set->addset(&POSIX::SIGCHLD); # to avoid zombies | |
850 | my $old_sig_set = POSIX::SigSet->new(); | |
ddaec666 | 851 | |
3164123a | 852 | sigprocmask(SIG_BLOCK, $sig_set, $old_sig_set); |
ddaec666 DM |
853 | } |
854 | ||
855 | sub pre_server_close_hook { | |
3164123a DM |
856 | my $self = shift; |
857 | ||
858 | my $prop = $self->{server}; | |
ddaec666 | 859 | |
3164123a DM |
860 | if (defined $prop->{_HUP}) { |
861 | undef $prop->{pid_file_unlink}; | |
862 | } | |
08f49442 DM |
863 | |
864 | if (defined $prop->{children}) { | |
865 | foreach my $pid (keys %{$prop->{children}}) { | |
1359baef | 866 | kill(1, $pid); # HUP children |
08f49442 DM |
867 | } |
868 | } | |
869 | ||
1359baef | 870 | # nicely shutdown children (give them max 30 seconds to shut down) |
08f49442 DM |
871 | my $previous_alarm = alarm(30); |
872 | eval { | |
873 | local $SIG{ALRM} = sub { die "Timed Out!\n" }; | |
874 | ||
875 | my $pid; | |
876 | 1 while ((($pid = waitpid(-1, 0)) > 0) || ($! == EINTR)); | |
877 | ||
878 | alarm(0); # avoid race | |
879 | }; | |
880 | alarm ($previous_alarm); | |
ddaec666 DM |
881 | } |
882 | ||
883 | sub setup_fork_signal_mask { | |
884 | my $block = shift; | |
885 | ||
886 | my $sig_set = POSIX::SigSet->new; | |
3164123a DM |
887 | $sig_set->addset(&POSIX::SIGINT); |
888 | $sig_set->addset(&POSIX::SIGTERM); | |
889 | $sig_set->addset(&POSIX::SIGQUIT); | |
890 | $sig_set->addset(&POSIX::SIGHUP); | |
ddaec666 DM |
891 | my $old_sig_set = POSIX::SigSet->new(); |
892 | ||
893 | if ($block) { | |
894 | sigprocmask (SIG_BLOCK, $sig_set, $old_sig_set); | |
895 | } else { | |
896 | sigprocmask (SIG_UNBLOCK, $sig_set, $old_sig_set); | |
897 | } | |
898 | } | |
899 | ||
900 | # subroutine to start up a specified number of children. | |
901 | # We need to block signals until handlers are set up correctly. | |
3164123a | 902 | # Else its possible that HUP occurs after fork, which triggers |
1359baef | 903 | # signal TERM at children and calls server_close() instead of |
ddaec666 DM |
904 | # simply exit the child. |
905 | # Note: on server startup signals are setup to trigger | |
906 | # asynchronously for a short period of time (in PreForkSimple]::loop, | |
3164123a | 907 | # run_n_children is called before run_parent) |
ddaec666 | 908 | # Net::Server::PreFork does not have this problem, because it is using |
3164123a | 909 | # signal HUP stop children |
ddaec666 | 910 | sub run_n_children { |
3164123a DM |
911 | my ($self, $n) = @_; |
912 | ||
ddaec666 | 913 | my $prop = $self->{server}; |
ddaec666 | 914 | |
3164123a DM |
915 | setup_fork_signal_mask(1); # block signals |
916 | ||
917 | $self->SUPER::run_n_children($n); | |
ddaec666 | 918 | |
3164123a | 919 | setup_fork_signal_mask(0); # unblocking signals for parent |
ddaec666 DM |
920 | } |
921 | ||
83e9f427 | 922 | # test sig_hup with: for ((;;)) ;do kill -HUP `cat /run/pmgpolicy.pid`; done; |
ddaec666 DM |
923 | # wrapper to avoid multiple calls to sig_hup |
924 | sub sig_hup { | |
3164123a DM |
925 | my $self = shift; |
926 | ||
927 | my $prop = $self->{server}; | |
ddaec666 | 928 | |
3164123a | 929 | return if defined($prop->{_HUP}); # do not call twice |
ddaec666 | 930 | |
3164123a | 931 | $self->SUPER::sig_hup(); |
ddaec666 DM |
932 | } |
933 | ||
934 | ### child process which will accept on the port | |
935 | sub run_child { | |
3164123a | 936 | my $self = shift; |
ddaec666 | 937 | |
3164123a | 938 | my $prop = $self->{server}; |
ddaec666 | 939 | |
3164123a | 940 | $self->log(4, "Child Preforked ($$)\n"); |
ddaec666 | 941 | |
3164123a DM |
942 | # set correct signal handlers before enabling signals again |
943 | $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub { | |
944 | $self->child_finish_hook; | |
945 | exit; | |
946 | }; | |
ddaec666 | 947 | |
3164123a | 948 | delete $prop->{children}; |
ddaec666 | 949 | |
3164123a | 950 | $self->child_init_hook; |
ddaec666 | 951 | |
3164123a | 952 | # accept connections |
ddaec666 | 953 | |
3164123a | 954 | my $sock = $prop->{sock}->[0]; |
ddaec666 | 955 | |
3164123a DM |
956 | # make sure we got a good sock |
957 | if (!defined ($sock)){ | |
958 | $self->log(0, "ERROR: Received a bad socket"); | |
959 | exit (-1); | |
960 | } | |
961 | ||
962 | # sometimes the socket is not usable, don't know why | |
963 | my $flags = fcntl($sock, F_GETFL, 0); | |
964 | if (!$flags) { | |
b902c0b8 | 965 | $self->log(0, "socket not ready - $!"); |
3164123a DM |
966 | exit (-1); |
967 | } | |
ddaec666 | 968 | |
3164123a DM |
969 | # cache is limited, because postfix does max. 100 queries |
970 | $self->{cache} = {}; | |
ddaec666 | 971 | |
3164123a DM |
972 | eval { |
973 | my $mux = $self->{mux}; | |
974 | $mux->listen ($sock); | |
975 | $mux->loop; | |
976 | }; | |
977 | if (my $err = $@) { | |
b902c0b8 | 978 | $self->log(0, "ERROR: $err"); |
3164123a | 979 | } |
ddaec666 | 980 | |
3164123a | 981 | $self->child_finish_hook; |
ddaec666 | 982 | |
3164123a | 983 | exit; |
ddaec666 DM |
984 | } |
985 | ||
3164123a DM |
986 | my $syslog_map = { |
987 | 0 => 'err', | |
988 | 1 => 'warning', | |
989 | 2 => 'notice', | |
990 | 3 => 'info', | |
991 | 4 => 'debug' | |
992 | }; | |
993 | ||
ddaec666 DM |
994 | sub log { |
995 | my ($self, $level, $msg, @therest) = @_; | |
3164123a | 996 | |
ddaec666 DM |
997 | my $prop = $self->{server}; |
998 | ||
999 | return if $level =~ /^\d+$/ && $level > $prop->{log_level}; | |
1000 | ||
3164123a | 1001 | $level = $syslog_map->{$level} || $level; |
ddaec666 DM |
1002 | if (@therest) { |
1003 | syslog($level, $msg, @therest); | |
1004 | } else { | |
1005 | syslog ($level, $msg); | |
1006 | } | |
1007 | } | |
1008 | ||
1009 | my $server = bless { | |
1010 | server => $server_attr, | |
1011 | }; | |
1012 | ||
1013 | $server->sig_chld(); # avoid zombies after restart | |
1014 | ||
1015 | $server->run (); | |
1016 | ||
1017 | exit (0); | |
1018 | ||
1019 | __END__ | |
1020 | ||
1021 | =head1 NAME | |
3164123a DM |
1022 | |
1023 | pmgpolicy - The Proxmox policy daemon | |
ddaec666 DM |
1024 | |
1025 | =head1 SYNOPSIS | |
1026 | ||
3164123a | 1027 | pmgpolicy |
ddaec666 DM |
1028 | |
1029 | =head1 DESCRIPTION | |
1030 | ||
1031 | Documentation is available at www.proxmox.com |