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