#!/usr/bin/perl -T -w ############################ package postfwd2::basic; use warnings; use strict; use IO::Socket qw(SOCK_STREAM); use Sys::Syslog qw(:DEFAULT setlogsock); # export use Exporter qw(import); our @EXPORT = qw( %postfwd_settings %postfwd_patterns &uniq &init_log &log_info &log_note &log_warn &log_err &log_crit ); our @EXPORT_OK = qw( %postfwd_commands &wantsdebug &hash_to_list &hash_to_str &str_to_hash &check_inet &check_unix &ts $TIMEHIRES $STORABLE ); our($TIMEHIRES); our($STORABLE); BEGIN { # use Time::HiRes if available eval { require Time::HiRes }; $TIMEHIRES = ($@) ? 0 : (Time::HiRes->VERSION || 'available'); # use Storable if available eval { require Storable }; $STORABLE = ($@) ? 0 : (Storable->VERSION || 'available'); }; # basics our $NAME = "postfwd2"; our $VERSION = "1.35"; our $DEFAULT = 'DUNNO'; # change this, to match your POD requirements # we need pod2text for the -m switch (manual) $ENV{PATH} = "/bin:/usr/bin:/usr/local/bin"; $ENV{ENV} = ""; our($cmd_manual) = "pod2text"; our($cmd_pager) = "more"; my $sepreq = '///'; my $seplst = ':::'; my $seplim = '~~~'; my $nounixsock = ($^O eq 'solaris'); # program settings our %postfwd_settings = ( base => { user => 'nobody', group => 'nobody', #setsid => 1, log_level => 2, log_file => 'Sys::Syslog', syslog_ident => "$NAME", umask => "0177", }, master => { pid_file => "/var/tmp/$NAME-master.pid", watchdog => 60, failures => 7, respawn => 4, daemons => [ 'cache', 'server' ], }, cache => { commandline => " ".$NAME."::cache", syslog_ident => "$NAME/cache", host => (($nounixsock) ? "127.0.0.1" : ""), port => (($nounixsock) ? "10043" : "/var/tmp/$NAME-cache.socket"), proto => (($nounixsock) ? "tcp" : "unix"), check => (($nounixsock) ? \&check_inet : \&check_unix), umask => "0177", }, server => { commandline => " ".$NAME."::policy", syslog_ident => "$NAME/policy", host => '127.0.0.1', port => 10045, proto => "tcp", check => \&check_inet, umask => "0111", # child control #check_for_dead => 30, #check_for_waiting => 10, min_spare_servers => 5, min_servers => 10, max_spare_servers => 50, max_servers => 100, max_requests => 1000, child_communication => 1, # children report data to parent for summary leave_children_open_on_hup => 1, # children should finish their work }, syslog => { nolog => 0, noidlestats => 0, norulestats => 0, name => $NAME, facility => 'mail', options => 'pid', # allow "umlaute" ;) #unsafe_charset => qr/[^\x20-\x7E,\x80-\xFE]/, unsafe_charset => qr/[^\x20-\x7E]/, unsafe_version => (not(defined $Sys::Syslog::VERSION) or $Sys::Syslog::VERSION lt '0.15'), perfmon => 0, stdout => 0, }, timeout => { rule => 40, cache => 3, server => 3, config => 4, }, request => { ttl => 600, cleanup => 600, no_sender => 0, rdomain_only => 0, no_size => 0, nolog => 0, noparent => 0, }, dns => { disable => 0, nolog => 0, noparent => 1, anylog => 0, async_txt => 0, timeout => 14, max_timeout => 10, max_interval => 1200, ttl => 3600, cleanup => 600, mask => '^127\.', max_ns_lookups => 100, max_mx_lookups => 100, }, rate => { cleanup => 600, noparent => 0, fast_eval => 0, store => undef, }, scores => { "5.0" => "554 5.7.1 ".$NAME." score exceeded", }, debug => { #all => 0, #verbose => 0, #cache => 0, #rates => 0, #config => 0, #cache => 0, #getcache => 0, #setcache => 0, #dns => 0, #getdns => 0, #setdns => 0, }, name => $NAME, version => $VERSION, default => $DEFAULT, daemon => 1, chroot => undef, manual => $cmd_manual, pager => $cmd_pager, sepreq => $sepreq, seplst => $seplst, seplim => $seplim, summary => 600, instant => 0, verbose => 0, test => 0, keep_rates => 0, max_command_recursion => 64, timeformat => ( ($TIMEHIRES) ? '%.2f' : '%d' ), ); # daemon commands our %postfwd_commands = ( ping => 'PING', pong => 'PONG', dumpstats => 'DS', dumpcache => 'DC', delcache => 'RC', delrate => 'RR', #wipecache => 'WC', countcache => 'CN', matchcache => 'MT', setcacheitem => 'SC', getcacheitem => 'GC', getcacheval => 'GV', checkrate => 'CR', setrateitem => 'SR', setrateitem2 => 'S2', getrateitem => 'GR', ); # precompiled patterns our %postfwd_patterns = ( ping => $postfwd_commands{ping}, pong => $postfwd_commands{pong}, keyval => qr/^([^=]+)=(.*)$/, cntval => qr/^([^=]+)=(\d+)$/, command => qr/^CMD\s*=/i, dumpstats => qr/^CMD\s*=\s*$postfwd_commands{dumpstats}\s*;\s*$/i, dumpcache => qr/^CMD\s*=\s*$postfwd_commands{dumpcache}\s*;\s*$/i, delcache => qr/^CMD\s*=\s*$postfwd_commands{delcache}\s+(.*?)$/i, delrate => qr/^CMD\s*=\s*$postfwd_commands{delrate}\s+(.*?)$/i, #wipecache => qr/^CMD\s*=\s*$postfwd_commands{wipecache}\s*;\s*$/i, countcache => qr/^CMD\s*=\s*$postfwd_commands{countcache}\s*;\s*TYPE\s*=\s*(.*?)\s*$/i, matchcache => qr/^CMD\s*=\s*$postfwd_commands{matchcache}\s*;\s*TYPE\s*=\s*(.*?)\s*$/i, setcacheitem => qr/^CMD\s*=\s*$postfwd_commands{setcacheitem}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$sepreq\s*(.*?)\s*$/i, getcacheitem => qr/^CMD\s*=\s*$postfwd_commands{getcacheitem}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$/i, getcacheval => qr/^CMD\s*=\s*$postfwd_commands{getcacheval}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$sepreq\s*KEY\s*=\s*(.*?)\s*$/i, checkrate => qr/^CMD\s*=\s*$postfwd_commands{checkrate}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*([^;]+)\s*;\s*SIZE\s*=\s*([^;]+)\s*;\s*RCPT\s*=\s*([^;]+)\s*$/i, setrateitem => qr/^CMD\s*=\s*$postfwd_commands{setrateitem}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$sepreq\s*(.*?)\s*$/i, setrateitem2 => qr/^CMD\s*=\s*$postfwd_commands{setrateitem2}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$sepreq\s*(.*?)\s*$/i, getrateitem => qr/^CMD\s*=\s*$postfwd_commands{getrateitem}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$/i, ); ## SUBS # prints formatted timestamp sub ts { return sprintf ($postfwd_settings{timeformat}, $_[0]) }; # takes a list and returns a unified list, keeping given order sub uniq { undef my %uniq; return grep(!$uniq{$_}++, @_); }; # tests debug levels sub wantsdebug { return unless %{$postfwd_settings{debug}}; foreach (@_) { return 1 if $postfwd_settings{debug}{$_} }; }; # hash -> scalar sub hash_to_str { my %request = @_; my $result = ''; map { $result .= $postfwd_settings{sepreq}."$_=".((ref $request{$_} eq 'ARRAY') ? (join $postfwd_settings{seplst}, @{$request{$_}}) : ($request{$_} || '')) } (keys %request); return $result; }; # scalar -> hash sub str_to_hash { my $request = shift; my %result = (); foreach (split $postfwd_settings{sepreq}, $request) { next unless m/$postfwd_patterns{keyval}/; my @items = split $postfwd_settings{seplst}, $2; ($#items) ? @{$result{$1}} = @items : $result{$1} = $2; }; return %result; }; # displays hash structure sub hash_to_list { my ($pre, %request) = @_; my @output = (); # get longest key my $minkey = '-'.(length((sort {length($b) <=> length($a)} (keys %request))[0] || '') + 1); while ( my($s, $v) = each %request ) { my $r = ref $v; if ($r eq 'HASH') { push @output, (%{$v}) ? hash_to_list ( sprintf ("%s -> %".$minkey."s", $pre, '%'.$s), %{$v} ) : sprintf ("%s -> %".$minkey."s -> %s", $pre, '%'.$s, 'undef'); } elsif ($r eq 'ARRAY') { push @output, sprintf ("%s -> %".$minkey."s -> %s", $pre, '@'.$s, ((@{$v}) ? "'".(join ",", @{$v})."'" : 'undef')); } elsif ($r eq 'CODE') { push @output, sprintf ("%s -> %".$minkey."s -> %s", $pre, '&'.$s, ((defined $v) ? "'".$v."'" : 'undef')); } else { push @output, sprintf ("%s -> %".$minkey."s -> %s", $pre, '$'.$s, ((defined $v) ? "'".$v."'" : 'undef')); }; }; return sort { my ($c, $d) = ($a, $b); $c =~ tr/$/1/; $c =~ tr/&/2/; $c =~ tr/@/3/; $c =~ tr/%/4/; $d =~ tr/$/1/; $d =~ tr/&/2/; $d =~ tr/@/3/; $d =~ tr/%/4/; return $c cmp $d; } @output; }; # Sys::Syslog < 0.15 sub mylogs_old { my($prio,$msg) = @_; eval { local $SIG{'__DIE__'}; syslog ($prio,$msg) }; }; # Sys::Syslog >= 0.15 sub mylogs_new { my($prio,$msg) = @_; syslog ($prio,$msg); }; # Syslog to stdout sub mylogs_stdout { my($prio,$msg) = @_; $msg =~ /^(.*)$/; printf STDOUT "[LOG $prio]: $1\n", @_; }; # send log message sub mylogs { my($prio,$msg) = @_; return if $postfwd_settings{syslog}{nolog}; # escape unsafe characters $msg =~ s/$postfwd_settings{syslog}{unsafe_charset}/?/g; $msg =~ s/\%/%%/g; &{$postfwd_settings{syslog}{logger}} ($prio,$msg); }; # short versions sub log_info { mylogs ('info', @_) }; sub log_note { mylogs ('notice', @_) }; sub log_warn { mylogs ('warning', @_) }; sub log_err { mylogs ('err', @_) }; sub log_crit { mylogs ('crit', @_) }; # init logging sub init_log { my($logname) = @_; $postfwd_settings{syslog}{name} = $logname if $logname; $postfwd_settings{syslog}{socktype} = ( $postfwd_settings{syslog}{socktype} || (($postfwd_settings{syslog}{unsafe_version}) ? (($nounixsock) ? 'inet' : 'unix') : 'native') ); if ($postfwd_settings{syslog}{stdout}) { $postfwd_settings{syslog}{logger} = \&mylogs_stdout; } else { # syslog init $postfwd_settings{syslog}{logger} = ($postfwd_settings{syslog}{unsafe_version}) ? \&mylogs_old : \&mylogs_new; setlogsock $postfwd_settings{syslog}{socktype}; openlog $postfwd_settings{syslog}{name}, $postfwd_settings{syslog}{options}, $postfwd_settings{syslog}{facility}; }; log_info ("set up syslogging Sys::Syslog".((defined $Sys::Syslog::VERSION) ? " version $Sys::Syslog::VERSION" : '') ) if wantsdebug (qw[ all verbose ]); }; # check: INET sub check_inet { my ($type,$send) = @_; if ( my $socket = new IO::Socket::INET ( PeerAddr => $postfwd_settings{$type}{host}, PeerPort => $postfwd_settings{$type}{port}, Proto => 'tcp', Timeout => $postfwd_settings{timeout}{$type}, Type => SOCK_STREAM ) ) { $socket->print("$send\n"); $send = $socket->getline(); $socket->close(); chomp($send); } else { warn("can not open socket to $postfwd_settings{$type}{host}:$postfwd_settings{$type}{port}: '$!' '$@'\n"); undef $send; }; return $send; }; # check: UNIX sub check_unix { my ($type,$send) = @_; if ( my $socket = new IO::Socket::UNIX ( Peer => $postfwd_settings{$type}{port}, Timeout => $postfwd_settings{timeout}{$type}, Type => SOCK_STREAM ) ) { $socket->print("$send\n"); $send = $socket->getline(); $socket->close(); chomp($send); } else { warn("can not open socket to $postfwd_settings{$type}{host}:$postfwd_settings{$type}{port}: '$!' '$@'\n"); undef $send; }; return $send; }; 1; # EOF postfwd2::basic ############################ package postfwd2::cache; ## MODULES use warnings; use strict; use base 'Net::Server::Multiplex'; import postfwd2::basic qw(:DEFAULT &wantsdebug &hash_to_list &str_to_hash &hash_to_str &ts $TIMEHIRES $STORABLE); use vars qw( %Cache %Cleanup %Count %Interval %Top $Reload_Conf $Summary $StartTime ); BEGIN { # use Time::HiRes if available Time::HiRes->import( qw(time) ) if $TIMEHIRES; # use Storable if available Storable->import( qw(store retrieve) ) if $STORABLE; }; ## SUBS # prepare stats sub list_stats { my @output = (); my $line = ''; my $now = time(); my $uptime = $now - $StartTime; return @output unless $uptime and (%Count or %Cache); push ( @output, sprintf ( "[STATS] %s::cache %s: %d queries since %d days, %02d:%02d:%02d hours", $postfwd_settings{name}, $postfwd_settings{version}, ($Count{cache_queries} || 0), ($uptime / 60 / 60 / 24), (($uptime / 60 / 60) % 24), (($uptime / 60) % 60), ($uptime % 60) ) ); my $lastreq = (($now - $Summary) > 0) ? (($Interval{request_set} || 0) + ($Interval{request_get} || 0)) / ($now - $Summary) * 60 : 0; $Top{request} = $lastreq if ($lastreq > ($Top{request} || 0)); $Top{request} ||= 0; my $lastdns = (($now - $Summary) > 0) ? (($Interval{dns_set} || 0) + ($Interval{dns_get} || 0)) / ($now - $Summary) * 60 : 0; $Top{dns} = $lastdns if ($lastdns > ($Top{dns} || 0)); $Top{dns} ||= 0; push ( @output, sprintf ( "[STATS] Requests: %.1f/min last, %.1f/min overall, %.1f/min top", $lastreq, (($Count{request_set} || 0) + ($Count{request_get} || 0)) / $uptime * 60, $Top{request} ) ); push ( @output, sprintf ( "[STATS] Dnsstats: %.1f/min last, %.1f/min overall, %.1f/min top", $lastdns, (($Count{dns_set} || 0) + ($Count{dns_get} || 0)) / $uptime * 60, $Top{dns} ) ) unless ($postfwd_settings{dns}{disable} or $postfwd_settings{dns}{noparent}); push ( @output, sprintf ( "[STATS] Hitrates: %.1f%% requests, %.1f%% dns, %.1f%% rates", ($Count{request_get}) ? ($Count{request_hits} || 0) / $Count{request_get} * 100 : 0, ($Count{dns_get}) ? ($Count{dns_hits} || 0) / $Count{dns_get} * 100 : 0, ($Count{rate_get}) ? ($Count{rate_hits} || 0) / $Count{rate_get} * 100 : 0 ) ); push ( @output, "[STATS] Contents: ". join ', ', map { $_ = "$_=".(scalar keys %{$Cache{$_}}) } (reverse sort keys %Cache) ); if (wantsdebug (qw[ all stats devel parent_cache ])) { push ( @output, "[STATS] Counters: ". join ', ', map { $_ = "$_=".$Count{$_} } (reverse sort keys %Count) ); push ( @output, "[STATS] Interval: ". join ', ', map { $_ = "$_=".$Interval{$_} } (reverse sort keys %Interval) ); }; map { $Interval{$_} = 0 } (keys %Interval); $Summary = $now; return @output; }; # return cache contents sub dump_cache { my @result = (); foreach (keys %Cache) { push @result, hash_to_list ('%'.$_."_cache", %{$Cache{$_}}) if %{$Cache{$_}}; }; return @result; }; # get a whole cache item sub get_cache { my ($self,$now,$type,$item) = @_; my @answer = (); return '' unless ( defined $Cache{$type}{$item}{'until'} and ($now <= $Cache{$type}{$item}{'until'}[0])); $Count{$type."_hits"}++; map { push @answer, "$_=".(join $postfwd_settings{seplst}, @{$Cache{$type}{$item}{$_}}) } (keys %{$Cache{$type}{$item}}); return (join $postfwd_settings{sepreq}, @answer); }; # set item to cache sub set_cache { my ($self,$type,$item,$vals) = @_; my @answer = (); undef $Cache{$type}{$item}; foreach my $arg (split ($postfwd_settings{sepreq}, $vals)) { map { push @{$Cache{$type}{$item}{$1}}, $_; push @answer, "$type->$item->$1=$_"; @{$Cache{$type}{$item}{$1}} = uniq(@{$Cache{$type}{$item}{$1}}); } (split $postfwd_settings{seplst}, $2) if ($arg =~ m/$postfwd_patterns{keyval}/); }; @answer = '' unless @answer; return (join '; ', @answer); }; # get rate item sub get_rate { my ($self,$now,$type,$item) = @_; my @answer = (); my $rindex = ''; ($item, $rindex) = split $postfwd_settings{seplim}, $item; return '' unless ( $item and $rindex and defined $Cache{$type}{$item} and defined $Cache{$type}{$item}{$rindex} and defined $Cache{$type}{$item}{$rindex}{'until'} and ($now <= $Cache{$type}{$item}{$rindex}{'until'}[0])); $Count{$type."_hits"}++; map { push @answer, "$_=".(join $postfwd_settings{seplst}, @{$Cache{$type}{$item}{$rindex}{$_}}) } (keys %{$Cache{$type}{$item}{$rindex}}); return (join $postfwd_settings{sepreq}, @answer); }; # set rate to cache sub set_rate { my ($self,$now,$type,$item,$vals) = @_; my @answer = (); my $rindex = ''; ($item, $rindex) = split $postfwd_settings{seplim}, $item; return '' if ( defined $Cache{$type}{$item} and defined $Cache{$type}{$item}{$rindex} and defined $Cache{$type}{$item}{$rindex}{'until'} and $now <= @{$Cache{$type}{$item}{$rindex}{'until'}}[0] ); push @{$Cache{$type}{$item}{'list'}}, $rindex; @{$Cache{$type}{$item}{'list'}} = uniq(@{$Cache{$type}{$item}{'list'}}); delete $Cache{$type}{$item}{$rindex} if defined $Cache{$type}{$item}{$rindex}; foreach my $arg (split ($postfwd_settings{sepreq}, $vals)) { map { push @{$Cache{$type}{$item}{$rindex}{$1}}, $_; push @answer, "$type->$item->$rindex->$1=$_"; @{$Cache{$type}{$item}{$rindex}{$1}} = uniq(@{$Cache{$type}{$item}{$rindex}{$1}}); } (split $postfwd_settings{seplst}, $2) if ($arg =~ m/$postfwd_patterns{keyval}/); }; @answer = '' unless @answer; return (join '; ', @answer); }; # set rate to cache sub set_rate2 { my ($self,$now,$type,$item,$vals) = @_; my $rindex = ''; my %entry = (); my $rcount = undef; ($item, $rindex) = split $postfwd_settings{seplim}, $item; push @{$Cache{$type}{$item}{'list'}}, $rindex; @{$Cache{$type}{$item}{'list'}} = uniq(@{$Cache{$type}{$item}{'list'}}); foreach my $arg (split ($postfwd_settings{sepreq}, $vals)) { map { push @{$entry{$1}}, $_; @{$entry{$1}} = uniq(@{$entry{$1}}); } (split $postfwd_settings{seplst}, $2) if ($arg =~ m/$postfwd_patterns{keyval}/); }; unless (defined $Cache{$type}{$item}{$rindex} and defined $Cache{$type}{$item}{$rindex}{'until'}) { %{$Cache{$type}{$item}{$rindex}} = %entry; } elsif ($now > $Cache{$type}{$item}{$rindex}{'until'}[0]) { %{$Cache{$type}{$item}{$rindex}} = %entry; } else { $rcount = $Cache{$type}{$item}{$rindex}{'count'}[0] + ($entry{'count'}[0] || 0); $Cache{$type}{$item}{$rindex}{'count'}[0] = $rcount unless $rcount > $Cache{$type}{$item}{$rindex}{'maxcount'}[0]; }; return $rcount || $Cache{$type}{$item}{$rindex}{'count'}[0] || ''; }; # check rate limits sub check_rate { my ($self,$now,$type,$item,$size,$rcpt) = @_; return '' unless ($type and $item); $size ||= 0; $rcpt ||= 0; my $answer = ''; RATES: foreach my $arg (split ($postfwd_settings{seplst}, $item)) { next RATES unless (defined $Cache{$type}{$arg} and defined $Cache{$type}{$arg}{'list'}); RINDEX: foreach my $rindex (@{$Cache{$type}{$arg}{'list'}}) { next RINDEX unless (defined $Cache{$type}{$arg}{$rindex} and defined $Cache{$type}{$arg}{$rindex}{'until'} and defined $Cache{$type}{$arg}{$rindex}{type}); my $rcount = ( (@{$Cache{$type}{$arg}{$rindex}{type}}[0] eq 'size') ? $size : ((@{$Cache{$type}{$arg}{$rindex}{type}}[0] eq 'rcpt') ? $rcpt : 1 ) ); # renew rate if ( $now > @{$Cache{$type}{$arg}{$rindex}{'until'}}[0] ) { @{$Cache{$type}{$arg}{$rindex}{count}}[0] = $rcount; @{$Cache{$type}{$arg}{$rindex}{'time'}}[0] = $now; @{$Cache{$type}{$arg}{$rindex}{'until'}}[0] = $now + @{$Cache{$type}{$arg}{$rindex}{ttl}}[0]; log_info ("[RATES] renewing rate limit object '".$arg."'" ." [type: ".@{$Cache{$type}{$arg}{$rindex}{type}}[0] .", max: ".@{$Cache{$type}{$arg}{$rindex}{maxcount}}[0] .", time: ".@{$Cache{$type}{$arg}{$rindex}{ttl}}[0]."s]") if wantsdebug (qw[ all rates ]); # increase rate } elsif (not(($rcount+=@{$Cache{$type}{$arg}{$rindex}{count}}[0]) > @{$Cache{$type}{$arg}{$rindex}{maxcount}}[0])) { @{$Cache{$type}{$arg}{$rindex}{count}}[0] = $rcount; log_info ("[RATES] increasing rate limit object '".$arg."' to ".@{$Cache{$type}{$arg}{$rindex}{count}}[0] ." [type: ".@{$Cache{$type}{$arg}{$rindex}{type}}[0] .", max: ".@{$Cache{$type}{$arg}{$rindex}{maxcount}}[0] .", time: ".@{$Cache{$type}{$arg}{$rindex}{ttl}}[0]."s]") if wantsdebug (qw[ all rates ]); }; # check rate if (not($answer) and $rcount > @{$Cache{$type}{$arg}{$rindex}{maxcount}}[0]) { $answer = $arg.$postfwd_settings{seplim}.$rindex.$postfwd_settings{seplst}.hash_to_str (%{$Cache{$type}{$arg}{$rindex}}); $Count{$type."_hits"}++; }; }; }; $answer = '' unless $answer; return $answer; }; # clean up cache sub cleanup_cache { my($type,$now) = @_; my $start = $Cleanup{$type} = time(); log_info ("[CLEANUP] checking $type cache...") if wantsdebug (qw[ all cleanup parentcleanup ]); return unless defined $Cache{$type} and my $count = scalar keys %{$Cache{$type}}; CLEANUP: foreach my $checkitem (keys %{$Cache{$type}}) { next CLEANUP unless (defined $Cache{$type}{$checkitem}); unless ( defined $Cache{$type}{$checkitem}{'list'} ) { # remove incomplete objects if ( !defined($Cache{$type}{$checkitem}{'until'}) or !defined($Cache{$type}{$checkitem}{ttl}) ) { if ( wantsdebug (qw[ all cleanup parentcleanup devel ]) ) { log_info ("[CLEANUP] deleting incomplete $type cache item '$checkitem'"); map { log_info ("[CLEANUP] $_") } ( hash_to_list(%{$Cache{$type}{$checkitem}}) ); }; delete $Cache{$type}{$checkitem}; # remove timed out objects } elsif ( $now > $Cache{$type}{$checkitem}{'until'}[0] ) { log_info ("[CLEANUP] removing $type cache item '$checkitem' after ttl ".$Cache{$type}{$checkitem}{ttl}[0]."s") if wantsdebug (qw[ all cleanup parentcleanup ]); delete $Cache{$type}{$checkitem}; }; } else { my @i = (); foreach my $crate (@{$Cache{$type}{$checkitem}{'list'}}) { if ( !(defined $Cache{$type}{$checkitem}{$crate}{'until'}) or !(defined $Cache{$type}{$checkitem}{$crate}{ttl}) ) { if ( wantsdebug (qw[ all cleanup parentcleanup devel ]) ) { log_info ("[CLEANUP] deleting incomplete $type cache item '$checkitem'->'$crate'"); map { log_info ("[CLEANUP] $_") } ( hash_to_list(%{$Cache{$type}{$checkitem}{$crate}}) ); }; delete $Cache{$type}{$checkitem}{$crate}; } elsif ( $now > $Cache{$type}{$checkitem}{$crate}{'until'}[0] ) { log_info ("[CLEANUP] removing $type cache item '$checkitem'->'$crate' after ttl ".$Cache{$type}{$checkitem}{$crate}{ttl}[0]."s") if wantsdebug (qw[ all cleanup parentcleanup ]); delete $Cache{$type}{$checkitem}{$crate}; } else { push @i, $crate; }; }; unless ($i[0]) { log_info ("[CLEANUP] removing $type cache complete item '$checkitem'") if wantsdebug (qw[ all cleanup parentcleanup ]); delete $Cache{$type}{$checkitem}; } else { log_info ("[CLEANUP] new $type cache limits for item '$checkitem': ".(join ', ', @i)) if wantsdebug (qw[ all cleanup parentcleanup ]); @{$Cache{$type}{$checkitem}{'list'}} = @i; }; }; }; my $end = time(); log_info ("[CLEANUP] cleaning $type cache needed ".ts($end - $start)." seconds for " .($count - scalar keys %{$Cache{$type}})." out of ".$count ." cached items after cleanup time ".$postfwd_settings{$type}{cleanup}."s") if ( wantsdebug (qw[ all verbose cleanup parentcleanup ]) or (($end - $start) >= 1) ); }; # saves rate limits to disk sub save_rates { return unless ($STORABLE and $postfwd_settings{rate}{store} and defined $Cache{rate}); cleanup_cache ('rate', time()); eval { local $SIG{__DIE__} = sub { log_note ("ERROR: Could not store rate limits to ".$postfwd_settings{rate}{store}.": $! @_") }; store ($Cache{rate}, $postfwd_settings{rate}{store}); }; unless( $@ ) { log_info ("Saved ".(scalar %{$Cache{rate}})." rates to ".$postfwd_settings{rate}{store}) if wantsdebug(qw[ all verbose rates loadrates saverates ]); }; }; # loads rate limits from disk sub load_rates { my $loadrate = undef; return unless ($STORABLE and $postfwd_settings{rate}{store} and (-f $postfwd_settings{rate}{store})); eval { local $SIG{__DIE__} = sub { log_note ("Could not load rate limits from ".$postfwd_settings{rate}{store}.": $! @_") }; $loadrate = retrieve($postfwd_settings{rate}{store}); }; if ( not($@) and defined $loadrate ) { $Cache{rate} = $loadrate; log_info ("Fetched ".(scalar %{$Cache{rate}})." rates from ".$postfwd_settings{rate}{store}) if wantsdebug(qw[ all verbose rates loadrates saverates ]); cleanup_cache ('rate', time()); }; }; ## Net::Server::Multiplex methods # ignore syslog failures sub handle_syslog_error {}; # set $Reload_Conf marker on HUP signal sub sig_hup { log_note ("catched HUP signal - clearing request cache on next request"); $Reload_Conf = 1; }; # cache start sub pre_loop_hook() { my $self = shift; # change cache name $0 = $self->{server}->{commandline} = " ".$postfwd_settings{name}.'::cache'; $self->{server}->{syslog_ident} = $postfwd_settings{name}."/cache"; init_log ($self->{server}->{syslog_ident}); load_rates(); $StartTime = $Summary = $Cleanup{request} = $Cleanup{rate} = $Cleanup{dns} = time(); log_info ("ready for input"); }; # cache end sub post_child_cleanup_hook { my $self = shift; save_rates(); }; # cache process request sub mux_input { my ($self, $mux, $client, $mydata) = @_; my $action = ''; my $now = time(); while ( $$mydata =~ s/^([^\r\n]*)\r?\n// ) { # check request line next unless defined $1; my $request = $1; log_info ("request: '$request'") if wantsdebug (qw[ all ]); if ($Reload_Conf) { undef $Reload_Conf; my $s = ''; delete $Cache{request}; unless ($postfwd_settings{keep_rates}) { delete $Cache{rate}; $s = 'and rate' }; log_info ("request".(($s) ? " $s" : '')." cache cleared") if wantsdebug (qw[ all verbose ]); }; if ($request eq $postfwd_patterns{ping}) { $action = $postfwd_patterns{pong}; } elsif ($request =~ m/$postfwd_patterns{checkrate}/) { my ($type, $item, $size, $rcpt) = ($1, $2, $3, $4); log_info ("[CHECKRATE] request: '$request'") if wantsdebug (qw[ all rates cache getcache ]); cleanup_cache ($type,$now) if (($now - $Cleanup{$type}) > ($postfwd_settings{$type}{cleanup} || 300)); $Count{cache_queries}++; $Interval{cache_queries}++; $Count{$type."_check"}++; $Interval{$type."_check"}++; $action = $self->check_rate($now,$type,$item,$size,$rcpt); log_info ("[CHECKRATE] answer: '$action'") if wantsdebug (qw[ all rates cache getcache ]); } elsif ($request =~ m/$postfwd_patterns{getcacheitem}/) { my ($type, $item) = ($1, $2); log_info ("[GETCACHEITEM] request: '$request'") if wantsdebug (qw[ all cache getcache ]); cleanup_cache ($type,$now) if (($now - $Cleanup{$type}) > ($postfwd_settings{$type}{cleanup} || 300)); $Count{cache_queries}++; $Interval{cache_queries}++; $Count{$type."_get"}++; $Interval{$type."_get"}++; $action = $self->get_cache($now,$type,$item); log_info ("[GETCACHEITEM] answer: '$action'") if wantsdebug (qw[ all cache getcache ]); } elsif ($request =~ m/$postfwd_patterns{setcacheitem}/) { my ($type, $item, $vals) = ($1, $2, $3); log_info ("[SETCACHEITEM] request: '$request'") if wantsdebug (qw[ all cache setcache ]); $Count{cache_queries}++; $Interval{cache_queries}++; $Count{$type."_set"}++; $Interval{$type."_set"}++; $action = $self->set_cache($type,$item,$vals); log_info ("[SETCACHEITEM] answer: '$action'") if wantsdebug (qw[ all cache setcache ]); } elsif ($request =~ m/$postfwd_patterns{getrateitem}/) { my ($type, $item) = ($1, $2); log_info ("[GETRATEITEM] request: '$request'") if wantsdebug (qw[ all cache getcache rates ]); cleanup_cache ($type,$now) if (($now - $Cleanup{$type}) > ($postfwd_settings{$type}{cleanup} || 300)); $Count{cache_queries}++; $Interval{cache_queries}++; $Count{$type."_get"}++; $Interval{$type."_get"}++; $action = $self->get_rate($now,$type,$item); log_info ("[GETRATEITEM] answer: '$action'") if wantsdebug (qw[ all cache getcache rates ]); } elsif ($request =~ m/$postfwd_patterns{setrateitem}/) { my ($type, $item, $vals) = ($1, $2, $3); log_info ("[SETRATEITEM] request: '$request'") if wantsdebug (qw[ all cache setcache ]); $Count{cache_queries}++; $Interval{cache_queries}++; $Count{$type."_set"}++; $Interval{$type."_set"}++; $action = $self->set_rate($now,$type,$item,$vals); log_info ("[SETRATEITEM] answer: '$action'") if wantsdebug (qw[ all cache setcache ]); } elsif ($request =~ m/$postfwd_patterns{setrateitem2}/) { my ($type, $item, $vals) = ($1, $2, $3); log_info ("[SETRATEITEM2] request: '$request'") if wantsdebug (qw[ all cache setcache ]); $Count{cache_queries}++; $Interval{cache_queries}++; $Count{$type."_set"}++; $Interval{$type."_set"}++; $action = $self->set_rate2($now,$type,$item,$vals); log_info ("[SETRATEITEM2] answer: '$action'") if wantsdebug (qw[ all cache setcache ]); } elsif ($request =~ m/$postfwd_patterns{dumpstats}/) { $action = join $postfwd_settings{sepreq}.$postfwd_settings{seplst}, list_stats(); } elsif ($request =~ m/$postfwd_patterns{dumpcache}/) { $action = join $postfwd_settings{sepreq}.$postfwd_settings{seplst}, dump_cache(); } elsif ($request =~ m/$postfwd_patterns{delcache}/) { my $del = $1; $del =~ s/^[%]?//; if (defined $Cache{'request'}{$del}) { delete $Cache{'request'}{$del}; log_info ("[DELCACHEITEM] request cache item '$del' removed"); $action = "request cache item '$del' removed"; } else { log_info ("[DELCACHEITEM] request cache removal of '$del' failed: item not found"); $action = "request cache removal of '$del' failed: item not found"; }; } elsif ($request =~ m/$postfwd_patterns{delrate}/) { my $del = $1; $del =~ s/^[%]?//; if (defined $Cache{'rate'}{$del}) { delete $Cache{'rate'}{$del}; log_info ("[DELRATEITEM] rate cache item '$del' removed"); $action = "rate cache item '$del' removed"; } else { log_info ("[DELRATEITEM] rate cache removal of '$del' failed: item not found"); $action = "rate cache removal of '$del' failed: item not found"; }; } else { log_note ("warning: ignoring unknown command '".substr($request,0,512)."'"); }; print $client "$action\n"; log_info ("answer: '$action'") if wantsdebug (qw[ all ]); }; }; 1; # EOF postfwd2::cache ############################ package postfwd2::server; use warnings; use strict; use IO::Socket qw(SOCK_STREAM); use Net::DNS; use base 'Net::Server::PreFork'; import postfwd2::basic qw(:DEFAULT %postfwd_commands &check_inet &check_unix &wantsdebug &hash_to_str &str_to_hash &hash_to_list &ts $TIMEHIRES); # export these functions for '-C' switch use Exporter qw(import); our @EXPORT_OK = qw( &read_config &show_config &process_input &get_plugins ); # use Time::HiRes if available BEGIN { Time::HiRes->import( qw(time) ) if $TIMEHIRES }; # these items have to be compared as... # scoring my $COMP_SCORES = "score"; my $COMP_NS_NAME = "sender_ns_names"; my $COMP_NS_ADDR = "sender_ns_addrs"; my $COMP_MX_NAME = "sender_mx_names"; my $COMP_MX_ADDR = "sender_mx_addrs"; my $COMP_HELO_ADDR = "helo_address"; # networks in CIDR notation (a.b.c.d/nn) my $COMP_NETWORK_CIDRS = "(client_address|sender_(ns|mx)_addrs|helo_address)"; # RBL checks my $COMP_DNSBL_TEXT = "dnsbltext"; my $COMP_RBL_CNT = "rblcount"; my $COMP_RHSBL_CNT = "rhsblcount"; my $COMP_RBL_KEY = "rbl"; my $COMP_RHSBL_KEY = "rhsbl"; my $COMP_RHSBL_KEY_CLIENT = "rhsbl_client"; my $COMP_RHSBL_KEY_SENDER = "rhsbl_sender"; my $COMP_RHSBL_KEY_RCLIENT = "rhsbl_reverse_client"; my $COMP_RHSBL_KEY_HELO = "rhsbl_helo"; my %DNSBLITEMS = ( rbl => { cnt => "rblcount", }, rhsbl => { cnt => "rhsblcount", }, rhsbl_client => { cnt => "rhsblcount", }, rhsbl_sender => { cnt => "rhsblcount", }, rhsbl_reverse_client => { cnt => "rhsblcount", }, rhsbl_helo => { cnt => "rhsblcount", }, ); # dns key value matching my %DNS_REPNAMES = ( "NS" => "nsdname", "MX" => "exchange", "A" => "address", "TXT" => "char_str_list", "CNAME" => "cname", ); # file items our($COMP_CONF_FILE) = 'cfile|file'; our($COMP_CONF_TABLE) = 'ctable|table'; our($COMP_LIVE_FILE) = 'lfile'; our($COMP_LIVE_TABLE) = 'ltable'; our($COMP_TABLES) = qr/^($COMP_CONF_TABLE|$COMP_LIVE_TABLE)$/i; our($COMP_CONF_FILE_TABLE) = qr/^($COMP_CONF_FILE|$COMP_CONF_TABLE):(.+)$/i; our($COMP_LIVE_FILE_TABLE) = qr/^($COMP_LIVE_FILE|$COMP_LIVE_TABLE):(.+)$/i; # date checks my $COMP_DATE = "date"; my $COMP_TIME = "time"; my $COMP_DAYS = "days"; my $COMP_MONTHS = "months"; # always true my $COMP_ACTION = "action"; my $COMP_ID = "id"; my $COMP_CACHE = "cache"; # rule hits my $COMP_HITS = "request_hits"; # item match counter my $COMP_MATCHES = "matches"; # separator my $COMP_SEPARATOR = "[=\~\<\>]=|[\<\>]|[=\!][=\~\<\>]|="; # macros my $COMP_ACL = "[\&][\&]"; # negation my $COMP_NEG = "[\!][\!]"; # variables my $COMP_VAR = "[\$][\$]"; # date calculations my $COMP_DATECALC = "($COMP_DATE|$COMP_TIME|$COMP_DAYS|$COMP_MONTHS)"; # these items allow whitespace-or-comma-separated values my $COMP_CSV = "($COMP_NETWORK_CIDRS|$COMP_RBL_KEY|$COMP_RHSBL_KEY|$COMP_RHSBL_KEY_CLIENT|$COMP_RHSBL_KEY_HELO|$COMP_RHSBL_KEY_SENDER|$COMP_RHSBL_KEY_RCLIENT|$COMP_DATECALC|$COMP_HELO_ADDR|$COMP_NS_ADDR|$COMP_MX_ADDR)"; # dont treat these as lists my $COMP_SINGLE = "($COMP_ID|$COMP_ACTION|$COMP_CACHE|$COMP_SCORES|$COMP_RBL_CNT|$COMP_RHSBL_CNT)"; # date tools my %months = ( "Jan" => 0, "jan" => 0, "JAN" => 0, "Feb" => 1, "feb" => 1, "FEB" => 1, "Mar" => 2, "mar" => 2, "MAR" => 2, "Apr" => 3, "apr" => 3, "APR" => 3, "May" => 4, "may" => 4, "MAY" => 4, "Jun" => 5, "jun" => 5, "JUN" => 5, "Jul" => 6, "jul" => 6, "JUL" => 6, "Aug" => 7, "aug" => 7, "AUG" => 7, "Sep" => 8, "sep" => 8, "SEP" => 8, "Oct" => 9, "oct" => 9, "OCT" => 9, "Nov" => 10, "nov" => 10, "NOV" => 10, "Dec" => 11, "dec" => 11, "DEC" => 11, ); my %weekdays = ( "Sun" => 0, "sun" => 0, "SUN" => 0, "Mon" => 1, "mon" => 1, "MON" => 1, "Tue" => 2, "tue" => 2, "TUE" => 2, "Wed" => 3, "wed" => 3, "WED" => 3, "Thu" => 4, "thu" => 4, "THU" => 4, "Fri" => 5, "fri" => 5, "FRI" => 5, "Sat" => 6, "sat" => 6, "SAT" => 6, ); use vars qw( @Rules @DNSBL_Text @Rate_Items %Rule_by_ID %Matches %ACLs %Timeouts %Hits %Count %postfwd_items %postfwd_compare %postfwd_actions %postfwd_items_plugin %postfwd_compare_plugin %postfwd_actions_plugin %Request_Cache %Config_Cache %DNS_Cache %Rate_Cache $Cleanup_Requests $Cleanup_RBLs $Cleanup_Rates $Cleanup_Timeouts %Cache %Cleanup $StartTime $Summary ); ## SUBS # cache query sub cache_query { return ( &{$postfwd_settings{cache}{check}}('cache',@_) || '' ) }; # get ip and mask sub cidr_parse { return undef unless defined $_[0]; return undef unless $_[0] =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/; return undef unless ($1 < 256 and $2 < 256 and $3 < 256 and $4 < 256 and $5 <= 32 and $5 >= 0); my $net = ($1<<24)+($2<<16)+($3<<8)+$4; my $mask = ~((1<<(32-$5))-1); return ($net & $mask, $mask); }; # compare address to network sub cidr_match { my ($net, $mask, $addr) = @_; return undef unless defined $net and defined $addr; $addr = ($1<<24)+($2<<16)+($3<<8)+$4 if ($addr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/); return ($addr & $mask) == $net; }; # sets an action for a score sub modify_score { my($myscore,$myaction) = @_; log_info ( ((defined $postfwd_settings{scores}{$myscore}) ? "redefined" : "setting new") ." score $myscore with action=\"$myaction\"") if wantsdebug (qw[ all thisrequest verbose ]); $postfwd_settings{scores}{$myscore} = $myaction; }; # returns content of !!() negation sub deneg_item { my($val) = (defined $_[0]) ? $_[0] : ''; return ( ($val =~ /^$COMP_NEG\s*\(?\s*(.+?)\s*\)?$/) ? $1 : '' ); }; # resolves $$() variables sub devar_item { my($cmp,$val,$myitem,%request) = @_; return '' unless $val and $myitem; my($pre,$post,$var,$myresult) = ''; while ( ($val =~ /(.*)$COMP_VAR\s*(\w+)(.*)/g) or ($val =~ /(.*)$COMP_VAR\s*\((\w+)\)(.*)/g) ) { ($pre,$var,$post) = ($1,$2,$3); if ($var eq $COMP_DNSBL_TEXT) { $myresult=$val=$pre.(join "; ", uniq(@DNSBL_Text)).$post; } elsif (defined $request{$var}) { $myresult=$val=$pre.$request{$var}.$post; }; log_info ("substitute : \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest verbose ]); }; return $myresult; }; # clean up RBL cache sub cleanup_dns_cache { my($now) = $_[0]; return unless $now; foreach my $checkitem (keys %DNS_Cache) { # remove inclomplete objects (dns timeouts) if ( !defined($DNS_Cache{$checkitem}{'until'}) or !defined($DNS_Cache{$checkitem}{ttl}) ) { log_info ("[CLEANUP] deleting incomplete dns-cache item '$checkitem'") if wantsdebug (qw[ all cleanup childcleanup devel ]); delete $DNS_Cache{$checkitem}; # remove timed out objects } elsif ( $now > $DNS_Cache{$checkitem}{'until'} ) { log_info ("[CLEANUP] removing dns-cache item '$checkitem' after ttl ".$DNS_Cache{$checkitem}{ttl}."s") if wantsdebug (qw[ all cleanup childcleanup ]); delete $DNS_Cache{$checkitem}; }; }; }; # clean up request cache sub cleanup_request_cache { my($now) = $_[0]; return unless $now; RITEM: foreach my $checkitem (keys %Request_Cache) { next RITEM unless defined $Request_Cache{$checkitem}{'until'}; if ( !defined($Request_Cache{$checkitem}{'until'}) or !defined($Request_Cache{$checkitem}{ttl}) ) { log_info ("[CLEANUP] deleting incomplete request-cache item '$checkitem'") if wantsdebug (qw[ all cleanup childcleanup devel ]); delete $Request_Cache{$checkitem}; } elsif ( $now > $Request_Cache{$checkitem}{'until'} ) { log_info ("[CLEANUP] removing request-cache item '$checkitem' after ttl ".$Request_Cache{$checkitem}{ttl}."s") if wantsdebug (qw[ all cleanup childcleanup ]); delete $Request_Cache{$checkitem}; }; }; }; # clean up rate cache sub cleanup_rate_cache { my($now) = $_[0]; return unless $now; foreach my $checkitem (keys %Rate_Cache) { unless (defined $Rate_Cache{$checkitem}{'list'}) { log_info ("[CLEANUP] deleting incomplete rate-cache item '$checkitem'") if wantsdebug (qw[ all cleanup childcleanup devel ]); delete $Rate_Cache{$checkitem}; } else { my @i = (); foreach my $crate (@{$Rate_Cache{$checkitem}{'list'}}) { if ( not(defined $Rate_Cache{$checkitem}{$crate}{'until'}) or not(defined $Rate_Cache{$checkitem}{$crate}{'ttl'}) ) { log_info ("[CLEANUP] deleting incomplete rate-cache item '$checkitem'->'$crate'") if wantsdebug (qw[ all cleanup childcleanup devel ]); delete $Rate_Cache{$checkitem}{$crate}; } elsif ( $now > $Rate_Cache{$checkitem}{$crate}{'until'} ) { log_info ("[CLEANUP] removing rate-cache item '$checkitem'->'$crate' after ttl ".$Rate_Cache{$checkitem}{$crate}{ttl}."s") if wantsdebug (qw[ all cleanup childcleanup ]); delete $Rate_Cache{$checkitem}{$crate}; } else { push @i, $crate; }; }; unless ($i[0]) { log_info ("[CLEANUP] removing complete rate-cache item '$checkitem'") if wantsdebug (qw[ all cleanup childcleanup ]); delete $Rate_Cache{$checkitem}; } else { log_info ("[CLEANUP] new limits for rate-cache item '$checkitem': ".(join ', ', @i)) if wantsdebug (qw[ all cleanup childcleanup ]); @{$Rate_Cache{$checkitem}{'list'}} = @i; }; }; }; }; # preparses configuration line for ACL syntax sub acl_parser { my($file,$num,$myline) = @_; if ( $myline =~ /^\s*($COMP_ACL[\-\w]+)\s*{\s*(.*?)\s*;?\s*}[\s;]*$/ ) { $ACLs{$1} = $2; $myline = ""; } else { while ( $myline =~ /($COMP_ACL[\-\w]+)/) { my($acl) = $1; if ( $acl and defined $ACLs{$acl} ) { $myline =~ s/\s*$acl\s*/$ACLs{$acl}/g; } else { #return "action=note(undefined macro '$acl')"; log_warn ("file $file, ignoring line $num: undefined macro '$acl'"); return ""; }; }; }; return $myline; }; # prepares pcre item sub prepare_pcre { my($item) = shift; undef my $neg; # temporarily remove negation $item = $neg if ($neg = deneg_item($item)); # allow // regex $item =~ s/^\/?(.*?)\/?$/$1/; # tested slow #$item = qr/$item/i; # re-enable negation $item = "!!($item)" if $neg; return $item; }; # prepares file item sub prepare_file { my($forced_reload,$type,$cmp,$file) = @_; my(@result) = (); undef my $fh; my($is_table) = ($type =~ /^$COMP_TABLES$/); unless (-e $file) { log_warn ("error: $type:$file not found - will be ignored"); return @result; }; if ( not($forced_reload) and (defined $Config_Cache{$file}{lastread}) and ($Config_Cache{$file}{lastread} > (stat $file)[9]) ) { log_info ("$type:$file unchanged - using cached content (mtime: " .(stat $file)[9].", cache: $Config_Cache{$file}{lastread})") if wantsdebug (qw[ all thisrequest config ]); return @{$Config_Cache{$file}{content}}; }; unless (open ($fh, "<$file")) { log_warn ("error: could not open $type:$file - $! - will be ignored"); return @result; }; log_info ("reading $type:$file") if wantsdebug (qw[ all thisrequest config ]); while (<$fh>) { chomp; s/#.*//g; next if /^\s*$/; s/\s+[^\s]+$// if $is_table; s/^\s+//; s/\s+$//; push @result, prepare_item($forced_reload, $cmp, $_); }; close ($fh); # update Config_Cache $Config_Cache{$file}{lastread} = time(); @{$Config_Cache{$file}{content}} = @result; log_info ("read ".($#result + 1)." items from $type:$file") if wantsdebug (qw[ all thisrequest config ]); return @result; }; # prepares ruleset item sub prepare_item { my($forced_reload,$cmp,$item) = @_; my(@result) = (); undef my $type; if ($item =~ /$COMP_CONF_FILE_TABLE/) { return prepare_file ($forced_reload, $1, $cmp, $2); } elsif ($cmp eq '=~' or $cmp eq '!~') { return $cmp.";".prepare_pcre($item); } else { return $cmp.";".$item; }; }; # compatibility for old "rate"-syntax sub check_for_old_syntax { my($myindex,$myfile,$mynum,$mykey,$myvalue) = @_; if ($mykey =~ /^action$/) { if ($myvalue =~ /^(\w[\-\w]+)\s*\(\s*(.*?)\s*\)$/) { my($mycmd,$myarg) = ($1, $2); if ($mycmd =~ /^(rate|size|rcpt)(5321)?$/i) { if ($myarg =~ /^\$\$(.*)$/) { $myarg = $1; $myvalue = "$mycmd($myarg)"; log_note ( "notice: Rule $myindex ($myfile line $mynum): " ."removing obsolete '\$\$' for $mycmd limit index. See man page for new syntax." ) if wantsdebug (qw[ all thisrequest config verbose ]); }; push @Rate_Items, (split '/', $myarg)[0]; }; }; }; return $myvalue; }; # parses configuration line sub parse_config_line { my($forced_reload, $myfile, $mynum, $myindex, $myline) = @_; my(%myrule) = (); my($mykey, $myvalue, $mycomp); eval { local $SIG{'__DIE__'}; local $SIG{'ALRM'} = sub { $myline =~ s/[ \t][ \t]*/ /g; log_warn ("timeout after ".$postfwd_settings{timeout}{config}."s at parsing Rule $myindex ($myfile line $mynum): \"$myline\""); %myrule = (); die }; my $prevalert = alarm($postfwd_settings{timeout}{config}) if $postfwd_settings{timeout}{config}; if ( $myline = acl_parser ($myfile, $mynum, $myline) ) { unless ( $myline =~ /^\s*[^=\s]+\s*$COMP_SEPARATOR\s*([^;\s]+\s*)+(;\s*[^=\s]+\s*$COMP_SEPARATOR\s*([^;\s]+\s*)+)*[;\s]*$/ ) { log_warn ("ignoring invalid $myfile line ".$mynum.": \"".$myline."\""); } else { # separate items foreach (split ";", $myline) { # remove whitespaces around s/^\s*(.*?)\s*($COMP_SEPARATOR)\s*(.*?)\s*$/$1$2$3/; ( ($mycomp = $2) =~ /^([\<\>\~])=$/ ) and $mycomp = "=$1"; ($mykey, $myvalue) = split /$COMP_SEPARATOR/, $_, 2; if ($mykey =~ /^$COMP_SINGLE$/) { log_note ( "notice: Rule $myindex ($myfile line $mynum):" ." overriding $mykey=\"".$myrule{$mykey}."\"" ." with $mykey=\"$myvalue\"" ) if (defined $myrule{$mykey}); $myvalue = check_for_old_syntax($myindex,$myfile,$mynum,$mykey,$myvalue); $myrule{$mykey} = $myvalue; } elsif ($mykey =~ /^$COMP_CSV$/) { map { push @{$myrule{$mykey}}, prepare_item ($forced_reload, $mycomp, $_) } ( split /\s*,\s*/, $myvalue ); } else { push @{$myrule{$mykey}}, prepare_item ($forced_reload, $mycomp, $myvalue); }; }; unless (exists($myrule{$COMP_ACTION})) { log_warn ("Rule ".$myindex." ($myfile line ".$mynum."): contains no action and will be ignored"); return (%myrule = ()); }; unless (exists($myrule{$COMP_ID})) { $myrule{$COMP_ID} = "R-".$myindex; log_note ("notice: Rule $myindex ($myfile line $mynum): contains no rule identifier - will use \"$myrule{id}\"") if wantsdebug (qw[ all thisrequest config verbose ]); }; log_info ("loaded: Rule $myindex ($myfile line $mynum): id->\"$myrule{id}\" action->\"$myrule{action}\"") if wantsdebug (qw[ all thisrequest config verbose ]); }; }; alarm($prevalert) if $postfwd_settings{timeout}{config}; }; return %myrule; }; # parses configuration file sub read_config_file { my($forced_reload, $myindex, $myfile) = @_; my(%myrule, @myruleset, @lines) = (); my($mybuffer) = ""; undef my $fh; unless (-e $myfile) { log_warn ("error: file ".$myfile." not found - file will be ignored"); } else { unless (open ($fh, "<$myfile")) { log_warn ("error: could not open ".$myfile." - $! - file will be ignored"); } else { log_info ("reading file $myfile") if wantsdebug (qw[ all thisrequest config verbose ]); while (<$fh>) { chomp; s/(\"|#.*)//g; next if /^\s*$/; if ( /(.*)\\\s*$/ or /(.*\{)\s*$/ ) { $mybuffer = $mybuffer.$1; next; }; $mybuffer .= $_; if ( $lines[0] and $mybuffer =~ /^(\}|\s+\S)/ ) { my $last = pop(@lines); $last .= ';' unless $last =~ /;\s*$/; $mybuffer = $last.$mybuffer; }; push @lines, $mybuffer; $mybuffer = ""; }; map { log_info ("parsing line: '$_'") if wantsdebug (qw[ all thisrequest config ]); %myrule = parse_config_line ($forced_reload, $myfile, $., ($#myruleset+$myindex+1), $mybuffer.$_); push ( @myruleset, { %myrule } ) if (%myrule); $mybuffer = ""; } @lines; close ($fh); log_info ("loaded: Rules $myindex - ".($myindex + $#myruleset)." from file \"$myfile\"") if wantsdebug (qw[ all thisrequest config verbose ]); }; }; return @myruleset; }; # reads all configuration items sub read_config { my($forced_reload) = shift; my(%myrule, @myruleset) = (); my($mytype,$myitem,$config); # init, cleanup cache and config vars @Rules = (); %Rule_by_ID = %Request_Cache = (); @Rate_Items = (); %Rate_Cache = () unless $postfwd_settings{keep_rates}; # parse configurations for $config (@{$postfwd_settings{Configs}}) { ($mytype,$myitem) = split $postfwd_settings{sepreq}, $config; if ($mytype eq "r" or $mytype eq "rule") { %myrule = parse_config_line ($forced_reload, 'RULE', 0, ($#Rules + 1), $myitem); push ( @Rules, { %myrule } ) if (%myrule); } elsif ($mytype eq "f" or $mytype eq "file") { if ( not($forced_reload) and defined $Config_Cache{$myitem}{lastread} and ($Config_Cache{$myitem}{lastread} > (stat $myitem)[9]) ) { log_info ("file \"$myitem\" unchanged - using cached ruleset (mtime: ".(stat $myitem)[9].", cache: $Config_Cache{$myitem}{lastread})" ) if wantsdebug (qw[ all thisrequest config verbose ]); push ( @Rules, @{$Config_Cache{$myitem}{ruleset}} ) if $Config_Cache{$myitem}{ruleset}; } else { @myruleset = read_config_file ($forced_reload, ($#Rules + 1), $myitem); if (@myruleset) { @Rules = ( @Rules, @myruleset ) if @myruleset; $Config_Cache{$myitem}{lastread} = time(); @{$Config_Cache{$myitem}{ruleset}} = @myruleset; }; }; }; }; if ($#Rules < 0) { log_warn("critical: no rules found - i feel useless (have you set -f or -r?)"); } else { # update Rule by ID hash map { $Rule_by_ID{$Rules[$_]{$COMP_ID}} = $_ } (0 .. $#Rules); if ( @Rate_Items ) { @Rate_Items = uniq(@Rate_Items); log_info ("rate items: ".(join ', ', @Rate_Items)) if wantsdebug (qw[ all thisrequest verbose rates ]); # disable request cache with ratelimits unless --fast_limit_evaluation is set unless ($postfwd_settings{rate}{fast_eval}) { $postfwd_settings{request}{ttl} = 0; log_note ("disabling request cache due to ratelimits in configuration. may be changed with the --fast_limit_evaluation option") if wantsdebug (qw[ all thisrequest verbose ]); }; }; }; }; # displays configuration sub show_config { if (wantsdebug (qw[ all verbose ])) { print STDOUT "=" x 75, "\n"; printf STDOUT "Rule count: %s\n", ($#Rules + 1); print STDOUT "=" x 75, "\n"; }; for my $index (0 .. $#Rules) { next unless exists $Rules[$index]; printf STDOUT "Rule %3d: id->\"%s\"; action->\"%s\"", $index, $Rules[$index]{$COMP_ID}, $Rules[$index]{$COMP_ACTION}; my $line = (wantsdebug (qw[ all verbose ])) ? "\n\t " : ""; for my $mykey ( reverse sort keys %{$Rules[$index]} ) { unless (($mykey eq $COMP_ACTION) or ($mykey eq $COMP_ID)) { $line .= "; " unless wantsdebug (qw[ all verbose ]); $line .= ($mykey =~ /^$COMP_SINGLE$/) ? $mykey."->\"".$Rules[$index]{$mykey}."\"" : $mykey."->\"".(join ', ', @{$Rules[$index]{$mykey}})."\""; $line .= " ; " if wantsdebug (qw[ all verbose ]); }; }; $line =~ s/\s*\;\s*$// if wantsdebug (qw[ all verbose ]); printf STDOUT "%s\n", $line; print STDOUT "-" x 75, "\n" if wantsdebug (qw[ all verbose ]); }; }; ## sub DNS # checks for rbl timeouts sub rbl_timeout { my($myrbl) = shift; return ( ($postfwd_settings{dns}{max_timeout} > 0) and (defined $Timeouts{$myrbl}) and ($Timeouts{$myrbl} > $postfwd_settings{dns}{max_timeout}) ); }; # reads DNS answers sub rbl_read_dns { my($myresult) = shift; my($now) = time(); my($que,$ttl,$res,$typ) = undef; my(@addrs,@texts) = (); if ( defined $myresult ) { # read question, for dns cache id foreach ($myresult->question) { $typ = ($_->qtype || ''); $que = ($_->qname || ''); map { &{$postfwd_settings{syslog}{logger}} ('info', "[GETDNS00] type=$typ, query=$que, $_") } (hash_to_list ('%packet', %{$myresult})) if wantsdebug (qw[ all thisrequest dns getdns getdnspacket ]); next unless ($typ and $que); log_info ("[GETDNS01] type=$typ, query=$que") if wantsdebug (qw[ all thisrequest dns getdns ]); unless ( (defined $DNS_Cache{$que}) and (($typ eq 'A') or ($typ eq 'TXT')) ) { log_note ("[DNSBL] ignoring unknown query '$que', type '$typ'"); next; }; # parse answers foreach ($myresult->answer) { log_info ("[GETDNS02] type=$typ, query=$que, restype='".$_->type."'") if wantsdebug (qw[ all thisrequest dns getdns ]); if ($_->type eq 'A') { push @addrs, $_->address if $_->address; $ttl = $_->ttl; log_info ("[GETDNSA1] type=$typ, query=$que, ttl=$ttl, answer='".($_->address || '')."'") if wantsdebug (qw[ all thisrequest dns getdns ]); } elsif ($_->type eq 'TXT') { $res = (join(" ", $_->char_str_list()) || ''); # escape commas for set() action $res =~ s/,/ /g; push @texts, $res; $ttl = $_->ttl; log_info ("[GETDNST1] type=$typ, query=$que, ttl=$ttl, answer='$res'") if wantsdebug (qw[ all thisrequest dns getdns ]); } elsif (wantsdebug (qw[ all thisrequest dns getdns ])) { log_info ("[GETDNS??] received answer type=".$typ." for query $que"); }; }; # save result in cache if ($typ eq 'A') { $ttl = ( $DNS_Cache{$que}{ttl} > ($ttl||=0) ) ? $DNS_Cache{$que}{ttl} : $ttl; @{$DNS_Cache{$que}{A}} = @addrs; $DNS_Cache{$que}{ttl} = $ttl; $DNS_Cache{$que}{delay} = ($now - $DNS_Cache{$que}{delay}); $DNS_Cache{$que}{'log'} = 1; $DNS_Cache{$que}{'until'} = $now + $DNS_Cache{$que}{ttl}; log_info ("[GETDNSA2] type=$typ, query=$que, cache='".(hash_to_str(%{$DNS_Cache{$que}}))."'") if wantsdebug (qw[ all thisrequest dns getdns ]); #} elsif ($typ eq 'TXT') { } else { $res = (join(" ", @texts) || ''); $ttl = ( $DNS_Cache{$que}{ttl} > ($ttl||=0) ) ? $DNS_Cache{$que}{ttl} : $ttl; $DNS_Cache{$que}{TXT} = $res; $DNS_Cache{$que}{ttl} = $ttl unless $DNS_Cache{$que}{ttl}; log_info ("[GETDNST2] type=$typ, query=$que, cache='".(hash_to_str(%{$DNS_Cache{$que}}))."'") if wantsdebug (qw[ all thisrequest dns getdns ]); }; }; return $que if (@addrs || $res); } else { log_note ("[DNSBL] dns timeout"); }; }; # fires DNS queries sub rbl_prepare_lookups { my($mytype, $myval, @myrbls) = @_; my($myresult) = undef; my($cmp,$rblitem,$myquery); my(@lookups) = (); # skip these return @lookups if (($myval eq '') or ($myval eq "unknown")) or ($myval =~ /:/); # removes duplicate lookups, but keeps the specified order @myrbls = uniq(@myrbls); RBLQUERY: foreach (@myrbls) { # separate rbl-name and answer ($cmp,$rblitem) = split ";", $_; next RBLQUERY unless $rblitem; my($myrbl, $myrblans, $myrbltime) = split /\//, $rblitem; next RBLQUERY unless $myrbl; next RBLQUERY if rbl_timeout($myrbl); $myrblans = $postfwd_settings{dns}{mask} unless $myrblans; $myrbltime = $postfwd_settings{dns}{ttl} unless $myrbltime; # create query string $myquery = $myval.".".$myrbl; my $mypat = qr/$myrblans/; # query our cache if ( exists($DNS_Cache{$myquery}) and exists($DNS_Cache{$myquery}{A}) ) { ANSWER1: foreach (@{$DNS_Cache{$myquery}{A}}) { last ANSWER1 if $myresult = ( $_ =~ /$mypat/ ) }; log_info ("[DNSBL] cached $mytype: $myrbl $myval ($myquery) - answer: \'".(join ", ", @{$DNS_Cache{$myquery}{A}})."\'") if ( wantsdebug (qw[ all thisrequest ]) or ($myresult and wantsdebug (qw[ verbose ])) ); # query parent cache } elsif ( not($postfwd_settings{dns}{noparent}) and not((my $pans = cache_query ("CMD=".$postfwd_commands{getcacheitem}.";TYPE=dns;ITEM=$myquery")) eq '') ) { %{$DNS_Cache{$myquery}} = str_to_hash($pans); delete $DNS_Cache{$myquery}{'log'} if $DNS_Cache{$myquery}{'log'}; if ($DNS_Cache{$myquery}{A}) { ref $DNS_Cache{$myquery}{A} eq 'ARRAY' or $DNS_Cache{$myquery}{A} = [ $DNS_Cache{$myquery}{A} ]; ANSWER2: foreach (@{$DNS_Cache{$myquery}{A}}) { last ANSWER2 if $myresult = ( $_ =~ /$mypat/ ) }; log_info ("[DNSBL] parent cached $mytype: $myrbl $myval ($myquery) - answer: \'".(join ", ", @{$DNS_Cache{$myquery}{A}})."\'") if ( wantsdebug (qw[ all thisrequest ]) or ($myresult and wantsdebug (qw[ verbose ])) ); }; # not found -> prepare dns query } else { $DNS_Cache{$myquery} = { type => $mytype, name => $myrbl, value => $myval, ttl => $myrbltime, delay => time(), }; log_info("[DNSBL] query $mytype: $myrbl $myval ($myquery)") if wantsdebug (qw[ all thisrequest ]); push @lookups, $myquery; }; }; # return necessary lookups return @lookups; }; # checks RBL items sub rbl_check { my($mytype,$myrbl,$myval) = @_; my($myanswer,$myrblans,$myrbltime,$myresult,$mystart,$myend); my($m1,$m2,$myrbltype,$m4,$myrbltxt,$myquery); my($now) = time(); # skip these return $myresult if (($myval eq '') or ($myval eq "unknown")) or ($myval =~ /:/); # separate rbl-name and answer ($myrbl, $myrblans, $myrbltime) = split '/', $myrbl; $myrblans = $postfwd_settings{dns}{mask} unless $myrblans; $myrbltime = $postfwd_settings{dns}{ttl} unless $myrbltime; # create query string $myquery = $myval.".".$myrbl; # query our cache return $myresult unless ( $myresult = (defined $DNS_Cache{$myquery} and not(defined $DNS_Cache{$myquery}{'timed'})) ); if (not($postfwd_settings{dns}{noparent}) and defined $DNS_Cache{$myquery}{'log'}) { my $pdns = "CMD=".$postfwd_commands{setcacheitem}.";TYPE=dns;ITEM=$myquery".hash_to_str(%{$DNS_Cache{$myquery}}); cache_query ($pdns); }; if ( $myresult = ($#{$DNS_Cache{$myquery}{A}} >= 0) ) { my $mypat = qr/$myrblans/; ANSWER: foreach (@{$DNS_Cache{$myquery}{A}}) { last ANSWER if ( $myresult = ( ($_) and ($_ =~ m/$mypat/)) ); }; push @DNSBL_Text, $DNS_Cache{$myquery}{type}.':'.$DNS_Cache{$myquery}{name}.':<'.($DNS_Cache{$myquery}{TXT} || '').'>' if $myresult and defined $DNS_Cache{$myquery}{type} and defined $DNS_Cache{$myquery}{name}; if ( wantsdebug (qw[ all thisrequest verbose ]) or $postfwd_settings{dns}{anylog} or ($myresult and not($postfwd_settings{dns}{nolog}) and defined $DNS_Cache{$myquery}{'log'}) ) { log_info ("[DNSBL] ".( ($mytype eq $COMP_RBL_KEY) ? join('.', reverse(split(/\./,$myval))) : $myval )." listed on " .lc(($DNS_Cache{$myquery}{type} || $mytype)).":$myrbl (answer: ".(join ", ", @{$DNS_Cache{$myquery}{A}}) .", time: ".ts($DNS_Cache{$myquery}{delay})."s, ttl: ".$DNS_Cache{$myquery}{ttl}."s, '".($DNS_Cache{$myquery}{TXT} || '')."')"); delete $DNS_Cache{$myquery}{'log'} if defined $DNS_Cache{$myquery}{'log'}; }; }; return $myresult; }; # dns resolver wrapper sub dns_query { my (@queries) = @_; undef my @result; eval { local $SIG{__DIE__} = sub { log_note ("[DNS] ERROR: \"$!\", DETAIL: \"@_\""); return if $^S; }; @result = dns_query_net_dns(@queries); }; return @result; }; # resolves dns queries using Net::DNS sub dns_query_net_dns { my (@queries) = @_; undef my @result; undef my $pans; my %ownsock = (); my @ownready = (); undef my $bgsock; my $ownsel = IO::Select->new(); my $dns = Net::DNS::Resolver->new( tcp_timeout => $postfwd_settings{dns}{timeout}, udp_timeout => $postfwd_settings{dns}{timeout}, persistent_tcp => 0, persistent_udp => 0, retrans => 0, retry => 1, dnsrch => 0, defnames => 0, ); my $now = time(); # prepare queries foreach (@queries) { my ($item, $type) = split ','; $type ||= 'A'; # query child cache if ( (defined $DNS_Cache{$item}{$type}) and (defined $DNS_Cache{$item}{'until'}) and ($DNS_Cache{$item}{'until'} >= $now) ) { $DNS_Cache{$item}{$type} = [ $DNS_Cache{$item}{$type} ] unless (ref $DNS_Cache{$item}{$type} eq 'ARRAY'); log_info ("[DNS] dnsccache: item=$item, type=$type -> ".(join ',', @{$DNS_Cache{$item}{$type}})." (ttl: ".($DNS_Cache{$item}{ttl} || 0).")") if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all thisrequest dns getdns ])); push @result, @{$DNS_Cache{$item}{$type}}; # query parent cache } elsif ( not($postfwd_settings{dns}{noparent}) and not(($pans = cache_query ("CMD=".$postfwd_commands{getcacheitem}.";TYPE=dns;ITEM=$item")) eq '') and (%{$DNS_Cache{$item}} = str_to_hash($pans)) and (defined $DNS_Cache{$item}{$type}) and (defined $DNS_Cache{$item}{'until'}) and ($DNS_Cache{$item}{'until'} >= $now) ) { $DNS_Cache{$item}{$type} = [ $DNS_Cache{$item}{$type} ] unless (ref $DNS_Cache{$item}{$type} eq 'ARRAY'); log_info ("[DNS] dnspcache: item=$item, type=$type -> ".(join ',', @{$DNS_Cache{$item}{$type}})." (ttl: ".($DNS_Cache{$item}{ttl} || 0).")") if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all thisrequest dns getdns ])); push @result, @{$DNS_Cache{$item}{$type}}; # send queries } else { log_info ("[DNS] dnsquery: item=$item, type=$type") if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all thisrequest dns getdns ])); $DNS_Cache{$item}{delay} = $now; $bgsock = $dns->bgsend ($item, $type); $ownsel->add($bgsock); $ownsock{$bgsock} = $item.','.$type; }; }; # retrieve answers while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($postfwd_settings{dns}{timeout}))) { foreach my $sock (@ownready) { if (defined $ownsock{$sock}) { my $packet = $dns->bgread($sock); my ($item, $type) = split ',', $ownsock{$sock}; my $rname = $DNS_REPNAMES{$type}; my @rrs = (grep { $_->type eq $type } $packet->answer); $now = time(); my $ttl = 0; my @ans = (); if (@rrs) { # sort MX records by preference @rrs = sort { $a->preference <=> $b->preference } @rrs if ($type eq 'MX'); foreach my $rr (@rrs) { $ttl = $rr->ttl if ($rr->ttl > $ttl); log_info ("[DNS] dnsanswer: item=$item, type=$type -> $rname=".$rr->$rname." (ttl: $ttl)") if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all thisrequest dns setdns ])); push @ans, $rr->$rname; }; push @result, @ans; }; # add to dns cache $ttl ||= $postfwd_settings{dns}{ttl}; @{$DNS_Cache{$item}{$type}} = @ans; $DNS_Cache{$item}{ttl} = $ttl; $DNS_Cache{$item}{'until'} = $now + $ttl; $DNS_Cache{$item}{delay} = ($DNS_Cache{delay}) ? $now - $DNS_Cache{delay} : 0; cache_query ( "CMD=".$postfwd_commands{setcacheitem}.";TYPE=dns;ITEM=$item".hash_to_str(%{$DNS_Cache{$item}}) ) unless ($postfwd_settings{dns}{noparent}); $DNS_Cache{$item}{'log'} = 1; log_info ("[DNS] dnsanswers: item=$item, type=$type -> $rname=".((@{$DNS_Cache{$item}{$type}}) ? join ',', @{$DNS_Cache{$item}{$type}} : '')." (delay: ".ts($DNS_Cache{$item}{delay}).", ttl: $ttl)") if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all thisrequest verbose dns setdns ])); delete $ownsock{$sock}; } else { $ownsel->remove($sock); $sock = undef; }; }; }; # show timeouts map { log_note ("dnsquery: timeout for $_ after ".$postfwd_settings{dns}{timeout}." seconds") } (values %ownsock); return @result; }; ## SUB plugins # # these subroutines integrate additional attributes to # a request before the ruleset is evaluated # call: %result = postfwd_items{foo}(%request) # save: $result{$_} # %postfwd_items = ( "__builtin__" => sub { my(%request) = @_; my(%result) = (); # postfwd version $result{version} = $postfwd_settings{name}." ".$postfwd_settings{version}; # sender info $request{sender} =~ /(.*)@([^@]*)$/; ( $result{sender_localpart}, $result{sender_domain} ) = ( $1, $2 ); # recipient info $request{recipient} =~ /(.*)@([^@]*)$/; ( $result{recipient_localpart}, $result{recipient_domain} ) = ( $1, $2 ); # reverted ip address (for lookups) $result{reverse_address} = (join(".", reverse(split(/\./,$request{client_address})))); return %result; }, "sender_dns" => sub { my(%request) = @_; my(%result) = (); map { $result{$_} = $request{sender_domain} } ($COMP_NS_NAME, $COMP_NS_ADDR, $COMP_MX_NAME, $COMP_MX_ADDR); $result{$COMP_HELO_ADDR} = $request{helo_name}; return %result; }, ); # returns additional request information # for all postfwd_items sub postfwd_items { my(%request) = @_; my(%result) = (); foreach (sort keys %postfwd_items) { log_info ("[PLUGIN] executing postfwd-item ".$_) if wantsdebug (qw[ all thisrequest ]); %result = (%result, &{$postfwd_items{$_}}((%request,%result))) if (defined $postfwd_items{$_}); }; map { $result{$_} = '' unless (defined $result{$_}); log_info ("[PLUGIN] Added key: $_=$result{$_}") if wantsdebug (qw[ all thisrequest ]) } (keys %result); return %result; }; # # compare item subroutines # must take compare_item_foo ( $COMPARE_TYPE, $RULEITEM, $REQUESTITEM, %REQUEST, %REQUESTINFO ); # %postfwd_compare = ( "cidr" => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = ($val and $myitem); log_info ("type cidr : \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); if ($myresult) { # always true $myresult = ($val eq '0.0.0.0/0'); unless ($myresult) { # v4 addresses only $myresult = ($myitem =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/); if ($myresult) { $val .= '/32' unless ($val =~ /\/\d{1,2}$/); $myresult = cidr_match((cidr_parse($val)),$myitem); } else { log_info ("Non IPv4 address. Using type default") if wantsdebug (qw[ all thisrequest ]); return &{$postfwd_compare{default}}($cmp,$val,$myitem,%request); }; }; }; $myresult = not($myresult) if ($cmp eq '!='); return $myresult; }, "numeric" => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; log_info ("type numeric : \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); $myitem ||= "0"; $val ||= "0"; if ($cmp eq '==') { $myresult = ($myitem == $val); } elsif ($cmp eq '=<') { $myresult = ($myitem <= $val); } elsif ($cmp eq '=>') { $myresult = ($myitem >= $val); } elsif ($cmp eq '<') { $myresult = ($myitem < $val); } elsif ($cmp eq '>') { $myresult = ($myitem > $val); } elsif ($cmp eq '!=') { $myresult = not($myitem == $val); } elsif ($cmp eq '!<') { $myresult = not($myitem <= $val); } elsif ($cmp eq '!>') { $myresult = not($myitem >= $val); } else { $myresult = ($myitem >= $val); }; return $myresult; }, $COMP_RBL_KEY => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = not($postfwd_settings{dns}{disabled}); log_info ("type rbl : \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); $myresult = ( rbl_check ($COMP_RBL_KEY, $val, $myitem) ) if $myresult; $myresult = not($myresult) if ($cmp eq '!='); return $myresult; }, $COMP_RHSBL_KEY => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = not($postfwd_settings{dns}{disabled}); log_info ("type rhsbl : \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); $myresult = ( rbl_check ($COMP_RHSBL_KEY, $val, $myitem) ) if $myresult; $myresult = not($myresult) if ($cmp eq '!='); return $myresult; }, $COMP_MONTHS => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; my($imon) = (split (',', $myitem))[4]; $imon ||= 0; my($rmin,$rmax) = split (/\s*-\s*/, $val); $rmin = ($rmin) ? (($rmin =~ /^\d$/) ? $rmin : $months{$rmin}) : $imon; $rmax = ($rmax) ? (($rmax =~ /^\d$/) ? $rmax : $months{$rmax}) : (($val =~ /-/) ? $imon : $rmin); log_info ("type months : \"$imon\" \"$cmp\" \"$rmin\"-\"$rmax\"") if wantsdebug (qw[ all thisrequest ]); $myresult = (($rmin <= $imon) and ($rmax >= $imon)); $myresult = not($myresult) if ($cmp eq '!='); return $myresult; }, $COMP_DAYS => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; my($iday) = (split (',', $myitem))[6]; $iday ||= 0; my($rmin,$rmax) = split (/\s*-\s*/, $val); $rmin = ($rmin) ? (($rmin =~ /^\d$/) ? $rmin : $weekdays{$rmin}) : $iday; $rmax = ($rmax) ? (($rmax =~ /^\d$/) ? $rmax : $weekdays{$rmax}) : (($val =~ /-/) ? $iday : $rmin); log_info ("type days : \"$iday\" \"$cmp\" \"$rmin\"-\"$rmax\"") if wantsdebug (qw[ all thisrequest ]); $myresult = (($rmin <= $iday) and ($rmax >= $iday)); $myresult = not($myresult) if ($cmp eq '!='); return $myresult; }, $COMP_DATE => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; my($isec,$imin,$ihour,$iday,$imon,$iyear) = split (',', $myitem); my($rmin,$rmax) = split (/\s*-\s*/, $val); my($idat) = ($iyear + 1900) . ((($imon+1) < 10) ? '0'.($imon+1) : ($imon+1)) . (($iday < 10) ? '0'.$iday : $iday); $rmin = ($rmin) ? join ('', reverse split ('\.', $rmin)) : $idat; $rmax = ($rmax) ? join ('', reverse split ('\.', $rmax)) : (($val =~ /-/) ? $idat : $rmin); log_info ("type date : \"$idat\" \"$cmp\" \"$rmin\"-\"$rmax\"") if wantsdebug (qw[ all thisrequest ]); $myresult = (($rmin <= $idat) and ($rmax >= $idat)); $myresult = not($myresult) if ($cmp eq '!='); return $myresult; }, $COMP_TIME => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; my($isec,$imin,$ihour,$iday,$imon,$iyear) = split (',', $myitem); my($rmin,$rmax) = split (/\s*-\s*/, $val); my($idat) = (($ihour < 10) ? '0'.$ihour : $ihour) . (($imin < 10) ? '0'.$imin : $imin) . (($isec < 10) ? '0'.$isec : $isec); $rmin = ($rmin) ? join ('', split ('\:', $rmin)) : $idat; $rmax = ($rmax) ? join ('', split ('\:', $rmax)) : (($val =~ /-/) ? $idat : $rmin); log_info ("type time : \"$idat\" \"$cmp\" \"$rmin\"-\"$rmax\"") if wantsdebug (qw[ all thisrequest ]); $myresult = (($rmin <= $idat) and ($rmax >= $idat)); $myresult = not($myresult) if ($cmp eq '!='); return $myresult; }, $COMP_HELO_ADDR => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; return $myresult if $postfwd_settings{dns}{disabled}; return $myresult unless $myitem =~ /\./; if ( my @answers = dns_query ("$myitem,A") ) { log_info ("type $COMP_HELO_ADDR : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); map { $myresult = ( &{$postfwd_compare{cidr}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; }; return $myresult; }, $COMP_NS_NAME => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; return $myresult if $postfwd_settings{dns}{disabled}; return $myresult unless $myitem =~ /\./; if ( my @answers = dns_query ("$myitem,NS") ) { log_info ("type $COMP_NS_NAME : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); map { $myresult = ( &{$postfwd_compare{default}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; } else { $myresult = ( &{$postfwd_compare{default}}(($cmp,$val,'',%request)) ); }; return $myresult; }, $COMP_MX_NAME => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; return $myresult if $postfwd_settings{dns}{disabled}; return $myresult unless $myitem =~ /\./; if ( my @answers = dns_query ("$myitem,MX") ) { log_info ("type $COMP_MX_NAME : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); map { $myresult = ( &{$postfwd_compare{default}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; } else { $myresult = ( &{$postfwd_compare{default}}(($cmp,$val,'',%request)) ); }; return $myresult; }, $COMP_NS_ADDR => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; return $myresult if $postfwd_settings{dns}{disabled}; return $myresult unless $myitem =~ /\./; if ( my @answers = dns_query ("$myitem,NS") ) { splice (@answers, $postfwd_settings{dns}{max_ns_lookups}) if $postfwd_settings{dns}{max_ns_lookups} and $#answers > $postfwd_settings{dns}{max_ns_lookups}; if ( @answers = dns_query (@answers) ) { log_info ("type $COMP_NS_ADDR : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); map { $myresult = ( &{$postfwd_compare{cidr}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; }; }; return $myresult; }, $COMP_MX_ADDR => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; return $myresult if $postfwd_settings{dns}{disabled}; return $myresult unless $myitem =~ /\./; if ( my @answers = dns_query ("$myitem,MX") ) { splice (@answers, $postfwd_settings{dns}{max_mx_lookups}) if $postfwd_settings{dns}{max_mx_lookups} and $#answers > $postfwd_settings{dns}{max_mx_lookups}; if ( @answers = dns_query (@answers) ) { log_info ("type $COMP_MX_ADDR : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); map { $myresult = ( &{$postfwd_compare{cidr}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; }; }; return $myresult; }, "default" => sub { my($cmp,$val,$myitem,%request) = @_; my($var,$myresult) = undef; log_info ("type default : \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); # backward compatibility $cmp = '==' if ( ($var) and ($cmp eq '=') ); if ($cmp eq '==') { $myresult = ( lc($myitem) eq lc($val) ) if $myitem; } elsif ($cmp eq '!=') { $myresult = not( lc($myitem) eq lc($val) ) if $myitem; } elsif ($cmp eq '=<') { $myresult = (($myitem || 0) <= $val); } elsif ($cmp eq '!<') { $myresult = not(($myitem || 0) <= $val); } elsif ($cmp eq '=>') { $myresult = (($myitem || 0) >= $val); } elsif ($cmp eq '!>') { $myresult = not(($myitem || 0) >= $val); } elsif ($cmp eq '<') { $myresult = (($myitem || 0) < $val); } elsif ($cmp eq '>') { $myresult = (($myitem || 0) > $val); } elsif ($cmp eq '=~') { $myresult = ($myitem =~ /$val/i); } elsif ($cmp eq '!~') { $myresult = ($myitem !~ /$val/i); } else { # allow // regex $val =~ s/^\/?(.*?)\/?$/$1/; $myresult = $myitem =~ /$val/i; }; return $myresult; }, "client_address" => sub { return &{$postfwd_compare{cidr}}(@_); }, "encryption_keysize" => sub { return &{$postfwd_compare{numeric}}(@_); }, "size" => sub { return &{$postfwd_compare{numeric}}(@_); }, "recipient_count" => sub { return &{$postfwd_compare{numeric}}(@_); }, "request_score" => sub { return &{$postfwd_compare{numeric}}(@_); }, $COMP_RHSBL_KEY_CLIENT => sub { return &{$postfwd_compare{$COMP_RHSBL_KEY}}(@_); }, $COMP_RHSBL_KEY_SENDER => sub { return &{$postfwd_compare{$COMP_RHSBL_KEY}}(@_); }, $COMP_RHSBL_KEY_HELO => sub { return &{$postfwd_compare{$COMP_RHSBL_KEY}}(@_); }, $COMP_RHSBL_KEY_RCLIENT => sub { return &{$postfwd_compare{$COMP_RHSBL_KEY}}(@_); }, ); # # these subroutines define postfwd actions # %postfwd_actions = ( # example action foo() # "foo" => sub { # my($index,$now,$mycmd,$myarg,$myline,%request) = @_; # my($myaction) = $postfwd_settings{default}; my($stop) = 0; # ... # return ($stop,$index,$myaction,$myline,%request); # }, # jump() command "jump" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; if (defined $Rule_by_ID{$myarg}) { my($ruleno) = $Rule_by_ID{$myarg}; log_info ("[RULES] ".$myline .", jump to rule $ruleno (id $myarg)") if wantsdebug (qw[ all thisrequest verbose ]); $index = $ruleno - 1; } else { log_warn ("[RULES] ".$myline." - error: jump failed, can not find rule-id ".$myarg." - ignoring"); }; return ($stop,$index,$myaction,$myline,%request); }, # set() command "set" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; foreach ( split (",", $myarg) ) { if ( /^\s*([^=]+?)\s*([\.\-\*\/\+=]=|=[\.\-\*\/\+=]|=)\s*(.*?)\s*$/ ) { my($r_var, $mod, $r_val) = ($1, $2, $3); my($m_val) = (defined $request{$r_var}) ? $request{$r_var} : 0; # saves some ifs if (($mod eq '=') or ($mod eq '==')) { $m_val = $r_val; } elsif ( ($mod eq '.=') or ($mod eq '=.') ) { $m_val .= $r_val; } elsif ( (($mod eq '+=') or ($mod eq '=+')) and (($m_val=~/^\-?\d+(\.\d+)?$/) and ($r_val=~/^\-?\d+(\.\d+)?$/)) ) { $m_val += $r_val; } elsif ( (($mod eq '-=') or ($mod eq '=-')) and (($m_val=~/^\-?\d+(\.\d+)?$/) and ($r_val=~/^\-?\d+(\.\d+)?$/)) ) { $m_val -= $r_val; } elsif ( (($mod eq '*=') or ($mod eq '=*')) and (($m_val=~/^\-?\d+(\.\d+)?$/) and ($r_val=~/^\-?\d+(\.\d+)?$/)) ) { $m_val *= $r_val; } elsif ( (($mod eq '/=') or ($mod eq '=/')) and (($m_val=~/^\-?\d+(\.\d+)?$/) and ($r_val=~/^\-?\d+(\.\d+)?$/)) ) { $m_val /= (($r_val == 0) ? 1 : $r_val); } else { $m_val = $r_val; }; $m_val = $1.($2 || '').($3 || '') if ( $m_val =~ /^(\-?\d+)([\.,]\d+)?(.*)$/ ); (defined $request{$r_var}) ? log_info ("notice", "[RULES] ".$myline.", redefining existing ".$r_var."=".$request{$r_var}." with ".$r_var."=".$m_val) : log_info ("[RULES] ".$myline.", defining ".$r_var."=".$m_val) if wantsdebug (qw[ all thisrequest verbose ]); $request{$r_var} = $m_val; } else { log_warn ("[RULES] ".$myline.", ignoring unknown set() attribute ".$_); }; }; return ($stop,$index,$myaction,$myline,%request); }, # score() command "score" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; my($score) = (defined $request{request_score}) ? $request{request_score} : 0; if ($myarg =~/^([\+\-\*\/\=]?)(\d+)([\.,](\d+))?$/) { my($mod, $val) = ($1, $2 + ((defined $4) ? "0.$4" : 0)); if ($mod eq '-') { $score -= $val; } elsif ($mod eq '*') { $score *= $val; } elsif ($mod eq '/') { $score /= $val unless ($val == 0); } elsif ($mod eq '=') { $score = $val; } else { $score += $val; }; $score = $1.((defined $2) ? $2 : '.0') if ( $score =~ /^(\-?\d+)([\.,]\d\d?)?/ ); log_info ("[SCORE] ".$myline.", modifying score about ".$myarg." points to ". $score) if wantsdebug (qw[ all thisrequest verbose ]); $request{score} = $request{request_score} = $score; } elsif ($myarg) { log_warn ("[RULES] ".$myline.", invalid value for score \"$myarg\" - ignoring"); }; MAXSCORE: foreach my $max_score (reverse sort keys %{$postfwd_settings{scores}}) { if ( ($score >= $max_score) and ($postfwd_settings{scores}{$max_score}) ) { $myaction=$postfwd_settings{scores}{$max_score}; $myline .= ", score=".$score."/".$max_score; $stop = $score; last MAXSCORE; }; }; return ($stop,$index,$myaction,$myline,%request); }, # mail() command "mail" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; my($mserver,$mhelo,$mfrom,$mto,$msubject,$mbody) = split "/", $myarg, 6; ($mserver, my $mport) = split ":", $mserver; my $res = ""; my @talk = ( "HELO $mhelo", "MAIL FROM: $mfrom", "RCPT TO: $mto", "DATA", "Subject: $msubject\r\n$mbody\r\n.", "QUIT", ); if ( my $socket = IO::Socket::INET->new( PeerAddr => $mserver, PeerPort => ($mport ||= 25), Proto => 'tcp', Timeout => 30, Type => SOCK_STREAM, ) ) { SMTP: foreach (@talk) { print $socket "$_\r\n"; $res = <$socket>; chomp($res); last SMTP unless $res =~ /^[23][0-9][0-9] /; }; close($socket); log_info ("[MAIL] ".$myline.", mail server=<$mserver:$mport>, from=<$mfrom>, to=<$mto>, subject=<$msubject>, status=<$res>"); } else { log_info ("[MAIL] ".$myline.", could not open socket to $mserver:$mport: '$!'"); }; return ($stop,$index,$myaction,$myline,%request); }, # sendmail() "sendmail" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; my($mcmd,$mfrom,$mto,$msubject,$mbody) = split '::', $myarg, 5; my($msg) = "From: $mfrom\nTo: $mto\nSubject: $msubject\n\n$mbody\n"; if ( (-x $mcmd) and open (SM, "| $mcmd -i -f $mfrom $mto") ) { if ( print SM "$msg" ) { log_info ("[SENDMAIL] ".$myline.", $mcmd from=<$mfrom>, to=<$mto>, subject=<$msubject>"); } else { log_note ("[SENDMAIL] ".$myline.", could not print to $mcmd pipe: '$!'"); }; close(SM); } else { log_note ("[SENDMAIL] ".$myline.", could not open pipe to $mcmd: '$!'"); }; return ($stop,$index,$myaction,$myline,%request); }, # rate() command "rate" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; my $prate = ''; my($ratetype,$ratecount,$ratetime,$ratecmd) = split "/", $myarg, 4; my($rcount) = ( ($mycmd =~ /^size/) ? $request{size} : (($mycmd =~ /^rcpt/) ? $request{recipient_count} : 1 ) ); if ($ratetype and $ratecount and $ratetime and $ratecmd and $rcount) { my $crate = $Rules[$index]{$COMP_ID}.'+'.$ratecount.'_'.$ratetime; if ( defined $request{$ratetype} ) { my $r = $request{$ratetype}; unless ($mycmd =~ /5321$/) { $r = lc($r); } else { $r = ($r =~ /^([^@]+)@(\S+)$/) ? $1.'@'.lc($2) : lc($r); }; $ratetype .= "=".$r; if ( $postfwd_settings{rate}{fast_eval} ) { # Check if rate already exists in cache my $rate_exists = ( defined $Rate_Cache{$ratetype}{$crate} ); if ( $rate_exists ) { # Child hit log_info ("[RULES] rate limit object '".$ratetype."' '".$crate."' exists in local cache") if wantsdebug (qw[ all thisrequest rates ]); # Query parent cache } elsif ( not $postfwd_settings{rate}{noparent} ) { my $prate = "CMD=".$postfwd_commands{getrateitem}.";TYPE=rate;ITEM=$ratetype".$postfwd_settings{seplim}.$crate; log_info ("[RULES] query parent cache: '$prate'") if wantsdebug (qw[ all thisrequest rates ]); $prate = cache_query($prate); log_info ("[RULES] parent cache answer: '$prate'") if wantsdebug (qw[ all thisrequest rates ]); $rate_exists = ( $prate ne '' ); if ( $rate_exists ) { # Parent hit, populate local cache %{$Rate_Cache{$ratetype}{$crate}} = str_to_hash($prate); push @{$Rate_Cache{$ratetype}{'list'}}, $crate; @{$Rate_Cache{$ratetype}{'list'}} = uniq(@{$Rate_Cache{$ratetype}{'list'}}); }; }; unless ( $rate_exists ) { log_info ("[RULES] ".$myline .", creating rate limit object '".$ratetype."' '".$crate."'" ." [type: ".$mycmd.", max: ".$ratecount.", time: ".$ratetime."s]") if wantsdebug (qw[ all thisrequest rates ]); push @{$Rate_Cache{$ratetype}{'list'}}, $crate; @{$Rate_Cache{$ratetype}{'list'}} = uniq(@{$Rate_Cache{$ratetype}{'list'}}); $Rate_Cache{$ratetype}{$crate} = { type => $mycmd, maxcount => $ratecount, ttl => $ratetime, 'time' => $now, 'until' => $now + $ratetime, count => $rcount, rule => $Rules[$index]{$COMP_ID}, action => $ratecmd, }; unless ($postfwd_settings{rate}{noparent}) { $prate = "CMD=".$postfwd_commands{setrateitem}.";TYPE=rate;ITEM=$ratetype".$postfwd_settings{seplim}.$crate.hash_to_str(%{$Rate_Cache{$ratetype}{$crate}}); log_info ("updating parent rate limit object '".$prate."'") if wantsdebug (qw[ all thisrequest rates setcache ]); cache_query ($prate); }; }; } else { push @{$Rate_Cache{$ratetype}{'list'}}, $crate; @{$Rate_Cache{$ratetype}{'list'}} = uniq(@{$Rate_Cache{$ratetype}{'list'}}); $Rate_Cache{$ratetype}{$crate} = { type => $mycmd, maxcount => $ratecount, ttl => $ratetime, 'time' => $now, 'until' => $now + $ratetime, count => $rcount, rule => $Rules[$index]{$COMP_ID}, action => $ratecmd, }; unless ($postfwd_settings{rate}{noparent}) { $prate = "CMD=".$postfwd_commands{setrateitem2}.";TYPE=rate;ITEM=$ratetype".$postfwd_settings{seplim}.$crate.hash_to_str(%{$Rate_Cache{$ratetype}{$crate}}); log_info ("updating parent rate limit object '".$prate."'") if wantsdebug (qw[ all thisrequest rates setcache ]); $prate = cache_query ($prate); }; $Rate_Cache{$ratetype}{$crate}{count} = $prate if ($prate =~ /^\d+$/); }; # rate exceeded $stop = ( $Rate_Cache{$ratetype}{$crate}{count} > $Rate_Cache{$ratetype}{$crate}{maxcount} ); if ($stop) { $myaction=$Rate_Cache{$ratetype}{$crate}{action}; $request{'ratecount'} = $prate; $myline .= ", rate=".$Rate_Cache{$ratetype}{$crate}{type}."/".$Rate_Cache{$ratetype}{$crate}{count}."/".ts($now - $Rate_Cache{$ratetype}{$crate}{'time'})."s"; }; } else { log_note ("[RULES] ".$myline.", ignoring empty index for ".$mycmd." limit '".$ratetype."'") if wantsdebug (qw[ all thisrequest rates ]); }; } else { log_note ("[RULES] ".$myline.(($rcount) ? ", ignoring unknown ".$mycmd."() attribute \'".$myarg."\'" : ", ignoring empty counter")); }; return ($stop,$index,$myaction,$myline,%request); }, # size() command "size" => sub { return &{$postfwd_actions{rate}}(@_); }, # rcpt() command "rcpt" => sub { return &{$postfwd_actions{rate}}(@_); }, # rate() command, according to rfc5321 case-sensivity "rate5321" => sub { return &{$postfwd_actions{rate}}(@_); }, # rcpt() command, according to rfc5321 case-sensivity "rcpt5321" => sub { return &{$postfwd_actions{rate}}(@_); }, # size() command, according to rfc5321 case-sensivity "size5321" => sub { return &{$postfwd_actions{rate}}(@_); }, # wait() command "wait" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; log_info ("[RULES] ".$myline.", delaying for $myarg seconds"); sleep $myarg; return ($stop,$index,$myaction,$myline,%request); }, # note() command "note" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; log_info ("[RULES] ".$myline." - note: ".$myarg) if $myarg; return ($stop,$index,$myaction,$myline,%request); }, # debug() command "debug" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; log_info ("[RULES] ".$myline.", DEBUG=$myarg"); ($myarg =~ /^(1|y(es)?|on)$/i) ? $postfwd_settings{debug}{thisrequest} = 1 : delete $postfwd_settings{debug}{thisrequest}; return ($stop,$index,$myaction,$myline,%request); }, # quit() command - not supported in this version "quit" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; log_warn ("[RULES] ".$myline." - critical: quit (".$myarg.") unsupported in this version - ignoring"); }, # file() command "file" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; log_warn ("[RULES] ".$myline." - error: command ".$mycmd."() has not been implemented yet - ignoring"); return ($stop,$index,$myaction,$myline,%request); }, # ask() command "ask" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $postfwd_settings{default}; my($stop) = 0; log_info ("Opening socket to '$myarg'") if wantsdebug (qw[ all thisrequest ]); my($addr,$port,$ignore) = split ':', $myarg; my %orig = str_to_hash ($request{orig}); if ( ($addr and $port) and my $socket = new IO::Socket::INET ( PeerAddr => $addr, PeerPort => $port, Proto => 'tcp', Timeout => 9, Type => SOCK_STREAM ) ) { my $sendstr = ''; foreach (keys %orig) { $sendstr .= $_."=".$orig{$_}."\n"; }; $sendstr .= "\n"; log_info ("Asking service $myarg -> '$sendstr'") if wantsdebug (qw[ all thisrequest ]); print $socket "$sendstr"; $sendstr = <$socket>; chomp($sendstr); log_info ("Answer from $myarg -> '$sendstr'") if wantsdebug (qw[ all thisrequest verbose ]); $sendstr =~ s/^(action=)//; if ($1 and $sendstr) { if ($ignore and ($sendstr =~ /$ignore/i)) { log_info ("ignoring answer '$sendstr' from $myarg") if wantsdebug (qw[ all thisrequest verbose ]); } else { $stop = $myaction = $sendstr; }; } else { log_note ("rule: $index got invalid answer '$sendstr' from $myarg"); }; } else { log_note ("Could not open socket to '$myarg' - $!"); }; return ($stop,$index,$myaction,$myline,%request); }, # exec() command "exec" => sub { return &{$postfwd_actions{file}}(@_); }, ); # load plugin-items sub get_plugins { my(@pluginfiles) = @_; my($pluginlog) = ''; foreach my $file (@pluginfiles) { unless ( -e $file ) { log_warn ("File not found: $file"); } else { $file =~ /^(.*)$/; require $1 if $1; map { delete $postfwd_items_plugin{$_} unless ($_ and defined $postfwd_items_plugin{$_}) } (keys %postfwd_items_plugin); map { delete $postfwd_compare_plugin{$_} unless ($_ and defined $postfwd_compare_plugin{$_}) } (keys %postfwd_compare_plugin); map { delete $postfwd_actions_plugin{$_} unless ($_ and defined $postfwd_actions_plugin{$_}) } (keys %postfwd_actions_plugin); map { log_note ("[PLUGIN] overriding prior item \'".$_."\'") if (defined $postfwd_items{$_}) } (keys %postfwd_items_plugin); map { log_note ("[PLUGIN] overriding prior compare function \'".$_."\'") if (defined $postfwd_compare{$_}) } (keys %postfwd_compare_plugin); map { log_note ("[PLUGIN] overriding prior action \'".$_."\'") if (defined $postfwd_actions{$_}) } (keys %postfwd_actions_plugin); %postfwd_items = ( %postfwd_items, %postfwd_items_plugin ) if %postfwd_items_plugin; %postfwd_compare = ( %postfwd_compare, %postfwd_compare_plugin ) if %postfwd_compare_plugin; %postfwd_actions = ( %postfwd_actions, %postfwd_actions_plugin ) if %postfwd_actions_plugin; $pluginlog = "[PLUGIN] Loaded plugins file: ".$file; $pluginlog .= " items: \"".(join ", ", (sort keys %postfwd_items_plugin))."\"" if %postfwd_items_plugin; $pluginlog .= " compare: \"".(join ", ", (sort keys %postfwd_compare_plugin))."\"" if %postfwd_compare_plugin; $pluginlog .= " actions: \"".(join ", ", (sort keys %postfwd_actions_plugin))."\"" if %postfwd_actions_plugin; log_info ($pluginlog); }; }; }; ### SUB ruleset # compare item main # use: compare_item ( $TYPE, $RULEITEM, $MINIMUMHITS, $REQUESTITEM, %REQUEST, %REQUESTINFO ); sub compare_item { my($mykey,$mymask,$mymin,$myitem, %request) = @_; my($val,$var,$cmp,$neg,$myresult,$postfwd_compare_proc); my($rcount) = 0; $mymin ||= 1; # # determine the right compare function $postfwd_compare_proc = (defined $postfwd_compare{$mykey}) ? $mykey : "default"; # # save list due to possible modification my @items = @{$mymask}; # now compare request to every single item ITEM: foreach (@items) { ($cmp, $val) = split ";"; next ITEM unless ($cmp and (defined $val) and $mykey); # prepare_file if ($val =~ /$COMP_LIVE_FILE_TABLE/) { push @items, prepare_file (0, $1, $cmp, $2); next ITEM; }; log_info ("compare $mykey: \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all thisrequest ]); $val = $neg if ($neg = deneg_item($val)); log_info ("deneg $mykey: \"$myitem\" \"$cmp\" \"$val\"") if ($neg and wantsdebug (qw[ all thisrequest ])); next ITEM unless (defined $val); # substitute check for $$vars in rule item if ( $var = devar_item ($cmp,$val,$myitem,%request) ) { $val = $var; $val =~ s/([^-_@\.\w\s])/\\$1/g unless ($cmp eq '=='); }; $myresult = &{$postfwd_compare{$postfwd_compare_proc}}($cmp,$val,$myitem,%request); log_info ("match $mykey: ".($myresult ? "TRUE" : "FALSE")) if wantsdebug (qw[ all thisrequest ]); if ($neg) { $myresult = not($myresult); log_info ("negate match $mykey: ".($myresult ? "TRUE" : "FALSE")) if wantsdebug (qw[ all thisrequest ]); }; $rcount++ if $myresult; $myresult = not($mymin eq 'all'); $myresult = ( $rcount >= $mymin ) if $myresult; log_info ("count $mykey: request=$rcount minimum: $mymin result: ".($myresult ? "TRUE" : "FALSE")) if wantsdebug (qw[ all thisrequest ]); last ITEM if $myresult; }; $myresult = $rcount if ($myresult or ($mymin eq 'all')); return $myresult; }; # # compare request against a single rule # sub compare_rule { my($index,$date,%request) = @_; my(@ruleitems) = keys %{$Rules[$index]}; my($has_rbl) = exists($Rules[$index]{$COMP_RBL_KEY}); my($has_rhl) = ( exists($Rules[$index]{$COMP_RHSBL_KEY}) or exists($Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}) or exists($Rules[$index]{$COMP_RHSBL_KEY_CLIENT}) or exists($Rules[$index]{$COMP_RHSBL_KEY_SENDER}) or exists($Rules[$index]{$COMP_RHSBL_KEY_HELO}) ); my($has_senderdns) = ( exists($Rules[$index]{$COMP_NS_NAME}) or exists($Rules[$index]{$COMP_MX_NAME}) or exists($Rules[$index]{$COMP_NS_ADDR}) or exists($Rules[$index]{$COMP_MX_ADDR}) ); my($hasdns) = ( not($postfwd_settings{dns}{disabled}) and ($has_senderdns or $has_rhl or $has_rbl) ); my($mykey,$myitem,$val,$cmp,$res,$myline,$timed) = undef; my(@myresult) = (0,0,0,0); my(@queries,@timedout) = (); my($num) = 1; undef @DNSBL_Text; my($ownres,$ownsel,$bgsock) = undef; my %ownsock = (); my @ownready = (); log_info ("[RULES] rule: $index, id: $Rules[$index]{$COMP_ID}, items: '".((@ruleitems) ? join ';', @ruleitems: '')."'") if wantsdebug (qw[ all thisrequest ]); # COMPARE-ITEMS # check all non-dns items ITEM: for $mykey ( keys %{$Rules[$index]} ) { # always true if ( ($mykey eq $COMP_ID) or ($mykey eq $COMP_ACTION) or ($mykey eq $COMP_CACHE) ) { $myresult[0]++; next ITEM; }; next ITEM if ( (($mykey eq $COMP_RBL_CNT) or ($mykey eq $COMP_RHSBL_CNT)) ); next ITEM if ( (($mykey eq $COMP_RBL_KEY) or ($mykey eq $COMP_RHSBL_KEY)) ); next ITEM if ( ($mykey eq $COMP_RHSBL_KEY_RCLIENT) or ($mykey eq $COMP_RHSBL_KEY_CLIENT) or ($mykey eq $COMP_RHSBL_KEY_SENDER) or ($mykey eq $COMP_RHSBL_KEY_HELO) ); # integration at this point enables redefining scores within ruleset if ($mykey eq $COMP_SCORES) { modify_score ($Rules[$index]{$mykey},$Rules[$index]{$COMP_ACTION}); $myresult[0] = 0; } else { $val = ( $mykey =~ /^$COMP_DATECALC$/ ) # prepare date check ? $date # default: compare against request attribute : $request{$mykey}; $myresult[0] = ($res = compare_item($mykey, $Rules[$index]{$mykey}, $num, ((defined $val) ? $val : ''), %request)) ? ($myresult[0] + $res) : 0; }; last ITEM unless ($myresult[0] > 0); }; log_info ("[RULES] pre-dns: rule: $index, id: $Rules[$index]{$COMP_ID}, RESULT: ".$myresult[0]) if wantsdebug (qw[ all thisrequest ]); # DNSQUERY-SECTION # fire bgsend()s with callback to result cache, # if they are not contained already, # and $postfwd_settings{dns}{disabled} is not set if ($hasdns and $myresult[0]) { # prepare dns queries $ownres = Net::DNS::Resolver->new( tcp_timeout => $postfwd_settings{dns}{timeout}, udp_timeout => $postfwd_settings{dns}{timeout}, persistent_tcp => 0, persistent_udp => 0, retrans => 0, retry => 1, dnsrch => 0, defnames => 0, ); $ownsel = IO::Select->new(); map { $timed .= (($timed) ? ", $_" : $_) if $Timeouts{$_} > $postfwd_settings{dns}{max_timeout} } (keys %Timeouts); log_note ("[DNSBL] skipping rbls: $timed - too much timeouts") if $timed; push @queries, rbl_prepare_lookups ( $COMP_RBL_KEY, $request{reverse_address}, @{$Rules[$index]{$COMP_RBL_KEY}} ) if (defined $Rules[$index]{$COMP_RBL_KEY}); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY, $request{client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY}} ) if (defined $Rules[$index]{$COMP_RHSBL_KEY}); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_CLIENT, $request{client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_CLIENT}} ) if (defined $Rules[$index]{$COMP_RHSBL_KEY_CLIENT}); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_RCLIENT, $request{reverse_client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}} ) if (defined $Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_HELO, $request{helo_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_HELO}} ) if (defined $Rules[$index]{$COMP_RHSBL_KEY_HELO}); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_SENDER, $request{sender_domain}, @{$Rules[$index]{$COMP_RHSBL_KEY_SENDER}} ) if (defined $Rules[$index]{$COMP_RHSBL_KEY_SENDER}); # send dns queries if ( @queries ) { @queries = uniq(@queries); QUERY: foreach my $query (@queries) { next QUERY unless $query; log_info ("[SENDDNS] sending query \'$query\'") if wantsdebug (qw[ all thisrequest ]); # send A query $bgsock = $ownres->bgsend($query, 'A'); $ownsel->add($bgsock); $ownsock{$bgsock} = 'A:'.$query; # send TXT query if ($postfwd_settings{dns}{async_txt}) { $bgsock = $ownres->bgsend($query, 'TXT'); $ownsel->add($bgsock); $ownsock{$bgsock} = 'TXT:'.$query; }; }; log_info ("[SENDDNS] rule: $index, id: $Rules[$index]{$COMP_ID}, lookups: ".($#queries + 1)) if wantsdebug (qw[ all thisrequest ]); $myresult[3] = "dnsqueries=".($#queries + 1).$postfwd_settings{sepreq}."dnsinterval=".($#queries + 1); }; # DNSRESULT-SECTION # wait for select() and check the results unless $postfwd_settings{dns}{disabled} my($ownstart) = time(); @queries = (); while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($postfwd_settings{dns}{timeout}))) { foreach my $sock (@ownready) { if (defined $ownsock{$sock}) { log_note ("[DNSBL] answer for ".$ownsock{$sock}) if wantsdebug (qw[ all thisrequest ]); my $packet = $ownres->bgread($sock); push @queries, (split ':', $ownsock{$sock})[1] if rbl_read_dns ($packet); delete $ownsock{$sock}; } else { $ownsel->remove($sock); $sock = undef; }; }; }; # timeout handling map { push @timedout, (split ':', $ownsock{$_})[1] } (keys %ownsock); if (@timedout) { @timedout = uniq(@timedout); $myresult[3] .= $postfwd_settings{sepreq}."dnstimeouts=".($#timedout + 1); foreach (@timedout) { my $now = time(); # @{$DNS_Cache{$_}{A}} = ('__TIMEOUT__'); $DNS_Cache{$_}{ttl} = $postfwd_settings{dns}{ttl} unless $DNS_Cache{$_}{ttl}; $DNS_Cache{$_}{'delay'} = $now - $ownstart; $DNS_Cache{$_}{'until'} = $now + $DNS_Cache{$_}{ttl}; $DNS_Cache{$_}{'timed'} = 1; $Timeouts{$DNS_Cache{$_}{name}} = (defined $Timeouts{$DNS_Cache{$_}{name}}) ? $Timeouts{$DNS_Cache{$_}{name}} + 1 : 1 if ( $postfwd_settings{dns}{max_timeout} > 0 ); log_note ("[DNSBL] warning: timeout (".$Timeouts{$DNS_Cache{$_}{name}}."/".$postfwd_settings{dns}{max_timeout}.") for ".$DNS_Cache{$_}{name}." after ".ts($DNS_Cache{$_}{'delay'})." seconds"); }; }; # perform outstanding TXT queries unless --dns_async_txt is set if (not($postfwd_settings{dns}{async_txt}) and @queries) { @queries = uniq(@queries); log_info ("[DNSBL] sending TXT queries for ".(join ',', @queries)) if wantsdebug (qw[ all thisrequest debugdns ]); foreach my $query (@queries) { log_info ("[SENDDNS] sending TXT query \'$query\'") if wantsdebug (qw[ all thisrequest ]); # send TXT query $bgsock = $ownres->bgsend($query, 'TXT'); $ownsel->add($bgsock); $ownsock{$bgsock} = 'TXT:'.$query; }; while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($postfwd_settings{dns}{timeout}))) { foreach my $sock (@ownready) { if (defined $ownsock{$sock}) { log_info ("[DNSBL] answer for ".$ownsock{$sock}) if wantsdebug (qw[ all thisrequest ]); my $packet = $ownres->bgread($sock); rbl_read_dns ($packet); delete $ownsock{$sock}; } else { $ownsel->remove($sock); $sock = undef; }; }; }; }; # compare dns results if ( ($myresult[0] > 0) and exists($Rules[$index]{$COMP_RBL_KEY}) ) { $res = compare_item( $COMP_RBL_KEY, $Rules[$index]{$COMP_RBL_KEY}, ($Rules[$index]{$COMP_RBL_CNT} ||= 1), $request{reverse_address}, %request ); $myresult[0] = ($res or ($Rules[$index]{$COMP_RBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; $myresult[1] = ($res) ? $res : 0; }; if ( $has_rhl and ($myresult[0] > 0) ) { if ( exists($Rules[$index]{$COMP_RHSBL_KEY}) ) { $res = compare_item( $COMP_RHSBL_KEY, $Rules[$index]{$COMP_RHSBL_KEY}, ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), $request{client_name}, %request ); $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; $myresult[2] += $res if $res; }; if ( exists($Rules[$index]{$COMP_RHSBL_KEY_CLIENT}) ) { $res = compare_item( $COMP_RHSBL_KEY_CLIENT, $Rules[$index]{$COMP_RHSBL_KEY_CLIENT}, ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), $request{client_name}, %request ); $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; $myresult[2] += $res if $res; }; if ( exists($Rules[$index]{$COMP_RHSBL_KEY_SENDER}) ) { $res = compare_item( $COMP_RHSBL_KEY_SENDER, $Rules[$index]{$COMP_RHSBL_KEY_SENDER}, ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), $request{sender_domain}, %request ); $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; $myresult[2] += $res if $res; }; if ( exists($Rules[$index]{$COMP_RHSBL_KEY_HELO}) ) { $res = compare_item( $COMP_RHSBL_KEY_HELO, $Rules[$index]{$COMP_RHSBL_KEY_HELO}, ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), $request{helo_name}, %request ); $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; $myresult[2] += $res if $res; }; if ( exists($Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}) ) { $res = compare_item( $COMP_RHSBL_KEY_RCLIENT, $Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}, ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), $request{reverse_client_name}, %request ); $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; $myresult[2] += $res if $res; }; }; }; if ( wantsdebug (qw[ all thisrequest ]) ) { $myline = "[RULES] RULE: ".$index." MATCHES: ".((($myresult[0] - 2) > 0) ? ($myresult[0] - 2) : 0); $myline .= " RBLCOUNT: ".$myresult[1] if $myresult[1]; $myline .= " RHSBLCOUNT: ".$myresult[2] if $myresult[2]; $myline .= " DNSBLTEXT: ".(join ("; ", @DNSBL_Text)) if ( (@DNSBL_Text) and (($myresult[1] > 0) or ($myresult[2] > 0)) ); log_info ($myline); }; return @myresult; }; ### SUB access policy # access policy routine sub smtpd_access_policy { my($parent,%request) = @_; my($myaction) = $postfwd_settings{default}; my($index) = 1; my($stop) = 1; my($now) = time(); my($date) = join(',', localtime($now)); my($counters) = "request=1".$postfwd_settings{sepreq}."interval=1"; my ($rhit) = "ruleset"; my($matched,$rblcnt,$rhlcnt,$t1,$t2,$t3,$ai) = 0; my($mykey,$cacheid,$myline,$checkreq,$checkval,$var,$ratehit,$rateindex,$rulehits) = ""; # save original request $request{orig} = hash_to_str (%request); # replace empty sender with <> $request{sender} = '<>' unless ($request{sender}); # load postfwd_items attributes if ( my(%postfwd_items_attr) = postfwd_items (%request) ) { %request = (%request, %postfwd_items_attr); }; # clear dnsbl timeout counters if ( $Cleanup_Timeouts and ($postfwd_settings{dns}{max_interval} > 0) and (($now - $Cleanup_Timeouts) > $postfwd_settings{dns}{max_interval}) ) { undef %Timeouts; log_info ("[CLEANUP] clearing dnsbl timeout counters") if wantsdebug (qw[ all thisrequest verbose ]); $Cleanup_Timeouts = $now; }; # wipe out old cache items if ( $Cleanup_Rates and ($postfwd_settings{rate}{cleanup} > 0) and (scalar keys %Rate_Cache > 0) and (($now - $Cleanup_Rates) > $postfwd_settings{rate}{cleanup}) ) { $t1 = time(); $t3 = scalar keys %Rate_Cache; cleanup_rate_cache($now); $t2 = time(); log_info ("[CLEANUP] cleaning rate-cache needed ".ts($t2 - $t1) ." seconds for rate cleanup of " .($t3 - scalar keys %Rate_Cache)." out of ".$t3 ." cached items after cleanup time ".$postfwd_settings{rate}{cleanup}."s") if ( wantsdebug (qw[ all thisrequest verbose rates cleanup childcleanup ]) or (($t2 - $t1) >= 1) ); $Cleanup_Rates = $t1; }; # increase rate limits if (@Rate_Items and $postfwd_settings{rate}{fast_eval}) { map { $checkval .= $_."=".lc($request{$_}).$postfwd_settings{seplst} if $request{$_} } (@Rate_Items); if ($checkval) { $checkval = "CMD=".$postfwd_commands{checkrate}.";TYPE=rate;ITEM=$checkval;SIZE=".($request{'size'} || 0).";RCPT=".($request{'recipient_count'} || 0); log_info ("[RATES] parent rate limit query: ".$checkval) if wantsdebug (qw[ all thisrequest verbose rates ]); $checkval = cache_query ($checkval); log_info ("[RATES] parent rate limit answer: ".$checkval) if wantsdebug (qw[ all thisrequest verbose rates ]); unless ($checkval eq '') { my($i,$r) = split $postfwd_settings{seplst}, $checkval; my($it, $ri) = split $postfwd_settings{seplim}, $i; if ($it and $ri and $r) { $ratehit = $it; $rateindex = $ri; %{$Rate_Cache{$it}{$ri}} = str_to_hash ($r); push @{$Rate_Cache{$it}{'list'}}, $ri; @{$Rate_Cache{$it}{'list'}} = uniq(@{$Rate_Cache{$it}{'list'}}); $request{'ratecount'} = $Rate_Cache{$it}{$ri}{'count'} + ( ($Rate_Cache{$it}{$ri}{type} eq 'size') ? $request{size} : (($Rate_Cache{$it}{$ri}{type} eq 'rcpt') ? $request{recipient_count} : 1 ) ); }; }; }; }; # Request cache enabled? if ( $postfwd_settings{request}{ttl} > 0 ) { # construct cache identifier if ($postfwd_settings{cacheid}) { map { $cacheid .= $request{$_}.';' if (defined $request{$_}) } @{$postfwd_settings{cacheid}}; } else { REQITEM: foreach $checkreq (sort keys %request) { next REQITEM unless $request{$checkreq}; next REQITEM if ( ($checkreq eq "instance") or ($checkreq eq "queue_id") or ($checkreq eq "orig")); next REQITEM if ( $postfwd_settings{request}{no_size} and ($checkreq eq "size") ); next REQITEM if ( $postfwd_settings{request}{no_sender} and ($checkreq eq "sender") ); if ( $postfwd_settings{request}{rdomain_only} and ($checkreq eq "recipient") ) { $cacheid .= $request{recipient_domain}.';'; } else { $cacheid .= $request{$checkreq}.';'; }; }; }; log_info ("created cache-id: $cacheid") if wantsdebug (qw[ all thisrequest ]); # wipe out old cache entries if ( $Cleanup_Requests and (scalar keys %Request_Cache > 0) and (($now - $Cleanup_Requests) > $postfwd_settings{request}{cleanup}) ) { $t1 = time(); $t3 = scalar keys %Request_Cache; cleanup_request_cache($now); $t2 = time(); log_info ("[CLEANUP] cleaning request-cache needed ".ts($t2 - $t1) ." seconds for request cleanup of " .($t3 - scalar keys %Request_Cache)." out of ".$t3 ." cached items after cleanup time ".$postfwd_settings{request}{cleanup}."s") if ( wantsdebug (qw[ all thisrequest verbose cleanup childcleanup ]) or (($t2 - $t1) >= 1) ); $Cleanup_Requests = $t1; }; }; # check rate if ( $postfwd_settings{rate}{fast_eval} and $ratehit and $rateindex and defined $Rate_Cache{$ratehit}{$rateindex} ) { $counters .= $postfwd_settings{sepreq}."rate=1"; $Matches{$Rate_Cache{$ratehit}{$rateindex}{rule}}++; $myaction = $Rate_Cache{$ratehit}{$rateindex}{action}; # substitute check for $$vars in action $myaction = $var if ( $var = devar_item ("==",$myaction,"action",%request) ); log_info ("[RATES] rule=".$Rule_by_ID{$Rate_Cache{$ratehit}{$rateindex}{rule}} . ", id=".$Rate_Cache{$ratehit}{$rateindex}{rule} . ( ($request{queue_id}) ? ", queue=".$request{queue_id} : '' ) . ", client=".$request{client_name}."[".$request{client_address}."]" . ( ($request{sasl_username}) ? ", user=".$request{sasl_username} : '' ) . ", sender=<".(($request{sender} eq '<>') ? "" : $request{sender}).">" . ( ($request{recipient}) ? ", recipient=<".$request{recipient}.">" : '' ) . ", helo=<".$request{helo_name}.">" . ", proto=".$request{protocol_name} . ", state=".$request{protocol_state} . ", delay=".ts(time() - $now)."s" . ", action=".$myaction." (item: '".$ratehit."'" . ", type: ".$Rate_Cache{$ratehit}{$rateindex}{type} . ", count: ".$request{ratecount}."/".$Rate_Cache{$ratehit}{$rateindex}{maxcount} . ", time: ".ts($now - $Rate_Cache{$ratehit}{$rateindex}{"time"})."/".$Rate_Cache{$ratehit}{$rateindex}{ttl}."s)" ) unless $postfwd_settings{request}{nolog}; # check own cache } elsif ( ($postfwd_settings{request}{ttl} > 0) and ((exists($Request_Cache{$cacheid}{$COMP_ACTION})) and ($now <= $Request_Cache{$cacheid}{'until'})) ) { $counters .= $postfwd_settings{sepreq}."ccache=1"; $myaction = $Request_Cache{$cacheid}{$COMP_ACTION}; if ( $Request_Cache{$cacheid}{hit} ) { $Matches{$Request_Cache{$cacheid}{$COMP_ID}}++; $rulehits = join $postfwd_settings{sepreq}, (split ';', $Request_Cache{$cacheid}{hits}) if $Request_Cache{$cacheid}{hits}; log_info ("[CACHE] rule=".$Rule_by_ID{$Request_Cache{$cacheid}{$COMP_ID}} . ", id=".$Request_Cache{$cacheid}{$COMP_ID} . ( ($request{queue_id}) ? ", queue=".$request{queue_id} : '' ) . ", client=".$request{client_name}."[".$request{client_address}."]" . ( ($request{sasl_username}) ? ", user=".$request{sasl_username} : '' ) . ", sender=<".(($request{sender} eq '<>') ? "" : $request{sender}).">" . ( ($request{recipient}) ? ", recipient=<".$request{recipient}.">" : '' ) . ", helo=<".$request{helo_name}.">" . ", proto=".$request{protocol_name} . ", state=".$request{protocol_state} . ", delay=".ts(time() - $now)."s" . ", hits=".$Request_Cache{$cacheid}{hits} . ", action=".$Request_Cache{$cacheid}{$COMP_ACTION} ) unless $postfwd_settings{request}{nolog}; }; # check parent cache } elsif ( ($postfwd_settings{request}{ttl} > 0) and not($postfwd_settings{request}{noparent}) and not((my $pans = cache_query ("CMD=".$postfwd_commands{getcacheitem}.";TYPE=request;ITEM=$cacheid")) eq '') ) { map { $Request_Cache{$cacheid}{$1} = $2 if m/$postfwd_patterns{keyval}/ } (split $postfwd_settings{sepreq}, $pans); $counters .= $postfwd_settings{sepreq}."pcache=1"; $myaction = $Request_Cache{$cacheid}{$COMP_ACTION}; if ( $Request_Cache{$cacheid}{hit} ) { $Matches{$Request_Cache{$cacheid}{$COMP_ID}}++; $rulehits = join $postfwd_settings{sepreq}, (split ';', $Request_Cache{$cacheid}{hits}) if $Request_Cache{$cacheid}{hits}; log_info ("[CACHE] rule=".$Rule_by_ID{$Request_Cache{$cacheid}{$COMP_ID}} . ", id=".$Request_Cache{$cacheid}{$COMP_ID} . ( ($request{queue_id}) ? ", queue=".$request{queue_id} : '' ) . ", client=".$request{client_name}."[".$request{client_address}."]" . ( ($request{sasl_username}) ? ", user=".$request{sasl_username} : '' ) . ", sender=<".(($request{sender} eq '<>') ? "" : $request{sender}).">" . ( ($request{recipient}) ? ", recipient=<".$request{recipient}.">" : '' ) . ", helo=<".$request{helo_name}.">" . ", proto=".$request{protocol_name} . ", state=".$request{protocol_state} . ", delay=".ts(time() - $now)."s" . ", hits=".$Request_Cache{$cacheid}{hits} . ", action=".$Request_Cache{$cacheid}{$COMP_ACTION} ) unless $postfwd_settings{request}{nolog}; }; # check rules } else { # refresh config if '-I' was set read_config(0) if $postfwd_settings{instant}; if ($#Rules < 0) { log_note("critical: no rules found - i feel useless (have you set -f or -r?)"); } else { # clean up rbl cache if ( not($postfwd_settings{dns}{disabled}) and (scalar keys %DNS_Cache > 0) and (($now - $Cleanup_RBLs) > $postfwd_settings{dns}{cleanup}) ) { $t1 = time(); $t3 = scalar keys %DNS_Cache; cleanup_dns_cache($now); $t2 = time(); log_info ("[CLEANUP] cleaning dns-cache needed ".ts($t2 - $t1) ." seconds for rbl cleanup of " .($t3 - scalar keys %DNS_Cache)." out of ".$t3 ." cached items after cleanup time ".$postfwd_settings{dns}{cleanup}."s") if ( wantsdebug (qw[ all thisrequest verbose cleanup childcleanup ]) or (($t2 - $t1) >= 1) ); $Cleanup_RBLs = $t1; }; # prepares hit counters $request{$COMP_MATCHES} = 0; $request{$COMP_RBL_CNT} = 0; $request{$COMP_RHSBL_CNT} = 0; RULE: for ($index=0;$index<=$#Rules;$index++) { # compare request against rule next unless exists $Rules[$index]; ($matched,$rblcnt,$rhlcnt,my $compcnt) = compare_rule ($index, $date, %request); # enables/overrides hit counters for later use $request{$COMP_MATCHES} = $matched; $request{$COMP_RBL_CNT} = $rblcnt; $request{$COMP_RHSBL_CNT} = $rhlcnt; $counters .= $postfwd_settings{sepreq}.$compcnt if $compcnt; # matched? prepare logline, increase counters if ($stop = $matched > 0) { $myaction = $Rules[$index]{$COMP_ACTION}; $Matches{$Rules[$index]{$COMP_ID}}++; $rulehits .= $postfwd_settings{sepreq} if $rulehits; $rulehits .= $Rules[$index]{$COMP_ID}; $request{$COMP_HITS} .= ';' if (defined $request{$COMP_HITS}); $request{$COMP_HITS} .= $Rules[$index]{$COMP_ID}; # substitute check for $$vars in action $myaction = $var if ( $var = devar_item ("==",$myaction,"action",%request) ); $myline = "rule=".$index . ", id=".$Rules[$index]{$COMP_ID} . ( ($request{queue_id}) ? ", queue=".$request{queue_id} : '' ) . ", client=".$request{client_name}."[".$request{client_address}."]" . ( ($request{sasl_username}) ? ", user=".$request{sasl_username} : '' ) . ", sender=<".(($request{sender} eq '<>') ? "" : $request{sender}).">" . ( ($request{recipient}) ? ", recipient=<".$request{recipient}.">" : '' ) . ", helo=<".$request{helo_name}.">" . ", proto=".$request{protocol_name} . ", state=".$request{protocol_state}; # check for postfwd action $ai = 0; # (re)set max_command_recursion counter while ($ai++ < $postfwd_settings{max_command_recursion} and $myaction =~ /^(\w[\-\w]+)\s*\(\s*(.*?)\s*\)$/) { my($mycmd,$myarg) = ($1, $2); $stop = 0; if (defined $postfwd_actions{$mycmd}) { log_info ("[PLUGIN] executing postfwd-action $mycmd") if wantsdebug (qw[ all thisrequest ]); ($stop, $index, $myaction, $myline, %request) = &{$postfwd_actions{$mycmd}}($index, $now, $mycmd, $myarg, $myline, %request); $rhit = "rate" if ($stop and $mycmd =~ /^(rate|size|rcpt)$/); # substitute again after postfwd-actions $myaction = $var if ( $var = devar_item ("==",$myaction,"action",%request) ); } else { log_warn ("[RULES] ".$myline." - error: unknown command \"".$1."\" - ignoring"); $myaction = $postfwd_settings{default}; }; }; if ($stop) { $myline .= ", delay=".ts(time() - $now)."s, hits=".$request{$COMP_HITS}.", action=".$myaction; log_info ("[RULES] ".$myline) unless $postfwd_settings{request}{nolog}; $counters .= $postfwd_settings{sepreq}.$rhit."=1"; # update cache if ( $postfwd_settings{request}{ttl} > 0 ) { $Request_Cache{$cacheid}{ttl} = ($Rules[$index]{$COMP_CACHE} || $postfwd_settings{request}{ttl}); $Request_Cache{$cacheid}{'until'} = $now + $Request_Cache{$cacheid}{ttl}; $Request_Cache{$cacheid}{$COMP_ACTION} = $myaction; $Request_Cache{$cacheid}{$COMP_ID} = $Rules[$index]{$COMP_ID}; $Request_Cache{$cacheid}{hit} = $matched; $Request_Cache{$cacheid}{hits} = $request{$COMP_HITS}; cache_query ("CMD=".$postfwd_commands{setcacheitem}.";TYPE=request;ITEM=$cacheid".hash_to_str(%{$Request_Cache{$cacheid}})) unless ($postfwd_settings{request}{noparent}); }; last RULE; }; } else { undef $myline; }; }; }; }; # increase counters and return action if ($postfwd_settings{summary} and defined $parent) { print $parent "CMD=".$postfwd_commands{countcache}.";TYPE=$counters" .(($rulehits) ? $postfwd_settings{seplst}."CMD=".$postfwd_commands{matchcache}.";TYPE=$rulehits" : "") ."\n"; $parent->getline(); }; $myaction = $postfwd_settings{default} if ($postfwd_settings{test} or !($myaction)); map { &{$postfwd_settings{syslog}{logger}} ('info', " %$_") } hash_to_list ('Request_Cache', %Request_Cache) if wantsdebug (qw[ child_cache child_request_cache ]); map { &{$postfwd_settings{syslog}{logger}} ('info', " %$_") } hash_to_list ('Rate_Cache', %Rate_Cache) if wantsdebug (qw[ child_cache child_rate_cache ]); map { &{$postfwd_settings{syslog}{logger}} ('info', " %$_") } hash_to_list ('DNS_Cache', %DNS_Cache) if wantsdebug (qw[ child_cache child_dns_cache ]); return $myaction; }; ## Net::Server::PreFork methods # ignore syslog failures sub handle_syslog_error {}; # reload config on HUP signal sub sig_hup { my $self = shift; log_note ("catched HUP signal - reloading ruleset on next request"); read_config(1); map { kill ("HUP", $_) } (keys %{$self->{server}->{children}}); }; # parent start sub pre_loop_hook { my $self = shift; # change parent's name $0 = $self->{server}->{commandline} = " ".$postfwd_settings{name}.'::policy'; $self->{server}->{syslog_ident} = $postfwd_settings{name}."/policy"; $StartTime = $Summary = $Cleanup_Timeouts = $Cleanup_Requests = $Cleanup_RBLs = $Cleanup_Rates = time(); init_log ($self->{server}->{syslog_ident}); # load plugin-items get_plugins (@{$postfwd_settings{Plugins}}) if $postfwd_settings{Plugins}; # read configuration read_config(1); log_info ("ready for input"); }; # increase counters sub count_cache { map { $Count{$1} += $2 if m/$postfwd_patterns{cntval}/ } (split ($postfwd_settings{sepreq}, $_[1])) if $_[1] }; # increase matches sub match_cache { map { $Hits{$_}++ } (split ($postfwd_settings{sepreq}, $_[1])) if $_[1] }; # program usage statistics sub list_stats { my $now = time(); my $uptime = $now - $StartTime; my @output =(); return @output unless $uptime and $Count{request}; # averages, hitrates and counters map { $Count{$_} ||= 0 } qw(ruleset interval top rate pcache ccache dnsqueries dnstimeouts dnsinterval dnstop); my $lastreq = (($now - $Summary) > 0) ? $Count{interval} / ($now - $Summary) * 60 : 0; my $lastdns = (($now - $Summary) > 0) ? $Count{dnsinterval} / ($now - $Summary) * 60 : 0; $Count{top} = $lastreq if $lastreq > $Count{top}; $Count{dnstop} = $lastdns if $lastdns > $Count{dnstop}; my $dnstimeoutrate = ($Count{dnsqueries}) ? $Count{dnstimeouts} / $Count{dnsqueries} * 100 : 0; # log program statistics if ( not($postfwd_settings{syslog}{noidlestats}) or ($Count{interval} > 0) ) { push ( @output, sprintf ( "[STATS] %s::policy %s: %d requests since %d days, %02d:%02d:%02d hours", $postfwd_settings{name}, $postfwd_settings{version}, $Count{request}, ($uptime / 60 / 60 / 24), (($uptime / 60 / 60) % 24), (($uptime / 60) % 60), ($uptime % 60) ) ); push ( @output, sprintf ( "[STATS] Requests: %.2f/min last, %.2f/min overall, %.2f/min top", $lastreq, ($uptime) ? $Count{request} / $uptime * 60 : 0, $Count{top} ) ); push ( @output, sprintf ( "[STATS] Dnsstats: %.2f/min last, %.2f/min overall, %.2f/min top", $lastdns, ($uptime) ? $Count{dnsqueries} / $uptime * 60 : 0, $Count{dnstop} ) ) unless ($postfwd_settings{dns}{disable}); push ( @output, sprintf ( "[STATS] Hitrates: %.1f%% ruleset, %.1f%% parent, %.1f%% child, %.1f%% rates", ($Count{request}) ? $Count{ruleset} / $Count{request} * 100 : 0, ($Count{request}) ? $Count{pcache} / $Count{request} * 100 : 0, ($Count{request}) ? $Count{ccache} / $Count{request} * 100 : 0, ($Count{request}) ? $Count{rate} / $Count{request} * 100 : 0 ) ); push ( @output, sprintf ( "[STATS] Timeouts: %.1f%% (%d of %d dns queries)", $dnstimeoutrate, $Count{dnstimeouts}, $Count{dnsqueries} ) ) unless ($postfwd_settings{dns}{disable}); # per rule stats if (%Hits and not($postfwd_settings{syslog}{norulestats})) { my @rulecharts = (sort { ($Hits{$b} || 0) <=> ($Hits{$a} || 0) } (keys %Hits)); my $cntln = length(($Hits{$rulecharts[0]} || 2)) + 2; map { push ( @output, sprintf ("[STATS] %".$cntln."d matches for id: %s", ($Hits{$_} || 0), $_)) } @rulecharts; }; }; $Count{interval} = $Count{dnsinterval} = 0; $Summary = $now; return @output; }; # parent processes child input sub child_is_talking_hook { my($self,$sock) = @_; my $answer = "\n"; my $msg = $sock->getline(); # during tests it turned out that children # send empty messages in some situations if (defined $msg) { log_info ("child said '$msg'") if wantsdebug (qw[ all ]); if ($msg =~ m/$postfwd_patterns{command}/) { foreach (split $postfwd_settings{seplst}, $msg) { if (m/$postfwd_patterns{countcache}/) { $self->count_cache($1); } elsif (m/$postfwd_patterns{matchcache}/) { $self->match_cache($1); } elsif (m/$postfwd_patterns{dumpstats}/) { $answer = (join $postfwd_settings{sepreq}.$postfwd_settings{seplst}, list_stats())."\n"; } else { log_note ("warning: child sent unknown command '$_'"); }; }; } else { log_note ("warning: child sent unknown message '$msg'"); }; }; print $sock "$answer"; }; # child start sub child_init_hook { my $self = shift; # change children's names $0 = $self->{server}->{commandline} = " ".$postfwd_settings{name}.'::policy::child'; log_info ("ready for input") if wantsdebug (qw[ all verbose ]); }; # child process request sub process_request { my($self) = shift; my($client) = $self->{server}->{client}; my($parent) = $self->{server}->{parent_sock}; my(%attr) = (); while () { s/\r?\n$//; # respond to masters ping if ($_ eq $postfwd_patterns{ping}) { $client->print("$postfwd_patterns{pong}\n"); } elsif (m/$postfwd_patterns{dumpstats}/) { $parent->print("$_\n"); $client->print($parent->getline()."\n"); # process input } else { process_input ($parent, $client, $_, \%attr); }; }; }; # process delegation protocol input sub process_input { my($parent,$client,$msg,$attr) = @_; # remember argument=value if ( $msg =~ /^([^=]{1,512})=(.{0,512})/ ) { $$attr{$1} = $2; # evaluate request } elsif ( $msg eq '' ) { map { log_info ("Attribute: $_=$$attr{$_}") } (keys %$attr) if wantsdebug (qw[ all thisrequest request ]); unless ( (defined $$attr{request}) and ($$attr{request} eq "smtpd_access_policy") ) { log_note ("Ignoring unrecognized request type: '".((defined $$attr{request}) ? substr($$attr{request},0,100) : '')."'"); } else { my $action = smtpd_access_policy($parent, %$attr) || $postfwd_settings{default}; log_info ("Action: $action") if wantsdebug (qw[ all thisrequest verbose ]); if ($client) { print $client ("action=$action\n\n"); } else { print STDOUT ("action=$action\n\n"); }; %$attr = (); delete $postfwd_settings{debug}{thisrequest}; }; # unknown command } else { log_note ("Ignoring garbage '".substr($msg, 0, 100)."'"); }; }; 1; # EOF postfwd2::server use warnings; use strict; use Getopt::Long 2.25 qw(:config no_ignore_case bundling); use Pod::Usage; # master daemon use Net::Server::Daemonize qw(daemonize); # own modules # program settings, syslogging import postfwd2::basic qw(:DEFAULT %postfwd_commands &check_inet &check_unix &wantsdebug &hash_to_list $TIMEHIRES); # cache daemon (requests, dns, limits), Net::Server::Multiplex import postfwd2::cache qw(); # policy daemon, Net::Server::PreFork import postfwd2::server qw(&read_config &show_config &process_input &get_plugins); # functions to start, override with '--daemons' at command line my @daemons = qw[ cache server ]; use vars qw( %options %children %failures ); # parse command-line my $Commandline = "$0 ".(join ' ', @ARGV); GetOptions( \%options, # Ruleset 'rule|r=s' => sub{ my($opt,$value) = @_; push (@{$postfwd_settings{Configs}}, $opt.$postfwd_settings{sepreq}.$value) }, 'file|f=s' => sub{ my($opt,$value) = @_; push (@{$postfwd_settings{Configs}}, $opt.$postfwd_settings{sepreq}.$value) }, 'scores|score|s=s%' => \%{$postfwd_settings{scores}}, "test|t" => \$postfwd_settings{test}, "instantcfg|I" => \$postfwd_settings{instant}, "config_timeout=i" => \$postfwd_settings{timeout}{config}, "showconfig|C", "defaults|settings|D", # Networking "umask=s" => \$postfwd_settings{base}{umask}, "user|u=s" => \$postfwd_settings{base}{user}, "group|g=s" => \$postfwd_settings{base}{group}, "server_socket|socket=s" => sub{ ($postfwd_settings{server}{proto}, $postfwd_settings{server}{host}, $postfwd_settings{server}{port}) = (split ':', $_[1]) }, "interface|i=s" => \$postfwd_settings{server}{host}, "port|p=s" => \$postfwd_settings{server}{port}, "proto=s" => \$postfwd_settings{server}{proto}, "server_umask=s" => \$postfwd_settings{server}{umask}, "min_servers=i" => \$postfwd_settings{server}{min_servers}, "max_servers=i" => \$postfwd_settings{server}{max_servers}, "min_spare_servers=i" => \$postfwd_settings{server}{min_spare_servers}, "max_spare_servers=i" => \$postfwd_settings{server}{max_spare_servers}, "nodns|n" => \$postfwd_settings{dns}{disabled}, "dns_timeout=i" => \$postfwd_settings{dns}{timeout}, "dns_async_txt" => \$postfwd_settings{dns}{async_txt}, "dns_timeout_max=i" => \$postfwd_settings{dns}{max_timeout}, "dns_timeout_interval=i" => \$postfwd_settings{dns}{max_interval}, "dns_max_ns_lookups=i" => \$postfwd_settings{dns}{max_ns_lookups}, "dns_max_mx_lookups=i" => \$postfwd_settings{dns}{max_mx_lookups}, "cache-rbl-timeout=i" => \$postfwd_settings{dns}{ttl}, "cache-rbl-default=s" => \$postfwd_settings{dns}{mask}, "cleanup-rbls=i" => \$postfwd_settings{dns}{cleanup}, "no_parent_dns_cache" => \$postfwd_settings{dns}{noparent}, "parent_dns_cache" => sub { $postfwd_settings{dns}{noparent} = 0 }, # Stats "summary|stats|S=i" => \$postfwd_settings{summary}, "norulestats" => \$postfwd_settings{syslog}{norulestats}, "no-rulestats" => \$postfwd_settings{syslog}{norulestats}, "noidlestats" => \$postfwd_settings{syslog}{noidlestats}, "no-idlestats" => \$postfwd_settings{syslog}{noidlestats}, "stdoutlog|stdout|L" => \$postfwd_settings{syslog}{stdout}, # Cache "cache_socket=s" => sub{ ($postfwd_settings{cache}{proto}, $postfwd_settings{cache}{host}, $postfwd_settings{cache}{port}) = (split ':', $_[1]) }, "cache_interface=s" => \$postfwd_settings{cache}{host}, "cache_port=s" => \$postfwd_settings{cache}{port}, "cache_proto=s" => \$postfwd_settings{cache}{proto}, "cache_umask=s" => \$postfwd_settings{server}{umask}, "cache|c=i" => \$postfwd_settings{request}{ttl}, "cacheid=s" => sub { push @{$postfwd_settings{cacheid}}, (split /[,\s]+/, $_[1]) }, "cache-rdomain-only" => \$postfwd_settings{request}{rdomain_only}, "cache-no-sender" => \$postfwd_settings{request}{no_sender}, "cache-no-size" => \$postfwd_settings{request}{no_size}, "cleanup-requests=i" => \$postfwd_settings{request}{cleanup}, "no_parent_request_cache" => \$postfwd_settings{request}{noparent}, "no_parent_rate_cache" => \$postfwd_settings{rate}{noparent}, "no_parent_cache" => sub{ $postfwd_settings{request}{noparent} = $postfwd_settings{rate}{noparent} = $postfwd_settings{dns}{noparent} = 1 }, # Limits "cleanup-rates=i" => \$postfwd_settings{rate}{cleanup}, "keep_rates|keep_limits|keep_rates_on_reload" => \$postfwd_settings{keep_rates}, "save_rates|save_limits|save_rates_on_restart=s" => \$postfwd_settings{rate}{store}, "fast_limit_evaluation" => \$postfwd_settings{rate}{fast_eval}, # Control 'version|V' => sub{ print "$postfwd_settings{name} $postfwd_settings{version} (Net::DNS ".(Net::DNS->VERSION || '').", Net::Server ".(Net::Server->VERSION || '').", Sys::Syslog ".($Sys::Syslog::VERSION || '').", ".(($TIMEHIRES) ? "Time::HiRes $TIMEHIRES, " : '').(($STORABLE) ? "Storable: $STORABLE, " : '')."Perl ".$]." on ".$^O.")\n"; exit 1; }, 'versionshort|shortversion' => sub{ print "$postfwd_settings{version}\n"; exit 1; }, 'manual|m' => sub{ # contructing command string (de-tainting $0) $postfwd_settings{manual} .= ($0 =~ /^([-\@\/\w. ]+)$/) ? " \"".$1 : " \"".$postfwd_settings{name}; $postfwd_settings{manual} .= "\" | ".$postfwd_settings{pager}; system ($postfwd_settings{manual}); exit 1; }, "term|kill|stop|k", "hup|reload", "delcache=s", "delrate=s", "dumpcache", "dumpstats", "pid|pidfile|pid_file=s" => \$postfwd_settings{master}{pid_file}, "watchdog=i" => \$postfwd_settings{master}{watchdog}, "respawn=i" => \$postfwd_settings{master}{respawn}, "failures=i" => \$postfwd_settings{master}{failures}, "daemon|d!" => \$postfwd_settings{daemon}, "daemons=s" => sub { push @{$options{daemons}}, (split /[,\s]+/, $_[1]) }, "chroot|R=s" => \$postfwd_settings{chroot}, # Logging "debug=s" => sub { push @{$options{debug}}, (split /[,\s]+/, $_[1]) }, "verbose|v+" => \$postfwd_settings{verbose}, "logname|l=s" => sub{ $postfwd_settings{name} = $_[1]; $postfwd_settings{cache}{syslog_ident} = $_[1].'/cache'; $postfwd_settings{server}{syslog_ident} = $_[1].'/policy'; }, "facility=s" => \$postfwd_settings{syslog}{facility}, "socktype=s" => \$postfwd_settings{syslog}{socktype}, "nodnslog" => \$postfwd_settings{dns}{nolog}, "no-dnslog" => \$postfwd_settings{dns}{nolog}, "anydnslog" => \$postfwd_settings{dns}{anylog}, "norulelog" => \$postfwd_settings{request}{nolog}, "no-rulelog" => \$postfwd_settings{request}{nolog}, "perfmon|P" => \$postfwd_settings{syslog}{nolog}, "plugins=s" => sub { push @{$postfwd_settings{Plugins}}, $_[1] }, # Unused "start", "shortlog", "dns_queuesize=i", "dns_retries=i", ) or pod2usage (-msg => "\nPlease see \"".$postfwd_settings{name}." -m\" for detailed instructions.\n", -verbose => 1); map { $postfwd_settings{syslog}{stdout} = 1 if defined $options{$_} } qw(term hup showconfig dumpcache dumpstats defaults delcache delrate); # basic syntax checks if ($postfwd_settings{verbose} > 1) { $postfwd_settings{debug}{all} = 1; } elsif ($postfwd_settings{verbose}) { $postfwd_settings{debug}{verbose} = 1; }; map { $postfwd_settings{debug}{$_} = 1 } uniq(@{$options{debug}}); map { $postfwd_settings{daemons}{$_} = 1 } ((defined $options{daemons}) ? uniq(@{$options{daemons}}) : uniq(@daemons)); map { $postfwd_settings{$_}{check} = ($postfwd_settings{$_}{proto} eq 'unix') ? \&check_unix : \&check_inet } @daemons; # terminate at -k or --kill if (defined $options{'term'}) { kill "TERM", get_master_pid(); exit (0); # reload at --reload } elsif (defined $options{'hup'}) { kill "HUP", get_master_pid(); exit (0); }; # chroot master if (defined $postfwd_settings{chroot}) { unless (eval {chroot($postfwd_settings{chroot});}) { print "Cannot chroot to $postfwd_settings{chroot}: $!\n"; exit (2); }; }; # init_log init_log ($postfwd_settings{name}."/master"); # read and display configuration if (defined $options{'showconfig'}) { read_config(1); show_config(); exit 1; }; # show program settings if (defined $options{'defaults'}) { print "\n"; map { print " %$_\n" } hash_to_list ('postfwd_settings', %postfwd_settings); if (wantsdebug (qw[ all verbose ])) { map { print " %$_\n" } hash_to_list ('postfwd_commands', %postfwd_commands); map { print " %$_\n" } hash_to_list ('postfwd_patterns', %postfwd_patterns); }; print "\n"; exit 1; }; # dump stats if (defined $options{'dumpstats'}) { foreach my $daemon (sort keys %{$postfwd_settings{daemons}}) { print "\n"; map { print ("$_\n") } get_stats ($daemon); }; print "\n"; exit 1; }; # dump cache contents if (defined $options{'dumpcache'}) { print "\n".( join "\n", split $postfwd_settings{sepreq}.$postfwd_settings{seplst}, (&{$postfwd_settings{cache}{check}} ('cache', 'CMD=DC;') || '') )."\n\n"; exit 1; }; # remove cache item if (defined $options{'delcache'} or defined $options{'delrate'}) { print "\n".( join "\n", split $postfwd_settings{sepreq}.$postfwd_settings{seplst}, (&{$postfwd_settings{cache}{check}} ('cache', (($options{'delcache'}) ? 'CMD=RC '.$options{'delcache'} : 'CMD=RR '.$options{'delrate'})) || '') )."\n\n"; exit 1; }; # -n - skip dns based checks log_note ("NODNS: set - will skip all dns based checks") if $postfwd_settings{dns}{disabled}; # de-taint command-line %postfwd_settings = detaint_hash (%postfwd_settings); # check for --nodaemon option unless ($postfwd_settings{daemon}) { log_note ("NODAEMON: Please note that rate() commands do not work with postfwd2 and --nodaemon option due to the missing cache daemon"); my(%attr) = (); get_plugins (@{$postfwd_settings{Plugins}}) if $postfwd_settings{Plugins}; read_config(1); map { $postfwd_settings{daemons}{$_} = 0 } (keys %{$postfwd_settings{daemons}}); $postfwd_settings{request}{noparent} = $postfwd_settings{rate}{noparent} = $postfwd_settings{dns}{noparent} = 1; while (<>) { chomp; process_input (undef, undef, $_, \%attr); }; exit; }; # daemonize master log_info ($postfwd_settings{name}." " .$postfwd_settings{version}." starting" .((scalar keys %{$postfwd_settings{debug}}) ? " with debug levels: ".(join ',', keys %{$postfwd_settings{debug}}) : '')); log_info ("Net::DNS ".(Net::DNS->VERSION || '').", Net::Server ".(Net::Server->VERSION || '').", Sys::Syslog ".($Sys::Syslog::VERSION || '').", ".(($TIMEHIRES) ? "Time::HiRes $TIMEHIRES, " : '')."Perl ".$]." on ".$^O) if wantsdebug (qw[ all verbose ]); umask oct($postfwd_settings{base}{umask}); daemonize($postfwd_settings{base}{user}, $postfwd_settings{base}{group}, $postfwd_settings{master}{pid_file}); $0 = $Commandline; # prepare shared SIG handlers $SIG{__WARN__} = sub { log_warn("warning: $_[0]") }; $SIG{__DIE__} = sub { log_crit("FATAL: $_[0]"); die @_; }; # fork daemons: cache and server foreach my $daemon (sort keys %{$postfwd_settings{daemons}}) { umask oct($postfwd_settings{$daemon}{umask}); if (my $pid = spawn_daemon ($daemon)) { log_info ("Started $daemon at pid $pid"); $children{$daemon} = $pid; }; }; umask oct($postfwd_settings{base}{umask}); # prepare master SIG handlers and enter main loop $SIG{TERM} = sub { end_program(); }; $SIG{HUP} = sub { reload_program(); }; if ($postfwd_settings{summary}) { $SIG{ALRM} = sub { log_stats(); alarm ($postfwd_settings{summary}) }; alarm ($postfwd_settings{summary}); }; while (1) { # check daemons every seconds if ($postfwd_settings{master}{watchdog}) { sleep ($postfwd_settings{master}{watchdog}); foreach my $daemon (sort keys %{$postfwd_settings{daemons}}) { if (check_daemon ($daemon)) { $failures{$daemon} = 0; } else { if (++$failures{$daemon} >= $postfwd_settings{master}{failures}) { # terminate program log_crit ("$daemon-daemon check failed $failures{$daemon} times - terminating program"); end_program(); } else { # restart daemon log_crit ("$daemon-daemon check failed $failures{$daemon} times - respawning in ".$postfwd_settings{master}{respawn}." seconds"); kill 15, $children{$daemon}; sleep $postfwd_settings{master}{respawn}; if (my $pid = spawn_daemon ($daemon)) { log_info ("Started $daemon at pid $pid"); $children{$daemon} = $pid; }; }; }; }; # no watchdog -> sleep until signal } else { sleep; }; }; die "master-daemon: should never see me!\n"; ## SUBS # cleanup children and files and terminate sub end_program { # ignore further TERM signals $SIG{TERM} = 'IGNORE'; if ($postfwd_settings{summary}) { undef $postfwd_settings{syslog}{noidlestats}; log_stats(); }; log_note ($postfwd_settings{name}." ".$postfwd_settings{version}." terminating..."); unlink $postfwd_settings{master}{pid_file} if (-T $postfwd_settings{master}{pid_file}); # negative signal no. kills the whole process group kill -15, $$; exit (0); }; # send hup to child processes sub reload_program { log_note ($postfwd_settings{name}." ".$postfwd_settings{version}." reloading..."); map { kill 1, $_ } (values %children) if %children; }; # check a cache or server daemon sub check_daemon { return ((&{$postfwd_settings{$_[0]}{check}}($_[0],$postfwd_patterns{ping}) || '') eq $postfwd_patterns{pong}) }; # spawn a cache or server daemon sub spawn_daemon { my ($type) = @_; my $pid = fork(); die "Can not fork $type: $!\n" unless defined $pid; if ($pid == 0) { my %service = %{$postfwd_settings{$type}}; # Net::Server dies when a unix domain socket without dot "." is used $service{port} .= '|unix' if (($service{proto} eq 'unix') and not($service{port} =~ /\|unix$/)); my %daemonopts = (%{$postfwd_settings{base}}, %service); my $daemon = bless { server => { %daemonopts } }, "postfwd2::$type"; $daemon->run(); die "$type-daemon: should never see me!\n"; }; return $pid; }; # get pid of running master process sub get_master_pid { (-e $postfwd_settings{master}{pid_file}) or die $postfwd_settings{name}.": Can not find pid_file ".$postfwd_settings{master}{pid_file}.": $!\n"; (-T $postfwd_settings{master}{pid_file}) or die $postfwd_settings{name}.": Can not open pid_file ".$postfwd_settings{master}{pid_file}.": not a textfile\n"; open PIDFILE, "<".$postfwd_settings{master}{pid_file} or die $postfwd_settings{name}.": Can open pid_file ".$postfwd_settings{master}{pid_file}.": $!\n"; my $pid = ; ($pid =~ m/^(\d+)$/) or die $postfwd_settings{name}.": Invalid pid_file content '$pid' (pid_file ".$postfwd_settings{master}{pid_file}.")\n"; return $1; }; # detaints postfwd2 settings sub detaint_hash { my (%request) = @_; # cycle through key=value pairs while ( my($s, $v) = each %request ) { my $r = ref $v; # type hash: recursively call ourself if ($r eq 'HASH') { %{$v} = detaint_hash ( %{$v} ); # type array: detaint whole list } elsif ($r eq 'ARRAY') { @{$request{$s}} = map { $_ = (($_ =~ m/^(.*)$/) ? $1 : $_ ) if $_ } @{$v}; # type scalar: detaint argument } elsif ($r eq '') { $request{$s} = (($v =~ m/^(.*)$/) ? $1 : $v) if ($s and $v); }; }; return %request; }; # send stats to syslog sub log_stats { map { &{$postfwd_settings{syslog}{logger}} ('notice', "$_") unless ($_ eq '') } get_stats(sort keys %{$postfwd_settings{daemons}}); }; # retrieve status from children sub get_stats { my @daemons = @_; my @output = (); map { push @output, (split $postfwd_settings{sepreq}.$postfwd_settings{seplst}, (&{$postfwd_settings{$_}{check}} ($_, 'CMD=DS;') || '')) } @daemons; return @output; }; # EOF postfwd2 __END__ =head1 NAME postfwd2 - postfix firewall daemon =head1 SYNOPSIS B [OPTIONS] [SOURCE1, SOURCE2, ...] Ruleset: (at least one, multiple use is allowed): -f, --file reads rules from -r, --rule adds to config -s, --scores = returns when score exceeds Server: -i, --interface listen on interface -p, --port listen on port --proto socket type (tcp or unix) --server_socket e.g. tcp:127.0.0.1:10045 -u, --user set uid to user -g, --group set gid to group --umask umask for master filepermissions --server_umask umask for server filepermissions --pidfile create pidfile under --min_servers spawn at least children --max_servers do not spawn more than children --min_spare_servers minimum idle children --max_spare_servers maximum idle children Cache: -c, --cache sets the request-cache timeout to seconds --cleanup-requests cleanup interval in seconds for request cache --cache_interface listen on interface --cache_port listen on port --cache_proto socket type (tcp or unix) --cache_socket e.g. tcp:127.0.0.1:10043 --cache_umask umask for cache filepermissions --cacheid list of request items for cache-id --cache-rdomain-only skip recipient localpart for cache-id --cache-no-sender skip sender address for cache-id --cache-no-size skip size for cache-id --no_parent_request_cache disable parent request cache --no_parent_rate_cache disable parent rate cache --no_parent_dns_cache disable parent dns cache (default) --no_parent_cache disable all parent caches Rates: --cleanup-rates cleanup interval in seconds for rate cache Control: -k, --kill, --stop terminate postfwd2 --reload, --hup reload postfwd2 --watchdog watchdog timer in seconds --respawn respawn delay in seconds --failures max respawn failure counter --daemons list of daemons to start --dumpcache show cache contents --dumpstats show statistics -R, --chroot chroot to before start --delcache removes an item from the request cache --delrate removes an item from the rate cache DNS: -n, --nodns skip any dns based test --dns_timeout dns query timeout in seconds --dns_timeout_max disable dnsbl after timeouts --dns_timeout_interval reenable dnsbl after seconds --cache-rbl-timeout default dns ttl if not specified in ruleset --cache-rbl-default default dns pattern if not specified in ruleset --cleanup-rbls cleanup old dns cache items every seconds --dns_async_txt perform dnsbl A and TXT lookups simultaneously --dns_max_ns_lookups max names to look up with sender_ns_addrs --dns_max_mx_lookups max names to look up with sender_mx_addrs Optional: -t, --test testing, always returns "dunno" -S, --summary show stats every seconds --noidlestats disables statistics when idle --norulestats disables per rule statistics -I, --instantcfg reloads ruleset on every new request --config_timeout parser timeout in seconds --keep_rates do not clear rate limit counters on reload --save_rates save and load rate limits on disk --fast_limit_evaluation evaluate rate limits before ruleset is parsed (please note the limitations) Plugins: --plugins loads postfwd plugins from file Logging: -l, --logname