src/bin/pmgpolicy

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