#!/usr/bin/perl -T -w # # postfwd - postfix firewall daemon # # Please see `postfwd -h` for usage or # `postfwd -m` for detailed instructions. # package postfwd; use warnings; use strict; # Includes use Pod::Usage; use Sys::Syslog qw(:DEFAULT setlogsock); use Getopt::Long 2.25 qw(:config no_ignore_case bundling); use POSIX qw(setsid setuid setgid setlocale strftime LC_ALL); # Networking use IO::Socket qw(SOCK_STREAM); use Net::DNS; use Net::Server::Multiplex; use vars qw(@ISA); @ISA = qw(Net::Server::Multiplex); our($TIMEHIRES); our($STORABLE); BEGIN { eval { require Time::HiRes }; if ($@) { $TIMEHIRES = '%d'; } else { Time::HiRes->import( qw(time) ); $TIMEHIRES = '%.2f'; }; eval { require Storable }; if ($@) { $STORABLE = undef; } else { $STORABLE = Storable->VERSION; Storable->import( qw(store retrieve) ); }; }; # Program constants our($NAME) = 'postfwd'; our($VERSION) = '1.35'; # Networking options (use -i, -p and -R to change) our($def_net_pid) = "/var/run/".$NAME.".pid"; our($def_net_chroot) = ""; our($def_net_interface) = "127.0.0.1"; our($def_net_port) = "10040"; our($def_net_proto) = "tcp"; our($def_net_umask) = "0111"; our($def_net_user) = "nobody"; our($def_net_group) = "nobody"; our($def_dns_queuesize) = "300"; our($def_dns_retries) = "3"; our($def_dns_timeout) = "14"; our($def_dns_max_ns_a_lookups) = "100"; our($def_dns_max_mx_a_lookups) = "100"; our($def_config_timeout) = "3"; our($reply_maxlen) = "512"; our($max_command_recursion) = "64"; # 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"; # default action, do not change # unless you really know why our($default_action) = "DUNNO"; # default maximum values for the score() command # if exceeded, the specified action will be returned # may be overwritten by the --scores switch at the command-line # or the score= item in your ruleset files. please see manual. our(%MAX_SCORES) = ( "5.0" => "554 5.7.1 ".$NAME." score exceeded" ); # Status interval, displays stats when using `-S` switch # override with `-S ` at command-line our($Stat_Interval_Time) = 600; # Timeout for request cache, results for identical requests will be # cached until config is reloaded or this time (in seconds) expired # can be changed with `-c` command-line option our($REQUEST_MAX_CACHE) = 600; # minimum ttl for other dns cache objects our($DNS_MIN_CACHE) = 3600; # dns key value matching our(%DNS_REPNAMES) = ( "NS" => "nsdname", "MX" => "exchange", "A" => "address", "TXT" => "char_str_list", "CNAME" => "cname", ); # RBL / RHSBL parameters, use "rbl = //" # to override for each RBL in your config # maximum cache time in seconds, use 0 to deactivate our($RBL_MAX_CACHE) = 3600; # default rbl reply if not specified our($RBL_DEFAULT) = '^127\.'; # skip this dnsbl after timeouts our($MAX_DNSBL_TIMEOUTS) = 10; our($MAX_DNSBL_INTERVAL) = 1200; # Cache cleanup routines will be called periodically our($CLEANUP_REQUEST_CACHE) = 600; our($CLEANUP_RBL_CACHE) = 600; our($CLEANUP_RATE_CACHE) = 600; # these items have to be compared as... # scoring our($COMP_SCORES) = "score"; our($COMP_NS_NAME) = "sender_ns_names"; our($COMP_NS_ADDR) = "sender_ns_addrs"; our($COMP_MX_NAME) = "sender_mx_names"; our($COMP_MX_ADDR) = "sender_mx_addrs"; our($COMP_HELO_ADDR) = "helo_address"; # networks in CIDR notation (a.b.c.d/nn) our($COMP_NETWORK_CIDRS) = "(client_address|sender_(ns|mx)_addrs|helo_address)"; # RBL checks our($COMP_DNSBL_TEXT) = "dnsbltext"; our($COMP_RBL_CNT) = "rblcount"; our($COMP_RHSBL_CNT) = "rhsblcount"; our($COMP_RBL_KEY) = "rbl"; our($COMP_RHSBL_KEY) = "rhsbl"; our($COMP_RHSBL_KEY_CLIENT) = "rhsbl_client"; our($COMP_RHSBL_KEY_SENDER) = "rhsbl_sender"; our($COMP_RHSBL_KEY_RCLIENT) = "rhsbl_reverse_client"; our($COMP_RHSBL_KEY_HELO) = "rhsbl_helo"; # 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 our($COMP_DATE) = "date"; our($COMP_TIME) = "time"; our($COMP_DAYS) = "days"; our($COMP_MONTHS) = "months"; # always true our($COMP_ACTION) = "action"; our($COMP_ID) = "id"; # rule hits our($COMP_HITS) = "request_hits"; # item match counter our($COMP_MATCHES) = "matches"; # separator our($COMP_SEPARATOR) = "[=\~\<\>]=|[\<\>]|[=\!][=\~\<\>]|="; # macros our($COMP_ACL) = "[\&][\&]"; # negation our($COMP_NEG) = "[\!][\!]"; # variables our($COMP_VAR) = "[\$][\$]"; # date calculations our($COMP_DATECALC) = "($COMP_DATE|$COMP_TIME|$COMP_DAYS|$COMP_MONTHS)"; # these items allow whitespace-or-comma-separated values our($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 our($COMP_SINGLE) = "($COMP_ID|$COMP_ACTION|$COMP_SCORES|$COMP_RBL_CNT|$COMP_RHSBL_CNT)"; # Syslog options our($syslog_name) = $NAME; our($syslog_facility) = "mail"; our($syslog_priority) = "info"; our($syslog_options) = "pid"; our($syslog_socktype) = 'unix'; our($syslog_maxlen) = 0; our($syslog_safe) = 0; our($syslog_unsafe_charset) = qr/[^\x20-\x7E]/; if ( defined $Sys::Syslog::VERSION and $Sys::Syslog::VERSION ge '0.15' ) { # use 'native' when Sys::Syslog >= 0.15 $syslog_socktype = 'native'; $syslog_options .= ",nofatal"; } elsif($^O eq 'solaris') { # 'stream' is broken and 'unix' doesn't work on Solaris: only 'inet' # seems to be useable with Sys::Syslog < 0.15 $syslog_socktype = 'inet'; } else { $syslog_safe = 1 }; # save command-line our(@CommandArgs) = @ARGV; # initializations - do not change our(%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, ); our(%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, ); our($SepReq) = '///'; our($SepLst) = ':::'; our($KeyVal) = qr/^([^=]+)=(.*)$/; use vars qw( @Configs @Rules @CacheID @DNSBL_Text @Plugins @Rate_Items @DEBUGLIST %Config_Cache %DNS_Cache %Request_Cache %Rule_by_ID %DEBUG %Matches %opt_scores %ACLs %Rates %Timeouts %postfwd_items %postfwd_items_plugin %postfwd_compare %postfwd_compare_plugin %postfwd_actions %postfwd_actions_plugin $Counter_Requests $Counter_Hits $opt_max_ns_lookups $opt_max_mx_lookups $Counter_Interval $Counter_Top $Counter_Rates $Starttime $Cleanup_Requests $Cleanup_RBLs $Cleanup_Rates $Cleanup_Timeouts $opt_daemon $opt_instantconfig $opt_nodns $opt_nodnslog $opt_norulelog $opt_summary $net_interface $net_port $net_umask $net_user $net_group $net_chroot $net_pid $net_proto $opt_saverates $opt_perfmon $opt_test $opt_verbose $opt_noidlestats $opt_delcache $opt_delrate $opt_cache_rdomain_only $opt_cache_no_size $config_timeout $opt_fast_limits $opt_cache_no_sender $opt_no_rulestats $opt_kill $opt_hup $opt_dumpcache $opt_dumpstats $opt_showconfig $opt_stdoutlog $opt_shortlog $dns_async_txt $opt_keep_rates_on_reload $DNS $Reload_Conf $dns_queuesize $dns_retries $dns_timeout ); our %Name_To_Var = ( \%Config_Cache => '%config_cache', \%Request_Cache => '%request_cache', \%DNS_Cache => '%dns_cache', \%Rates => '%rate_cache', \%ACLs => '%acl_cache', \%Matches => '%match_cache', \%Timeouts => '%timeout_cache', ); ### SUB tools # # send log message # sub mylog { my($prio) = shift(@_); my($msg) = shift(@_); # truncate syslogs (--loglen option) $msg = substr($msg, 0, $syslog_maxlen) if $syslog_maxlen; if ( not($opt_perfmon) or ($prio eq "crit") ) { unless ($opt_stdoutlog) { # Sys::Syslog < 0.15 dies when syslog daemon is temporarily not # present (for example on syslog rotation) if($syslog_safe) { eval { local $SIG{__DIE__} = sub { }; syslog $prio, "$msg", @_; }; } else { syslog $prio, "$msg", @_; }; } else { $msg =~ s/\%/%%/g; $msg =~ /^(.*)$/; printf "[LOG $prio]: $1\n", @_; }; }; }; # # send log message, escaping % character # sub mylogs { my($prio) = shift(@_); my($msg) = shift(@_); $msg =~ s/\%/%%/g; $msg =~ s/$syslog_unsafe_charset/?/g; mylog $prio, $msg; }; # # print a string to STDOUT # sub myprint { my($msg) = shift(@_); print STDOUT $msg, @_ unless $opt_perfmon; }; # # print formatted string to STDOUT # sub myprintf { my($msg) = shift(@_); printf STDOUT $msg, @_ unless $opt_perfmon; }; # # 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', @_) }; # # tests debug levels # sub wantsdebug { return unless %DEBUG; foreach (@_) { return 1 if $DEBUG{$_} }; }; # # prints formatted timestamp # sub ts { return sprintf ("$TIMEHIRES", $_[0]) }; # # Log an error and abort. # sub fatal_exit { my($msg) = shift(@_); warn "fatal: $msg", @_; exit 1; }; # # finish program # sub end_program { undef $opt_noidlestats; show_stats() if $opt_summary; $net_pid ||= $def_net_pid; unlink $net_pid if (-T $net_pid); save_rates(); log_note $NAME." ".$VERSION." terminated" if $opt_daemon; exit; }; # get pid of running master process sub get_master_pid { $net_pid ||= $def_net_pid; (-e $net_pid) or die $NAME.": Can not find pid_file ".$net_pid.": $!\n"; (-T $net_pid) or die $NAME.": Can not open pid_file ".$net_pid.": not a textfile\n"; open PIDFILE, "<".$net_pid or die $NAME.": Can open pid_file ".$net_pid.": $!\n"; my $pid = ; ($pid =~ m/^(\d+)$/) or die $NAME.": Invalid pid_file content '$pid' (pid_file ".$net_pid.")\n"; return $1; }; # # run a shell command # sub exec_cmd { my($mycmd) = @_; my($myresult) = ( system($mycmd) ); if ( $myresult ) { myprint "Could not execute `".$mycmd."` (Error: ".$myresult.")\n"; myprint "Please check the \$ENV{PATH} setting in the first lines of this program.\n"; myprint "Current setting: \"".$ENV{PATH}."\"\n"; }; return not($myresult); }; # # takes a list and returns a unified list, keeping given order # sub uniq { undef my %uniq; return grep(!$uniq{$_}++, @_); }; # # hash -> scalar # sub hash_to_str { my %request = @_; my $result = ''; map { $result .= $SepReq."$_=".((ref $request{$_} eq 'ARRAY') ? (join $SepLst, @{$request{$_}}) : ($request{$_} || '')) } (keys %request); return $result; }; # # scalar -> hash # sub str_to_hash { my $request = shift; my %result = (); foreach (split $SepReq, $request) { next unless m/$KeyVal/; my @items = split $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; }; # # get ip and mask # sub cidr_parse { defined $_[0] or return undef; $_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/ or return undef; $1 < 256 and $2 < 256 and $3 < 256 and $4 < 256 and $5 <= 32 and $5 >= 0 or return undef; 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; if($addr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { $addr = ($1<<24)+($2<<16)+($3<<8)+$4; }; return ($addr & $mask) == $net; }; # # clean up RBL cache # sub cleanup_dns_cache { my($now) = $_[0]; foreach my $checkitem (keys %DNS_Cache) { # remove inclomplete objects (dns timeouts) if ( !defined($DNS_Cache{$checkitem}{"time"}) or !defined($DNS_Cache{$checkitem}{ttl}) ) { log_info "[CLEANUP] deleting incomplete dns-cache item '$checkitem'" if (wantsdebug(qw[ all cleanup ])); delete $DNS_Cache{$checkitem}; # remove timed out objects } elsif ( ($now - $DNS_Cache{$checkitem}{"time"}) > $DNS_Cache{$checkitem}{ttl} ) { log_info "[CLEANUP] removing dns-cache item '$checkitem' after ttl ".$DNS_Cache{$checkitem}{ttl}."s" if (wantsdebug(qw[ all cleanup ])); delete $DNS_Cache{$checkitem}; }; }; }; # # clean up request cache # sub cleanup_request_cache { my($now) = $_[0]; foreach my $checkitem (keys %Request_Cache) { if ( not(defined $Request_Cache{$checkitem}{'until'}) ) { log_info "[CLEANUP] deleting incomplete request-cache item '$checkitem'" if (wantsdebug(qw[ all cleanup ])); delete $Request_Cache{$checkitem}; } elsif ( $now > $Request_Cache{$checkitem}{'until'} ) { log_info "[CLEANUP] removing request-cache item '$checkitem' after ttl ".$REQUEST_MAX_CACHE."s" if (wantsdebug(qw[ all cleanup ])); delete $Request_Cache{$checkitem}; }; }; }; # # clean up rate cache # sub cleanup_rate_cache { my($now) = $_[0]; foreach my $checkitem (keys %Rates) { unless (defined $Rates{$checkitem}{'list'}) { delete $Rates{$checkitem}; } else { my @i = (); foreach my $crate (@{$Rates{$checkitem}{'list'}}) { if ( not(defined $Rates{$checkitem}{$crate}{'until'}) ) { log_info "[CLEANUP] deleting incomplete rate-cache item '$checkitem'->'$crate'" if (wantsdebug(qw[ all cleanup ])); delete $Rates{$checkitem}{$crate}; } elsif ( $now > $Rates{$checkitem}{$crate}{'until'} ) { log_info "[CLEANUP] removing rate-cache item '$checkitem'->'$crate' after ttl ".$Rates{$checkitem}{$crate}{ttl}."s" if (wantsdebug(qw[ all cleanup ])); delete $Rates{$checkitem}{$crate}; } else { push @i, $crate; }; }; unless ($i[0]) { log_info "[CLEANUP] deleting complete rate-cache item '$checkitem'" if (wantsdebug(qw[ all cleanup ])); delete $Rates{$checkitem}; } else { log_info "[CLEANUP] new index list for rate-cache item '$checkitem': ".(join ', ', @i) if (wantsdebug(qw[ all cleanup ])); @{$Rates{$checkitem}{'list'}} = @i; }; }; }; }; # # sets an action for a score # sub modify_score { (my($myscore), my($myaction)) = @_; ( exists($MAX_SCORES{$myscore}) ) ? log_note "redefined score $myscore with action=\"$myaction\"" : log_note "setting new score $myscore with action=\"$myaction\"" if wantsdebug(qw[ all thisrequest verbose score ]); $MAX_SCORES{$myscore} = $myaction; }; # # dump cache contents # sub dump_cache { my @dump = (); my @list = (\%Request_Cache, \%Rates); @list = (@list, \%DNS_Cache) unless $opt_nodns; @list = (@list, \%Config_Cache, \%ACLs, \%Matches, \%Timeouts) if wantsdebug(qw[ all verbose ]); map { @dump = ( @dump, hash_to_list ($Name_To_Var{$_}, %{$_}) ) } @list; return @dump; }; # # creates program usage statistics # sub list_stats { my $now = time(); my @output = (); my $uptime = $now - $Starttime; $Counter_Requests ||= 0; $Counter_Interval ||= 0; $Counter_Top ||= 0; $Counter_Hits ||= 0; $Counter_Rates ||= 0; my($totalreqpermin) = ( (($uptime > 0) ? ($Counter_Requests / $uptime) : 0 ) * 60); my($lastreqpermin) = ($Counter_Interval / (((defined $Stat_Interval_Time) and ($Stat_Interval_Time > 0)) ? $Stat_Interval_Time : 1)) * 60; $Counter_Top = $lastreqpermin if ($lastreqpermin > $Counter_Top); if (not($opt_noidlestats) or ($Counter_Interval > 0) ) { push @output, sprintf ( "%s %s: up since %d days, %02d:%02d:%02d hours", $NAME, $VERSION, ($uptime / 60 / 60 / 24), (($uptime / 60 / 60) % 24), (($uptime / 60) % 60), ($uptime % 60)); push @output, sprintf ("Requests: %d overall, %d last interval, %.1f%% cache hits, %.1f%% rate hits", $Counter_Requests, $Counter_Interval, ($Counter_Requests > 0) ? (($Counter_Hits / $Counter_Requests) * 100) : 0, ($Counter_Requests > 0) ? (($Counter_Rates / $Counter_Requests) * 100) : 0); push @output, sprintf ("Averages: %.1f overall, %.1f last interval, %.1f top", $totalreqpermin, $lastreqpermin, $Counter_Top); push @output, sprintf ("Contents: %d rules, %d cached requests, %d cached dns results, %d rate limits", $#Rules, scalar keys %Request_Cache, scalar keys %DNS_Cache, scalar keys %Rates); # per rule stats if (not($opt_no_rulestats) and @Rules and %Matches) { my @rulecharts = (sort { ($Matches{$b} || 0) <=> ($Matches{$a} || 0) } (keys %Matches)); my $cntln = length(($Matches{$rulecharts[0]} || 2)) + 2; map { push @output, sprintf ("%".$cntln."d matches for id: %s", ($Matches{$_} || 0), $_) } @rulecharts; }; }; return @output; }; # # shows program usage statistics via syslog # sub show_stats { map { mylog 'notice', "[STATS] $_" } list_stats(); $Counter_Interval = 0; }; # # 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 devar ])); }; return $myresult; }; ### SUB configuration # # 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]) ) { mylogs $syslog_priority, "$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 verbose config ]); }; 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 ".$config_timeout."s at parsing Rule $myindex ($myfile line $mynum): \"$myline\""; %myrule = (); die }; my $prevalert = alarm($config_timeout) if $config_timeout; 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$/) { $myvalue =~ s/\s*,\s*/,/g; 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 verbose config ]); }; log_info "loaded: Rule $myindex ($myfile line $mynum): id->\"$myrule{id}\" action->\"$myrule{action}\"" if wantsdebug(qw[ all thisrequest verbose config ]); }; }; alarm($prevalert) if $config_timeout; }; 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) { warn "error: file ".$myfile." not found - file will be ignored"; } else { unless (open ($fh, "<$myfile")) { warn "error: could not open ".$myfile." - $! - file will be ignored"; } else { log_info "reading file $myfile" if wantsdebug(qw[ all thisrequest verbose config ]); 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), $_); push ( @myruleset, { %myrule } ) if (%myrule); } @lines; close ($fh); log_info "loaded: Rules $myindex - ".($myindex + $#myruleset)." from file \"$myfile\"" if wantsdebug(qw[ all thisrequest verbose config ]); }; }; 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 = (); %Rates = () unless $opt_keep_rates_on_reload; # parse configurations for $config (@Configs) { ($mytype,$myitem) = split '::', $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]) ) { mylogs $syslog_priority, "file \"$myitem\" unchanged - using cached ruleset (mtime: ".(stat $myitem)[9].", cache: $Config_Cache{$myitem}{lastread})" if wantsdebug(qw[ all thisrequest verbose config ]); push ( @Rules, @{$Config_Cache{$myitem}{ruleset}} ); } else { @myruleset = read_config_file ($forced_reload, ($#Rules+1), $myitem); if (@myruleset) { push ( @Rules, @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 config rates ]); # disable request cache with ratelimits unless --fast_limit_evaluation is set unless ($opt_fast_limits) { $REQUEST_MAX_CACHE = 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 { my($index,$line,$mykey); if (wantsdebug(qw[ all verbose ])) { myprint "=" x 75, "\n"; myprintf "Rule count: %s\n", ($#Rules + 1); myprint "=" x 75, "\n"; }; for $index (0 .. $#Rules) { next unless exists $Rules[$index]; myprintf "Rule %3d: id->\"%s\"; action->\"%s\"", $index, $Rules[$index]{$COMP_ID}, $Rules[$index]{$COMP_ACTION}; $line = (wantsdebug(qw[ all verbose ])) ? "\n\t " : ""; for $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 ]); myprintf "%s\n", $line; myprint "-" x 75, "\n" if wantsdebug(qw[ all verbose ]); }; } # # saves rate limits to disk # sub save_rates { return unless ($STORABLE and $opt_saverates and %Rates); cleanup_rate_cache(time()); umask oct('0177'); eval { store (\%Rates, $opt_saverates) }; if ( $@ ) { log_note "ERROR: Could not store rate limits to ".$opt_saverates." ('$!': '@_')"; } else { log_info "Saved ".(scalar %Rates)." rates to ".$opt_saverates if wantsdebug(qw[ all verbose rates loadrates saverates ]); }; umask oct($net_umask); }; # # loads rate limits from disk # sub load_rates { return unless ($STORABLE and $opt_saverates and (-f $opt_saverates)); eval { %Rates = %{ retrieve($opt_saverates) } }; if ( $@ ) { log_note "Could not load rate limits from ".$opt_saverates." ('$!': '@_')"; } else { log_info "Fetched ".(scalar %Rates)." rates from ".$opt_saverates if wantsdebug(qw[ all verbose rates loadrates saverates ]); cleanup_rate_cache(time()); }; }; ## sub DNS # # checks for rbl timeouts # sub rbl_timeout { my($myrbl) = shift; return ( ($MAX_DNSBL_TIMEOUTS > 0) and (defined $Timeouts{$myrbl}) and ($Timeouts{$myrbl} > $MAX_DNSBL_TIMEOUTS) ); }; # # reads DNS answers # sub rbl_read_dns { my($myresult) = shift; my($now) = time(); my($que,$ttl,$res,$typ) = undef; my(@addrs) = (); if ( defined $myresult ) { # read question, for dns cache id foreach ($myresult->question) { $typ = $_->qtype; next unless (($typ eq 'A') or ($typ eq 'TXT')); if ($que = $_->qname) { # some RBLs return CNAMEs, so the number of the questions # is not necessarily the number of answers you get foreach ($myresult->answer) { if ($_->type eq 'A') { push @addrs, $_->address if $_->address; $ttl = $_->ttl; } elsif ($_->type eq 'TXT') { $res = join(" ", $_->char_str_list()); $ttl = $_->ttl; }; }; # save result in cache if ( exists($DNS_Cache{$que}) ) { if ($typ eq 'A') { $ttl = ( $DNS_Cache{$que}{ttl} > ($ttl||=0) ) ? $DNS_Cache{$que}{ttl} : $ttl; log_info "[DNSBL] object " .( ($DNS_Cache{$que}{type} eq $COMP_RBL_KEY) ? join(".", reverse(split(/\./,$DNS_Cache{$que}{value}))) : $DNS_Cache{$que}{value} ) ." listed on ".$DNS_Cache{$que}{type}.":".$DNS_Cache{$que}{name} ." (answer: ".(join ", ", @addrs) .", time: ".ts($now - $DNS_Cache{$que}{starttime})."s" .", ttl: ".$ttl."s)" if ( @addrs and not($opt_nodnslog) ); @{$DNS_Cache{$que}{A}} = @addrs; $DNS_Cache{$que}{"time"} = $now; $DNS_Cache{$que}{ttl} = $ttl; } elsif ($typ eq 'TXT') { $res ||= ''; # ugly, commas need to be escaped for set() action $res =~ s/,/ /g; $ttl = ( $DNS_Cache{$que}{ttl} > ($ttl||=0) ) ? $DNS_Cache{$que}{ttl} : $ttl; $DNS_Cache{$que}{TXT} = $res; $DNS_Cache{$que}{endtime} = $now unless $DNS_Cache{$que}{endtime}; $DNS_Cache{$que}{ttl} = $ttl unless $DNS_Cache{$que}{ttl}; }; } else { log_note "[DNSBL] ignoring unknown query $que"; }; }; }; } else { log_note "[DNSBL] dns timeout"; }; return $que if (@addrs || $res); }; # # fires DNS queries # sub rbl_prepare_lookups { my($mytype, $myval, @myrbls) = @_; my($myresult) = undef; my($cmp,$rblitem,$myquery); my(@lookups) = (); # 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 = $RBL_DEFAULT unless $myrblans; $myrbltime = $RBL_MAX_CACHE unless $myrbltime; # create query string $myquery = $myval.".".$myrbl; # query our cache if ( exists($DNS_Cache{$myquery}) and exists($DNS_Cache{$myquery}{A}) ) { ANSWER: foreach (@{$DNS_Cache{$myquery}{A}}) { last ANSWER if $myresult = ( $_ =~ /$myrblans/ ); }; log_info "[DNSQUERY] cached $mytype: $myrbl $myval ($myquery) - answer: \'".(join ", ", @{$DNS_Cache{$myquery}{A}})."\'" if ( ($myresult and wantsdebug(qw[ verbose ])) or (wantsdebug(qw[ all thisrequest ])) ); # not found -> prepare dns query } else { my $now = time(); $DNS_Cache{$myquery} = { starttime => $now, ttl => $myrbltime, name => $myrbl, value => $myval, type => $mytype, }; log_info "[DNSQUERY] 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(); # separate rbl-name and answer ($myrbl, $myrblans, $myrbltime) = split /\//, $myrbl; $myrblans = $RBL_DEFAULT unless $myrblans; $myrbltime = $RBL_MAX_CACHE unless $myrbltime; # create query string $myquery = $myval.".".$myrbl; # query our cache $myresult = ( exists($DNS_Cache{$myquery}) and ($#{$DNS_Cache{$myquery}{A}} >= 0) ); if ( $myresult ) { ANSWER: foreach (@{$DNS_Cache{$myquery}{A}}) { if ( $myresult = ( ($_) and ($_ =~ /$myrblans/)) ) { log_info "[DNSBL] query $myval listed on " .uc($mytype).":$myrbl (answer: ".(join ", ", @{$DNS_Cache{$myquery}{A}}) .", cached: ".ts($now - $DNS_Cache{$myquery}{"time"})."s ago)" if wantsdebug(qw[ all thisrequest verbose ]); push @DNSBL_Text, $DNS_Cache{$myquery}{type}.':'.$DNS_Cache{$myquery}{name}.':<'.($DNS_Cache{$myquery}{TXT} || '').'>' if (defined $DNS_Cache{$myquery}{type} and defined $DNS_Cache{$myquery}{name}); last ANSWER; }; }; }; return $myresult; } # # dns resolver wrapper # sub dns_query { my (@queries) = @_; undef my @result; eval { local $SIG{__DIE__} = sub { log_note "dns err: \"$!\", 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; my %ownsock = (); my @ownready = (); undef my $bgsock; my $ownsel = IO::Select->new(); my $dns = Net::DNS::Resolver->new( tcp_timeout => $dns_timeout, udp_timeout => $dns_timeout, persistent_tcp => 0, persistent_udp => 0, retrans => 0, retry => 1, dnsrch => 0, defnames => 0, ); # send 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'} >= time()) ) { $DNS_Cache{$item}{$type} = [ $DNS_Cache{$item}{$type} ] unless (ref $DNS_Cache{$item}{$type} eq 'ARRAY'); log_info "dnsccache: item=$item, type=$type -> ".(join ',', @{$DNS_Cache{$item}{$type}})." (ttl: ".($DNS_Cache{$item}{ttl} || 0).")" if (wantsdebug(qw[ all thisrequest verbose ])); push @result, @{$DNS_Cache{$item}{$type}}; } else { log_info "dnsquery: item=$item, type=$type" if (wantsdebug(qw[ all thisrequest verbose ])); $bgsock = $dns->bgsend ($item, $type); $ownsel->add($bgsock); $ownsock{$bgsock} = $item.','.$type; }; }; # retrieve answers while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($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); 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) { log_info "dnsanswer: item=$item, type=$type -> $rname=".$rr->$rname." (ttl: ".$rr->ttl.")" if wantsdebug(qw[ all thisrequest verbose ]); push @ans, $rr->$rname; }; push @result, @ans; }; # add to dns cache $ttl ||= $DNS_MIN_CACHE; @{$DNS_Cache{$item}{$type}} = @ans; $DNS_Cache{$item}{ttl} = $ttl; $DNS_Cache{$item}{'until'} = time() + $ttl; delete $ownsock{$sock}; } else { $ownsel->remove($sock); $sock = undef; }; }; }; # show timeouts map { log_note "dnsquery: timeout for $_ after $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} = $NAME." ".$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($opt_nodns); 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($opt_nodns); 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 $opt_nodns; 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 $opt_nodns; 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 $opt_nodns; 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 $opt_nodns; return $myresult unless $myitem =~ /\./; if ( my @answers = dns_query ("$myitem,NS") ) { splice (@answers, $opt_max_ns_lookups) if $opt_max_ns_lookups and $#answers > $opt_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 $opt_nodns; return $myresult unless $myitem =~ /\./; if ( my @answers = dns_query ("$myitem,MX") ) { splice (@answers, $opt_max_mx_lookups) if $opt_max_mx_lookups and $#answers > $opt_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 = (($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 = not(($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) = $default_action; my($stop) = 0; # ... # return ($stop,$index,$myaction,$myline,%request); # }, # jump() command "jump" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $default_action; 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 { 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) = $default_action; 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_note "[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 { 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) = $default_action; 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) { warn "[RULES] ".$myline.", invalid value for score \"$myarg\" - ignoring"; }; MAXSCORE: foreach my $max_score (reverse sort keys %MAX_SCORES) { if ( ($score >= $max_score) and ($MAX_SCORES{$max_score}) ) { $myaction=$MAX_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) = $default_action; 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_note "[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) = $default_action; 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) = $default_action; my($stop) = 0; 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; unless ( defined $Rates{$ratetype}{$crate} ) { # create rate object push @{$Rates{$ratetype}{'list'}}, $crate; $Rates{$ratetype}{$crate} = { 'type' => $mycmd, 'maxcount' => $ratecount, 'ttl' => $ratetime, 'count' => $rcount, 'time' => $now, 'until' => $now + $ratetime, 'rule' => $Rules[$index]{$COMP_ID}, 'action' => $ratecmd, }; log_info "[RATES] ".$myline .", creating rate object ".$ratetype ." [type: ".$mycmd.", max: ".$ratecount.", time: ".$ratetime."s]" if (wantsdebug(qw[ all thisrequest rates ])); } elsif (not $opt_fast_limits) { if ( $now > $Rates{$ratetype}{$crate}{'until'} ) { # renew rate $Rates{$ratetype}{$crate}{'count'} = $rcount; $Rates{$ratetype}{$crate}{'time'} = $now; $Rates{$ratetype}{$crate}{'until'} = $now + $Rates{$ratetype}{$crate}{ttl}; log_info "[RATES] ".$myline .", renewing rate object '".$ratetype."/".$crate."'" ." [type: ".$Rates{$ratetype}{$crate}{type} .", max: ".$Rates{$ratetype}{$crate}{maxcount} .", time: ".$Rates{$ratetype}{$crate}{ttl}."s]" if (wantsdebug(qw[ all thisrequest rates ])); } elsif (not (($rcount+=$Rates{$ratetype}{$crate}{count}) > $Rates{$ratetype}{$crate}{maxcount})) { # increase rate $Rates{$ratetype}{$crate}{count} = $rcount; log_info "[RATES] ".$myline .", increasing rate object '".$ratetype."/".$crate."'" ." to ".$Rates{$ratetype}{$crate}{count} ." [type: ".$Rates{$ratetype}{$crate}{type} .", max: ".$Rates{$ratetype}{$crate}{maxcount} .", time: ".$Rates{$ratetype}{$crate}{ttl}."s]" if (wantsdebug(qw[ all thisrequest rates ])); }; }; # rate exceeded $stop = ($rcount > $Rates{$ratetype}{$crate}{maxcount}); if ($stop) { $Counter_Rates++; $myaction=$Rates{$ratetype}{$crate}{action}; $request{'ratecount'} = $rcount; $myline .= ", rate=".$Rates{$ratetype}{$crate}{type}."/".$rcount."/".ts($now - $Rates{$ratetype}{$crate}{'time'})."s"; }; } else { log_info "[RULES] ".$myline.", ignoring empty index for ".$mycmd." limit '".$ratetype."'" if (wantsdebug(qw[ all thisrequest ])); }; } 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) = $default_action; 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) = $default_action; 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) = $default_action; my($stop) = 0; log_info "[RULES] ".$myline.", DEBUG=$myarg"; ($myarg =~ /^(1|y(es)?|on)$/i) ? $DEBUG{thisrequest} = 1 : delete $DEBUG{thisrequest}; return ($stop,$index,$myaction,$myline,%request); }, # quit() command "quit" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; warn "[RULES] ".$myline." - critical: quit (".$myarg.")"; end_program; }, # file() command "file" => sub { my($index,$now,$mycmd,$myarg,$myline,%request) = @_; my($myaction) = $default_action; my($stop) = 0; 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) = $default_action; my($stop) = 0; mylogs ('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"; mylogs ('info', "Asking service $myarg -> '$sendstr'") if (wantsdebug(qw[ all thisrequest ])); print $socket "$sendstr"; $sendstr = <$socket>; chomp($sendstr); mylogs ('info', "Answer from $myarg -> '$sendstr'") if (wantsdebug(qw[ all thisrequest ])); $sendstr =~ s/^(action=)//; if ($1 and $sendstr) { if ($ignore and ($sendstr =~ /$ignore/i)) { mylogs ('info', "ignoring answer '$sendstr' from $myarg") if (wantsdebug(qw[ all thisrequest ])); } else { $stop = $myaction = $sendstr; }; } else { mylogs ('notice', "rule: $index got invalid answer '$sendstr' from $myarg"); }; } else { mylogs ('notice', "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 ) { 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($hasdns) = ( not($opt_nodns) and ($has_rhl or $has_rbl) ); my($mykey,$myitem,$val,$cmp,$res,$myline,$timed) = undef; my(@myresult) = (0,0,0); my(@queries,@timedout) = (); my($num) = 1; undef @DNSBL_Text; # prepare dns queries my $ownres = Net::DNS::Resolver->new( tcp_timeout => ($dns_timeout || $def_dns_timeout), udp_timeout => ($dns_timeout || $def_dns_timeout), persistent_tcp => 0, persistent_udp => 0, retrans => 0, retry => 1, dnsrch => 0, defnames => 0, ); my $ownsel = IO::Select->new(); my %ownsock = (); my @ownready = (); my $bgsock = undef; 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)) ) { $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); }; # DNSQUERY-SECTION # fire add()s with callback to result cache, # if they are not contained already, # and $opt_nodns is not set if ($hasdns and $myresult[0]) { map { $timed .= (($timed) ? ", $_" : $_) if $Timeouts{$_} > $MAX_DNSBL_TIMEOUTS } (keys %Timeouts); log_note "[DNSQUERY] 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 ( exists($Rules[$index]{$COMP_RBL_KEY}) and not($request{client_address} =~ /:/) ); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY, $request{client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY}} ) if ( exists($Rules[$index]{$COMP_RHSBL_KEY}) and not($request{client_name} eq "unknown") ); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_CLIENT, $request{client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_CLIENT}} ) if ( exists($Rules[$index]{$COMP_RHSBL_KEY_CLIENT}) and not($request{client_name} eq "unknown") ); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_SENDER, $request{sender_domain}, @{$Rules[$index]{$COMP_RHSBL_KEY_SENDER}} ) if ( exists($Rules[$index]{$COMP_RHSBL_KEY_SENDER}) and not($request{sender_domain} eq "") ); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_HELO, $request{helo_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_HELO}} ) if ( exists($Rules[$index]{$COMP_RHSBL_KEY_HELO}) and not($request{helo_name} eq "") ); push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_RCLIENT, $request{reverse_client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}} ) if ( exists($Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}) and not($request{reverse_client_name} eq "unknown") ); # send dns queries if ( @queries ) { @queries = uniq(@queries); foreach my $query (@queries) { 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 ($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 ])); }; # DNSRESULT-SECTION # if all other items matched, run await() # and check the results unless $opt_nodns my($ownstart) = time(); @queries = (); my($timout) = $dns_timeout || $def_dns_timeout; while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($timout))) { foreach my $sock (@ownready) { if (defined $ownsock{$sock}) { mylogs ('notice', "[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); foreach (uniq(@timedout)) { # @{$DNS_Cache{$_}{A}} = ('__TIMEOUT__'); $DNS_Cache{$_}{endtime} = time(); $DNS_Cache{$_}{ttl} = $RBL_MAX_CACHE; $Timeouts{$DNS_Cache{$_}{name}} = (defined $Timeouts{$DNS_Cache{$_}{name}}) ? $Timeouts{$DNS_Cache{$_}{name}} + 1 : 1 if ( $MAX_DNSBL_TIMEOUTS > 0 ); mylogs ('notice', "[DNSBL] warning: timeout (".$Timeouts{$DNS_Cache{$_}{name}}."/".$MAX_DNSBL_TIMEOUTS.") for ".$DNS_Cache{$_}{name}." after ".ts(time() - $ownstart)." seconds"); }; # perform outstanding TXT queries unless --dns_async_txt is set if (not($dns_async_txt) and @queries) { @queries = uniq(@queries); log_info "[DNSBL] sending TXT queries for ".(join ',', @queries) if (wantsdebug(qw[ all thisrequest ])); 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($timout))) { foreach my $sock (@ownready) { if (defined $ownsock{$sock}) { mylogs ('notice', "[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}) ) { if ($request{client_name} eq "unknown") { $myresult[0] = (defined $Rules[$index]{$COMP_RHSBL_CNT}) ? ( ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all') ? 1 : 0 ) : 0; } else { $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}) ) { if ($request{client_name} eq "unknown") { $myresult[0] = (defined $Rules[$index]{$COMP_RHSBL_CNT}) ? ( ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all') ? 1 : 0 ) : 0; } else { $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}) ) { if ($request{sender_domain} eq "") { $myresult[0] = (defined $Rules[$index]{$COMP_RHSBL_CNT}) ? ( ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all') ? 1 : 0 ) : 0; } else { $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}) ) { if ($request{helo_domain} eq "") { $myresult[0] = (defined $Rules[$index]{$COMP_RHSBL_CNT}) ? ( ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all') ? 1 : 0 ) : 0; } else { $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}) ) { if ($request{reverse_client_name} eq "unknown") { $myresult[0] = (defined $Rules[$index]{$COMP_RHSBL_CNT}) ? ( ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all') ? 1 : 0 ) : 0; } else { $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] > 0); $myline .= " RHSBLCOUNT: ".$myresult[2] if ($myresult[2] > 0); $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(%request) = @_; my($myaction) = $default_action; my($index) = 1; my($stop) = 1; my($now) = time(); my($date) = join(',', localtime($now)); my($matched,$rblcnt,$rhlcnt,$t1,$t2,$t3,$rcount,$ai) = 0; my($mykey,$cacheid,$myline,$checkreq,$var,$ratehit,$rateitem) = ""; # 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); }; # check for HUP signal if ( $Reload_Conf ) { undef $Reload_Conf; show_stats; read_config(1); }; # clear dnsbl timeout counters if ( ($MAX_DNSBL_INTERVAL > 0) and (($now - $Cleanup_Timeouts) > $MAX_DNSBL_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_RATE_CACHE > 0) and (scalar keys %Rates > 0) and (($now - $Cleanup_Rates) > $CLEANUP_RATE_CACHE) ) { $t1 = time(); $t3 = scalar keys %Rates; cleanup_rate_cache($now); $t2 = time(); log_info "[CLEANUP] needed ".ts($t2 - $t1) ." seconds for rate cleanup of " .($t3 - scalar keys %Rates)." out of ".$t3 ." cached items after cleanup time ".$CLEANUP_RATE_CACHE."s" if ( wantsdebug(qw[ all thisrequest verbose cleanup ]) or (($t2 - $t1) >= 1) ); $Cleanup_Rates = $t1; }; # increase rate limits if (@Rate_Items and $opt_fast_limits) { RATES: foreach $checkreq (@Rate_Items) { next RATES unless $request{$checkreq}; my $checkval = $checkreq."=".lc($request{$checkreq}); next RATES unless ( defined $Rates{$checkval} and defined $Rates{$checkval}{'list'} ); CRATE: foreach my $crate (@{$Rates{$checkval}{'list'}}) { $rcount = ( ($Rates{$checkval}{$crate}{type} eq 'size') ? $request{size} : (($Rates{$checkval}{$crate}{type} eq 'rcpt') ? $request{recipient_count} : 1 ) ); if ( $now > $Rates{$checkval}{$crate}{'until'} ) { # renew rate $Rates{$checkval}{$crate}{'count'} = $rcount; $Rates{$checkval}{$crate}{'time'} = $now; $Rates{$checkval}{$crate}{'until'} = $now + $Rates{$checkval}{$crate}{ttl}; log_info "[RATES] renewing rate object '".$checkval."/".$crate."'" ." [type: ".$Rates{$checkval}{$crate}{type} .", max: ".$Rates{$checkval}{$crate}{maxcount} .", time: ".$Rates{$checkval}{$crate}{ttl}."s]" if (wantsdebug(qw[ all thisrequest ])); } elsif (not (($rcount+=$Rates{$checkval}{$crate}{count}) > $Rates{$checkval}{$crate}{maxcount})) { # increase rate $Rates{$checkval}{$crate}{count} = $rcount; log_info "[RATES] increasing rate object '".$checkval."/".$crate."'" ." to ".$Rates{$checkval}{$crate}{count} ." [type: ".$Rates{$checkval}{$crate}{type} .", max: ".$Rates{$checkval}{$crate}{maxcount} .", time: ".$Rates{$checkval}{$crate}{ttl}."s]" if (wantsdebug(qw[ all thisrequest ])); }; $ratehit = ($rcount > $Rates{$checkval}{$crate}{maxcount}) ? $checkval : undef; if ($ratehit) { $request{'ratecount'} = $rcount; $rateitem = $crate; last CRATE; }; }; last RATES if $ratehit; }; }; # Request cache enabled? if ( $REQUEST_MAX_CACHE > 0 ) { # construct cache identifier if (@CacheID) { map { $cacheid .= $request{$_}.";" if (defined $request{$_}) } @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 ( $opt_cache_no_size and ($checkreq eq "size") ); next REQITEM if ( $opt_cache_no_sender and ($checkreq eq "sender") ); if ( $opt_cache_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 ( (scalar keys %Request_Cache > 0) and (($now - $Cleanup_Requests) > $CLEANUP_REQUEST_CACHE) ) { $t1 = time(); $t3 = scalar keys %Request_Cache; cleanup_request_cache($now); $t2 = time(); log_info "[CLEANUP] needed ".ts($t2 - $t1) ." seconds for request cleanup of " .($t3 - scalar keys %Request_Cache)." out of ".$t3 ." cached items after cleanup time ".$CLEANUP_REQUEST_CACHE."s" if ( wantsdebug(qw[ all thisrequest verbose cleanup ]) or (($t2 - $t1) >= 1) ); $Cleanup_Requests = $t1; }; }; # check rate if ( $ratehit and $opt_fast_limits ) { $Counter_Rates++; $Matches{$Rates{$ratehit}{$rateitem}{rule}}++; $myaction = $Rates{$ratehit}{$rateitem}{action}; # substitute check for $$vars in action $myaction = $var if ( $var = devar_item ("==",$myaction,"action",%request) ); log_info "[RATES] rule=".$Rule_by_ID{$Rates{$ratehit}{$rateitem}{rule}} . ", id=".$Rates{$ratehit}{$rateitem}{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: ".$Rates{$ratehit}{$rateitem}{type} . ", count: ".$request{ratecount}."/".$Rates{$ratehit}{$rateitem}{maxcount} . ", time: ".ts($now - $Rates{$ratehit}{$rateitem}{"time"})."/".$Rates{$ratehit}{$rateitem}{ttl}."s)" unless $opt_norulelog; # check cache } elsif ( ($REQUEST_MAX_CACHE > 0) and ( exists($Request_Cache{$cacheid}{$COMP_ACTION}) and ($now <= $Request_Cache{$cacheid}{'until'}) ) ) { $Counter_Hits++; $myaction = $Request_Cache{$cacheid}{$COMP_ACTION}; if ( $Request_Cache{$cacheid}{hit} and $Request_Cache{$cacheid}{$COMP_ID}) { map { $Matches{$_}++ } (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 $opt_norulelog; }; # check rules } else { # refresh config if '-I' was set read_config(0) if $opt_instantconfig; if ($#Rules < 0) { log_warn "critical: no rules found - i feel useless (have you set -f or -r?)"; } else { # clean up rbl cache if ( not($opt_nodns) and (scalar keys %DNS_Cache > 0) and (($now - $Cleanup_RBLs) > $CLEANUP_RBL_CACHE) ) { $t1 = time(); $t3 = scalar keys %DNS_Cache; cleanup_dns_cache($now); $t2 = time(); log_info "[CLEANUP] needed ".ts($t2 - $t1) ." seconds for rbl cleanup of " .($t3 - scalar keys %DNS_Cache)." out of ".$t3 ." cached items after cleanup time ".$CLEANUP_RBL_CACHE."s" if ( wantsdebug(qw[ all thisrequest verbose cleanup ]) 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) = 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; # matched? prepare logline, increase counters if ($stop = $matched > 0) { $myaction = $Rules[$index]{$COMP_ACTION}; $Matches{$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++ < $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); # substitute again after postfwd-actions $myaction = $var if ( $var = devar_item ("==",$myaction,"action",%request) ); } else { warn "[RULES] ".$myline." - error: unknown command \"".$1."\" - ignoring"; $myaction = $default_action; }; }; if ($stop) { $myline .= ", delay=".ts(time() - $now)."s, hits=".$request{$COMP_HITS}.", action=".$myaction; log_info "[RULES] ".$myline unless $opt_norulelog; last RULE; }; } else { undef $myline; }; }; }; # update cache if ( $REQUEST_MAX_CACHE > 0 ) { $Request_Cache{$cacheid}{"time"} = $now; $Request_Cache{$cacheid}{'until'} = $now + $REQUEST_MAX_CACHE; $Request_Cache{$cacheid}{$COMP_ACTION} = $myaction; $Request_Cache{$cacheid}{hit} = $matched; $Request_Cache{$cacheid}{hits} = $request{$COMP_HITS}; $Request_Cache{$cacheid}{$COMP_ID} = $Rules[$index]{$COMP_ID} if ($matched > 0); }; }; map { mylog $syslog_priority, "[DUMP] $_" } dump_cache() if (wantsdebug(qw[ all ])); $myaction = $default_action if ($opt_test or !($myaction)); return $myaction; }; # process delegation protocol input sub process_input { my($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 ])); if (defined $$attr{request}) { if ( $$attr{request} eq "smtpd_access_policy" ) { my $action = smtpd_access_policy(%$attr) || $default_action; log_info "Action: $action" if (wantsdebug(qw[ all thisrequest ])); if ($client) { print $client ("action=$action\n\n"); } else { print STDOUT ("action=$action\n\n"); }; $Counter_Requests++; $Counter_Interval++; %$attr = (); delete $DEBUG{thisrequest}; } elsif ( $$attr{request} eq "dumpstats" ) { log_info "STATS requested"; map { print $client "[STATS] $_\r\n" } list_stats(); close($client); } elsif ( $$attr{request} eq "dumpcache" ) { log_info "DUMP requested"; map { print $client "$_\r\n" } dump_cache(); close($client); } elsif ( $$attr{request} =~ /^delrate (.*)$/ ) { my $del = $1; $del =~ s/^[%]?//g; if (defined $Rates{$del}) { log_note "rate cache item '$del' removed"; print $client "rate cache item '$del' removed\r\n"; delete $Rates{$del}; } else { log_note "rate cache removal of '$del' failed: item not found"; print $client "rate cache removal of '$del' failed: item not found\r\n"; }; close($client); } elsif ( $$attr{request} =~ /^delcache (.*)$/ ) { my $del = $1; $del =~ s/^[%]?//g; if (defined $Request_Cache{$del}) { log_note "request cache item '$del' removed"; print $client "request cache item '$del' removed\r\n"; delete $Request_Cache{$del}; } else { log_note "request cache removal of '$del' failed: item not found"; print $client "request cache removal of '$del' failed: item not found\r\n"; }; close($client); } else { log_warn "Ignoring unrecognized request type: '".((defined $$attr{request}) ? substr($$attr{request},0,100) : '')."'"; }; }; # unknown command } else { log_warn "Ignoring garbage '".substr($msg, 0, 100)."'"; }; }; #### MAIN #### # parse command-line GetOptions ( "term|kill|stop|k" => \$opt_kill, "hup|reload" => \$opt_hup, 't|test' => \$opt_test, 'v|verbose' => sub { $opt_verbose++ }, 'debug=s' => sub { push @DEBUGLIST, (split /[,\s]+/, $_[1]) }, 'l|logname=s' => \$syslog_name, 'facility=s' => \$syslog_facility, 'socktype=s' => \$syslog_socktype, 'loglen=i' => \$syslog_maxlen, 'n|nodns' => \$opt_nodns, 'nodnslog' => \$opt_nodnslog, 'no-dnslog' => \$opt_nodnslog, 'norulelog' => \$opt_norulelog, 'no-rulelog' => \$opt_norulelog, 'shortlog' => \$opt_shortlog, # for compatibility 'd|daemon!' => \$opt_daemon, 'I|instantcfg' => \$opt_instantconfig, 'P|perfmon' => \$opt_perfmon, 'L|stdoutlog' => \$opt_stdoutlog, 'i|interface=s' => \$net_interface, 'p|port=s' => \$net_port, 'proto=s' => \$net_proto, 'R|chroot=s' => \$net_chroot, 'pid|pidfile=s' => \$net_pid, 'umask=s' => \$net_umask, 'u|user=s' => \$net_user, 'g|group=s' => \$net_group, 'dns_queuesize=s' => \$dns_queuesize, 'dns_retries=i' => \$dns_retries, 'dns_timeout=i' => \$dns_timeout, 'dns_timeout_max=i' => \$MAX_DNSBL_TIMEOUTS, 'dns_timeout_interval=i' => \$MAX_DNSBL_INTERVAL, 'dns_async_txt' => \$dns_async_txt, 'dns_max_ns_lookups=i' => \$opt_max_ns_lookups, 'dns_max_mx_lookups=i' => \$opt_max_mx_lookups, 'c|cache=i' => \$REQUEST_MAX_CACHE, 'cacheid=s' => sub { @CacheID = ( @CacheID, (split /[,\s]+/, $_[1]) ) }, 'cache-rdomain-only' => \$opt_cache_rdomain_only, 'cache-no-sender' => \$opt_cache_no_sender, 'cache-no-size' => \$opt_cache_no_size, 'cache-rbl-timeout=i' => \$RBL_MAX_CACHE, 'cache-rbl-default=s' => \$RBL_DEFAULT, 'cleanup-requests=i' => \$CLEANUP_REQUEST_CACHE, 'cleanup-rbls=i' => \$CLEANUP_RBL_CACHE, 'cleanup-rates=i' => \$CLEANUP_RATE_CACHE, 'S|summary:i' => \$opt_summary, 'norulestats' => \$opt_no_rulestats, 'no-rulestats' => \$opt_no_rulestats, 'noidlestats' => \$opt_noidlestats, 'no-idlestats' => \$opt_noidlestats, 's|scores=s' => \%opt_scores, 'config_timeout=i' => \$config_timeout, 'keep_rates|keep_limits|keep_rates_on_reload' => \$opt_keep_rates_on_reload, 'save_rates|save_limits|save_rates_on_restart=s' => \$opt_saverates, 'fast_limit_evaluation' => \$opt_fast_limits, 'dumpcache' => \$opt_dumpcache, 'dumpstats' => \$opt_dumpstats, 'delcache=s' => \$opt_delcache, 'delrate=s' => \$opt_delrate, 'f|file=s' => sub{ my($opt,$value) = @_; push (@Configs, $opt.'::'.$value) }, 'r|rule=s' => sub{ my($opt,$value) = @_; push (@Configs, $opt.'::'.$value) }, 'plugins=s' => \@Plugins, 'V|version' => sub{ print "$NAME $VERSION (Net::DNS ".(Net::DNS->VERSION || '').", Net::Server ".(Net::Server->VERSION || '').", Sys::Syslog ".($Sys::Syslog::VERSION || '').", ".((defined Time::HiRes->VERSION) ? "Time::HiRes ".(Time::HiRes->VERSION || '').", " : '').(($STORABLE) ? "Storable $STORABLE, " : '')."Perl ".$]." on ".$^O.")\n"; exit 1; }, 'versionshort|shortversion' => sub{ print "$VERSION\n"; exit 1; }, 'C|showconfig' => \$opt_showconfig, 'h|H|?|help|Help|HELP' => sub{ pod2usage (-msg => "\nPlease see \"".$NAME." -m\" for detailed instructions.\n", -verbose => 1); }, 'm|M|manual' => sub{ # contructing command string (de-tainting $0) $cmd_manual .= ($0 =~ /^([-\@\/\w. ]+)$/) ? " \"".$1 : " \"".$NAME; $cmd_manual .= "\" | ".$cmd_pager; exec_cmd ($cmd_manual); exit 1; }, ) or pod2usage (-msg => "\nPlease see \"".$NAME." -m\" for detailed instructions.\n", -verbose => 1); $opt_verbose = 0 unless $opt_verbose; $opt_stdoutlog = 1 if ($opt_kill or $opt_hup or $opt_showconfig or $opt_dumpcache or $opt_dumpstats); if ($opt_verbose) { push @DEBUGLIST, 'verbose'; push @DEBUGLIST, 'all ' if ($opt_verbose > 1); }; map { $DEBUG{$_} = 1 } uniq(@DEBUGLIST); # terminate at -k or --kill if ($opt_kill) { kill "TERM", get_master_pid(); exit (0); # reload at --reload } elsif ($opt_hup) { kill "HUP", get_master_pid(); exit (0); }; # check for Storable module if ( not($STORABLE) and $opt_saverates ) { print STDERR "Perl module 'Storable' required to load and save rate limits!\n"; exit(1); }; # init syslog setlogsock $syslog_socktype; $syslog_options = 'cons,pid' unless $opt_daemon; openlog $syslog_name, $syslog_options, $syslog_facility; log_note $NAME." ".$VERSION." starting" if $opt_daemon; log_note "Net::DNS ".(Net::DNS->VERSION || '').", Net::Server ".(Net::Server->VERSION || '').", Sys::Syslog ".($Sys::Syslog::VERSION || '').", Perl ".$]." on ".$^O if (wantsdebug(qw[ all verbose ])); # query usage statistics if ($opt_dumpstats) { $net_interface ||= $def_net_interface; $net_port ||= $def_net_port; my $prevalert = undef; eval { local $SIG{'__DIE__'}; local $SIG{'ALRM'} = sub { print STDERR "\nTimeout for socket $net_interface:$net_port after 60 seconds\n\n"; die }; $prevalert = alarm(60); if ( my $socket = new IO::Socket::INET ( PeerAddr => $net_interface, PeerPort => $net_port, Proto => 'tcp', Timeout => 10, Type => SOCK_STREAM ) ) { print $socket "request=dumpstats\r\n\r\n"; print "\n"; map { print } (<$socket>); print "\n"; close($socket); } else { print STDERR "\nERROR: can not open socket to $net_interface:$net_port\n\n"; }; }; alarm($prevalert); exit 1; }; # query cache contents if ($opt_dumpcache) { $net_interface ||= $def_net_interface; $net_port ||= $def_net_port; my $prevalert = undef; eval { local $SIG{'__DIE__'}; local $SIG{'ALRM'} = sub { print STDERR "\nTimeout for socket $net_interface:$net_port after 60 seconds\n\n"; die }; $prevalert = alarm(60); if ( my $socket = new IO::Socket::INET ( PeerAddr => $net_interface, PeerPort => $net_port, Proto => 'tcp', Timeout => 10, Type => SOCK_STREAM ) ) { print $socket "request=dumpcache\r\n\r\n"; print "\n"; map { print } (<$socket>); print "\n"; close($socket); } else { print STDERR "\nERROR: can not open socket to $net_interface:$net_port\n\n"; }; }; alarm($prevalert); exit 1; }; # remove cache item if ($opt_delcache or $opt_delrate) { $net_interface ||= $def_net_interface; $net_port ||= $def_net_port; my $prevalert = undef; eval { local $SIG{'__DIE__'}; local $SIG{'ALRM'} = sub { print STDERR "\nTimeout for socket $net_interface:$net_port after 60 seconds\n\n"; die }; $prevalert = alarm(60); if ( my $socket = new IO::Socket::INET ( PeerAddr => $net_interface, PeerPort => $net_port, Proto => 'tcp', Timeout => 10, Type => SOCK_STREAM ) ) { print $socket "request=".(($opt_delcache) ? "delcache ".$opt_delcache : "delrate ".$opt_delrate)."\r\n\r\n"; print "\n"; map { print } (<$socket>); print "\n"; close($socket); } else { print STDERR "\nERROR: can not open socket to $net_interface:$net_port\n\n"; }; }; alarm($prevalert); exit 1; }; # read configuration read_config(1); if ($opt_showconfig) { show_config; exit 1; }; # check modes log_note "TESTMODE: set - will return ".$default_action." to all requests" if ($opt_test); if (wantsdebug(qw[ all verbose ])) { $opt_summary ||= $Stat_Interval_Time; log_note "VERBOSE: set"; }; # -n - skip dns based checks log_note "NODNS: set - will skip all dns based checks" if $opt_nodns; # set max lookups to default (set to 0 to disable) $opt_max_ns_lookups = $def_dns_max_ns_a_lookups unless defined $opt_max_ns_lookups; $opt_max_mx_lookups = $def_dns_max_mx_a_lookups unless defined $opt_max_mx_lookups; # init scores from command-line map ( modify_score (each %opt_scores), (keys %opt_scores) ); # get summary interval time, set next display time $Stat_Interval_Time = $opt_summary if $opt_summary; $Cleanup_Timeouts = $Cleanup_Requests = $Cleanup_RBLs = $Cleanup_Rates = $Starttime = time(); log_info "Overriding cacheid itemlist with: ".(join ",", @CacheID) if ( @CacheID ); # load plugin-items get_plugins (@Plugins) if @Plugins; # de-taint arguments $net_interface ||= $def_net_interface; $net_port ||= $def_net_port; $net_proto ||= $def_net_proto; $net_umask ||= $def_net_umask; $net_user ||= $def_net_user; $net_group ||= $def_net_group; $net_chroot ||= $def_net_chroot; $net_pid ||= $def_net_pid; $dns_queuesize ||= $def_dns_queuesize; $dns_retries ||= $def_dns_retries; $dns_timeout ||= $def_dns_timeout; $config_timeout ||= $def_config_timeout; $syslog_name ||= $NAME; $net_interface = ( $net_interface =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ ) ? $1 : $def_net_interface; $net_port = ( $net_port =~ /^(\d+|[-\|\@\/\w. ]+)$/ ) ? $1 : $def_net_port; $net_proto = ( $net_proto =~ /^(tcp|unix)$/i ) ? $1 : $def_net_proto; $net_umask = ( $net_umask =~ /^([0-7]+)$/ ) ? $1 : $def_net_umask; $net_user = ( $net_user =~ /^([\w]+)$/ ) ? $1 : $def_net_user; $net_group = ( $net_group =~ /^([\w]+)$/ ) ? $1 : $def_net_group; $net_chroot = ( $net_chroot =~ /^(.+)$/ ) ? $1 : $def_net_chroot; $net_pid = ( $net_pid =~ /^([-\@\/\w. ]+)$/ ) ? $1 : $def_net_pid; $dns_queuesize = ( $dns_queuesize =~ /^(\d+)$/ ) ? $1 : $dns_queuesize; $dns_retries = ( $dns_retries =~ /^(\d+)$/ ) ? $1 : $dns_retries; $dns_timeout = ( $dns_timeout =~ /^(\d+)$/ ) ? $1 : $dns_timeout; $syslog_name = ( $syslog_name =~ /^(.+)$/ ) ? $1 : $NAME; $config_timeout = ( $config_timeout =~ /^(\d+)$/ ) ? $1 : $def_config_timeout; $opt_saverates = ( $opt_saverates =~ /^([-\|\@\/\w. ]+)$/ ) ? $1 : '' if $opt_saverates; # load rate items load_rates(); # Unbuffer standard output. select((select(STDOUT), $| = 1)[0]); if ($opt_daemon) { # # Networking # # The networking part is implemented as non-forking server. It handles multiple client # connections via non-blocking sockets using queueing via IO::Multiplex. # Please check http://search.cpan.org/dist/Net-Server/lib/Net/Server/Multiplex.pm for info. # # create server object my $server = bless { server => { commandline => [$0, @CommandArgs], # Net::Server dies when a unix domain socket without dot (".") is used port => (($net_proto eq 'unix') and not($net_port =~ /\|unix$/)) ? "$net_port|unix" : $net_port, host => ($net_proto eq 'unix') ? '' : $net_interface, proto => $net_proto, user => $net_user, group => $net_group, chroot => $net_chroot ? $net_chroot : undef, setsid => $opt_daemon ? 1 : undef, pid_file => $net_pid ? $net_pid : undef, log_level => $opt_perfmon ? 0 : ($opt_verbose + 2), log_file => $opt_perfmon ? undef : 'Sys::Syslog', syslog_logsock => $syslog_socktype, syslog_facility => $syslog_facility, syslog_ident => $syslog_name, }, }, 'postfwd'; ## run the servers main loop umask oct($net_umask); $server->run; # ignore syslog failures sub handle_syslog_error {}; # set $Reload_Conf marker on HUP signal # does not call read_config directly, to avoid # possible race conditions when caches are cleared sub sig_hup () { log_note "catched HUP signal - reloading ruleset on next request"; $Reload_Conf = 1; }; # show stats on exit sub pre_server_close_hook() { log_note "terminating..." if $opt_summary; end_program; }; # init sub pre_loop_hook() { # install signal handlers $SIG{__WARN__} = sub { log_crit "warning - \"@_\""; }; $SIG{__DIE__} = sub { fatal_exit "last err: \"$!\", detail: \"@_\""; }; $SIG{ALRM} = sub { show_stats; alarm ($Stat_Interval_Time); } if $opt_summary; log_info "successfully installed signal handlers" if wantsdebug(qw[ all verbose ]); # process init umask oct($net_umask); setlocale(LC_ALL, 'C'); $0 = $0." ".join(" ",@CommandArgs); chdir "/" or fatal_exit "Could not chdir to /"; # set first status interval time if ($opt_summary) { alarm ($Stat_Interval_Time); log_info "Setting status interval to $Stat_Interval_Time seconds"; }; # let's go log_info "$NAME $VERSION ready for input"; }; # main loop sub mux_input() { my ($self, $mux, $client, $mydata) = @_; my ($request,$answer) = undef; my (%myattr) = (); # check request and print output while ( $$mydata =~ s/^([^\r\n]*)\r?\n// ) { # check request line and print output next unless defined $1; $request = $1; process_input ($client, $request, \%myattr); }; }; } else { # main loop for command line use # regexp is used to keep it similar to the server main loop my($request,$answer) = undef; my (%myattr) = (); while (<>) { # check request and print output s/^([^\r\n]*)\r?\n//; next unless defined $1; $request = $1; process_input (undef, $request, \%myattr); }; # finishing end_program; }; die "should never see me..."; ## EOF __END__ =head1 NAME postfwd - postfix firewall daemon =head1 SYNOPSIS postfwd [OPTIONS] [SOURCE1, SOURCE2, ...] Ruleset: (at least one, multiple use is allowed): -f, --file reads rules from -r, --rule adds to config Scoring: -s, --scores = returns when score exceeds Control: -d, --daemon run postfwd as daemon -k, --kill stops daemon --reload reloads configuration --dumpstats displays usage statistics --dumpcache displays cache contents --delcache removes an item from the request cache --delrate removes an item from the rate cache Networking: -i, --interface listen on interface -p, --port listen on port --proto socket type (tcp or unix) -u, --user set uid to user -g, --group set gid to group --umask set umask for file permissions -R, --chroot chroot the daemon to --pidfile create pidfile under --facility syslog facility --socktype syslog socktype -l, --logname