#!/usr/bin/perl -T -w # # postfwd - postfix firewall daemon # # Please see `postfwd -h` for usage or # `postfwd -m` for detailed instructions. # ### SUB init package postfwd; use strict; # Includes 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); use Pod::Usage; use Net::DNS::Async; use Net::CIDR::Lite; use Net::Server::Multiplex; use vars qw(@ISA); @ISA = qw(Net::Server::Multiplex); # Program constants our($NAME) = 'postfwd'; our($VERSION) = '1.10pre6'; # 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_user) = "nobody"; our($def_net_group) = "nobody"; our($def_net_proto) = "tcp"; our($def_dns_queuesize) = "100"; our($def_dns_retries) = "3"; our($def_dns_timeout) = "7"; # 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; # 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\.0\.0\.\d+$'; # 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"; # networks in CIDR notation (a.b.c.d/nn) our($COMP_NETWORK_CIDRS) = "client_address"; # RBL checks 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"; # 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"; # item match counter our($COMP_MATCHES) = "matches"; # separator #our($COMP_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_SENDER|$COMP_RHSBL_KEY_RCLIENT|$COMP_DATECALC)"; # dont treat these as lists our($COMP_SINGLE) = "($COMP_ID|$COMP_ACTION|$COMP_SCORES|$COMP_RBL_CNT|$COMP_RHSBL_CNT)"; # Syslogging options # NOTE: try changing the $syslog_socktype line if syslogging does not # work on your system. Some operating systems (like Solaris) prefer 'inet'. our($syslog_name) = $NAME; our($syslog_socktype) = ($^O eq 'solaris') ? 'inet' : 'unix'; # inet, unix, stream, console our($syslog_facility) = "mail"; our($syslog_options) = "pid"; our($syslog_priority) = "info"; # save command-line our(@CommandArgs) = @ARGV; # initializations - do not change our(@Configs,@Rules,@CacheID) = (); our(%Config_Cache, %RBL_Cache, %Request_Cache) = (); our(%Matches, %opt_scores, %ACLs, %compare, %Rates) = (); our( $Counter_Requests,$Counter_Hits, $Counter_Interval,$Counter_Top, $Counter_Rates, $Starttime,$Startdate, $Cleanup_Requests, $Cleanup_RBLs, $Cleanup_Rates ) = 0; 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, ); use vars qw( $opt_daemon $opt_instantconfig $opt_nodns $opt_summary $net_interface $net_port $net_user $net_group $net_chroot $net_pid $opt_perfmon $opt_test $opt_verbose $opt_cache_rdomain_only $opt_cache_no_size $opt_cache_no_sender $opt_showconfig $opt_stdoutlog $opt_shortlog $DNS $Reload_Conf $dns_queuesize $dns_retries $dns_timeout ); ### SUB tools # # send log message # escaping % character for safe syslogging # sub mylogs { my($prio) = shift(@_); my($msg) = shift(@_); # dangerous % will be replaced by %% $msg =~ s/\%/%%/g; unless ($opt_stdoutlog) { syslog $prio, "$msg", @_ if (($prio eq "crit") or not($opt_perfmon)); } else { printf "[LOGS $prio]: $msg\n", @_ if (($prio eq "crit") or not($opt_perfmon)); }; } # # send log message # no escaping for the % character - use only for safe output (stats) # sub mylog { my($prio) = shift(@_); my($msg) = shift(@_); unless ($opt_stdoutlog) { syslog $prio, "$msg", @_ if (($prio eq "crit") or not($opt_perfmon)); } else { printf "[LOG $prio]: $msg\n", @_ if (($prio eq "crit") or not($opt_perfmon)); }; } # # 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; } # # Log an error and abort. # sub fatal_exit { my($msg) = shift(@_); warn "fatal: $msg", @_; exit 1; } # # finish program # sub end_program { show_stats() if $opt_summary; mylogs "notice", $NAME." ".$VERSION." terminated" if $opt_daemon; exit; }; # # 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); }; # # clean up request cache # sub request_cache_cleanup { my($now) = $_[0]; foreach my $checkitem (keys %Request_Cache) { if ( (($now - $Request_Cache{$checkitem}{"time"}) > $REQUEST_MAX_CACHE) ) { mylogs $syslog_priority, "[CLEANUP] removing request-cache $checkitem after " .($now - $Request_Cache{$checkitem}{"time"})." seconds (timeout: ".$REQUEST_MAX_CACHE."s)" if ($opt_verbose > 1); delete $Request_Cache{$checkitem}; }; }; }; # # clean up RBL cache # sub rbl_cache_cleanup { my($now) = $_[0]; foreach my $checkitem (keys %RBL_Cache) { if ( (($now - @{$RBL_Cache{$checkitem}}[1]) > @{$RBL_Cache{$checkitem}}[2]) ) { mylogs $syslog_priority, "[CLEANUP] removing rbl-cache for $checkitem after " .($now - @{$RBL_Cache{$checkitem}}[1])." seconds (timeout: ".@{$RBL_Cache{$checkitem}}[2]."s)" if ($opt_verbose > 1); delete $RBL_Cache{$checkitem}; }; }; }; # # clean up rate cache # sub rate_cache_cleanup { my($now) = $_[0]; foreach my $checkitem (keys %Rates) { if ( (($now - @{$Rates{$checkitem}}[4]) > @{$Rates{$checkitem}}[2]) ) { mylogs $syslog_priority, "[CLEANUP] removing rate-cache for $checkitem after " .($now - @{$Rates{$checkitem}}[4])." seconds (timeout: ".@{$Rates{$checkitem}}[2]."s)" if ($opt_verbose > 1); delete $Rates{$checkitem}; }; }; }; # # sets an action for a score # sub modify_score { (my($myscore), my($myaction)) = @_; ( exists($MAX_SCORES{$myscore}) ) ? mylogs "notice", "redefined score $myscore with action=\"$myaction\"" : mylogs "notice", "setting new score $myscore with action=\"$myaction\"" if $opt_verbose; $MAX_SCORES{$myscore} = $myaction; }; # # displays program usage statistics # sub show_stats { my($now) = time; $Counter_Interval ||= 0; $Counter_Top ||= 0; $Counter_Hits ||= 0; $Counter_Rates ||= 0; my($totalreqpermin) = ( ((($now - $Starttime) > 0) ? ($Counter_Requests / ($now - $Starttime)) : 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); mylog "notice", "[STATS] Counters: %d seconds uptime since %s", ($now - $Starttime), $Startdate; mylog "notice", "[STATS] Requests: %d overall, %d last interval, %.2f%% cache hits, %.2f%% rate hits", $Counter_Requests, $Counter_Interval, ($Counter_Requests > 0) ? (($Counter_Hits / $Counter_Requests) * 100) : 0, ($Counter_Requests > 0) ? (($Counter_Rates / $Counter_Requests) * 100) : 0; mylog "notice", "[STATS] Averages: %.2f overall, %.2f last interval, %.2f top", $totalreqpermin, $lastreqpermin, $Counter_Top; mylog "notice", "[STATS] Contents: %d rules, %d cached requests, %d cached dnsbl results, %d rate limits", $#Rules, scalar keys %Request_Cache, scalar keys %RBL_Cache, scalar keys %Rates; # per rule stats map { mylogs "notice", "[STATS] Rule ID: $_ matched: $Matches{$_} times" } (sort keys %Matches); $Counter_Interval = 0; }; ### SUB configuration # # preparses configuration line for ACL syntax # sub acl_parser { my($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; $myline =~ s/\s*$acl\s*/$ACLs{$acl}/g if exists($ACLs{$acl}); }; }; return $myline; } # # parses configuration line # sub parse_config_line { my($mynum, $myindex, $myline) = @_; my(%myrule) = (); my($mykey, $myvalue, $mycomp); if ( $myline = acl_parser ($myline) ) { unless ( $myline =~ /^\s*[^=\s]+\s*$COMP_SEPARATOR\s*([^;\s]+\s*)+(;\s*[^=\s]+\s*$COMP_SEPARATOR\s*([^;\s]+\s*)+)*[;\s]*$/ ) { warn "warning: ignoring invalid line ".$mynum.": \"".$myline."\""; } else { # separate items foreach (split ";", $myline) { # remove whitespaces around s/^\s*(.*?)\s*($COMP_SEPARATOR)\s*(.*?)\s*$/$1$2$3/; $mycomp = $2; ($mykey, $myvalue) = split /$COMP_SEPARATOR/, $_, 2; if ($mykey =~ /^$COMP_CSV$/) { $myvalue =~ s/\s*-\s*/-/g if ($mykey =~ /^$COMP_DATECALC$/); $myvalue =~ s/\s*,\s*/,/g; map { push ( @{$myrule{$mykey}}, $mycomp.";".$_ ) } ( split ",", $myvalue ); } elsif ($mykey =~ /^$COMP_SINGLE$/) { mylogs "notice", "warning: Rule $myindex (line $mynum):" ." overriding $mykey=\"".$myrule{$mykey}."\"" ." with $mykey=\"$myvalue\"" if (defined $myrule{$mykey}); $myrule{$mykey} = $myvalue; } else { push ( @{$myrule{$mykey}}, $mycomp.";".$myvalue ); }; }; unless (exists($myrule{$COMP_ACTION})) { $myrule{$COMP_ACTION} = "WARN rule found but no action was defined"; mylogs "notice", "warning: Rule ".$myindex." (line ".$mynum."): contains no action - default will be used"; }; unless (exists($myrule{$COMP_ID})) { $myrule{$COMP_ID} = "R-".$myindex; mylogs "notice", "notice: Rule $myindex (line $mynum): contains no rule identifier - will use \"$myrule{id}\"" if $opt_verbose; }; mylogs $syslog_priority, "loaded: Rule $myindex (line $mynum): id->\"$myrule{id}\" action->\"$myrule{action}\"" if $opt_verbose; }; }; return %myrule; } # # parses configuration file # sub read_config_file { my($myindex, $myfile) = @_; my(%myrule, @myruleset) = (); my($mybuffer) = ""; unless (-e $myfile) { warn "error: file ".$myfile." not found - file will be ignored"; } else { unless (open (IN, "<$myfile")) { warn "error: could not open ".$myfile." - file will be ignored"; } else { mylogs $syslog_priority, "reading file $myfile" if $opt_verbose; while () { chomp; s/(\"|#.*)//g; next if /^\s*$/; if (/(.*)\\\s*$/) { $mybuffer = $mybuffer.$1; next; }; %myrule = parse_config_line ($., ($#myruleset+$myindex+1), $mybuffer.$_); push ( @myruleset, { %myrule } ) if (%myrule); $mybuffer = ""; }; close (IN); mylogs $syslog_priority, "loaded: Rules $myindex - ".($myindex + $#myruleset)." from file \"$myfile\"" if $opt_verbose; }; }; return @myruleset; } # # reads all configuration items # sub read_config { my(%myrule, @myruleset) = (); my($mytype,$myitem,$config); undef(@Rules); undef(%Request_Cache); undef(%Rates); for $config (@Configs) { ($mytype,$myitem) = split '::', $config; if ($mytype eq "r" or $mytype eq "rule") { %myrule = parse_config_line (0, ($#Rules + 1), $myitem); push ( @Rules, { %myrule } ) if (%myrule); } elsif ($mytype eq "f" or $mytype eq "file") { if ( (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 $opt_verbose; push ( @Rules, @{$Config_Cache{$myitem}{ruleset}} ); } else { @myruleset = read_config_file (($#Rules+1), $myitem); if (@myruleset) { push ( @Rules, @myruleset ); $Config_Cache{$myitem}{lastread} = time; @{$Config_Cache{$myitem}{ruleset}} = @myruleset; }; }; }; }; } # # displays configuration # sub show_config { my($index,$line,$mykey); if ($opt_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 = ($opt_verbose) ? "\n\t " : ""; for $mykey ( reverse sort keys %{$Rules[$index]} ) { unless (($mykey eq $COMP_ACTION) or ($mykey eq $COMP_ID)) { $line .= "; " unless $opt_verbose; $line .= ($mykey =~ /^$COMP_SINGLE$/) ? $mykey."->\"".$Rules[$index]{$mykey}."\"" : $mykey."->\"".(join ', ', @{$Rules[$index]{$mykey}})."\""; $line .= " ; " if $opt_verbose; }; }; $line =~ s/\s*\;\s*$// if $opt_verbose; myprintf "%s\n", $line; myprint "-" x 75, "\n" if $opt_verbose; }; } ## sub DNS # # reads DNS answers # sub rbl_read_dns { my($myresult) = shift; my($que,$res) = undef; my($now) = time; if ( defined $myresult ) { # read question, for rbl cache id foreach ($myresult->question) { next unless ($_->qtype eq 'A'); $que = $_->qname; }; if (defined $que) { # some RBLs return CNAMEs, so the number of the questions # is not necessarily the number of answers you get foreach ($myresult->answer) { next unless ($_->type eq 'A'); $res = $_->address; }; $res ||= ''; # save result in cache if ( exists($RBL_Cache{$que}) ) { mylogs $syslog_priority, "[DNSBL] object " .( (@{$RBL_Cache{$que}}[5] eq $COMP_RBL_KEY) ? join(".", reverse(split(/\./,@{$RBL_Cache{$que}}[4]))) : @{$RBL_Cache{$que}}[4] ) ." listed on ".@{$RBL_Cache{$que}}[5].":".@{$RBL_Cache{$que}}[3] ." (answer: $res, time: ".($now - @{$RBL_Cache{$que}}[1])."s)" if $res; @{$RBL_Cache{$que}} = ( $res, $now, @{$RBL_Cache{$que}}[2], @{$RBL_Cache{$que}}[3], @{$RBL_Cache{$que}}[4], @{$RBL_Cache{$que}}[5], ($now - @{$RBL_Cache{$que}}[1]) ); } else { mylogs "notice", "[DNSBL] ignoring unknown query $que -> $res"; }; }; } else { warn "[DNSBL] dns timeout"; }; }; # # fires DNS queries # sub rbl_send_dns { my($mytype, $myval, @myrbls) = @_; my($now) = time; my($myresult) = undef; my($cmp,$rblitem,$myquery); 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; $myrblans = $RBL_DEFAULT unless $myrblans; $myrbltime = $RBL_MAX_CACHE unless $myrbltime; # create query string $myquery = $myval.".".$myrbl; # query our cache if ( exists($RBL_Cache{$myquery}) and not(@{$RBL_Cache{$myquery}}[0] eq '**query**') ) { my($myanswer, $mystart, $myend, $m1, $m2, $m3, $m4) = @{$RBL_Cache{$myquery}}; $myresult = ( $myanswer =~ /$myrblans/ ); mylogs $syslog_priority, "[DNSQUERY] cached $mytype: $myrbl $myval ($myquery - $myanswer)" if ( $myresult and $opt_verbose ); # not found -> send dns query } else { @{$RBL_Cache{$myquery}} = ('**query**', $now, $myrbltime, $myrbl, $myval, $mytype, 0); mylogs $syslog_priority, "[DNSQUERY] query $mytype: $myrbl $myval ($myquery)" if $opt_verbose; $DNS->add (\&rbl_read_dns, $myquery); }; }; }; # # checks RBL items # sub rbl_check { my($mytype,$myrbl,$myval) = @_; my($myanswer,$myrblans,$myrbltime,$myresult,$mystart,$myend); my($g1,$g2,$g3,$g4,$m1,$m2,$m3,$m4,$myquery,@addrs); 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($RBL_Cache{$myquery}) ); if ( $myresult ) { ($myanswer, $mystart, $myend, $m1, $m2, $m3, $m4) = @{$RBL_Cache{$myquery}}; $myresult = ( $myanswer =~ /$myrblans/ ); if ( $myresult ) { mylogs $syslog_priority, "[DNSBL] query $myval listed on ".uc($mytype).":$myrbl (answer: $myanswer, cached: ".($now - $mystart)."s ago)" if $opt_verbose; } elsif ($myanswer eq '**query**') { mylogs "notice", "[DNSBL] timeout for query ".uc($mytype).":$myrbl after $m3 seconds (object: " .(($mytype eq $COMP_RBL_KEY) ? join(".", reverse(split(/\./,$m2))) : $m2).")"; }; } else { mylogs "notice", "[OLDDNSBL] can not find cache item. will use syncronous $mytype query: $myrbl $myval ($myquery)"; $mystart = time; ($g1,$g2,$g3,$g4,@addrs) = gethostbyname($myquery); $myend = time; # compare $myanswer = ($addrs[0]) ? join (".", unpack('C4',$addrs[0])) : "_error_"; $myresult = ( $myanswer =~ /$myrblans/ ); mylogs $syslog_priority, "[OLDDNSBL] client $myval listed on ".uc($mytype).":$myrbl (answer: $myanswer, time: ".($myend - $mystart)."s)" if $myresult; @{$RBL_Cache{$myval}} = ($myanswer, $mystart, $myrbltime, $myrbl, $myval, $mytype, ($myend - $mystart)); }; return $myresult; } ## SUB pre_plugins # # these subroutines will integrate additional attributes to # a request before the ruleset is evaluated # call: %result = pre_plugin_sub{foo}(%request) # save: $result{$_} # our(%pre_plugin_sub) = ( # enables the execution of rules on the # specified postfwd version "version" => sub { my(%request) = @_; my(%result) = (); $result{$_} = $NAME." ".$VERSION; return %result; }, "sender_localpart" => sub { my(%request) = @_; my(%result) = (); $request{sender} =~ /(.*)@[^@]*$/; $result{$_} = $1; return %result; }, "sender_domain" => sub { my(%request) = @_; my(%result) = (); $request{sender} =~ /@([^@]*)$/; $result{$_} = $1; return %result; }, "recipient_localpart" => sub { my(%request) = @_; my(%result) = (); $request{recipient} =~ /(.*)@[^@]*$/; $result{$_} = $1; return %result; }, "recipient_domain" => sub { my(%request) = @_; my(%result) = (); $request{recipient} =~ /@([^@]*)$/; $result{$_} = $1; return %result; }, "reverse_address" => sub { my(%request) = @_; my(%result) = (); $result{$_} = (join(".", reverse(split(/\./,$request{client_address})))); return %result; }, ); # returns additional request information # for all pre_plugins sub pre_plugin { my(%request) = @_; my(%result) = (); foreach (keys %pre_plugin_sub) { %result = (%result, &{$pre_plugin_sub{$_}}(%request)) if (defined $pre_plugin_sub{$_}); }; map { $result{$_} = '' unless $result{$_} } (keys %result); return %result; }; ### SUB ruleset # # get a rule number by id # sub get_rule_by_id { my($id) = @_; my($matched,$myresult) = ""; my($index); RULE: for $index (0 .. $#Rules) { next unless exists $Rules[$index]; $matched = ( $id eq $Rules[$index]{$COMP_ID} ); $myresult = $index if $matched; last RULE if $matched; }; return $myresult; } # # 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) = @_; 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 (defined $request{$var}) { $var = $request{$var}; # substitute dangerous characters $var =~ s/([^-\w\s])/\\$1/g if ( $cmp =~ /~/ ); $myresult=$val=$pre.$var.$post; }; mylogs $syslog_priority, "substitute : \"$myitem\" \"$cmp\" \"$val\"" if ($opt_verbose > 1); }; return $myresult; }; # # compare item subroutines # must take compare_item_foo ( $COMPARE_TYPE, $RULEITEM, $REQUESTITEM, %REQUEST, %REQUESTINFO ); # %compare = ( "cidr" => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; mylogs $syslog_priority, "type cidr : \"$myitem\" \"$cmp\" \"$val\"" if ($opt_verbose > 1); my $myref = Net::CIDR::Lite->new($val); $myresult = ( $myref->find($myitem) ); return $myresult; }, "numeric" => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; mylogs $syslog_priority, "type numeric : \"$myitem\" \"$cmp\" \"$val\"" if ($opt_verbose > 1); $myitem ||= "0"; $val ||= "0"; if (($cmp eq '<=') or ($cmp eq '=<')) { $myresult = ($myitem <= $val); } elsif ($cmp eq '==') { $myresult = ($myitem == $val); } else { $myresult = ($myitem >= $val); }; return $myresult; }, $COMP_RBL_KEY => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = not($opt_nodns); mylogs $syslog_priority, "type rbl : \"$myitem\" \"$cmp\" \"$val\"" if ($opt_verbose > 1); $myresult = ( rbl_check ($COMP_RBL_KEY, $val, $myitem) ) if $myresult; return $myresult; }, $COMP_RHSBL_KEY => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = not($opt_nodns); mylogs $syslog_priority, "type rhsbl : \"$myitem\" \"$cmp\" \"$val\"" if ($opt_verbose > 1); $myresult = ( rbl_check ($COMP_RHSBL_KEY, $val, $myitem) ) if $myresult; return $myresult; }, $COMP_MONTHS => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; my($imon) = (split (',', $myitem))[4]; $imon ||= 0; my($rmin,$rmax) = split ('-', $val); $rmin = ($rmin) ? (($rmin =~ /^\d$/) ? $rmin : $months{$rmin}) : $imon; $rmax = ($rmax) ? (($rmax =~ /^\d$/) ? $rmax : $months{$rmax}) : $imon; mylogs $syslog_priority, "type months : \"$imon\" \"$cmp\" \"$rmin\"-\"$rmax\"" if ($opt_verbose > 1); $myresult = (($rmin <= $imon) and ($rmax >= $imon)); return $myresult; }, $COMP_DAYS => sub { my($cmp,$val,$myitem,%request) = @_; my($myresult) = undef; my($iday) = (split (',', $myitem))[6]; $iday ||= 0; my($rmin,$rmax) = split ('-', $val); $rmin = ($rmin) ? (($rmin =~ /^\d$/) ? $rmin : $weekdays{$rmin}) : $iday; $rmax = ($rmax) ? (($rmax =~ /^\d$/) ? $rmax : $weekdays{$rmax}) : $iday; mylogs $syslog_priority, "type days : \"$iday\" \"$cmp\" \"$rmin\"-\"$rmax\"" if ($opt_verbose > 1); $myresult = (($rmin <= $iday) and ($rmax >= $iday)); 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 ('-', $val); my($idat); $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)) : $idat; mylogs $syslog_priority, "type date : \"$idat\" \"$cmp\" \"$rmin\"-\"$rmax\"" if ($opt_verbose > 1); $myresult = (($rmin <= $idat) and ($rmax >= $idat)); 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 ('-', $val); my($idat); $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)) : $idat; mylogs $syslog_priority, "type time : \"$idat\" \"$cmp\" \"$rmin\"-\"$rmax\"" if ($opt_verbose > 1); $myresult = (($rmin <= $idat) and ($rmax >= $idat)); return $myresult; }, "default" => sub { my($cmp,$val,$myitem,%request) = @_; my($var,$myresult) = undef; mylogs $syslog_priority, "type default : \"$myitem\" \"$cmp\" \"$val\"" if ($opt_verbose > 1); # substitute check for $$vars in action $val = $var if ( $var = devar_item ($cmp,$val,$myitem,%request) ); # backward compatibility $cmp = '==' if ( ($var) and ($cmp eq '=') ); if ($cmp eq '==') { $myresult = ( lc($myitem) eq lc($val) ) if $myitem; } elsif (($cmp eq '<=') or ($cmp eq '=<')) { $myresult = ($myitem <= $val); } elsif (($cmp eq '>=') or ($cmp eq '=>')) { $myresult = ($myitem >= $val); } else { # allow // regex $val =~ s/^\/?(.*?)\/?$/$1/; $myresult = ( $myitem =~ /$val/i ) if $myitem; }; return $myresult; }, "client_address" => sub { return &{$compare{"cidr"}}(@_); }, "encryption_keysize" => sub { return &{$compare{"numeric"}}(@_); }, "size" => sub { return &{$compare{"numeric"}}(@_); }, "recipient_count" => sub { return &{$compare{"numeric"}}(@_); }, $COMP_RHSBL_KEY_CLIENT => sub { return &{$compare{$COMP_RHSBL_KEY}}(@_); }, $COMP_RHSBL_KEY_SENDER => sub { return &{$compare{$COMP_RHSBL_KEY}}(@_); }, $COMP_RHSBL_KEY_RCLIENT => sub { return &{$compare{$COMP_RHSBL_KEY}}(@_); }, ); # # compare item main # use: compare_item ( $TYPE, $RULEITEM, $MINIMUMHITS, $REQUESTITEM, %REQUEST, %REQUESTINFO ); # sub compare_item { my($mykey,$mymask,$mymin,$myitem, %request) = @_; my($val,$cmp,$neg,$myresult,$compare_proc); my($rcount) = 0; $mymin ||= 1; # # determine the right compare function $compare_proc = (defined $compare{$mykey}) ? $mykey : "default"; # # now compare request to every single item ITEM: foreach (@{$mymask}) { ($cmp, $val) = split ";"; next ITEM unless ($cmp and $val and $mykey and $myitem); mylogs $syslog_priority, "compare $mykey: \"$myitem\" \"$cmp\" \"$val\"" if ($opt_verbose > 1); $val = $neg if ($neg = deneg_item($val)); mylogs $syslog_priority, "deneg $mykey: \"$myitem\" \"$cmp\" \"$val\"" if ($neg and ($opt_verbose > 1)); next ITEM unless $val; $myresult = &{$compare{$compare_proc}}($cmp,$val,$myitem,%request); mylogs $syslog_priority, "match $mykey: ".($myresult ? "TRUE" : "FALSE") if ($opt_verbose > 1); if ($neg) { $myresult = not($myresult); mylogs $syslog_priority, "negate match $mykey: ".($myresult ? "TRUE" : "FALSE") if ($opt_verbose > 1); }; $rcount++ if $myresult; $myresult = not($mymin eq 'all'); $myresult = ( $rcount >= $mymin ) if $myresult; mylogs $syslog_priority, "count $mykey: request=$rcount minimum: $mymin result: ".($myresult ? "TRUE" : "FALSE") if ($opt_verbose > 1); 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($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}) ); my($hasdns) = ( not($opt_nodns) and ($has_rhl or exists($Rules[$index]{$COMP_RBL_KEY})) ); my($mykey,$myitem,$val,$cmp,$res,$myrip,$myline) = undef; my(@myresult) = (0,0,0); my(@queries) = (); my($num) = 1; mylogs $syslog_priority, "rule: $index, id: $Rules[$index]{$COMP_ID}" if ($opt_verbose > 1); # DNSQUERY-SECTION # fire add()s with callback to result cache, # if they are not contained already, # and $opt_nodns is not set if ($hasdns) { if ( exists($Rules[$index]{$COMP_RBL_KEY}) ) { $myrip = (defined $request{"reverse_address"}) ? $request{"reverse_address"} : (join(".", reverse(split(/\./,$request{"client_address"})))); rbl_send_dns ( $COMP_RBL_KEY, $myrip, @{$Rules[$index]{$COMP_RBL_KEY}} ); }; rbl_send_dns ( $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") ); rbl_send_dns ( $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") ); rbl_send_dns ( $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 "") ); rbl_send_dns ( $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") ); }; # 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)) ); # 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, $val, %request)) ? ($myresult[0] + $res) : 0; }; last ITEM unless ($myresult[0] > 0); }; # DNSRESULT-SECTION # if all other items matched, run await() # and check the results unless $opt_nodns if ($hasdns) { $DNS->await(); 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), $myrip, %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_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 ($opt_verbose > 1) { $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); mylogs $syslog_priority, $myline; }; return @myresult; } ### SUB access policy # # access policy routine # sub smtpd_access_policy { my(%myattr) = @_; my($myaction) = $default_action; my($index) = 1; my($now) = time; my($date) = join(',', localtime($now)); my(@hits) = (); my($matched,$rblcnt,$rhlcnt,$t1,$t2,$t3) = 0; my($mykey,$cacheid,$myline,$checkreq) = ""; my($rdat,$rcnt,$ratecount,$ratetime,$ratecmd,$rateid,$ratetype,$ratehit) = undef; # replace empty sender with <> $myattr{"sender"} = '<>' unless ($myattr{"sender"}); # check for HUP signal if ( $Reload_Conf ) { undef $Reload_Conf; show_stats; read_config; }; # 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; rate_cache_cleanup($now); $t2 = time; mylogs $syslog_priority, "[CLEANUP] needed ".($t2 - $t1) ." seconds for rate cleanup of " .($t3 - scalar keys %Rates)." out of ".$t3 ." cached items after ".($now - $Cleanup_Rates) ." seconds (min ".$CLEANUP_RATE_CACHE."s)" if ( $opt_verbose or (($t2 - $t1) > 0) ); $Cleanup_Rates = $t1; }; # increase rate limits RATES: foreach $checkreq (keys %myattr) { next RATES unless ( $myattr{$checkreq} ); next RATES unless ( defined $Rates{$myattr{$checkreq}} ); ($ratetype, $ratecount, $ratetime, $rcnt, $rdat, $rateid, $ratecmd) = @{$Rates{$myattr{$checkreq}}}; if ( ($now - $rdat) > $ratetime ) { $rcnt = 0; $Rates{$myattr{$checkreq}} = [ $ratetype, $ratecount, $ratetime, ( ($ratetype eq 'size') ? $myattr{"size"} : 1 ), $now, $rateid, $ratecmd ]; mylogs $syslog_priority, "[RATE] renewing rate object ".$myattr{$checkreq}." [type: ".$ratetype.", max: ".$ratecount.", time: ".$ratetime."s]" if ($opt_verbose > 1); } else { $Rates{$myattr{$checkreq}} = [ $ratetype, $ratecount, $ratetime, ( ($ratetype eq 'size') ? ($rcnt+=$myattr{"size"}) : ++$rcnt ), $rdat, $rateid, $ratecmd ]; mylogs $syslog_priority, "[RATE] increasing rate object ".$myattr{$checkreq}." to ".$rcnt." [type: ".$ratetype.", max: ".$ratecount.", time: ".$ratetime."s]" if ($opt_verbose > 1); $ratehit = $checkreq if ($rcnt > $ratecount); last RATES if $ratehit; }; }; # Request cache enabled? if ( $REQUEST_MAX_CACHE > 0 ) { # construct cache identifier if (@CacheID) { map { $cacheid .= $myattr{$_}.";" if (defined $myattr{$_}) } @CacheID; } else { REQITEM: foreach $checkreq (sort keys %myattr) { next REQITEM unless $myattr{$checkreq}; next REQITEM if ( ($checkreq eq "instance") or ($checkreq eq "queue_id") ); next REQITEM if ( defined $pre_plugin_sub{$checkreq} ); 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") ) { $myattr{$checkreq} =~ /@([^@]+)$/; $cacheid .= $1.";" if $1; } else { $cacheid .= $myattr{$checkreq}.";"; }; }; }; mylogs $syslog_priority, "created cache-id: $cacheid" if ($opt_verbose > 1); # 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; request_cache_cleanup($now); $t2 = time; mylogs $syslog_priority, "[CLEANUP] needed ".($t2 - $t1) ." seconds for request cleanup of " .($t3 - scalar keys %Request_Cache)." out of ".$t3 ." cached items after ".($now - $Cleanup_Requests) ." seconds (min ".$CLEANUP_REQUEST_CACHE."s)" if ( $opt_verbose or (($t2 - $t1) > 0) ); $Cleanup_Requests = $t1; }; }; # check rate if ( $ratehit ) { $Counter_Rates++; $Matches{$rateid}++; $myaction = $ratecmd; mylogs $syslog_priority, "[RATE] rule=".get_rule_by_id ($rateid) . ", id=".$rateid . ", client=".$myattr{"client_name"}."[".$myattr{"client_address"}."]" . ", sender=".$myattr{"sender"} . ", recipient=".$myattr{"recipient"} . ", helo=".$myattr{"helo_name"} . ", proto=".$myattr{"protocol_name"} . ", state=".$myattr{"protocol_state"} . ", delay=".(time - $now)."s" . ", action=".$myaction." (item: ".$myattr{$ratehit}.", type: ".$ratetype.", count: ".$rcnt."/".$ratecount.", time: ".($now - $rdat)."/".$ratetime."s)"; # check cache } elsif ( ($REQUEST_MAX_CACHE > 0) and ((exists($Request_Cache{$cacheid}{$COMP_ACTION})) and (($now - $Request_Cache{$cacheid}{"time"}) <= $REQUEST_MAX_CACHE)) ) { $Counter_Hits++; $myaction = $Request_Cache{$cacheid}{$COMP_ACTION}; if ( $Request_Cache{$cacheid}{"hit"} ) { $Matches{$Request_Cache{$cacheid}{$COMP_ID}}++; mylogs $syslog_priority, "[CACHE] rule=".get_rule_by_id ($Request_Cache{$cacheid}{$COMP_ID}) . ", id=".$Request_Cache{$cacheid}{$COMP_ID} . ", client=".$myattr{"client_name"}."[".$myattr{"client_address"}."]" . ", sender=".$myattr{"sender"} . ", recipient=".$myattr{"recipient"} . ", helo=".$myattr{"helo_name"} . ", proto=".$myattr{"protocol_name"} . ", state=".$myattr{"protocol_state"} . ", delay=".(time - $now)."s" . ", hits=".$Request_Cache{$cacheid}{"hits"} . ", action=".$Request_Cache{$cacheid}{$COMP_ACTION}; }; # check rules } else { my($score) = 0; my($var) = ''; # refresh config if '-I' was set read_config if $opt_instantconfig; if ($#Rules < 0) { warn "critical: no rules found - i feel useless (have you set -f or -r?)"; } else { # load pre_plugin attributes if ( my(%pre_plugin_attr) = pre_plugin (%myattr) ) { %myattr = (%myattr, %pre_plugin_attr); map {mylogs $syslog_priority, "[PRE-PLUGIN] Add key: $_=$pre_plugin_attr{$_}" } (keys %pre_plugin_attr) if ($opt_verbose > 1); }; # clean up rbl cache if ( not($opt_nodns) and (scalar keys %RBL_Cache > 0) and (($now - $Cleanup_RBLs) > $CLEANUP_RBL_CACHE) ) { $t1 = time; $t3 = scalar keys %RBL_Cache; rbl_cache_cleanup($now); $t2 = time; mylogs $syslog_priority, "[CLEANUP] needed ".($t2 - $t1) ." seconds for rbl cleanup of " .($t3 - scalar keys %RBL_Cache)." out of ".$t3 ." cached items after ".($now - $Cleanup_RBLs) ." seconds (min ".$CLEANUP_RBL_CACHE."s)" if ( $opt_verbose or (($t2 - $t1) > 0) ); $Cleanup_RBLs = $t1; }; # prepares hit counters $myattr{$COMP_MATCHES} = 0; $myattr{$COMP_RBL_CNT} = 0; $myattr{$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, %myattr); # enables/overrides hit counters for later use $myattr{$COMP_MATCHES} = $matched; $myattr{$COMP_RBL_CNT} = $rblcnt; $myattr{$COMP_RHSBL_CNT} = $rhlcnt; # matched? prepare logline, increase counters if ($matched > 0) { $myaction = $Rules[$index]{$COMP_ACTION}; $Matches{$Rules[$index]{$COMP_ID}}++; push ( @hits, $Rules[$index]{$COMP_ID} ); # substitute check for $$vars in action $myaction = $var if ( $var = devar_item ("==",$myaction,"action",%myattr) ); $myline = "rule=".$index . ", id=".$Rules[$index]{$COMP_ID} . ", client=".$myattr{"client_name"}."[".$myattr{"client_address"}."]" . ", sender=".$myattr{"sender"} . ", recipient=".$myattr{"recipient"} . ", helo=".$myattr{"helo_name"} . ", proto=".$myattr{"protocol_name"} . ", state=".$myattr{"protocol_state"}; # check for postfwd action if ($myaction =~ /^([a-zA-Z]{3,5})\(([^\)]*)\)$/) { my($mycmd,$myarg) = ($1, $2); # jump() command if ($mycmd eq "jump") { my($ruleno) = get_rule_by_id ($myarg); if ($ruleno) { mylogs $syslog_priority, "[RULES] ".$myline.", jump to rule $ruleno (id $myarg)" unless $opt_shortlog; $index = $ruleno - 1; } else { warn "[RULES] ".$myline." - error: jump failed, can not find rule-id ".$myarg." - ignoring"; }; $myaction = $default_action; # set() command } elsif ($mycmd eq "set") { foreach ( split (",", $myarg) ) { if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) { my($r_var, $r_val) = ($1, $2); (defined $myattr{$r_var}) ? mylogs "notice", "[RULES] ".$myline.", redefining existing ".$r_var."=".$myattr{$r_var}." with ".$r_var."=".$r_val : mylogs $syslog_priority, "[RULES] ".$myline.", defining ".$r_var."=".$r_val unless $opt_shortlog; $myattr{$r_var} = $r_val; } else { warn "[RULES] ".$myline.", ignoring unknown set() attribute ".$myarg; }; }; $myaction = $default_action; # rate() and size() command } elsif (($mycmd eq "rate") or ($mycmd eq "size")) { ($ratetype,$ratecount,$ratetime,$ratecmd) = split "/", $myarg, 4; if ($ratetype and $ratecount and $ratetime and $ratecmd) { unless ( defined $Rates{$ratetype} ) { $Rates{$ratetype} = [ $mycmd, $ratecount, $ratetime, ( ($mycmd eq 'size') ? $myattr{"size"} : 1 ), $now, $Rules[$index]{$COMP_ID}, $ratecmd ]; mylogs $syslog_priority, "[RULES] ".$myline .", creating rate object ".$ratetype ." [type: ".$mycmd.", max: ".$ratecount.", time: ".$ratetime."s]" if ($opt_verbose > 1); }; } else { mylogs "notice", "[RULES] ".$myline.", ignoring unknown rate() attribute ".$myarg; }; $myaction = $default_action; # wait() command } elsif ($mycmd eq "wait") { mylogs $syslog_priority, "[RULES] ".$myline.", delaying for $myarg seconds"; sleep $myarg; $myaction = $default_action; # score() command } elsif ($mycmd eq "score") { $myaction = $default_action; if ($myarg =~/^([\+\-\*\/\=]?)(\d+)[\.,](\d+)$/) { my($mod, $val) = ($1, $2 + $3 / 10); if ($mod eq '-') { $score -= $val; } elsif ($mod eq '*') { $score *= $val; } elsif ($mod eq '/') { $score /= $val; } elsif ($mod eq '=') { $score = $val; } else { $score += $val; }; $score = $1.$2 if ( $score =~ /^(\-?\d+)([\.,]\d\d?)?.*/ ); mylogs $syslog_priority, "[SCORE] ".$myline.", modifying score about ".$myarg." points to ". $score unless $opt_shortlog; my($max_score); foreach $max_score (reverse sort keys %MAX_SCORES) { if ($score >= $max_score) { $myaction=$MAX_SCORES{$max_score}; $myline .= ", delay=".(time - $now)."s, hits=".(join (";", @hits)).", action=".$myaction." (score ".$score."/".$max_score.")"; mylogs $syslog_priority, "[RULES] ".$myline; last RULE; }; }; } else { warn "[RULES] ".$myline.", invalid value for score \"$myarg\" - ignoring"; }; # note() command } elsif ($mycmd eq "note") { mylogs $syslog_priority, "[RULES] ".$myline." - note: ".$myarg if $myarg; $myaction = $default_action; # quit() command } elsif ($mycmd eq "quit") { warn "[RULES] ".$myline." - critical: quit (".$myarg.")"; exit($myarg); # file() command } elsif ($mycmd eq "file") { warn "[RULES] ".$myline." - error: command file() has not been implemented yet - ignoring"; $myaction = $default_action; # exec() command } elsif ($mycmd eq "exec") { warn "[RULES] ".$myline." - error: command exec() has not been implemented yet - ignoring"; $myaction = $default_action; } else { warn "[RULES] ".$myline." - error: unknown command \"".$1."\" - ignoring"; $myaction = $default_action; }; # normal rule. returns $action. } else { $myline .= ", delay=".(time - $now)."s, hits=".(join (";", @hits)).", action=".$myaction; mylogs $syslog_priority, "[RULES] ".$myline; last RULE; }; } else {undef($myline)}; }; }; # update cache if ( $REQUEST_MAX_CACHE > 0 ) { $Request_Cache{$cacheid}{"time"} = $now; $Request_Cache{$cacheid}{$COMP_ACTION} = $myaction; $Request_Cache{$cacheid}{"hit"} = $matched; $Request_Cache{$cacheid}{"hits"} = join (";", @hits); $Request_Cache{$cacheid}{$COMP_ID} = $Rules[$index]{$COMP_ID} if ($matched > 0); }; }; $myaction = $default_action if ($opt_test or !($myaction)); return $myaction; }; #### MAIN #### # parse command-line GetOptions ( 't|test' => \$opt_test, 'v|verbose' => sub { $opt_verbose++ }, 'shortlog' => \$opt_shortlog, 'l|logname=s' => \$syslog_name, 'n|nodns' => \$opt_nodns, '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, 'R|chroot=s' => \$net_chroot, 'pid|pidfile=s' => \$net_pid, 'u|user=s' => \$net_user, 'g|group=s' => \$net_group, 'dns_queuesize=s' => \$dns_queuesize, 'dns_retries=s' => \$dns_retries, 'dns_timeout=s' => \$dns_timeout, '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, 's|scores=s' => \%opt_scores, 'f|file=s' => sub{ my($opt,$value) = @_; push (@Configs, $opt.'::'.$value) }, 'r|rule=s' => sub{ my($opt,$value) = @_; push (@Configs, $opt.'::'.$value) }, 'V|version' => sub{ print "$NAME $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; # init syslog setlogsock $syslog_socktype; $syslog_options = 'cons,pid' unless $opt_daemon; openlog $syslog_name, $syslog_options, $syslog_facility; # read configuration read_config; if ($opt_showconfig) { show_config; exit 1; }; # check modes mylogs "notice", "TESTMODE: set - will return ".$default_action." to all requests" if ($opt_test); if ($opt_verbose) { $opt_summary ||= $Stat_Interval_Time; mylogs "notice", "VERBOSE: set"; }; # -n - skip dns based checks mylogs "notice", "NODNS: set - will skip all dns based checks" if $opt_nodns; # 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; $Startdate = strftime("%a, %d %b %Y %T %Z", localtime); $Cleanup_Requests = $Cleanup_RBLs = $Cleanup_Rates = $Starttime = time; mylogs $syslog_priority, "Overriding cacheid itemlist with: ".(join ",", @CacheID) if ( @CacheID ); # de-taint arguments $net_interface ||= $def_net_interface; $net_port ||= $def_net_port; $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; $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+)$/ ) ? $1 : $def_net_port; $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; # create Net::DNS::Async object $DNS = new Net::DNS::Async ( QueueSize => $dns_queuesize, Retries => $dns_retries, Timeout => $dns_timeout ); # 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], port => $net_port, host => $net_interface, proto => $def_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 ? 3 : 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 $server->run; # 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 () { mylogs "notice", "catched HUP signal - reloading ruleset on next request"; $Reload_Conf = 1; }; # show stats on exit sub pre_server_close_hook() { mylogs "notice", "terminating..." if $opt_summary; end_program; }; # init sub pre_loop_hook() { # install signal handlers $SIG{__WARN__} = sub { mylogs "crit", "warning - \"@_\""; }; $SIG{__DIE__} = sub { fatal_exit "last err: \"$!\", detail: \"@_\""; }; $SIG{ALRM} = sub { show_stats; alarm ($Stat_Interval_Time); } if $opt_summary; mylogs $syslog_priority, "successfully installed signal handlers" if $opt_verbose; # process init umask 0077; 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); mylogs $syslog_priority, "Setting status interval to $Stat_Interval_Time seconds"; }; # let's go mylogs $syslog_priority, "$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; if ($request =~ /([^=]+)=(.*)/) { $myattr{substr($1, 0, 512)} = substr($2, 0, 512); } elsif ($request eq '') { if ($opt_verbose > 1) { for (keys %myattr) { mylogs $syslog_priority, "Client: $client Attribute: $_=$myattr{$_}"; }; }; unless ($myattr{"request"} eq "smtpd_access_policy") { warn "ignoring unrecognized request type: '$myattr{request}'" } else { my($action) = smtpd_access_policy(%myattr); mylogs $syslog_priority, "Client: $client Action: $action" if $opt_verbose; print $client "action=$action\n\n"; $Counter_Requests++; $Counter_Interval++; }; } else { chop; warn "error: ignoring garbage from $client \"".$request."\""; }; }; }; } 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; if ($request =~ /([^=]+)=(.*)/) { $myattr{substr($1, 0, 512)} = substr($2, 0, 512); } elsif ($request eq '') { if ($opt_verbose > 1) { for (keys %myattr) { mylogs $syslog_priority, "Attribute: $_=$myattr{$_}"; }; }; unless ($myattr{"request"} eq "smtpd_access_policy") { warn "ignoring unrecognized request type: '$myattr{request}'" } else { my($action) = smtpd_access_policy(%myattr); mylogs $syslog_priority, "Action: $action" if $opt_verbose; myprint "action=$action\n\n"; $Counter_Requests++; $Counter_Interval++; }; } else { chop; warn "error: ignoring garbage \"".$request."\""; }; }; # 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 Networking: -d, --daemon run postfwd as daemon -i, --interface listen on interface -p, --port listen on port -u, --user set uid to user -g, --group set gid to group -R, --chroot chroot the daemon to -l, --logname