api/Quarantine: load custom rules description
[pmg-api.git] / src / bin / pmgpolicy
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