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