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