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