From b60d3a2540eb7afb3ca10b4f9f98ed42a85f56a6 Mon Sep 17 00:00:00 2001 From: Jan Wagner Date: Wed, 8 Dec 2010 21:06:31 +0000 Subject: [PATCH] drop patch of postfwd2 --- debian/patches/00list | 1 - debian/patches/01_postfwd2.dpatch | 4282 ----------------------------- 2 files changed, 4283 deletions(-) delete mode 100755 debian/patches/01_postfwd2.dpatch diff --git a/debian/patches/00list b/debian/patches/00list index ccbeb27..e69de29 100644 --- a/debian/patches/00list +++ b/debian/patches/00list @@ -1 +0,0 @@ -#01_postfwd2 diff --git a/debian/patches/01_postfwd2.dpatch b/debian/patches/01_postfwd2.dpatch deleted file mode 100755 index ef603b4..0000000 --- a/debian/patches/01_postfwd2.dpatch +++ /dev/null @@ -1,4282 +0,0 @@ -#! /bin/sh /usr/share/dpatch/dpatch-run -## 01_postfwd2.dpatch by Jan Wagner -## -## DP: Add postfwd2 - -@DPATCH@ -diff -urNad '--exclude=CVS' '--exclude=.svn' '--exclude=.git' '--exclude=.arch' '--exclude=.hg' '--exclude=_darcs' '--exclude=.bzr' postfwd-1.18~/doc/postfwd2.CHANGELOG postfwd-1.18/doc/postfwd2.CHANGELOG ---- postfwd-1.18~/doc/postfwd2.CHANGELOG 1970-01-01 01:00:00.000000000 +0100 -+++ postfwd-1.18/doc/postfwd2.CHANGELOG 2010-04-28 20:23:24.000000000 +0200 -@@ -0,0 +1,151 @@ -+postfwd2 0.21 -+============= -+- bugfix: Fixed bug when comparing sender and recipient addresses, like -+ "sender=$$recipient". This affects only postfwd2 version 0.20. -+ -+postfwd2 0.20 -+============= -+- bugfix: Invalid characters in variable substitutions were not correctly catched when -+ the '=' operator was used, like "client_name=$$helo_name". If you can not -+ upgrade for some reason change your rule to "client_name=~$$helo_name" -+- code: Net::DNS errors will now be handled gracefully -+- code: default for options --dns_max_ns_a_lookups and --dns_max_mx_a_lookups of 100 -+ -+postfwd2 0.19 -+============= -+- bugfix: this is a bugfix release for 0.18. anyone affected is encouraged to upgrade. -+ detail: the default behavior for the '=' operator with numeric items -+ (size, recipient_count, ...) changed with version 0.18 to '==' (equals to). -+ now these items are compared '>=' (greater than) again. -+ note: if you are using 0.18 and you are not able upgrade for some reason, -+ please change '=' to '>=' in your ruleset where you mean 'greater than'. -+ -+postfwd2 0.18 -+============= -+- feature: items may now be retrieved from files using "item=file:/some/where" -+ more information in the postfwd manual (FILES section) -+- feature: helo_address, and sender_(ns|mx)_addrs can now be csv items -+- feature: new rcpt() command counts recipients for rate limits (thanks to Sahil Tandon) -+- code: redirect syslog to stdout for --kill, --reload, --showconfig and --dump(cache|stats) -+- code: option --reload (HUP signal) now reloads config, if the file is unchanged -+- code: new --debug classes 'config' and 'request' -+- code: configuration parser improvements: -+ * rules without defined action will be skipped at configuration stage -+ * undefined ACLs will now be detected and skipped at configuration stage -+ * parser timeout skips loading a rule after 4s, to prevent problems with -+ large files or loops. use --config_timeout to override -+- bugfix: documentation fixed (missing "action=" in ask() examples) -+- bugfix: fixed logging of an uninitialized value in cache cleanups -+ -+postfwd2 0.17 -+============= -+- feature: new compare operators * -+ ==================================================================== -+ ITEM == VALUE true if ITEM equals VALUE -+ ITEM => VALUE true if ITEM >= VALUE -+ ITEM =< VALUE true if ITEM <= VALUE -+ ITEM =~ VALUE true if ITEM ~= /^VALUE$/i -+ *ITEM != VALUE false if ITEM equals VALUE -+ *ITEM !> VALUE false if ITEM >= VALUE -+ *ITEM !< VALUE false if ITEM <= VALUE -+ *ITEM !~ VALUE false if ITEM ~= /^VALUE$/i -+ ITEM = VALUE default behaviour (see ITEMS section) -+ ==================================================================== -+- feature: added --nodaemon and --stdout options -+- code: non dns items first: if a rule contains dns and non dns items, the -+ lookups will only be done if all non dns items matched -+- bugfix: empty pcre with empty sender_(ns|mx)_names was parsed incorrectly. -+ this bug affects postfwd2 versions 0.15 - 0.16 -+- bugfix: negated pcre items with '~=' operator were parsed incorrectly. -+ this bug affects postfwd2 version 0.16 -+ -+postfwd2 0.16 -+============= -+- feature: enabled dns cache for sender(ns|mx) and helo address -+- feature: new options --dns_max_ns_lookups and --dns_max_mx_lookups -+- code: parent_dns_cache is now disabled by default. use -+ --parent_dns_cache if you have a slow nameserver -+- bugfix: workaround: Net::Server died if a unix domain socket -+ filename without a dot ('.') was used (B. Frauendienst) -+ -+postfwd2 0.15 -+============= -+- feature: new items sender_ns_names and sender_ns_addrs -+- feature: new items sender_mx_names and sender_mx_addrs -+- feature: new item helo_address, please see docs for more -+- feature: new parent cache statistics. the command line option --dumpstats -+ uses the --daemons setting now (default: cache,server) -+- feature: dnsbl txt lookups only for dnsbls with at least one a record. -+ use --dns_async_txt for the old behaviour (see docs for more). -+- code: summary function went to postfwd::master (and will stay there ;) -+- code: small performance improvement (5-10%) for pcre (~= or =~) items -+- bugfix: network 0.0.0.0/0 did not work as expected on all platforms -+ -+ -+postfwd2 0.14 -+============= -+- code: summary function was moved from postfwd::cache to postfwd::policy. -+ the reduced policy <-> cache communication increases throughput -+ considerably and improves cpu balancing on multiprocessor systems -+- bugfix: fixed potential division by zero in summary function -+ -+ -+postfwd2 0.13 -+============= -+- feature: new options --noidlestats and --norulestats -+- feature: more informative --version -+- feature: documentation updates -+- bugfix: disabled parent_cache counters when --summary=0 -+ -+ -+postfwd2 0.12 -+============= -+- feature: the ask() action allows to delegate the policy decision to another -+ policy service (like postgrey). a new parameter allows to specify -+ answer patterns which should be ignored by postfwd. please look -+ at the 'ACTIONS' section in the manual (postfwd2 -m) for details. -+- feature: parent-request cache will now only be updated, if a rule matches. -+ if postfwd should cache all requests, you must place a last rule: -+ id=DEFAULT; action=dunno -+- bugfix: reorganised some parent-cache loggings for -vv and *cache debug classes -+ -+ -+postfwd2 0.11 -+============= -+- bugfix: all postfwd settings are now detainted -+- bugfix: cache-update used an uninitialized value when no rule had hit -+ -+ -+postfwd2 0.10 -+============= -+- bugfix: command line arguments --pidfile -+ -+ -+postfwd2 0.09 -+============= -+- bugfix: command line arguments --user and --group were not correctly de-tainted -+ -+ -+postfwd2 0.08 -+============= -+- bugfix: command line argument --pid_file was ignored -+- bugfix: command line argument --manual (-m) did not work -+ -+ -+postfwd2 0.07 -+============= -+- first semi-public release of postfwd2 -+- full ruleset compatibility, no changes required when migrating from postfwd v1 -+- new architecture: -+ -+ * Net::Server::PreFork -+ ruleset processor (server) forks new child for any request -+ -+ * Net::Server::Multiplex for parent cache -+ offers a shared request, dns and rate cache for postfwd2 children -+ -+ * Net::Server::Daemonize for master process -+ controls server and cache (watchdog function) and allows direct -+ access to statistics, cache-contents, ... from the command-line -+ -+- many new commandline options (see postfwd2 -h) for more information -diff -urNad '--exclude=CVS' '--exclude=.svn' '--exclude=.git' '--exclude=.arch' '--exclude=.hg' '--exclude=_darcs' '--exclude=.bzr' postfwd-1.18~/sbin/postfwd2 postfwd-1.18/sbin/postfwd2 ---- postfwd-1.18~/sbin/postfwd2 1970-01-01 01:00:00.000000000 +0100 -+++ postfwd-1.18/sbin/postfwd2 2010-06-16 16:39:37.000000000 +0200 -@@ -0,0 +1,4117 @@ -+#!/usr/bin/perl -T -w -+ -+############################ -+package postfwd2::basic; -+ -+use warnings; -+use strict; -+use IO::Socket qw(SOCK_STREAM); -+use Sys::Syslog qw(:DEFAULT setlogsock); -+# export -+use Exporter qw(import); -+our @EXPORT = qw( -+ %postfwd_settings %postfwd_patterns -+ &uniq &init_log &log_info &log_note -+ &log_warn &log_err &log_crit -+); -+our @EXPORT_OK = qw( -+ %postfwd_commands -+ &wantsdebug &hash_to_list -+ &hash_to_str &str_to_hash -+ &check_inet &check_unix -+); -+ -+# basics -+our $NAME = "postfwd2"; -+our $VERSION = "0.21"; -+our $DEFAULT = 'DUNNO'; -+ -+# change this, to match your POD requirements -+# we need pod2text for the -m switch (manual) -+$ENV{PATH} = "/bin:/usr/bin:/usr/local/bin"; -+$ENV{ENV} = ""; -+our($cmd_manual) = "pod2text"; -+our($cmd_pager) = "more"; -+ -+my $sepreq = '///'; -+my $seplst = ':::'; -+my $nounixsock = ($^O eq 'solaris'); -+ -+# program settings -+our %postfwd_settings = ( -+ base => { -+ user => 'nobody', -+ group => 'nobody', -+ #setsid => 1, -+ log_level => 2, -+ log_file => 'Sys::Syslog', -+ syslog_logopt => 'pid', -+ syslog_facility => 'mail', -+ syslog_ident => "$NAME", -+ #chroot => $net_chroot ? $net_chroot : undef, -+ }, -+ master => { -+ pid_file => "/var/tmp/$NAME-master.pid", -+ watchdog => 60, -+ failures => 7, -+ respawn => 4, -+ daemons => [ 'cache', 'server' ], -+ }, -+ cache => { -+ commandline => " ".$NAME."::cache", -+ syslog_ident => "$NAME/cache", -+ host => (($nounixsock) ? "127.0.0.1" : ""), -+ port => (($nounixsock) ? "10043" : "/var/tmp/$NAME-cache.socket"), -+ proto => (($nounixsock) ? "tcp" : "unix"), -+ check => (($nounixsock) ? \&check_inet : \&check_unix), -+ }, -+ server => { -+ commandline => " ".$NAME."::policy", -+ syslog_ident => "$NAME/policy", -+ host => '127.0.0.1', -+ port => 10045, -+ proto => "tcp", -+ check => \&check_inet, -+ # child control -+ #check_for_dead => 30, -+ #check_for_waiting => 10, -+ min_spare_servers => 5, -+ min_servers => 10, -+ max_spare_servers => 50, -+ max_servers => 100, -+ max_requests => 1000, -+ child_communication => 1, # children report data to parent for summary -+ leave_children_open_on_hup => 1, # children should finish their work -+ }, -+ syslog => { -+ nolog => 0, -+ noidlestats => 0, -+ norulestats => 0, -+ name => $NAME, -+ facility => 'mail', -+ options => 'pid', -+ # allow "umlaute" ;) -+ #unsafe_charset => qr/[^\x20-\x7E,\x80-\xFE]/, -+ unsafe_charset => qr/[^\x20-\x7E]/, -+ unsafe_version => (not(defined $Sys::Syslog::VERSION) or $Sys::Syslog::VERSION lt '0.15'), -+ perfmon => 0, -+ stdout => 0, -+ }, -+ timeout => { -+ rule => 40, -+ cache => 3, -+ server => 3, -+ config => 4, -+ }, -+ request => { -+ ttl => 600, -+ cleanup => 600, -+ no_sender => 0, -+ rdomain_only => 0, -+ no_size => 0, -+ nolog => 0, -+ noparent => 0, -+ }, -+ dns => { -+ disable => 0, -+ nolog => 0, -+ noparent => 1, -+ anylog => 0, -+ async_txt => 0, -+ timeout => 14, -+ max_timeout => 10, -+ max_interval => 1200, -+ ttl => 3600, -+ cleanup => 600, -+ mask => '^127\.', -+ max_ns_lookups => 100, -+ max_mx_lookups => 100, -+ }, -+ rate => { -+ cleanup => 600, -+ noparent => 0, -+ }, -+ scores => { -+ "5.0" => "554 5.7.1 ".$NAME." score exceeded", -+ }, -+ debug => { -+ #all => 0, -+ #verbose => 0, -+ #cache => 0, -+ #getcache => 0, -+ #setcache => 0, -+ #dns => 0, -+ #getdns => 0, -+ #setdns => 0, -+ }, -+ name => $NAME, -+ version => $VERSION, -+ default => $DEFAULT, -+ daemon => 1, -+ manual => $cmd_manual, -+ pager => $cmd_pager, -+ sepreq => $sepreq, -+ seplst => $seplst, -+ summary => 600, -+ instant => 0, -+ verbose => 0, -+ test => 0, -+); -+ -+# daemon commands -+our %postfwd_commands = ( -+ ping => 'PING', -+ pong => 'PONG', -+ dumpstats => 'DS', -+ dumpcache => 'DC', -+ #wipecache => 'WC', -+ countcache => 'CN', -+ matchcache => 'MT', -+ setcacheitem => 'SC', -+ getcacheitem => 'GC', -+ getcacheval => 'GV', -+); -+ -+# precompiled patterns -+our %postfwd_patterns = ( -+ ping => $postfwd_commands{ping}, -+ pong => $postfwd_commands{pong}, -+ keyval => qr/^([^=]+)=(.*)$/, -+ cntval => qr/^([^=]+)=(\d+)$/, -+ command => qr/^CMD\s*=/i, -+ dumpstats => qr/^CMD\s*=\s*$postfwd_commands{dumpstats}\s*;\s*$/i, -+ dumpcache => qr/^CMD\s*=\s*$postfwd_commands{dumpcache}\s*;\s*$/i, -+ #wipecache => qr/^CMD\s*=\s*$postfwd_commands{wipecache}\s*;\s*$/i, -+ countcache => qr/^CMD\s*=\s*$postfwd_commands{countcache}\s*;\s*TYPE\s*=\s*(.*?)\s*$/i, -+ matchcache => qr/^CMD\s*=\s*$postfwd_commands{matchcache}\s*;\s*TYPE\s*=\s*(.*?)\s*$/i, -+ setcacheitem => qr/^CMD\s*=\s*$postfwd_commands{setcacheitem}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$sepreq\s*(.*?)\s*$/i, -+ getcacheitem => qr/^CMD\s*=\s*$postfwd_commands{getcacheitem}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$/i, -+ getcacheval => qr/^CMD\s*=\s*$postfwd_commands{getcacheval}\s*;\s*TYPE\s*=\s*([^;]+)\s*;\s*ITEM\s*=\s*(.*?)\s*$sepreq\s*KEY\s*=\s*(.*?)\s*$/i, -+); -+ -+ -+## SUBS -+ -+# takes a list and returns a unified list, keeping given order -+sub uniq { -+ undef my %uniq; -+ return grep(!$uniq{$_}++, @_); -+}; -+ -+# tests debug levels -+sub wantsdebug { -+ return unless %{$postfwd_settings{debug}}; -+ foreach (@_) { return 1 if $postfwd_settings{debug}{$_} }; -+}; -+ -+# hash -> scalar -+sub hash_to_str { -+ my %request = @_; my $result = ''; -+ map { $result .= $postfwd_settings{sepreq}."$_=".((ref $request{$_} eq 'ARRAY') ? (join $postfwd_settings{seplst}, @{$request{$_}}) : ($request{$_} || '')) } (keys %request); -+ return $result; -+}; -+ -+# scalar -> hash -+sub str_to_hash { -+ my $request = shift; my %result = (); -+ foreach (split $postfwd_settings{sepreq}, $request) { -+ next unless m/$postfwd_patterns{keyval}/; -+ my @items = split $postfwd_settings{seplst}, $2; -+ ($#items) ? @{$result{$1}} = @items : $result{$1} = $2; -+ }; return %result; -+}; -+ -+# displays hash structure -+sub hash_to_list { -+ my ($pre, %request) = @_; my @output = (); -+ # get longest key -+ my $minkey = '-'.(length((sort {length($b) <=> length($a)} (keys %request))[0] || '') + 1); -+ while ( my($s, $v) = each %request ) { -+ my $r = ref $v; -+ if ($r eq 'HASH') { -+ push @output, (%{$v}) -+ ? hash_to_list ( sprintf ("%s -> %".$minkey."s", $pre, '%'.$s), %{$v} ) -+ : sprintf ("%s -> %".$minkey."s -> %s", $pre, '%'.$s, 'undef'); -+ } elsif ($r eq 'ARRAY') { -+ push @output, sprintf ("%s -> %".$minkey."s -> %s", $pre, '@'.$s, ((@{$v}) ? "'".(join ",", @{$v})."'" : 'undef')); -+ } elsif ($r eq 'CODE') { -+ push @output, sprintf ("%s -> %".$minkey."s -> %s", $pre, '&'.$s, ((defined $v) ? "'".$v."'" : 'undef')); -+ } else { -+ push @output, sprintf ("%s -> %".$minkey."s -> %s", $pre, '$'.$s, ((defined $v) ? "'".$v."'" : 'undef')); -+ }; -+ }; -+ return sort { my ($c, $d) = ($a, $b); -+ $c =~ tr/$/1/; $c =~ tr/&/2/; $c =~ tr/@/3/; $c =~ tr/%/4/; -+ $d =~ tr/$/1/; $d =~ tr/&/2/; $d =~ tr/@/3/; $d =~ tr/%/4/; -+ return $c cmp $d; } @output; -+}; -+ -+# Sys::Syslog < 0.15 -+sub mylogs_old { -+ my($prio,$msg) = @_; -+ eval { local $SIG{'__DIE__'}; syslog ($prio,$msg) }; -+}; -+ -+# Sys::Syslog >= 0.15 -+sub mylogs_new { -+ my($prio,$msg) = @_; -+ syslog ($prio,$msg); -+}; -+ -+# Syslog to stdout -+sub mylogs_stdout { -+ my($prio,$msg) = @_; -+ printf STDOUT "[LOG $prio]: $msg\n", @_; -+}; -+ -+# send log message -+sub mylogs { -+ my($prio,$msg) = @_; -+ return if $postfwd_settings{syslog}{nolog}; -+ # escape unsafe characters -+ $msg =~ s/$postfwd_settings{syslog}{unsafe_charset}/?/g; -+ $msg =~ s/\%/%%/g; -+ &{$postfwd_settings{syslog}{logger}} ($prio,$msg); -+}; -+ -+# short versions -+sub log_info { mylogs ('info', @_) }; -+sub log_note { mylogs ('notice', @_) }; -+sub log_warn { mylogs ('warning', @_) }; -+sub log_err { mylogs ('err', @_) }; -+sub log_crit { mylogs ('crit', @_) }; -+ -+# init logging -+sub init_log { -+ my($logname) = @_; -+ $postfwd_settings{syslog}{name} = $logname if $logname; -+ $postfwd_settings{syslog}{socktype} = ($postfwd_settings{syslog}{unsafe_version}) ? (($nounixsock) ? 'inet' : 'unix') : 'native'; -+ if ($postfwd_settings{syslog}{stdout}) { -+ $postfwd_settings{syslog}{logger} = \&mylogs_stdout; -+ } else { -+ # syslog init -+ $postfwd_settings{syslog}{logger} = ($postfwd_settings{syslog}{unsafe_version}) ? \&mylogs_old : \&mylogs_new; -+ setlogsock $postfwd_settings{syslog}{socktype}; -+ openlog $postfwd_settings{syslog}{name}, $postfwd_settings{syslog}{options}, $postfwd_settings{syslog}{facility}; -+ }; -+ log_info ("set up syslogging Sys::Syslog".((defined $Sys::Syslog::VERSION) ? " version $Sys::Syslog::VERSION" : '') ) if wantsdebug (qw[ all verbose ]); -+}; -+ -+# check: INET -+sub check_inet { -+ my ($type,$send) = @_; -+ if ( my $socket = new IO::Socket::INET ( -+ PeerAddr => $postfwd_settings{$type}{host}, -+ PeerPort => $postfwd_settings{$type}{port}, -+ Proto => 'tcp', -+ Timeout => $postfwd_settings{timeout}{$type}, -+ Type => SOCK_STREAM ) ) { -+ $socket->print("$send\r\n"); -+ $send = $socket->getline(); -+ chomp($send); -+ $socket->close(); -+ } else { -+ warn("can not open socket to $postfwd_settings{$type}{host}:$postfwd_settings{$type}{port}: '$!' '$@'\n"); -+ undef $send; -+ }; -+ return $send; -+}; -+ -+# check: UNIX -+sub check_unix { -+ my ($type,$send) = @_; -+ if ( my $socket = new IO::Socket::UNIX ( -+ Peer => $postfwd_settings{$type}{port}, -+ Timeout => $postfwd_settings{timeout}{$type}, -+ Type => SOCK_STREAM ) ) { -+ $socket->print("$send\r\n"); -+ $send = $socket->getline(); -+ chomp($send); -+ $socket->close(); -+ } else { -+ warn("can not open socket to $postfwd_settings{$type}{host}:$postfwd_settings{$type}{port}: '$!' '$@'\n"); -+ undef $send; -+ }; -+ return $send; -+}; -+ -+1; # EOF postfwd2::basic -+ -+ -+############################ -+package postfwd2::cache; -+ -+## MODULES -+use warnings; -+use strict; -+use base 'Net::Server::Multiplex'; -+import postfwd2::basic qw(:DEFAULT &wantsdebug &hash_to_list); -+use vars qw( %Cache %Cleanup %Count %Interval %Top $Reload_Conf $Summary $StartTime ); -+ -+ -+## SUBS -+ -+# prepare stats -+sub list_stats { -+ my @output = (); my $line = ''; my $now = time(); -+ my $uptime = $now - $StartTime; -+ return @output unless $uptime and (%Count or %Cache); -+ push ( @output, sprintf ( -+ "[STATS] %s::cache %s: %d queries since %d days, %02d:%02d:%02d hours", -+ $postfwd_settings{name}, -+ $postfwd_settings{version}, -+ $Count{cache_queries}, -+ ($uptime / 60 / 60 / 24), -+ (($uptime / 60 / 60) % 24), -+ (($uptime / 60) % 60), -+ ($uptime % 60) -+ ) ); -+ my $lastreq = (($now - $Summary) > 0) ? (($Interval{request_set} || 0) + ($Interval{request_get} || 0)) / ($now - $Summary) * 60 : 0; -+ $Top{request} = $lastreq if ($lastreq > ($Top{request} || 0)); $Top{request} ||= 0; -+ my $lastdns = (($now - $Summary) > 0) ? (($Interval{dns_set} || 0) + ($Interval{dns_get} || 0)) / ($now - $Summary) * 60 : 0; -+ $Top{dns} = $lastdns if ($lastdns > ($Top{dns} || 0)); $Top{dns} ||= 0; -+ push ( @output, sprintf ( -+ "[STATS] Requests: %.1f/min last, %.1f/min overall, %.1f/min top", -+ $lastreq, -+ (($Count{request_set} || 0) + ($Count{request_get} || 0)) / $uptime * 60, -+ $Top{request} -+ ) ); -+ push ( @output, sprintf ( -+ "[STATS] Dnsstats: %.1f/min last, %.1f/min overall, %.1f/min top", -+ $lastdns, -+ (($Count{dns_set} || 0) + ($Count{dns_get} || 0)) / $uptime * 60, -+ $Top{dns} -+ ) ) unless ($postfwd_settings{dns}{disable} or $postfwd_settings{dns}{noparent}); -+ push ( @output, sprintf ( -+ "[STATS] Hitrates: %.1f%% requests, %.1f%% dns", -+ ($Count{request_get}) ? ($Count{request_hits} || 0) / $Count{request_get} * 100 : 0, -+ ($Count{dns_get}) ? ($Count{dns_hits} || 0) / $Count{dns_get} * 100 : 0 -+ ) ); -+ push ( @output, "[STATS] Contents: ". -+ join ', ', map { $_ = "$_=".(scalar keys %{$Cache{$_}}) } (reverse sort keys %Cache) -+ ); -+ if (wantsdebug (qw[ all devel parent_cache ])) { -+ push ( @output, "[STATS] Counters: ". -+ join ', ', map { $_ = "$_=".$Count{$_} } (reverse sort keys %Count) ); -+ push ( @output, "[STATS] Interval: ". -+ join ', ', map { $_ = "$_=".$Interval{$_} } (reverse sort keys %Interval) ); -+ }; -+ map { $Interval{$_} = 0 } (keys %Interval); -+ $Summary = $now; -+ return @output; -+}; -+ -+# return cache contents -+sub dump_cache { -+ my @result = (); -+ foreach (keys %Cache) { -+ push @result, hash_to_list ('%'.$_."_cache", %{$Cache{$_}}) -+ if %{$Cache{$_}} and wantsdebug ("devel", "parent_cache", "parent_".$_."_cache"); -+ }; return @result; -+}; -+ -+# get a whole cache item -+sub get_cache { -+ my ($self,$type,$item) = @_; -+ my @answer = (); -+ return '' unless ( defined $Cache{$type}{$item}{'until'} and (time() <= $Cache{$type}{$item}{'until'}[0])); -+ $Count{$type."_hits"}++; -+ map { push @answer, "$_=".(join $postfwd_settings{seplst}, @{$Cache{$type}{$item}{$_}}) } (keys %{$Cache{$type}{$item}}); -+ return (join $postfwd_settings{sepreq}, @answer); -+}; -+ -+# set item to cache -+sub set_cache { -+ my ($self,$type,$item,$vals) = @_; -+ my @answer = (); -+ undef $Cache{$type}{$item}; -+ foreach my $arg (split ($postfwd_settings{sepreq}, $vals)) { -+ map { push @{$Cache{$type}{$item}{$1}}, $_; -+ push @answer, "$type->$item->$1=$_"; -+ @{$Cache{$type}{$item}{$1}} = uniq(@{$Cache{$type}{$item}{$1}}); -+ } (split $postfwd_settings{seplst}, $2) if ($arg =~ m/$postfwd_patterns{keyval}/); -+ }; -+ @answer = '' unless @answer; -+ return (join '; ', @answer); -+}; -+ -+# clean up cache -+sub cleanup_cache { -+ my($type,$now) = @_; -+ my $start = time(); -+ return unless defined $Cache{$type} and my $count = scalar keys %{$Cache{$type}}; -+ foreach my $checkitem (keys %{$Cache{$type}}) { -+ # remove inclomplete objects -+ if ( !defined($Cache{$type}{$checkitem}{'until'}) or !defined($Cache{$type}{$checkitem}{ttl}) ) { -+ log_info ("[CLEANUP] deleting incomplete $type cache item $checkitem after " -+ ." timeout: ".((defined $Cache{$type}{$checkitem}{ttl}) ? $Cache{$type}{$checkitem}{ttl}[0] : '')."s") -+ if wantsdebug (qw[ all ]); -+ delete $Cache{$type}{$checkitem}; -+ # remove timed out objects -+ } elsif ( $now > $Cache{$type}{$checkitem}{'until'}[0] ) { -+ log_info ("[CLEANUP] removing $type cache for $checkitem after " -+ ." timeout: ".$Cache{$type}{$checkitem}{ttl}[0]."s)") -+ if wantsdebug (qw[ all ]); -+ delete $Cache{$type}{$checkitem}; -+ }; -+ }; -+ my $end = time(); -+ log_info ("[CLEANUP] needed ".($end - $start) -+ ." seconds for request cleanup of " -+ .($count - scalar keys %{$Cache{$type}})." out of ".$count -+ ." cached items after ".($now - $Cleanup{$type}) -+ ." seconds (min ".$postfwd_settings{request}{cleanup}."s)") if ( wantsdebug (qw[ all verbose ]) or (($end - $start) > 0) ); -+ $Cleanup{$type} = $start; -+}; -+ -+ -+ -+## Net::Server::Multiplex methods -+ -+# ignore syslog failures -+sub handle_syslog_error {}; -+ -+# set $Reload_Conf marker on HUP signal -+sub sig_hup { -+ log_note ("catched HUP signal - clearing request cache on next request"); -+ $Reload_Conf = 1; -+}; -+ -+# cache start -+sub pre_loop_hook() { -+ my $self = shift; -+ # change cache name -+ $0 = $self->{server}->{commandline} = " ".$postfwd_settings{name}.'::cache'; -+ $self->{server}->{syslog_ident} = $postfwd_settings{name}."/cache"; -+ init_log ($self->{server}->{syslog_ident}); -+ $StartTime = $Summary = $Cleanup{request} = $Cleanup{rate} = $Cleanup{dns} = time(); -+ log_info ("ready for input"); -+}; -+ -+# cache process request -+sub mux_input { -+ my ($self, $mux, $client, $mydata) = @_; -+ my $action = ''; -+ my $now = time(); -+ while ( $$mydata =~ s/^([^\r\n]*)\r?\n// ) { -+ # check request line -+ next unless defined $1; -+ my $request = $1; -+ log_info ("request: '$request'") if wantsdebug (qw[ all ]); -+ if ($Reload_Conf) { -+ undef $Reload_Conf; -+ delete $Cache{request}; -+ log_info ("request cache cleared") if wantsdebug (qw[ all verbose ]); -+ }; -+ if ($request eq $postfwd_patterns{ping}) { -+ $action = $postfwd_patterns{pong}; -+ } elsif ($request =~ m/$postfwd_patterns{getcacheitem}/) { -+ my ($type, $item) = ($1, $2); -+ log_info ("[GETCACHEITEM] request: '$request'") if wantsdebug (qw[ all cache getcache ]); -+ cleanup_cache ($type,$now) if (($now - $Cleanup{$type}) > ($postfwd_settings{$type}{cleanup} || 300)); -+ $Count{cache_queries}++; $Interval{cache_queries}++; -+ $Count{$type."_get"}++; $Interval{$type."_get"}++; -+ $action = $self->get_cache($type,$item); -+ log_info ("[GETCACHEITEM] answer: '$action'") if wantsdebug (qw[ all cache getcache ]); -+ } elsif ($request =~ m/$postfwd_patterns{setcacheitem}/) { -+ log_info ("[SETCACHEITEM] request: '$request'") if wantsdebug (qw[ all cache setcache ]); -+ $Count{cache_queries}++; $Interval{cache_queries}++; -+ $Count{$1."_set"}++; $Interval{$1."_set"}++; -+ $action = $self->set_cache($1,$2,$3); -+ log_info ("[SETCACHEITEM] answer: '$action'") if wantsdebug (qw[ all cache setcache ]); -+ } elsif ($request =~ m/$postfwd_patterns{dumpstats}/) { -+ $action = join $postfwd_settings{sepreq}.$postfwd_settings{seplst}, list_stats(); -+ } elsif ($request =~ m/$postfwd_patterns{dumpcache}/) { -+ $action = join $postfwd_settings{sepreq}.$postfwd_settings{seplst}, dump_cache(); -+ } else { -+ log_note ("warning: ignoring unknown command '".substr($request,0,512)."'"); -+ }; -+ print $client "$action\n"; -+ log_info ("answer: '$action'") if wantsdebug (qw[ all ]); -+ }; -+}; -+ -+1; # EOF postfwd2::cache -+ -+ -+############################ -+package postfwd2::server; -+ -+use warnings; -+use strict; -+use IO::Socket qw(SOCK_STREAM); -+use Net::DNS; -+use base 'Net::Server::PreFork'; -+import postfwd2::basic qw(:DEFAULT %postfwd_commands &check_inet &check_unix &wantsdebug &hash_to_str &str_to_hash &hash_to_list); -+# export these functions for '-C' switch -+use Exporter qw(import); -+our @EXPORT_OK = qw( -+ &read_config &show_config &process_input -+); -+ -+ -+# these items have to be compared as... -+# scoring -+my $COMP_SCORES = "score"; -+my $COMP_NS_NAME = "sender_ns_names"; -+my $COMP_NS_ADDR = "sender_ns_addrs"; -+my $COMP_MX_NAME = "sender_mx_names"; -+my $COMP_MX_ADDR = "sender_mx_addrs"; -+my $COMP_HELO_ADDR = "helo_address"; -+# networks in CIDR notation (a.b.c.d/nn) -+my $COMP_NETWORK_CIDRS = "(client_address|sender_(ns|mx)_addrs|helo_address)"; -+# RBL checks -+my $COMP_DNSBL_TEXT = "dnsbltext"; -+my $COMP_RBL_CNT = "rblcount"; -+my $COMP_RHSBL_CNT = "rhsblcount"; -+my $COMP_RBL_KEY = "rbl"; -+my $COMP_RHSBL_KEY = "rhsbl"; -+my $COMP_RHSBL_KEY_CLIENT = "rhsbl_client"; -+my $COMP_RHSBL_KEY_SENDER = "rhsbl_sender"; -+my $COMP_RHSBL_KEY_RCLIENT = "rhsbl_reverse_client"; -+my $COMP_RHSBL_KEY_HELO = "rhsbl_helo"; -+my %DNSBLITEMS = ( -+ rbl => { -+ cnt => "rblcount", -+ }, -+ rhsbl => { -+ cnt => "rhsblcount", -+ }, -+ rhsbl_client => { -+ cnt => "rhsblcount", -+ }, -+ rhsbl_sender => { -+ cnt => "rhsblcount", -+ }, -+ rhsbl_reverse_client => { -+ cnt => "rhsblcount", -+ }, -+ rhsbl_helo => { -+ cnt => "rhsblcount", -+ }, -+); -+# dns key value matching -+my %DNS_REPNAMES = ( -+ "NS" => "nsdname", -+ "MX" => "exchange", -+ "A" => "address", -+ "TXT" => "char_str_list", -+ "CNAME" => "cname", -+); -+ -+# file items -+our($COMP_CONF_FILE) = 'cfile|file'; -+our($COMP_CONF_TABLE) = 'ctable|table'; -+our($COMP_LIVE_FILE) = 'lfile'; -+our($COMP_LIVE_TABLE) = 'ltable'; -+our($COMP_TABLES) = qr/^($COMP_CONF_TABLE|$COMP_LIVE_TABLE)$/i; -+our($COMP_CONF_FILE_TABLE) = qr/^($COMP_CONF_FILE|$COMP_CONF_TABLE):(.+)$/i; -+our($COMP_LIVE_FILE_TABLE) = qr/^($COMP_LIVE_FILE|$COMP_LIVE_TABLE):(.+)$/i; -+# date checks -+my $COMP_DATE = "date"; -+my $COMP_TIME = "time"; -+my $COMP_DAYS = "days"; -+my $COMP_MONTHS = "months"; -+# always true -+my $COMP_ACTION = "action"; -+my $COMP_ID = "id"; -+my $COMP_CACHE = "cache"; -+# rule hits -+my $COMP_HITS = "request_hits"; -+# item match counter -+my $COMP_MATCHES = "matches"; -+# separator -+my $COMP_SEPARATOR = "[=\~\<\>]=|[=\!][=\~\<\>]|="; -+# macros -+my $COMP_ACL = "[\&][\&]"; -+# negation -+my $COMP_NEG = "[\!][\!]"; -+# variables -+my $COMP_VAR = "[\$][\$]"; -+# date calculations -+my $COMP_DATECALC = "($COMP_DATE|$COMP_TIME|$COMP_DAYS|$COMP_MONTHS)"; -+# these items allow whitespace-or-comma-separated values -+my $COMP_CSV = "($COMP_NETWORK_CIDRS|$COMP_RBL_KEY|$COMP_RHSBL_KEY|$COMP_RHSBL_KEY_CLIENT|$COMP_RHSBL_KEY_HELO|$COMP_RHSBL_KEY_SENDER|$COMP_RHSBL_KEY_RCLIENT|$COMP_DATECALC|$COMP_HELO_ADDR|$COMP_NS_ADDR|$COMP_MX_ADDR)"; -+# dont treat these as lists -+my $COMP_SINGLE = "($COMP_ID|$COMP_ACTION|$COMP_CACHE|$COMP_SCORES|$COMP_RBL_CNT|$COMP_RHSBL_CNT)"; -+ -+# date tools -+my %months = ( -+ "Jan" => 0, "jan" => 0, "JAN" => 0, -+ "Feb" => 1, "feb" => 1, "FEB" => 1, -+ "Mar" => 2, "mar" => 2, "MAR" => 2, -+ "Apr" => 3, "apr" => 3, "APR" => 3, -+ "May" => 4, "may" => 4, "MAY" => 4, -+ "Jun" => 5, "jun" => 5, "JUN" => 5, -+ "Jul" => 6, "jul" => 6, "JUL" => 6, -+ "Aug" => 7, "aug" => 7, "AUG" => 7, -+ "Sep" => 8, "sep" => 8, "SEP" => 8, -+ "Oct" => 9, "oct" => 9, "OCT" => 9, -+ "Nov" => 10, "nov" => 10, "NOV" => 10, -+ "Dec" => 11, "dec" => 11, "DEC" => 11, -+); -+my %weekdays = ( -+ "Sun" => 0, "sun" => 0, "SUN" => 0, -+ "Mon" => 1, "mon" => 1, "MON" => 1, -+ "Tue" => 2, "tue" => 2, "TUE" => 2, -+ "Wed" => 3, "wed" => 3, "WED" => 3, -+ "Thu" => 4, "thu" => 4, "THU" => 4, -+ "Fri" => 5, "fri" => 5, "FRI" => 5, -+ "Sat" => 6, "sat" => 6, "SAT" => 6, -+); -+ -+use vars qw( -+ @Rules @DNSBL_Text -+ %Rule_by_ID %Matches %ACLs %Timeouts %Hits %Count -+ %postfwd_items %postfwd_compare %postfwd_actions -+ %postfwd_items_plugin %postfwd_compare_plugin %postfwd_actions_plugin -+ %Request_Cache %Config_Cache %DNS_Cache %Rate_Cache -+ $Cleanup_Requests $Cleanup_RBLs $Cleanup_Rates $Cleanup_Timeouts -+ %Cache %Cleanup $StartTime $Summary -+); -+ -+ -+## SUBS -+ -+# cache query -+sub cache_query { return ( &{$postfwd_settings{cache}{check}}('cache',@_) || '' ) }; -+ -+# get ip and mask -+sub cidr_parse { -+ return undef unless defined $_[0]; -+ return undef unless $_[0] =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)\/(\d+)$/; -+ return undef unless ($1 < 256 and $2 < 256 and $3 < 256 and $4 < 256 and $5 <= 32 and $5 >= 0); -+ my $net = ($1<<24)+($2<<16)+($3<<8)+$4; -+ my $mask = ~((1<<(32-$5))-1); -+ return ($net & $mask, $mask); -+}; -+ -+# compare address to network -+sub cidr_match { -+ my ($net, $mask, $addr) = @_; -+ return undef unless defined $net and defined $addr; -+ $addr = ($1<<24)+($2<<16)+($3<<8)+$4 if ($addr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/); -+ return ($addr & $mask) == $net; -+}; -+ -+# sets an action for a score -+sub modify_score { -+ my($myscore,$myaction) = @_; -+ log_info ( ((defined $postfwd_settings{scores}{$myscore}) ? "redefined" : "setting new") -+ ." score $myscore with action=\"$myaction\"") if wantsdebug (qw[ all verbose ]); -+ $postfwd_settings{scores}{$myscore} = $myaction; -+}; -+ -+# returns content of !!() negation -+sub deneg_item { -+ my($val) = (defined $_[0]) ? $_[0] : ''; -+ return ( ($val =~ /^$COMP_NEG\s*\(?\s*(.+?)\s*\)?$/) ? $1 : '' ); -+}; -+ -+# resolves $$() variables -+sub devar_item { -+ my($cmp,$val,$myitem,%request) = @_; -+ 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 verbose ]); -+ }; -+ return $myresult; -+}; -+ -+# clean up RBL cache -+sub cleanup_dns_cache { -+ my($now) = $_[0]; return unless $now; -+ foreach my $checkitem (keys %DNS_Cache) { -+ # remove inclomplete objects (dns timeouts) -+ if ( !defined($DNS_Cache{$checkitem}{'until'}) or !defined($DNS_Cache{$checkitem}{ttl}) ) { -+ log_info ("[CLEANUP] deleting incomplete dns-cache item $checkitem after " -+ ." timeout: ".((defined $DNS_Cache{$checkitem}{ttl}) ? $DNS_Cache{$checkitem}{ttl} : '')."s") -+ if wantsdebug (qw[ all ]); -+ delete $DNS_Cache{$checkitem}; -+ # remove timed out objects -+ } elsif ( $now > $DNS_Cache{$checkitem}{'until'} ) { -+ log_info ("[CLEANUP] removing rbl-cache for $checkitem after timeout: " -+ .$DNS_Cache{$checkitem}{ttl}."s") if wantsdebug (qw[ all ]); -+ delete $DNS_Cache{$checkitem}; -+ }; -+ }; -+}; -+ -+# clean up request cache -+sub cleanup_request_cache { -+ my($now) = $_[0]; return unless $now; -+ RITEM: foreach my $checkitem (keys %Request_Cache) { -+ next RITEM unless defined $Request_Cache{$checkitem}{'until'}; -+ if ( $now > $Request_Cache{$checkitem}{'until'} ) { -+ log_info ("[CLEANUP] removing request-cache $checkitem after timeout: " -+ .$Request_Cache{$checkitem}{ttl}."s") if wantsdebug (qw[ all ]); -+ delete $Request_Cache{$checkitem}; -+ }; -+ }; -+}; -+ -+# clean up rate cache -+sub cleanup_rate_cache { -+ my($now) = $_[0]; return unless $now; -+ LITEM: foreach my $checkitem (keys %Rate_Cache) { -+ next LITEM unless defined $Rate_Cache{$checkitem}{'until'}; -+ if ( $now > $Rate_Cache{$checkitem}{'until'} ) { -+ log_info ("[CLEANUP] removing rate-cache for $checkitem after timeout: " -+ .$Rate_Cache{$checkitem}{ttl}."s") if wantsdebug (qw[ all ]); -+ delete $Rate_Cache{$checkitem}; -+ }; -+ }; -+}; -+ -+# preparses configuration line for ACL syntax -+sub acl_parser { -+ my($file,$num,$myline) = @_; -+ if ( $myline =~ /^\s*($COMP_ACL[\-\w]+)\s*{\s*(.*?)\s*;\s*}[\s;]*$/ ) { -+ $ACLs{$1} = $2; $myline = ""; -+ } else { -+ while ( $myline =~ /($COMP_ACL[\-\w]+)/) { -+ my($acl) = $1; -+ if ( $acl and defined $ACLs{$acl} ) { -+ $myline =~ s/\s*$acl\s*/$ACLs{$acl}/g; -+ } else { -+ #return "action=note(undefined macro '$acl')"; -+ log_warn ("file $file, ignoring line $num: undefined macro '$acl'"); -+ return ""; -+ }; -+ }; -+ }; -+ return $myline; -+}; -+ -+# prepares pcre item -+sub prepare_pcre { -+ my($item) = shift; undef my $neg; -+ # temporarily remove negation -+ $item = $neg if ($neg = deneg_item($item)); -+ # allow // regex -+ $item =~ s/^\/?(.*?)\/?$/$1/; -+ # tested slow -+ #$item = qr/$item/i; -+ # re-enable negation -+ $item = "!!($item)" if $neg; -+ return $item; -+}; -+ -+# prepares file item -+sub prepare_file { -+ my($forced_reload,$type,$cmp,$file) = @_; my(@result) = (); undef my $fh; -+ my($is_table) = ($type =~ /^$COMP_TABLES$/); -+ unless (-e $file) { -+ log_warn ("error: $type:$file not found - will be ignored"); -+ return @result; -+ }; -+ if ( not($forced_reload) and (defined $Config_Cache{$file}{lastread}) and ($Config_Cache{$file}{lastread} > (stat $file)[9]) ) { -+ log_info ("$type:$file unchanged - using cached content (mtime: " -+ .(stat $file)[9].", cache: $Config_Cache{$file}{lastread})") -+ if wantsdebug (qw[ all 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 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 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; -+ }; -+}; -+ -+# parses configuration line -+sub parse_config_line { -+ my($forced_reload, $myfile, $mynum, $myindex, $myline) = @_; -+ my(%myrule) = (); -+ my($mykey, $myvalue, $mycomp); -+ eval { -+ local $SIG{'__DIE__'}; -+ local $SIG{'ALRM'} = sub { $myline =~ s/[ \t][ \t]*/ /g; log_warn ("timeout after ".$postfwd_settings{timeout}{config}."s at parsing Rule $myindex ($myfile line $mynum): \"$myline\""); %myrule = (); die }; -+ my $prevalert = alarm($postfwd_settings{timeout}{config}) if $postfwd_settings{timeout}{config}; -+ if ( $myline = acl_parser ($myfile, $mynum, $myline) ) { -+ unless ( $myline =~ /^\s*[^=\s]+\s*$COMP_SEPARATOR\s*([^;\s]+\s*)+(;\s*[^=\s]+\s*$COMP_SEPARATOR\s*([^;\s]+\s*)+)*[;\s]*$/ ) { -+ log_warn ("ignoring invalid $myfile line ".$mynum.": \"".$myline."\""); -+ } else { -+ # separate items -+ foreach (split ";", $myline) { -+ # remove whitespaces around -+ s/^\s*(.*?)\s*($COMP_SEPARATOR)\s*(.*?)\s*$/$1$2$3/; -+ ( ($mycomp = $2) =~ /^([\<\>\~])=$/ ) and $mycomp = "=$1"; -+ ($mykey, $myvalue) = split /$COMP_SEPARATOR/, $_, 2; -+ if ($mykey =~ /^$COMP_SINGLE$/) { -+ log_note ( "notice: Rule $myindex ($myfile line $mynum):" -+ ." overriding $mykey=\"".$myrule{$mykey}."\"" -+ ." with $mykey=\"$myvalue\"" -+ ) if (defined $myrule{$mykey}); -+ $myrule{$mykey} = $myvalue; -+ } elsif ($mykey =~ /^$COMP_CSV$/) { -+ map { push @{$myrule{$mykey}}, prepare_item ($forced_reload, $mycomp, $_) } ( split /\s*,\s*/, $myvalue ); -+ } else { -+ push @{$myrule{$mykey}}, prepare_item ($forced_reload, $mycomp, $myvalue); -+ }; -+ }; -+ unless (exists($myrule{$COMP_ACTION})) { -+ log_warn ("Rule ".$myindex." ($myfile line ".$mynum."): contains no action and will be ignored"); -+ return (%myrule = ()); -+ }; -+ unless (exists($myrule{$COMP_ID})) { -+ $myrule{$COMP_ID} = "R-".$myindex; -+ log_note ("notice: Rule $myindex ($myfile line $mynum): contains no rule identifier - will use \"$myrule{id}\"") if wantsdebug (qw[ all config verbose ]); -+ }; -+ log_info ("loaded: Rule $myindex ($myfile line $mynum): id->\"$myrule{id}\" action->\"$myrule{action}\"") if wantsdebug (qw[ all config verbose ]); -+ }; -+ }; -+ alarm($prevalert) if $postfwd_settings{timeout}{config}; -+ }; -+ return %myrule; -+}; -+ -+# parses configuration file -+sub read_config_file { -+ my($forced_reload, $myindex, $myfile) = @_; -+ my(%myrule, @myruleset) = (); -+ my($mybuffer) = ""; undef my $fh; -+ -+ unless (-e $myfile) { -+ log_warn ("error: file ".$myfile." not found - file will be ignored"); -+ } else { -+ unless (open ($fh, "<$myfile")) { -+ log_warn ("error: could not open ".$myfile." - $! - file will be ignored"); -+ } else { -+ log_info ("reading file $myfile") if wantsdebug (qw[ all config verbose ]); -+ while (<$fh>) { -+ chomp; -+ s/(\"|#.*)//g; -+ next if /^\s*$/; -+ if (/(.*)\\\s*$/) { $mybuffer = $mybuffer.$1; next; }; -+ %myrule = parse_config_line ($forced_reload, $myfile, $., ($#myruleset+$myindex+1), $mybuffer.$_); -+ push ( @myruleset, { %myrule } ) if (%myrule); -+ $mybuffer = ""; -+ }; -+ close ($fh); -+ log_info ("loaded: Rules $myindex - ".($myindex + $#myruleset)." from file \"$myfile\"") if wantsdebug (qw[ all config verbose ]); -+ }; -+ }; -+ return @myruleset; -+}; -+ -+# reads all configuration items -+sub read_config { -+ my($forced_reload) = shift; -+ my(%myrule, @myruleset) = (); -+ my($mytype,$myitem,$config); -+ -+ # init, cleanup cache and config vars -+ @Rules = (); %Rule_by_ID = %Request_Cache = (); -+ -+ # parse configurations -+ for $config (@{$postfwd_settings{Configs}}) { -+ ($mytype,$myitem) = split $postfwd_settings{sepreq}, $config; -+ if ($mytype eq "r" or $mytype eq "rule") { -+ %myrule = parse_config_line ($forced_reload, 'RULE', 0, ($#Rules + 1), $myitem); -+ push ( @Rules, { %myrule } ) if (%myrule); -+ } elsif ($mytype eq "f" or $mytype eq "file") { -+ if ( not($forced_reload) and defined $Config_Cache{$myitem}{lastread} and ($Config_Cache{$myitem}{lastread} > (stat $myitem)[9]) ) { -+ log_info ("file \"$myitem\" unchanged - using cached ruleset (mtime: ".(stat $myitem)[9].", -+ cache: $Config_Cache{$myitem}{lastread})" -+ ) if wantsdebug (qw[ all config verbose ]); -+ push ( @Rules, @{$Config_Cache{$myitem}{ruleset}} ) if $Config_Cache{$myitem}{ruleset}; -+ } else { -+ @myruleset = read_config_file ($forced_reload, ($#Rules + 1), $myitem); -+ if (@myruleset) { -+ @Rules = ( @Rules, @myruleset ) if @myruleset; -+ $Config_Cache{$myitem}{lastread} = time(); -+ @{$Config_Cache{$myitem}{ruleset}} = @myruleset; -+ }; -+ }; -+ }; -+ }; -+ if ($#Rules < 0) { -+ log_warn("critical: no rules found - i feel useless (have you set -f or -r?)"); -+ } else { -+ # update Rule by ID hash -+ map { $Rule_by_ID{$Rules[$_]{$COMP_ID}} = $_ } (0 .. $#Rules); -+ }; -+}; -+ -+# displays configuration -+sub show_config { -+ if (wantsdebug (qw[ all verbose ])) { -+ print STDOUT "=" x 75, "\n"; -+ printf STDOUT "Rule count: %s\n", ($#Rules + 1); -+ print STDOUT "=" x 75, "\n"; -+ }; -+ for my $index (0 .. $#Rules) { -+ next unless exists $Rules[$index]; -+ printf STDOUT "Rule %3d: id->\"%s\"; action->\"%s\"", $index, $Rules[$index]{$COMP_ID}, $Rules[$index]{$COMP_ACTION}; -+ my $line = (wantsdebug (qw[ all verbose ])) ? "\n\t " : ""; -+ for my $mykey ( reverse sort keys %{$Rules[$index]} ) { -+ unless (($mykey eq $COMP_ACTION) or ($mykey eq $COMP_ID)) { -+ $line .= "; " unless wantsdebug (qw[ all verbose ]); -+ $line .= ($mykey =~ /^$COMP_SINGLE$/) -+ ? $mykey."->\"".$Rules[$index]{$mykey}."\"" -+ : $mykey."->\"".(join ', ', @{$Rules[$index]{$mykey}})."\""; -+ $line .= " ; " if wantsdebug (qw[ all verbose ]); -+ }; -+ }; -+ $line =~ s/\s*\;\s*$// if wantsdebug (qw[ all verbose ]); -+ printf STDOUT "%s\n", $line; -+ print STDOUT "-" x 75, "\n" if wantsdebug (qw[ all verbose ]); -+ }; -+}; -+ -+ -+## sub DNS -+ -+# checks for rbl timeouts -+sub rbl_timeout { -+ my($myrbl) = shift; -+ return ( ($postfwd_settings{dns}{max_timeout} > 0) and (defined $Timeouts{$myrbl}) and ($Timeouts{$myrbl} > $postfwd_settings{dns}{max_timeout}) ); -+}; -+ -+# reads DNS answers -+sub rbl_read_dns { -+ my($myresult) = shift; -+ my($now) = time(); -+ my($que,$ttl,$res,$typ) = undef; -+ my(@addrs,@texts) = (); -+ -+ if ( defined $myresult ) { -+ # read question, for dns cache id -+ foreach ($myresult->question) { -+ $typ = ($_->qtype || ''); $que = ($_->qname || ''); -+ map { &{$postfwd_settings{syslog}{logger}} ('info', "[GETDNS00] type=$typ, query=$que, $_") } (hash_to_list ('%packet', %{$myresult})) -+ if wantsdebug (qw[ all dns getdns getdnspacket ]); -+ next unless ($typ and $que); -+ log_info ("[GETDNS01] type=$typ, query=$que") if wantsdebug (qw[ all dns getdns ]); -+ unless ( (defined $DNS_Cache{$que}) -+ and (($typ eq 'A') or ($typ eq 'TXT')) ) { -+ log_note ("[DNSBL] ignoring unknown query '$que', type '$typ'"); -+ next; -+ }; -+ -+ # parse answers -+ foreach ($myresult->answer) { -+ log_info ("[GETDNS02] type=$typ, query=$que, restype='".$_->type."'") if wantsdebug (qw[ all dns getdns ]); -+ if ($_->type eq 'A') { -+ push @addrs, $_->address if $_->address; -+ $ttl = $_->ttl; -+ log_info ("[GETDNSA1] type=$typ, query=$que, ttl=$ttl, answer='".($_->address || '')."'") if wantsdebug (qw[ all dns getdns ]); -+ } elsif ($_->type eq 'TXT') { -+ $res = (join(" ", $_->char_str_list()) || ''); -+ # escape commas for set() action -+ $res =~ s/,/ /g; -+ push @texts, $res; -+ $ttl = $_->ttl; -+ log_info ("[GETDNST1] type=$typ, query=$que, ttl=$ttl, answer='$res'") if wantsdebug (qw[ all dns getdns ]); -+ } elsif (wantsdebug (qw[ all dns getdns devel ])) { -+ log_info ("[GETDNS??] received answer type=".$typ." for query $que"); -+ }; -+ }; -+ -+ # save result in cache -+ if ($typ eq 'A') { -+ $ttl = ( $DNS_Cache{$que}{ttl} > ($ttl||=0) ) ? $DNS_Cache{$que}{ttl} : $ttl; -+ @{$DNS_Cache{$que}{A}} = @addrs; -+ $DNS_Cache{$que}{ttl} = $ttl; -+ $DNS_Cache{$que}{delay} = ($now - $DNS_Cache{$que}{delay}); -+ $DNS_Cache{$que}{'log'} = 1; -+ $DNS_Cache{$que}{'until'} = $now + $DNS_Cache{$que}{ttl}; -+ log_info ("[GETDNSA2] type=$typ, query=$que, cache='".(hash_to_str(%{$DNS_Cache{$que}}))."'") if wantsdebug (qw[ all dns getdns ]); -+ #} elsif ($typ eq 'TXT') { -+ } else { -+ $res = (join(" ", @texts) || ''); -+ $ttl = ( $DNS_Cache{$que}{ttl} > ($ttl||=0) ) ? $DNS_Cache{$que}{ttl} : $ttl; -+ $DNS_Cache{$que}{TXT} = $res; -+ $DNS_Cache{$que}{ttl} = $ttl unless $DNS_Cache{$que}{ttl}; -+ log_info ("[GETDNST2] type=$typ, query=$que, cache='".(hash_to_str(%{$DNS_Cache{$que}}))."'") if wantsdebug (qw[ all dns getdns ]); -+ }; -+ }; -+ return $que if (@addrs || $res); -+ } else { -+ log_note ("[DNSBL] dns timeout"); -+ }; -+}; -+ -+# fires DNS queries -+sub rbl_prepare_lookups { -+ my($mytype, $myval, @myrbls) = @_; -+ my($myresult) = undef; -+ my($cmp,$rblitem,$myquery); -+ my(@lookups) = (); -+ -+ # skip these -+ return @lookups if ($myval eq '') or ($myval eq "unknown"); -+ -+ # removes duplicate lookups, but keeps the specified order -+ @myrbls = uniq(@myrbls); -+ -+ RBLQUERY: foreach (@myrbls) { -+ -+ # separate rbl-name and answer -+ ($cmp,$rblitem) = split ";", $_; -+ next RBLQUERY unless $rblitem; -+ my($myrbl, $myrblans, $myrbltime) = split /\//, $rblitem; -+ next RBLQUERY unless $myrbl; -+ next RBLQUERY if rbl_timeout($myrbl); -+ $myrblans = $postfwd_settings{dns}{mask} unless $myrblans; -+ $myrbltime = $postfwd_settings{dns}{ttl} unless $myrbltime; -+ -+ # create query string -+ $myquery = $myval.".".$myrbl; -+ my $mypat = qr/$myrblans/; -+ -+ # query our cache -+ if ( exists($DNS_Cache{$myquery}) and exists($DNS_Cache{$myquery}{A}) ) { -+ ANSWER1: foreach (@{$DNS_Cache{$myquery}{A}}) { last ANSWER1 if $myresult = ( $_ =~ /$mypat/ ) }; -+ log_info ("[DNSBL] cached $mytype: $myrbl $myval ($myquery) - answer: \'".(join ", ", @{$DNS_Cache{$myquery}{A}})."\'") -+ if ( wantsdebug (qw[ all ]) or ($myresult and wantsdebug (qw[ verbose ])) ); -+ -+ # query parent cache -+ } elsif ( not($postfwd_settings{dns}{noparent}) -+ and not((my $pans = cache_query ("CMD=".$postfwd_commands{getcacheitem}.";TYPE=dns;ITEM=$myquery")) eq '') ) { -+ %{$DNS_Cache{$myquery}} = str_to_hash($pans); delete $DNS_Cache{$myquery}{'log'} if $DNS_Cache{$myquery}{'log'}; -+ if ($DNS_Cache{$myquery}{A}) { -+ ref $DNS_Cache{$myquery}{A} eq 'ARRAY' or $DNS_Cache{$myquery}{A} = [ $DNS_Cache{$myquery}{A} ]; -+ ANSWER2: foreach (@{$DNS_Cache{$myquery}{A}}) { last ANSWER2 if $myresult = ( $_ =~ /$mypat/ ) }; -+ log_info ("[DNSBL] parent cached $mytype: $myrbl $myval ($myquery) - answer: \'".(join ", ", @{$DNS_Cache{$myquery}{A}})."\'") -+ if ( wantsdebug (qw[ all ]) or ($myresult and wantsdebug (qw[ verbose ])) ); -+ }; -+ -+ # not found -> prepare dns query -+ } else { -+ $DNS_Cache{$myquery} = { -+ type => $mytype, -+ name => $myrbl, -+ value => $myval, -+ ttl => $myrbltime, -+ delay => time(), -+ }; -+ log_info("[DNSBL] query $mytype: $myrbl $myval ($myquery)") if wantsdebug (qw[ all ]); -+ push @lookups, $myquery; -+ }; -+ }; -+ # return necessary lookups -+ return @lookups; -+}; -+ -+# checks RBL items -+sub rbl_check { -+ my($mytype,$myrbl,$myval) = @_; -+ my($myanswer,$myrblans,$myrbltime,$myresult,$mystart,$myend); -+ my($m1,$m2,$myrbltype,$m4,$myrbltxt,$myquery); -+ my($now) = time(); -+ -+ # skip these -+ return $myresult if ($myval eq '') or ($myval eq "unknown"); -+ -+ # separate rbl-name and answer -+ ($myrbl, $myrblans, $myrbltime) = split '/', $myrbl; -+ $myrblans = $postfwd_settings{dns}{mask} unless $myrblans; -+ $myrbltime = $postfwd_settings{dns}{ttl} unless $myrbltime; -+ -+ # create query string -+ $myquery = $myval.".".$myrbl; -+ -+ # query our cache -+ return $myresult unless ( $myresult = (defined $DNS_Cache{$myquery} and not(defined $DNS_Cache{$myquery}{'timed'})) ); -+ if (not($postfwd_settings{dns}{noparent}) and defined $DNS_Cache{$myquery}{'log'}) { -+ my $pdns = "CMD=".$postfwd_commands{setcacheitem}.";TYPE=dns;ITEM=$myquery".hash_to_str(%{$DNS_Cache{$myquery}}); -+ cache_query ($pdns); -+ }; -+ if ( $myresult = ($#{$DNS_Cache{$myquery}{A}} >= 0) ) { -+ my $mypat = qr/$myrblans/; -+ ANSWER: foreach (@{$DNS_Cache{$myquery}{A}}) { -+ last ANSWER if ( $myresult = ( ($_) and ($_ =~ m/$mypat/)) ); -+ }; -+ push @DNSBL_Text, $DNS_Cache{$myquery}{type}.':'.$DNS_Cache{$myquery}{name}.':<'.($DNS_Cache{$myquery}{TXT} || '').'>' -+ if $myresult and defined $DNS_Cache{$myquery}{type} and defined $DNS_Cache{$myquery}{name}; -+ if ( wantsdebug (qw[ all verbose ]) or $postfwd_settings{dns}{anylog} -+ or ($myresult and not($postfwd_settings{dns}{nolog}) and defined $DNS_Cache{$myquery}{'log'}) ) { -+ log_info ("[DNSBL] ".( ($mytype eq $COMP_RBL_KEY) ? join('.', reverse(split(/\./,$myval))) : $myval )." listed on " -+ .lc(($DNS_Cache{$myquery}{type} || $mytype)).":$myrbl (answer: ".(join ", ", @{$DNS_Cache{$myquery}{A}}) -+ .", time: ".$DNS_Cache{$myquery}{delay}."s, ttl: ".$DNS_Cache{$myquery}{ttl}."s, '".($DNS_Cache{$myquery}{TXT} || '')."')"); -+ delete $DNS_Cache{$myquery}{'log'} if defined $DNS_Cache{$myquery}{'log'}; -+ }; -+ }; -+ return $myresult; -+}; -+ -+# dns resolver wrapper -+sub dns_query { -+ my (@queries) = @_; undef my @result; -+ eval { -+ local $SIG{__DIE__} = sub { log_note ("[DNS] ERROR: \"$!\", DETAIL: \"@_\""); }; -+ @result = dns_query_net_dns(@queries); -+ }; -+ return @result; -+}; -+ -+# resolves dns queries using Net::DNS -+sub dns_query_net_dns { -+ my (@queries) = @_; undef my @result; undef my $pans; -+ my %ownsock = (); my @ownready = (); undef my $bgsock; -+ my $ownsel = IO::Select->new(); -+ my $dns = Net::DNS::Resolver->new( -+ tcp_timeout => $postfwd_settings{dns}{timeout}, -+ udp_timeout => $postfwd_settings{dns}{timeout}, -+ persistent_tcp => 0, persistent_udp => 0, -+ retrans => 0, retry => 1, dnsrch => 0, defnames => 0, -+ ); -+ my $now = time(); -+ # prepare queries -+ foreach (@queries) { -+ my ($item, $type) = split ','; $type ||= 'A'; -+ # query child cache -+ if ( (defined $DNS_Cache{$item}{$type}) and (defined $DNS_Cache{$item}{'until'}) and ($DNS_Cache{$item}{'until'} >= $now) ) { -+ $DNS_Cache{$item}{$type} = [ $DNS_Cache{$item}{$type} ] unless (ref $DNS_Cache{$item}{$type} eq 'ARRAY'); -+ log_info ("[DNS] dnsccache: item=$item, type=$type -> ".(join ',', @{$DNS_Cache{$item}{$type}})." (ttl: ".($DNS_Cache{$item}{ttl} || 0).")") -+ if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all dns getdns ])); -+ push @result, @{$DNS_Cache{$item}{$type}}; -+ # query parent cache -+ } elsif ( not($postfwd_settings{dns}{noparent}) -+ and not(($pans = cache_query ("CMD=".$postfwd_commands{getcacheitem}.";TYPE=dns;ITEM=$item")) eq '') -+ and (%{$DNS_Cache{$item}} = str_to_hash($pans)) -+ and (defined $DNS_Cache{$item}{$type}) and (defined $DNS_Cache{$item}{'until'}) and ($DNS_Cache{$item}{'until'} >= $now) ) { -+ $DNS_Cache{$item}{$type} = [ $DNS_Cache{$item}{$type} ] unless (ref $DNS_Cache{$item}{$type} eq 'ARRAY'); -+ log_info ("[DNS] dnspcache: item=$item, type=$type -> ".(join ',', @{$DNS_Cache{$item}{$type}})." (ttl: ".($DNS_Cache{$item}{ttl} || 0).")") -+ if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all dns getdns ])); -+ push @result, @{$DNS_Cache{$item}{$type}}; -+ # send queries -+ } else { -+ log_info ("[DNS] dnsquery: item=$item, type=$type") -+ if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all dns getdns devel ])); -+ $DNS_Cache{$item}{delay} = $now; -+ $bgsock = $dns->bgsend ($item, $type); -+ $ownsel->add($bgsock); -+ $ownsock{$bgsock} = $item.','.$type; -+ }; -+ }; -+ # retrieve answers -+ while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($postfwd_settings{dns}{timeout}))) { -+ foreach my $sock (@ownready) { -+ if (defined $ownsock{$sock}) { -+ my $packet = $dns->bgread($sock); -+ my ($item, $type) = split ',', $ownsock{$sock}; -+ my $rname = $DNS_REPNAMES{$type}; -+ my @rrs = (grep { $_->type eq $type } $packet->answer); -+ $now = time(); my $ttl = 0; my @ans = (); -+ if (@rrs) { -+ # sort MX records by preference -+ @rrs = sort { $a->preference <=> $b->preference } @rrs if ($type eq 'MX'); -+ foreach my $rr (@rrs) { -+ $ttl = $rr->ttl if ($rr->ttl > $ttl); -+ log_info ("[DNS] dnsanswer: item=$item, type=$type -> $rname=".$rr->$rname." (ttl: $ttl)") -+ if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all dns setdns ])); -+ push @ans, $rr->$rname; -+ }; -+ push @result, @ans; -+ }; -+ # add to dns cache -+ $ttl ||= $postfwd_settings{dns}{ttl}; -+ @{$DNS_Cache{$item}{$type}} = @ans; -+ $DNS_Cache{$item}{ttl} = $ttl; -+ $DNS_Cache{$item}{'until'} = $now + $ttl; -+ $DNS_Cache{$item}{delay} = ($DNS_Cache{delay}) ? $now - $DNS_Cache{delay} : 0; -+ cache_query ( "CMD=".$postfwd_commands{setcacheitem}.";TYPE=dns;ITEM=$item".hash_to_str(%{$DNS_Cache{$item}}) ) -+ unless ($postfwd_settings{dns}{noparent}); -+ $DNS_Cache{$item}{'log'} = 1; -+ log_info ("[DNS] dnsanswers: item=$item, type=$type -> $rname=".((@{$DNS_Cache{$item}{$type}}) ? join ',', @{$DNS_Cache{$item}{$type}} : '')." (delay: ".$DNS_Cache{$item}{delay}.", ttl: $ttl)") -+ if ($postfwd_settings{dns}{anylog} or wantsdebug (qw[ all verbose dns setdns devel ])); -+ delete $ownsock{$sock}; -+ } else { -+ $ownsel->remove($sock); -+ $sock = undef; -+ }; -+ }; -+ }; -+ # show timeouts -+ map { log_note ("dnsquery: timeout for $_ after ".$postfwd_settings{dns}{timeout}." seconds") } (values %ownsock); -+ return @result; -+}; -+ -+ -+## SUB plugins -+ -+# -+# these subroutines integrate additional attributes to -+# a request before the ruleset is evaluated -+# call: %result = postfwd_items{foo}(%request) -+# save: $result{$_} -+# -+%postfwd_items = ( -+ "__builtin__" => sub { -+ my(%request) = @_; my(%result) = (); -+ # postfwd version -+ $result{version} = $postfwd_settings{name}." ".$postfwd_settings{version}; -+ # sender info -+ $request{sender} =~ /(.*)@([^@]*)$/; -+ ( $result{sender_localpart}, $result{sender_domain} ) = ( $1, $2 ); -+ # recipient info -+ $request{recipient} =~ /(.*)@([^@]*)$/; -+ ( $result{recipient_localpart}, $result{recipient_domain} ) = ( $1, $2 ); -+ # reverted ip address (for lookups) -+ $result{reverse_address} = (join(".", reverse(split(/\./,$request{client_address})))); -+ return %result; -+ }, -+ "sender_dns" => sub { -+ my(%request) = @_; my(%result) = (); -+ map { $result{$_} = $request{sender_domain} } ($COMP_NS_NAME, $COMP_NS_ADDR, $COMP_MX_NAME, $COMP_MX_ADDR); -+ $result{$COMP_HELO_ADDR} = $request{helo_name}; -+ return %result; -+ }, -+); -+# returns additional request information -+# for all postfwd_items -+sub postfwd_items { -+ my(%request) = @_; -+ my(%result) = (); -+ foreach (sort keys %postfwd_items) { -+ log_info ("[PLUGIN] executing postfwd-item ".$_) -+ if wantsdebug (qw[ all ]); -+ %result = (%result, &{$postfwd_items{$_}}((%request,%result))) -+ if (defined $postfwd_items{$_}); -+ }; -+ map { $result{$_} = '' unless $result{$_}; log_info ("[PLUGIN] Added key: $_=$result{$_}") if wantsdebug (qw[ all ]) } (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 ]); -+ if ($myresult) { -+ return $myresult if ( ($val eq '0.0.0.0/0') and ($myitem =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) ); -+ $val .= '/32' unless ($val =~ /\/\d{1,2}$/); -+ $myresult = cidr_match((cidr_parse($val)),$myitem); -+ }; -+ $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 ]); -+ $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 = not($myitem == $val); -+ } elsif ($cmp eq '!<') { -+ $myresult = not($myitem <= $val); -+ } elsif ($cmp eq '!>') { -+ $myresult = not($myitem >= $val); -+ } else { -+ $myresult = ($myitem >= $val); -+ }; -+ return $myresult; -+ }, -+ $COMP_RBL_KEY => sub { -+ my($cmp,$val,$myitem,%request) = @_; -+ my($myresult) = not($postfwd_settings{dns}{disabled}); -+ log_info ("type rbl : \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all ]); -+ $myresult = ( rbl_check ($COMP_RBL_KEY, $val, $myitem) ) if $myresult; -+ $myresult = not($myresult) if ($cmp eq '!='); -+ return $myresult; -+ }, -+ $COMP_RHSBL_KEY => sub { -+ my($cmp,$val,$myitem,%request) = @_; -+ my($myresult) = not($postfwd_settings{dns}{disabled}); -+ log_info ("type rhsbl : \"$myitem\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all ]); -+ $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 ]); -+ $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 ]); -+ $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 ]); -+ $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 ]); -+ $myresult = (($rmin <= $idat) and ($rmax >= $idat)); -+ $myresult = not($myresult) if ($cmp eq '!='); -+ return $myresult; -+ }, -+ $COMP_HELO_ADDR => sub { -+ my($cmp,$val,$myitem,%request) = @_; -+ my($myresult) = undef; -+ return $myresult if $postfwd_settings{dns}{disabled}; -+ return $myresult unless $myitem =~ /\./; -+ if ( my @answers = dns_query ("$myitem,A") ) { -+ log_info ("type $COMP_HELO_ADDR : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all ]); -+ map { $myresult = ( &{$postfwd_compare{cidr}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; -+ }; -+ return $myresult; -+ }, -+ $COMP_NS_NAME => sub { -+ my($cmp,$val,$myitem,%request) = @_; -+ my($myresult) = undef; -+ return $myresult if $postfwd_settings{dns}{disabled}; -+ return $myresult unless $myitem =~ /\./; -+ if ( my @answers = dns_query ("$myitem,NS") ) { -+ log_info ("type $COMP_NS_NAME : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all ]); -+ map { $myresult = ( &{$postfwd_compare{default}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; -+ } else { -+ $myresult = ( &{$postfwd_compare{default}}(($cmp,$val,'',%request)) ); -+ }; -+ return $myresult; -+ }, -+ $COMP_MX_NAME => sub { -+ my($cmp,$val,$myitem,%request) = @_; -+ my($myresult) = undef; -+ return $myresult if $postfwd_settings{dns}{disabled}; -+ return $myresult unless $myitem =~ /\./; -+ if ( my @answers = dns_query ("$myitem,MX") ) { -+ log_info ("type $COMP_MX_NAME : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all ]); -+ map { $myresult = ( &{$postfwd_compare{default}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; -+ } else { -+ $myresult = ( &{$postfwd_compare{default}}(($cmp,$val,'',%request)) ); -+ }; -+ return $myresult; -+ }, -+ $COMP_NS_ADDR => sub { -+ my($cmp,$val,$myitem,%request) = @_; -+ my($myresult) = undef; -+ return $myresult if $postfwd_settings{dns}{disabled}; -+ return $myresult unless $myitem =~ /\./; -+ if ( my @answers = dns_query ("$myitem,NS") ) { -+ splice (@answers, $postfwd_settings{dns}{max_ns_lookups}) if $postfwd_settings{dns}{max_ns_lookups} and $#answers > $postfwd_settings{dns}{max_ns_lookups}; -+ if ( @answers = dns_query (@answers) ) { -+ log_info ("type $COMP_NS_ADDR : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all ]); -+ map { $myresult = ( &{$postfwd_compare{cidr}}(($cmp,$val,$_,%request)) ); return $myresult if $myresult } @answers; -+ }; -+ }; -+ return $myresult; -+ }, -+ $COMP_MX_ADDR => sub { -+ my($cmp,$val,$myitem,%request) = @_; -+ my($myresult) = undef; -+ return $myresult if $postfwd_settings{dns}{disabled}; -+ return $myresult unless $myitem =~ /\./; -+ if ( my @answers = dns_query ("$myitem,MX") ) { -+ splice (@answers, $postfwd_settings{dns}{max_mx_lookups}) if $postfwd_settings{dns}{max_mx_lookups} and $#answers > $postfwd_settings{dns}{max_mx_lookups}; -+ if ( @answers = dns_query (@answers) ) { -+ log_info ("type $COMP_MX_ADDR : \"".(join ',', @answers)."\" \"$cmp\" \"$val\"") if wantsdebug (qw[ all ]); -+ 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 ]); -+ # backward compatibility -+ $cmp = '==' if ( ($var) and ($cmp eq '=') ); -+ if ($cmp eq '==') { -+ $myresult = ( lc($myitem) eq lc($val) ) if $myitem; -+ } elsif ( $cmp eq '=~' ) { -+ $myresult = ( $myitem =~ /$val/i ); -+ } elsif ( $cmp eq '!~' ) { -+ $myresult = ( $myitem !~ /$val/i ); -+ } elsif ($cmp eq '!=') { -+ $myresult = not( lc($myitem) eq lc($val) ) if $myitem; -+ } elsif ($cmp eq '=<') { -+ $myresult = (($myitem || 0) <= $val); -+ } elsif ($cmp eq '!<') { -+ $myresult = not(($myitem || 0) <= $val); -+ } elsif ($cmp eq '=>') { -+ $myresult = (($myitem || 0) >= $val); -+ } elsif ($cmp eq '!>') { -+ $myresult = not(($myitem || 0) >= $val); -+ } else { -+ # allow // regex -+ $val =~ s/^\/?(.*?)\/?$/$1/; -+ $myresult = ( $myitem =~ /$val/i ); -+ }; -+ return $myresult; -+ }, -+ "client_address" => sub { return &{$postfwd_compare{cidr}}(@_); }, -+ "encryption_keysize" => sub { return &{$postfwd_compare{numeric}}(@_); }, -+ "size" => sub { return &{$postfwd_compare{numeric}}(@_); }, -+ "recipient_count" => sub { return &{$postfwd_compare{numeric}}(@_); }, -+ "request_score" => sub { return &{$postfwd_compare{numeric}}(@_); }, -+ $COMP_RHSBL_KEY_CLIENT => sub { return &{$postfwd_compare{$COMP_RHSBL_KEY}}(@_); }, -+ $COMP_RHSBL_KEY_SENDER => sub { return &{$postfwd_compare{$COMP_RHSBL_KEY}}(@_); }, -+ $COMP_RHSBL_KEY_HELO => sub { return &{$postfwd_compare{$COMP_RHSBL_KEY}}(@_); }, -+ $COMP_RHSBL_KEY_RCLIENT => sub { return &{$postfwd_compare{$COMP_RHSBL_KEY}}(@_); }, -+); -+# -+# these subroutines define postfwd actions -+# -+%postfwd_actions = ( -+ # example action foo() -+ # "foo" => sub { -+ # my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ # my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ # ... -+ # return ($stop,$index,$myaction,$myline,%request); -+ # }, -+ # jump() command -+ "jump" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ if (defined $Rule_by_ID{$myarg}) { -+ my($ruleno) = $Rule_by_ID{$myarg}; -+ log_info ("[RULES] ".$myline -+ .", jump to rule $ruleno (id $myarg)") -+ if wantsdebug (qw[ all verbose ]); -+ $index = $ruleno - 1; -+ } else { -+ log_warn ("[RULES] ".$myline." - error: jump failed, can not find rule-id ".$myarg." - ignoring"); -+ }; -+ return ($stop,$index,$myaction,$myline,%request); -+ }, -+ # set() command -+ "set" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ foreach ( split (",", $myarg) ) { -+ if ( /^\s*([^=]+?)\s*([\.\-\*\/\+=]=|=[\.\-\*\/\+=]|=)\s*(.*?)\s*$/ ) { -+ my($r_var, $mod, $r_val) = ($1, $2, $3); -+ my($m_val) = (defined $request{$r_var}) ? $request{$r_var} : 0; -+ # saves some ifs -+ if (($mod eq '=') or ($mod eq '==')) { -+ $m_val = $r_val; -+ } elsif ( ($mod eq '.=') or ($mod eq '=.') ) { -+ $m_val .= $r_val; -+ } elsif ( (($mod eq '+=') or ($mod eq '=+')) and (($m_val=~/^\d+(\.\d+)?$/) and ($r_val=~/^\d+(\.\d+)?$/)) ) { -+ $m_val += $r_val; -+ } elsif ( (($mod eq '-=') or ($mod eq '=-')) and (($m_val=~/^\d+(\.\d+)?$/) and ($r_val=~/^\d+(\.\d+)?$/)) ) { -+ $m_val -= $r_val; -+ } elsif ( (($mod eq '*=') or ($mod eq '=*')) and (($m_val=~/^\d+(\.\d+)?$/) and ($r_val=~/^\d+(\.\d+)?$/)) ) { -+ $m_val *= $r_val; -+ } elsif ( (($mod eq '/=') or ($mod eq '=/')) and (($m_val=~/^\d+(\.\d+)?$/) and ($r_val=~/^\d+(\.\d+)?$/)) ) { -+ $m_val /= (($r_val == 0) ? 1 : $r_val); -+ } else { -+ $m_val = $r_val; -+ }; -+ $m_val = $1.((defined $2) ? $2 : '') if ( $m_val =~ /^(\-?\d+)([\.,]\d\d?)?/ ); -+ (defined $request{$r_var}) -+ ? log_info ("notice", "[RULES] ".$myline.", redefining existing ".$r_var."=".$request{$r_var}." with ".$r_var."=".$m_val) -+ : log_info ("[RULES] ".$myline.", defining ".$r_var."=".$m_val) -+ if wantsdebug (qw[ all verbose ]); -+ $request{$r_var} = $m_val; -+ } else { -+ log_warn ("[RULES] ".$myline.", ignoring unknown set() attribute ".$_); -+ }; -+ }; -+ return ($stop,$index,$myaction,$myline,%request); -+ }, -+ # score() command -+ "score" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ my($score) = (defined $request{request_score}) ? $request{request_score} : 0; -+ if ($myarg =~/^([\+\-\*\/\=]?)(\d+)([\.,](\d+))?$/) { -+ my($mod, $val) = ($1, $2 + ((defined $4) ? ($4 / 10) : 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 verbose ]); -+ $request{score} = $request{request_score} = $score; -+ } elsif ($myarg) { -+ log_warn ("[RULES] ".$myline.", invalid value for score \"$myarg\" - ignoring"); -+ }; -+ MAXSCORE: foreach my $max_score (reverse sort keys %{$postfwd_settings{scores}}) { -+ if ( ($score >= $max_score) and ($postfwd_settings{scores}{$max_score}) ) { -+ $myaction=$postfwd_settings{scores}{$max_score}; -+ $myline .= ", score=".$score."/".$max_score; -+ $stop = $score; last MAXSCORE; -+ }; -+ }; -+ return ($stop,$index,$myaction,$myline,%request); -+ }, -+ # rate() command -+ "rate" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ my($ratetype,$ratecount,$ratetime,$ratecmd) = split "/", $myarg, 4; -+ if ($ratetype and $ratecount and $ratetime and $ratecmd) { -+ unless ( defined $Rate_Cache{$ratetype} ) { -+ log_info ("[RULES] ".$myline -+ .", creating rate object ".$ratetype -+ ." [type: ".$mycmd.", max: ".$ratecount.", time: ".$ratetime."s]") -+ if wantsdebug (qw[ all ]); -+ $Rate_Cache{$ratetype} = { -+ type => $mycmd, -+ maxcount => $ratecount, -+ ttl => $ratetime, -+ 'until' => $now + $ratetime, -+ count => ( ($mycmd eq 'size') ? $request{size} : (($mycmd eq 'rcpt') ? $request{recipient_count} : 1 ) ), -+ rule => $Rules[$index]{$COMP_ID}, -+ action => $ratecmd, -+ }; -+ unless ($postfwd_settings{rate}{noparent}) { -+ my $prate = "CMD=".$postfwd_commands{setcacheitem}.";TYPE=rate;ITEM=$ratetype".hash_to_str(%{$Rate_Cache{$ratetype}}); -+ #cache_query ($prate); -+ }; -+ }; -+ } else { -+ log_note ("[RULES] ".$myline.", ignoring unknown ".$mycmd."() attribute \'".$myarg."\'"); -+ }; -+ return ($stop,$index,$myaction,$myline,%request); -+ }, -+ # size() command -+ "size" => sub { return &{$postfwd_actions{rate}}(@_); }, -+ # rcpt() command -+ "rcpt" => sub { return &{$postfwd_actions{rate}}(@_); }, -+ # wait() command -+ "wait" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ log_info ("[RULES] ".$myline.", delaying for $myarg seconds"); -+ sleep $myarg; -+ return ($stop,$index,$myaction,$myline,%request); -+ }, -+ # note() command -+ "note" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ log_info ("[RULES] ".$myline." - note: ".$myarg) if $myarg; -+ return ($stop,$index,$myaction,$myline,%request); -+ }, -+ # quit() command - not supported in this version -+ "quit" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ log_warn ("[RULES] ".$myline." - critical: quit (".$myarg.") unsupported in this version - ignoring"); -+ }, -+ # file() command -+ "file" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ log_warn ("[RULES] ".$myline." - error: command ".$mycmd."() has not been implemented yet - ignoring"); -+ return ($stop,$index,$myaction,$myline,%request); -+ }, -+ # ask() command -+ "ask" => sub { -+ my($index,$now,$mycmd,$myarg,$myline,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; my($stop) = 0; -+ log_info ("Opening socket to '$myarg'") if wantsdebug (qw[ all ]); -+ my($addr,$port,$ignore) = split ':', $myarg; -+ my %orig = str_to_hash ($request{orig}); -+ if ( ($addr and $port) and my $socket = new IO::Socket::INET ( -+ PeerAddr => $addr, -+ PeerPort => $port, -+ Proto => 'tcp', -+ Timeout => 9, -+ Type => SOCK_STREAM ) ) { -+ -+ my $sendstr = ''; -+ foreach (keys %orig) { -+ $sendstr .= $_."=".$orig{$_}."\n"; -+ }; -+ $sendstr .= "\n"; -+ log_info ("Asking service $myarg -> '$sendstr'") if wantsdebug (qw[ all ]); -+ print $socket "$sendstr"; -+ $sendstr = <$socket>; -+ chomp($sendstr); -+ log_info ("Answer from $myarg -> '$sendstr'") if wantsdebug (qw[ all verbose ]); -+ $sendstr =~ s/^(action=)//; -+ if ($1 and $sendstr) { -+ if ($ignore and ($sendstr =~ /$ignore/i)) { -+ log_info ("ignoring answer '$sendstr' from $myarg") if wantsdebug (qw[ all verbose ]); -+ } else { -+ $stop = $myaction = $sendstr; -+ }; -+ } else { -+ mylogs ('notice', "rule: $index got invalid answer '$sendstr' from $myarg"); -+ }; -+ } else { -+ log_note ("Could not open socket to '$myarg' - $!"); -+ }; -+ return ($stop,$index,$myaction,$myline,%request); -+ }, -+ # exec() command -+ "exec" => sub { return &{$postfwd_actions{file}}(@_); }, -+); -+ -+# load plugin-items -+sub get_plugins { -+ my(@pluginfiles) = @_; -+ my($pluginlog) = ''; -+ foreach my $file (@pluginfiles) { -+ unless ( -e $file ) { -+ log_warn ("File not found: $file"); -+ } else { -+ $file =~ /^(.*)$/; -+ require $1 if $1; -+ map { delete $postfwd_items_plugin{$_} unless ($_ and defined $postfwd_items_plugin{$_}) } (keys %postfwd_items_plugin); -+ map { delete $postfwd_compare_plugin{$_} unless ($_ and defined $postfwd_compare_plugin{$_}) } (keys %postfwd_compare_plugin); -+ map { delete $postfwd_actions_plugin{$_} unless ($_ and defined $postfwd_actions_plugin{$_}) } (keys %postfwd_actions_plugin); -+ map { log_note ("[PLUGIN] overriding prior item \'".$_."\'") if (defined $postfwd_items{$_}) } (keys %postfwd_items_plugin); -+ map { log_note ("[PLUGIN] overriding prior compare function \'".$_."\'") if (defined $postfwd_compare{$_}) } (keys %postfwd_compare_plugin); -+ map { log_note ("[PLUGIN] overriding prior action \'".$_."\'") if (defined $postfwd_actions{$_}) } (keys %postfwd_actions_plugin); -+ %postfwd_items = ( %postfwd_items, %postfwd_items_plugin ) if %postfwd_items_plugin; -+ %postfwd_compare = ( %postfwd_compare, %postfwd_compare_plugin ) if %postfwd_compare_plugin; -+ %postfwd_actions = ( %postfwd_actions, %postfwd_actions_plugin ) if %postfwd_actions_plugin; -+ $pluginlog = "[PLUGIN] Loaded plugins file: ".$file; -+ $pluginlog .= " items: \"".(join ", ", (sort keys %postfwd_items_plugin))."\"" -+ if %postfwd_items_plugin; -+ $pluginlog .= " compare: \"".(join ", ", (sort keys %postfwd_compare_plugin))."\"" -+ if %postfwd_compare_plugin; -+ $pluginlog .= " actions: \"".(join ", ", (sort keys %postfwd_actions_plugin))."\"" -+ if %postfwd_actions_plugin; -+ log_info ($pluginlog); -+ }; -+ }; -+}; -+ -+ -+### SUB ruleset -+ -+# compare item main -+# use: compare_item ( $TYPE, $RULEITEM, $MINIMUMHITS, $REQUESTITEM, %REQUEST, %REQUESTINFO ); -+sub compare_item { -+ my($mykey,$mymask,$mymin,$myitem, %request) = @_; -+ my($val,$var,$cmp,$neg,$myresult,$postfwd_compare_proc); -+ my($rcount) = 0; -+ $mymin ||= 1; -+ -+ # -+ # determine the right compare function -+ $postfwd_compare_proc = (defined $postfwd_compare{$mykey}) ? $mykey : "default"; -+ # -+ # save list due to possible modification -+ my @items = @{$mymask}; -+ # now compare request to every single item -+ ITEM: foreach (@items) { -+ ($cmp, $val) = split ";"; -+ next ITEM unless ($cmp and $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 ]); -+ $val = $neg if ($neg = deneg_item($val)); -+ log_info ("deneg $mykey: \"$myitem\" \"$cmp\" \"$val\"") if ($neg and wantsdebug (qw[ all ])); -+ next ITEM unless $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 ]); -+ if ($neg) { -+ $myresult = not($myresult); -+ log_info ("negate match $mykey: ".($myresult ? "TRUE" : "FALSE")) if wantsdebug (qw[ all ]); -+ }; -+ $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 ]); -+ last ITEM if $myresult; -+ }; -+ $myresult = $rcount if ($myresult or ($mymin eq 'all')); -+ return $myresult; -+}; -+ -+ -+# -+# compare request against a single rule -+# -+sub compare_rule { -+ my($index,$date,%request) = @_; -+ my(@ruleitems) = keys %{$Rules[$index]}; -+ my($has_rbl) = exists($Rules[$index]{$COMP_RBL_KEY}); -+ my($has_rhl) = ( -+ exists($Rules[$index]{$COMP_RHSBL_KEY}) or exists($Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}) or -+ exists($Rules[$index]{$COMP_RHSBL_KEY_CLIENT}) or exists($Rules[$index]{$COMP_RHSBL_KEY_SENDER}) or -+ exists($Rules[$index]{$COMP_RHSBL_KEY_HELO}) -+ ); -+ my($has_senderdns) = ( exists($Rules[$index]{$COMP_NS_NAME}) -+ or exists($Rules[$index]{$COMP_MX_NAME}) -+ or exists($Rules[$index]{$COMP_NS_ADDR}) -+ or exists($Rules[$index]{$COMP_MX_ADDR}) -+ ); -+ my($hasdns) = ( not($postfwd_settings{dns}{disabled}) and ($has_senderdns or $has_rhl or $has_rbl) ); -+ my($mykey,$myitem,$val,$cmp,$res,$myline,$timed) = undef; -+ my(@myresult) = (0,0,0,0); -+ my(@queries,@timedout) = (); -+ my($num) = 1; -+ undef @DNSBL_Text; -+ my($ownres,$ownsel,$bgsock) = undef; -+ my %ownsock = (); -+ my @ownready = (); -+ -+ log_info ("[RULES] rule: $index, id: $Rules[$index]{$COMP_ID}, items: '".((@ruleitems) ? join ';', @ruleitems: '')."'") if wantsdebug (qw[ all ]); -+ -+ # COMPARE-ITEMS -+ # check all non-dns items -+ ITEM: for $mykey ( keys %{$Rules[$index]} ) { -+ # always true -+ if ( ($mykey eq $COMP_ID) or ($mykey eq $COMP_ACTION) or ($mykey eq $COMP_CACHE) ) { -+ $myresult[0]++; -+ next ITEM; -+ }; -+ next ITEM if ( (($mykey eq $COMP_RBL_CNT) or ($mykey eq $COMP_RHSBL_CNT)) ); -+ next ITEM if ( (($mykey eq $COMP_RBL_KEY) or ($mykey eq $COMP_RHSBL_KEY)) ); -+ next ITEM if ( ($mykey eq $COMP_RHSBL_KEY_RCLIENT) or ($mykey eq $COMP_RHSBL_KEY_CLIENT) or ($mykey eq $COMP_RHSBL_KEY_SENDER) or ($mykey eq $COMP_RHSBL_KEY_HELO) ); -+ -+ # integration at this point enables redefining scores within ruleset -+ if ($mykey eq $COMP_SCORES) { -+ modify_score ($Rules[$index]{$mykey},$Rules[$index]{$COMP_ACTION}); -+ $myresult[0] = 0; -+ } else { -+ $val = ( $mykey =~ /^$COMP_DATECALC$/ ) -+ # prepare date check -+ ? $date -+ # default: compare against request attribute -+ : $request{$mykey}; -+ $myresult[0] = ($res = compare_item($mykey, $Rules[$index]{$mykey}, $num, ($val || ''), %request)) ? ($myresult[0] + $res) : 0; -+ }; -+ last ITEM unless ($myresult[0] > 0); -+ }; -+ log_info ("[RULES] pre-dns: rule: $index, id: $Rules[$index]{$COMP_ID}, RESULT: ".$myresult[0]) if wantsdebug (qw[ all ]); -+ -+ # DNSQUERY-SECTION -+ # fire bgsend()s with callback to result cache, -+ # if they are not contained already, -+ # and $postfwd_settings{dns}{disabled} is not set -+ if ($hasdns and $myresult[0]) { -+ -+ # prepare dns queries -+ $ownres = Net::DNS::Resolver->new( -+ tcp_timeout => $postfwd_settings{dns}{timeout}, -+ udp_timeout => $postfwd_settings{dns}{timeout}, -+ persistent_tcp => 0, persistent_udp => 0, -+ retrans => 0, retry => 1, dnsrch => 0, defnames => 0, -+ ); -+ $ownsel = IO::Select->new(); -+ -+ map { $timed .= (($timed) ? ", $_" : $_) if $Timeouts{$_} > $postfwd_settings{dns}{max_timeout} } (keys %Timeouts); -+ log_note ("[DNSBL] skipping rbls: $timed - too much timeouts") if $timed; -+ -+ push @queries, rbl_prepare_lookups ( $COMP_RBL_KEY, $request{reverse_address}, @{$Rules[$index]{$COMP_RBL_KEY}} ) -+ if (defined $Rules[$index]{$COMP_RBL_KEY}); -+ -+ push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY, $request{client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY}} ) -+ if (defined $Rules[$index]{$COMP_RHSBL_KEY}); -+ -+ push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_CLIENT, $request{client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_CLIENT}} ) -+ if (defined $Rules[$index]{$COMP_RHSBL_KEY_CLIENT}); -+ -+ push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_RCLIENT, $request{reverse_client_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}} ) -+ if (defined $Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}); -+ -+ push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_HELO, $request{helo_name}, @{$Rules[$index]{$COMP_RHSBL_KEY_HELO}} ) -+ if (defined $Rules[$index]{$COMP_RHSBL_KEY_HELO}); -+ -+ push @queries, rbl_prepare_lookups ( $COMP_RHSBL_KEY_SENDER, $request{sender_domain}, @{$Rules[$index]{$COMP_RHSBL_KEY_SENDER}} ) -+ if (defined $Rules[$index]{$COMP_RHSBL_KEY_SENDER}); -+ -+ # send dns queries -+ if ( @queries ) { -+ @queries = uniq(@queries); -+ QUERY: foreach my $query (@queries) { -+ next QUERY unless $query; -+ log_info ("[SENDDNS] sending query \'$query\'") -+ if wantsdebug (qw[ all ]); -+ # send A query -+ $bgsock = $ownres->bgsend($query, 'A'); -+ $ownsel->add($bgsock); -+ $ownsock{$bgsock} = 'A:'.$query; -+ # send TXT query -+ if ($postfwd_settings{dns}{async_txt}) { -+ $bgsock = $ownres->bgsend($query, 'TXT'); -+ $ownsel->add($bgsock); -+ $ownsock{$bgsock} = 'TXT:'.$query; -+ }; -+ }; -+ log_info ("[SENDDNS] rule: $index, id: $Rules[$index]{$COMP_ID}, lookups: ".($#queries + 1)) -+ if wantsdebug (qw[ all ]); -+ $myresult[3] = "dnsqueries=".($#queries + 1).$postfwd_settings{sepreq}."dnsinterval=".($#queries + 1); -+ }; -+ -+ # DNSRESULT-SECTION -+ # wait for select() and check the results unless $postfwd_settings{dns}{disabled} -+ my($ownstart) = time(); @queries = (); -+ while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($postfwd_settings{dns}{timeout}))) { -+ foreach my $sock (@ownready) { -+ if (defined $ownsock{$sock}) { -+ log_note ("[DNSBL] answer for ".$ownsock{$sock}) -+ if wantsdebug (qw[ all ]); -+ my $packet = $ownres->bgread($sock); -+ push @queries, (split ':', $ownsock{$sock})[1] if rbl_read_dns ($packet); -+ delete $ownsock{$sock}; -+ } else { -+ $ownsel->remove($sock); -+ $sock = undef; -+ }; -+ }; -+ }; -+ -+ # timeout handling -+ map { push @timedout, (split ':', $ownsock{$_})[1] } (keys %ownsock); -+ if (@timedout) { -+ @timedout = uniq(@timedout); -+ $myresult[3] .= $postfwd_settings{sepreq}."dnstimeouts=".($#timedout + 1); -+ foreach (@timedout) { -+ my $now = time(); -+ # @{$DNS_Cache{$_}{A}} = ('__TIMEOUT__'); -+ $DNS_Cache{$_}{ttl} = $postfwd_settings{dns}{ttl} unless $DNS_Cache{$_}{ttl}; -+ $DNS_Cache{$_}{'delay'} = $now - $ownstart; -+ $DNS_Cache{$_}{'until'} = $now + $DNS_Cache{$_}{ttl}; -+ $DNS_Cache{$_}{'timed'} = 1; -+ $Timeouts{$DNS_Cache{$_}{name}} = (defined $Timeouts{$DNS_Cache{$_}{name}}) -+ ? $Timeouts{$DNS_Cache{$_}{name}} + 1 -+ : 1 -+ if ( $postfwd_settings{dns}{max_timeout} > 0 ); -+ log_note ("[DNSBL] warning: timeout (".$Timeouts{$DNS_Cache{$_}{name}}."/".$postfwd_settings{dns}{max_timeout}.") for ".$DNS_Cache{$_}{name}." after ".$DNS_Cache{$_}{'delay'}." seconds"); -+ }; -+ }; -+ -+ # perform outstanding TXT queries unless --dns_async_txt is set -+ if (not($postfwd_settings{dns}{async_txt}) and @queries) { -+ @queries = uniq(@queries); -+ log_info ("[DNSBL] sending TXT queries for ".(join ',', @queries)) if wantsdebug (qw[ all debugdns ]); -+ foreach my $query (@queries) { -+ log_info ("[SENDDNS] sending TXT query \'$query\'") if wantsdebug (qw[ all ]); -+ # send TXT query -+ $bgsock = $ownres->bgsend($query, 'TXT'); -+ $ownsel->add($bgsock); -+ $ownsock{$bgsock} = 'TXT:'.$query; -+ }; -+ while ((scalar keys %ownsock) and (@ownready = $ownsel->can_read($postfwd_settings{dns}{timeout}))) { -+ foreach my $sock (@ownready) { -+ if (defined $ownsock{$sock}) { -+ log_info ("[DNSBL] answer for ".$ownsock{$sock}) -+ if wantsdebug (qw[ all ]); -+ my $packet = $ownres->bgread($sock); -+ rbl_read_dns ($packet); -+ delete $ownsock{$sock}; -+ } else { -+ $ownsel->remove($sock); -+ $sock = undef; -+ }; -+ }; -+ }; -+ }; -+ -+ # compare dns results -+ if ( ($myresult[0] > 0) and exists($Rules[$index]{$COMP_RBL_KEY}) ) { -+ $res = compare_item( -+ $COMP_RBL_KEY, -+ $Rules[$index]{$COMP_RBL_KEY}, -+ ($Rules[$index]{$COMP_RBL_CNT} ||= 1), -+ $request{reverse_address}, -+ %request -+ ); -+ $myresult[0] = ($res or ($Rules[$index]{$COMP_RBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; -+ $myresult[1] = ($res) ? $res : 0; -+ }; -+ -+ if ( $has_rhl and ($myresult[0] > 0) ) { -+ if ( exists($Rules[$index]{$COMP_RHSBL_KEY}) ) { -+ $res = compare_item( -+ $COMP_RHSBL_KEY, -+ $Rules[$index]{$COMP_RHSBL_KEY}, -+ ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), -+ $request{client_name}, -+ %request -+ ); -+ $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; -+ $myresult[2] += $res if $res; -+ }; -+ if ( exists($Rules[$index]{$COMP_RHSBL_KEY_CLIENT}) ) { -+ $res = compare_item( -+ $COMP_RHSBL_KEY_CLIENT, -+ $Rules[$index]{$COMP_RHSBL_KEY_CLIENT}, -+ ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), -+ $request{client_name}, -+ %request -+ ); -+ $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; -+ $myresult[2] += $res if $res; -+ }; -+ if ( exists($Rules[$index]{$COMP_RHSBL_KEY_SENDER}) ) { -+ $res = compare_item( -+ $COMP_RHSBL_KEY_SENDER, -+ $Rules[$index]{$COMP_RHSBL_KEY_SENDER}, -+ ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), -+ $request{sender_domain}, -+ %request -+ ); -+ $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; -+ $myresult[2] += $res if $res; -+ }; -+ if ( exists($Rules[$index]{$COMP_RHSBL_KEY_HELO}) ) { -+ $res = compare_item( -+ $COMP_RHSBL_KEY_HELO, -+ $Rules[$index]{$COMP_RHSBL_KEY_HELO}, -+ ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), -+ $request{helo_name}, -+ %request -+ ); -+ $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; -+ $myresult[2] += $res if $res; -+ }; -+ if ( exists($Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}) ) { -+ $res = compare_item( -+ $COMP_RHSBL_KEY_RCLIENT, -+ $Rules[$index]{$COMP_RHSBL_KEY_RCLIENT}, -+ ($Rules[$index]{$COMP_RHSBL_CNT} ||= 1), -+ $request{reverse_client_name}, -+ %request -+ ); -+ $myresult[0] = ($res or ($Rules[$index]{$COMP_RHSBL_CNT} eq 'all')) ? ($myresult[0] + $res) : 0; -+ $myresult[2] += $res if $res; -+ }; -+ }; -+ }; -+ if ( wantsdebug (qw[ all ]) ) { -+ $myline = "[RULES] RULE: ".$index." MATCHES: ".((($myresult[0] - 2) > 0) ? ($myresult[0] - 2) : 0); -+ $myline .= " RBLCOUNT: ".$myresult[1] if $myresult[1]; -+ $myline .= " RHSBLCOUNT: ".$myresult[2] if $myresult[2]; -+ $myline .= " DNSBLTEXT: ".(join ("; ", @DNSBL_Text)) if ( (defined @DNSBL_Text) and (($myresult[1] > 0) or ($myresult[2] > 0)) ); -+ log_info ($myline); -+ }; -+ return @myresult; -+}; -+ -+ -+### SUB access policy -+ -+# access policy routine -+sub smtpd_access_policy { -+ my($parent,%request) = @_; -+ my($myaction) = $postfwd_settings{default}; -+ my($index) = 1; -+ my($now) = time(); -+ my($date) = join(',', localtime($now)); -+ my($counters) = "request=1".$postfwd_settings{sepreq}."interval=1"; -+ my($matched,$rblcnt,$rhlcnt,$t1,$t2,$t3,$stop) = 0; -+ my($mykey,$cacheid,$myline,$checkreq,$var,$ratehit,$rulehits) = ""; -+ -+ # save original request -+ $request{orig} = hash_to_str (%request); -+ -+ # replace empty sender with <> -+ $request{sender} = '<>' unless ($request{sender}); -+ -+ # load postfwd_items attributes -+ if ( my(%postfwd_items_attr) = postfwd_items (%request) ) { -+ %request = (%request, %postfwd_items_attr); -+ }; -+ -+ # clear dnsbl timeout counters -+ if ( $Cleanup_Timeouts and ($postfwd_settings{dns}{max_interval} > 0) and (($now - $Cleanup_Timeouts) > $postfwd_settings{dns}{max_interval}) ) { -+ undef %Timeouts; -+ log_info ("[CLEANUP] clearing dnsbl timeout counters") if wantsdebug (qw[ all verbose ]); -+ $Cleanup_Timeouts = $now; -+ }; -+ -+ # wipe out old cache items -+ if ( $Cleanup_Rates and ($postfwd_settings{rate}{cleanup} > 0) and (scalar keys %Rate_Cache > 0) and (($now - $Cleanup_Rates) > $postfwd_settings{rate}{cleanup}) ) { -+ $t1 = time(); -+ $t3 = scalar keys %Rate_Cache; -+ cleanup_rate_cache($now); -+ $t2 = time(); -+ log_info ("[CLEANUP] needed ".($t2 - $t1) -+ ." seconds for rate cleanup of " -+ .($t3 - scalar keys %Rate_Cache)." out of ".$t3 -+ ." cached items after ".($now - $Cleanup_Rates) -+ ." seconds (min ".$postfwd_settings{rate}{cleanup}."s)") if ( wantsdebug (qw[ all verbose ]) or (($t2 - $t1) > 0) ); -+ $Cleanup_Rates = $t1; -+ }; -+ -+ # increase rate limits -+ RATES: foreach $checkreq (keys %request) { -+ next RATES unless ( $request{$checkreq} and (defined $Rate_Cache{$request{$checkreq}}) ); -+ if ( $now > $Rate_Cache{$request{$checkreq}}{'until'} ) { -+ # renew rate -+ $Rate_Cache{$request{$checkreq}}{count} = ( ($Rate_Cache{$request{$checkreq}}{type} eq 'size') ? $request{size} : -+ (($Rate_Cache{$request{$checkreq}}{type} eq 'rcpt') ? $request{recipient_count} : 1 ) ); -+ $Rate_Cache{$request{$checkreq}}{'until'} = $now + $Rate_Cache{$request{$checkreq}}{ttl}; -+ log_info ("[RATE] renewing rate object ".$request{$checkreq} -+ ." [type: ".$Rate_Cache{$request{$checkreq}}{type} -+ .", max: ".$Rate_Cache{$request{$checkreq}}{maxcount} -+ .", time: ".$Rate_Cache{$request{$checkreq}}{ttl}."s]") -+ if wantsdebug (qw[ all ]); -+ } else { -+ # increase rate -+ $Rate_Cache{$request{$checkreq}}{count} += ( ($Rate_Cache{$request{$checkreq}}{type} eq 'size') ? $request{size} : -+ (($Rate_Cache{$request{$checkreq}}{type} eq 'rcpt') ? $request{recipient_count} : 1 ) ); -+ log_info ("[RATE] increasing rate object ".$request{$checkreq} -+ ." to ".$Rate_Cache{$request{$checkreq}}{count} -+ ." [type: ".$Rate_Cache{$request{$checkreq}}{type} -+ .", max: ".$Rate_Cache{$request{$checkreq}}{maxcount} -+ .", time: ".$Rate_Cache{$request{$checkreq}}{ttl}."s]" -+ ) if wantsdebug (qw[ all ]); -+ $ratehit = $checkreq if ($Rate_Cache{$request{$checkreq}}{count} > $Rate_Cache{$request{$checkreq}}{maxcount}); -+ last RATES if $ratehit; -+ }; -+ }; -+ -+ # Request cache enabled? -+ if ( $postfwd_settings{request}{ttl} > 0 ) { -+ -+ # construct cache identifier -+ if ($postfwd_settings{cacheid}) { -+ map { $cacheid .= $request{$_}.';' if (defined $request{$_}) } @{$postfwd_settings{cacheid}}; -+ } else { -+ REQITEM: foreach $checkreq (sort keys %request) { -+ next REQITEM unless $request{$checkreq}; -+ next REQITEM if ( ($checkreq eq "instance") or ($checkreq eq "queue_id") or ($checkreq eq "orig")); -+ next REQITEM if ( $postfwd_settings{request}{no_size} and ($checkreq eq "size") ); -+ next REQITEM if ( $postfwd_settings{request}{no_sender} and ($checkreq eq "sender") ); -+ if ( $postfwd_settings{request}{rdomain_only} and ($checkreq eq "recipient") ) { -+ $cacheid .= $request{recipient_domain}.';'; -+ } else { -+ $cacheid .= $request{$checkreq}.';'; -+ }; -+ }; -+ }; -+ log_info ("created cache-id: $cacheid") if wantsdebug (qw[ all ]); -+ -+ # wipe out old cache entries -+ if ( $Cleanup_Requests and (scalar keys %Request_Cache > 0) and (($now - $Cleanup_Requests) > $postfwd_settings{request}{cleanup}) ) { -+ $t1 = time(); -+ $t3 = scalar keys %Request_Cache; -+ cleanup_request_cache($now); -+ $t2 = time(); -+ log_info ("[CLEANUP] needed ".($t2 - $t1) -+ ." seconds for request cleanup of " -+ .($t3 - scalar keys %Request_Cache)." out of ".$t3 -+ ." cached items after ".($now - $Cleanup_Requests) -+ ." seconds (min ".$postfwd_settings{request}{cleanup}."s)") if ( wantsdebug (qw[ all verbose ]) or (($t2 - $t1) > 0) ); -+ $Cleanup_Requests = $t1; -+ }; -+ }; -+ -+ # check rate -+ if ( $ratehit ) { -+ -+ $counters .= $postfwd_settings{sepreq}."rate=1"; -+ $Matches{$Rate_Cache{$request{$ratehit}}{rule}}++; -+ $myaction = $Rate_Cache{$request{$ratehit}}{action}; -+ log_info ("[RATE] rule=".$Rule_by_ID{$Rate_Cache{$request{$ratehit}}{rule}} -+ . ", id=".$Rate_Cache{$request{$ratehit}}{rule} -+ . ", client=".$request{client_name}."[".$request{client_address}."]" -+ . ", sender=<".(($request{sender} eq '<>') ? "" : $request{sender}).">" -+ . ", recipient=<".$request{recipient}.">" -+ . ", helo=<".$request{helo_name}.">" -+ . ", proto=".$request{protocol_name} -+ . ", state=".$request{protocol_state} -+ . ", delay=".(time() - $now)."s" -+ . ", action=".$myaction." (item: ".$request{$ratehit} -+ . ", type: ".$Rate_Cache{$request{$ratehit}}{type} -+ . ", count: ".$Rate_Cache{$request{$ratehit}}{count}."/".$Rate_Cache{$request{$ratehit}}{maxcount} -+ . ", ttl: ".$Rate_Cache{$request{$ratehit}}{ttl}."s" -+ ) unless $postfwd_settings{request}{nolog}; -+ -+ # check own cache -+ } elsif ( ($postfwd_settings{request}{ttl} > 0) -+ and ((exists($Request_Cache{$cacheid}{$COMP_ACTION})) and ($now <= $Request_Cache{$cacheid}{'until'})) ) { -+ $counters .= $postfwd_settings{sepreq}."ccache=1"; -+ $myaction = $Request_Cache{$cacheid}{$COMP_ACTION}; -+ if ( $Request_Cache{$cacheid}{hit} ) { -+ $Matches{$Request_Cache{$cacheid}{$COMP_ID}}++; -+ $rulehits = join $postfwd_settings{sepreq}, (split ';', $Request_Cache{$cacheid}{hits}) if $Request_Cache{$cacheid}{hits}; -+ log_info ("[CACHE] rule=".$Rule_by_ID{$Request_Cache{$cacheid}{$COMP_ID}} -+ . ", id=".$Request_Cache{$cacheid}{$COMP_ID} -+ . ", client=".$request{client_name}."[".$request{client_address}."]" -+ . ", sender=<".(($request{sender} eq '<>') ? "" : $request{sender}).">" -+ . ", recipient=<".$request{recipient}.">" -+ . ", helo=<".$request{helo_name}.">" -+ . ", proto=".$request{protocol_name} -+ . ", state=".$request{protocol_state} -+ . ", delay=".(time() - $now)."s" -+ . ", hits=".$Request_Cache{$cacheid}{hits} -+ . ", action=".$Request_Cache{$cacheid}{$COMP_ACTION} -+ ) unless $postfwd_settings{request}{nolog}; -+ }; -+ -+ # check parent cache -+ } elsif ( ($postfwd_settings{request}{ttl} > 0) -+ and not($postfwd_settings{request}{noparent}) -+ and not((my $pans = cache_query ("CMD=".$postfwd_commands{getcacheitem}.";TYPE=request;ITEM=$cacheid")) eq '') ) { -+ map { $Request_Cache{$cacheid}{$1} = $2 if m/$postfwd_patterns{keyval}/ } (split $postfwd_settings{sepreq}, $pans); -+ $counters .= $postfwd_settings{sepreq}."pcache=1"; -+ $myaction = $Request_Cache{$cacheid}{$COMP_ACTION}; -+ if ( $Request_Cache{$cacheid}{hit} ) { -+ $Matches{$Request_Cache{$cacheid}{$COMP_ID}}++; -+ $rulehits = join $postfwd_settings{sepreq}, (split ';', $Request_Cache{$cacheid}{hits}) if $Request_Cache{$cacheid}{hits}; -+ log_info ("[CACHE] rule=".$Rule_by_ID{$Request_Cache{$cacheid}{$COMP_ID}} -+ . ", id=".$Request_Cache{$cacheid}{$COMP_ID} -+ . ", client=".$request{client_name}."[".$request{client_address}."]" -+ . ", sender=<".(($request{sender} eq '<>') ? "" : $request{sender}).">" -+ . ", recipient=<".$request{recipient}.">" -+ . ", helo=<".$request{helo_name}.">" -+ . ", proto=".$request{protocol_name} -+ . ", state=".$request{protocol_state} -+ . ", delay=".(time() - $now)."s" -+ . ", hits=".$Request_Cache{$cacheid}{hits} -+ . ", action=".$Request_Cache{$cacheid}{$COMP_ACTION} -+ ) unless $postfwd_settings{request}{nolog}; -+ }; -+ -+ # check rules -+ } else { -+ -+ # refresh config if '-I' was set -+ read_config(0) if $postfwd_settings{instant}; -+ -+ if ($#Rules < 0) { -+ log_note("critical: no rules found - i feel useless (have you set -f or -r?)"); -+ -+ } else { -+ -+ # clean up rbl cache -+ if ( not($postfwd_settings{dns}{disabled}) and (scalar keys %DNS_Cache > 0) and (($now - $Cleanup_RBLs) > $postfwd_settings{dns}{cleanup}) ) { -+ $t1 = time(); -+ $t3 = scalar keys %DNS_Cache; -+ cleanup_dns_cache($now); -+ $t2 = time(); -+ log_info ("[CLEANUP] needed ".($t2 - $t1) -+ ." seconds for rbl cleanup of " -+ .($t3 - scalar keys %DNS_Cache)." out of ".$t3 -+ ." cached items after ".($now - $Cleanup_RBLs) -+ ." seconds (min ".$postfwd_settings{dns}{cleanup}."s)") if ( wantsdebug (qw[ all verbose ]) or (($t2 - $t1) > 0) ); -+ $Cleanup_RBLs = $t1; -+ }; -+ -+ # prepares hit counters -+ $request{$COMP_MATCHES} = 0; -+ $request{$COMP_RBL_CNT} = 0; -+ $request{$COMP_RHSBL_CNT} = 0; -+ -+ RULE: for ($index=0;$index<=$#Rules;$index++) { -+ -+ # compare request against rule -+ next unless exists $Rules[$index]; -+ ($matched,$rblcnt,$rhlcnt,my $compcnt) = compare_rule ($index, $date, %request); -+ -+ # enables/overrides hit counters for later use -+ $request{$COMP_MATCHES} = $matched; -+ $request{$COMP_RBL_CNT} = $rblcnt; -+ $request{$COMP_RHSBL_CNT} = $rhlcnt; -+ $counters .= $postfwd_settings{sepreq}.$compcnt if $compcnt; -+ -+ # matched? prepare logline, increase counters -+ if ($matched > 0) { -+ $myaction = $Rules[$index]{$COMP_ACTION}; -+ $Matches{$Rules[$index]{$COMP_ID}}++; -+ $rulehits .= $postfwd_settings{sepreq} if $rulehits; -+ $rulehits .= $Rules[$index]{$COMP_ID}; -+ $request{$COMP_HITS} .= ';' if (defined $request{$COMP_HITS}); -+ $request{$COMP_HITS} .= $Rules[$index]{$COMP_ID}; -+ # substitute check for $$vars in action -+ $myaction = $var if ( $var = devar_item ("==",$myaction,"action",%request) ); -+ $myline = "rule=".$index -+ . ", id=".$Rules[$index]{$COMP_ID} -+ . ", client=".$request{client_name}."[".$request{client_address}."]" -+ . ", sender=<".(($request{sender} eq '<>') ? "" : $request{sender}).">" -+ . ", recipient=<".$request{recipient}.">" -+ . ", helo=<".$request{helo_name}.">" -+ . ", proto=".$request{protocol_name} -+ . ", state=".$request{protocol_state}; -+ -+ # check for postfwd action -+ if ($myaction =~ /^(\w[\-\w]+)\s*\(\s*(.*?)\s*\)$/) { -+ my($mycmd,$myarg) = ($1, $2); -+ if (defined $postfwd_actions{$mycmd}) { -+ log_info ("[PLUGIN] executing postfwd-action $mycmd") if wantsdebug (qw[ all ]); -+ ($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 { -+ log_warn ("[RULES] ".$myline." - error: unknown command \"".$1."\" - ignoring"); -+ $myaction = $postfwd_settings{default}; -+ }; -+ # normal rule. returns $action. -+ } else { $stop = 1; }; -+ if ($stop) { -+ $myline .= ", delay=".(time() - $now)."s, hits=".$request{$COMP_HITS}.", action=".$myaction; -+ log_info ("[RULES] ".$myline) unless $postfwd_settings{request}{nolog}; -+ $counters .= $postfwd_settings{sepreq}."ruleset=1"; -+ # update cache -+ if ( $postfwd_settings{request}{ttl} > 0 ) { -+ $Request_Cache{$cacheid}{ttl} = ($Rules[$index]{$COMP_CACHE} || $postfwd_settings{request}{ttl}); -+ $Request_Cache{$cacheid}{'until'} = $now + $Request_Cache{$cacheid}{ttl}; -+ $Request_Cache{$cacheid}{$COMP_ACTION} = $myaction; -+ $Request_Cache{$cacheid}{$COMP_ID} = $Rules[$index]{$COMP_ID}; -+ $Request_Cache{$cacheid}{hit} = $matched; -+ $Request_Cache{$cacheid}{hits} = $request{$COMP_HITS}; -+ cache_query ("CMD=".$postfwd_commands{setcacheitem}.";TYPE=request;ITEM=$cacheid".hash_to_str(%{$Request_Cache{$cacheid}})) -+ unless ($postfwd_settings{request}{noparent}); -+ }; -+ last RULE; -+ }; -+ } else { undef $myline; }; -+ }; -+ }; -+ }; -+ # increase counters and return action -+ if ($postfwd_settings{summary} and defined $parent) { -+ print $parent "CMD=".$postfwd_commands{countcache}.";TYPE=$counters" -+ .(($rulehits) ? $postfwd_settings{seplst}."CMD=".$postfwd_commands{matchcache}.";TYPE=$rulehits" : "") -+ ."\n"; $parent->getline(); -+ }; -+ $myaction = $postfwd_settings{default} if ($postfwd_settings{test} or !($myaction)); -+ map { &{$postfwd_settings{syslog}{logger}} ('info', " %$_") } hash_to_list ('Request_Cache', %Request_Cache) if wantsdebug (qw[ child_cache child_request_cache ]); -+ map { &{$postfwd_settings{syslog}{logger}} ('info', " %$_") } hash_to_list ('Rate_Cache', %Rate_Cache) if wantsdebug (qw[ child_cache child_rate_cache ]); -+ map { &{$postfwd_settings{syslog}{logger}} ('info', " %$_") } hash_to_list ('DNS_Cache', %DNS_Cache) if wantsdebug (qw[ child_cache child_dns_cache ]); -+ return $myaction; -+}; -+ -+ -+## Net::Server::PreFork methods -+ -+# ignore syslog failures -+sub handle_syslog_error {}; -+ -+# reload config on HUP signal -+sub sig_hup { -+ my $self = shift; -+ log_note ("catched HUP signal - reloading ruleset on next request"); -+ read_config(1); -+ map { kill ("HUP", $_) } (keys %{$self->{server}->{children}}); -+}; -+ -+# parent start -+sub pre_loop_hook { -+ my $self = shift; -+ # change parent's name -+ $0 = $self->{server}->{commandline} = " ".$postfwd_settings{name}.'::policy'; -+ $self->{server}->{syslog_ident} = $postfwd_settings{name}."/policy"; -+ $StartTime = $Summary = $Cleanup_Timeouts = $Cleanup_Requests = $Cleanup_RBLs = $Cleanup_Rates = time(); -+ init_log ($self->{server}->{syslog_ident}); -+ read_config(1); -+ log_info ("ready for input"); -+}; -+ -+# increase counters -+sub count_cache { map { $Count{$1} += $2 if m/$postfwd_patterns{cntval}/ } (split ($postfwd_settings{sepreq}, $_[1])) if $_[1] }; -+ -+# increase matches -+sub match_cache { map { $Hits{$_}++ } (split ($postfwd_settings{sepreq}, $_[1])) if $_[1] }; -+ -+# program usage statistics -+sub list_stats { -+ my $now = time(); -+ my $uptime = $now - $StartTime; -+ my @output =(); -+ return @output unless $uptime and $Count{request}; -+ -+ # averages, hitrates and counters -+ map { $Count{$_} ||= 0 } qw(ruleset interval top rate pcache ccache dnsqueries dnstimeouts dnsinterval dnstop); -+ my $lastreq = (($now - $Summary) > 0) ? $Count{interval} / ($now - $Summary) * 60 : 0; -+ my $lastdns = (($now - $Summary) > 0) ? $Count{dnsinterval} / ($now - $Summary) * 60 : 0; -+ $Count{top} = $lastreq if $lastreq > $Count{top}; -+ $Count{dnstop} = $lastdns if $lastdns > $Count{dnstop}; -+ my $dnstimeoutrate = ($Count{dnsqueries}) ? $Count{dnstimeouts} / $Count{dnsqueries} * 100 : 0; -+ -+ # log program statistics -+ if ( not($postfwd_settings{syslog}{noidlestats}) or ($Count{interval} > 0) ) { -+ push ( @output, sprintf ( -+ "[STATS] %s::policy %s: %d requests since %d days, %02d:%02d:%02d hours", -+ $postfwd_settings{name}, -+ $postfwd_settings{version}, -+ $Count{request}, -+ ($uptime / 60 / 60 / 24), -+ (($uptime / 60 / 60) % 24), -+ (($uptime / 60) % 60), -+ ($uptime % 60) -+ ) ); -+ -+ push ( @output, sprintf ( -+ "[STATS] Requests: %.2f/min last, %.2f/min overall, %.2f/min top", -+ $lastreq, -+ ($uptime) ? $Count{request} / $uptime * 60 : 0, -+ $Count{top} -+ ) ); -+ -+ push ( @output, sprintf ( -+ "[STATS] Dnsstats: %.2f/min last, %.2f/min overall, %.2f/min top", -+ $lastdns, -+ ($uptime) ? $Count{dnsqueries} / $uptime * 60 : 0, -+ $Count{dnstop} -+ ) ) unless ($postfwd_settings{dns}{disable}); -+ -+ push ( @output, sprintf ( -+ "[STATS] Hitrates: %.1f%% ruleset, %.1f%% parent, %.1f%% child, %.1f%% rates", -+ ($Count{request}) ? $Count{ruleset} / $Count{request} * 100 : 0, -+ ($Count{request}) ? $Count{pcache} / $Count{request} * 100 : 0, -+ ($Count{request}) ? $Count{ccache} / $Count{request} * 100 : 0, -+ ($Count{request}) ? $Count{rate} / $Count{request} * 100 : 0 -+ ) ); -+ -+ push ( @output, sprintf ( -+ "[STATS] Timeouts: %.1f%% (%d of %d dns queries)", -+ $dnstimeoutrate, -+ $Count{dnstimeouts}, -+ $Count{dnsqueries} -+ ) ) unless ($postfwd_settings{dns}{disable}); -+ -+ # per rule stats -+ if (%Hits and not($postfwd_settings{syslog}{norulestats})) { -+ my @rulecharts = (sort { $Hits{$b} <=> $Hits{$a} } (keys %Hits)); my $cntln = length($Hits{$rulecharts[0]}) + 2; -+ map { push ( @output, sprintf ("[STATS] %".$cntln."d matches for id: %s", $Hits{$_}, $_)) } @rulecharts; -+ }; -+ }; -+ -+ $Count{interval} = $Count{dnsinterval} = 0; -+ $Summary = $now; -+ return @output; -+}; -+ -+# parent processes child input -+sub child_is_talking_hook { -+ my($self,$sock) = @_; -+ my $answer = "\n"; -+ my $msg = $sock->getline(); -+ # during tests it turned out that children -+ # send empty messages in some situations -+ if (defined $msg) { -+ log_info ("child said '$msg'") if wantsdebug (qw[ all ]); -+ if ($msg =~ m/$postfwd_patterns{command}/) { -+ foreach (split $postfwd_settings{seplst}, $msg) { -+ if (m/$postfwd_patterns{countcache}/) { -+ $self->count_cache($1); -+ } elsif (m/$postfwd_patterns{matchcache}/) { -+ $self->match_cache($1); -+ } elsif (m/$postfwd_patterns{dumpstats}/) { -+ $answer = (join $postfwd_settings{sepreq}.$postfwd_settings{seplst}, list_stats())."\n"; -+ } else { -+ log_note ("warning: child sent unknown command '$_'"); -+ }; -+ }; -+ } else { -+ log_note ("warning: child sent unknown message '$msg'"); -+ }; -+ }; -+ print $sock "$answer"; -+}; -+ -+# child start -+sub child_init_hook { -+ my $self = shift; -+ # change children's names -+ $0 = $self->{server}->{commandline} = " ".$postfwd_settings{name}.'::policy::child'; -+ log_info ("ready for input") if wantsdebug (qw[ all verbose ]); -+}; -+ -+# child process request -+sub process_request { -+ my($self) = shift; -+ my($client) = $self->{server}->{client}; -+ my($parent) = $self->{server}->{parent_sock}; -+ my(%attr) = (); -+ while () { -+ s/\r?\n$//; -+ # respond to masters ping -+ if ($_ eq $postfwd_patterns{ping}) { -+ $client->print("$postfwd_patterns{pong}\n"); -+ } elsif (m/$postfwd_patterns{dumpstats}/) { -+ $parent->print("$_\n"); -+ $client->print($parent->getline()."\n"); -+ # process input -+ } else { -+ process_input ($parent, $client, $_, \%attr); -+ }; -+ }; -+}; -+ -+# process delegation protocol input -+sub process_input { -+ my($parent,$client,$msg,$attr) = @_; -+ # remember argument=value -+ if ( $msg =~ /^([^=]{1,512})=(.{0,512})/ ) { -+ $$attr{$1} = $2; -+ # evaluate request -+ } elsif ( $msg eq '' ) { -+ map { log_info ("Attribute: $_=$$attr{$_}") } (keys %$attr) if wantsdebug (qw[ all request ]); -+ unless ( (defined $$attr{request}) and ($$attr{request} eq "smtpd_access_policy") ) { -+ log_note ("Ignoring unrecognized request type: '".((defined $$attr{request}) ? substr($$attr{request},0,100) : '')."'"); -+ } else { -+ my $action = smtpd_access_policy($parent, %$attr) || $postfwd_settings{default}; -+ log_info ("Action: $action") if wantsdebug (qw[ all verbose ]); -+ if ($client) { -+ print $client ("action=$action\n\n"); -+ } else { -+ print STDOUT ("action=$action\n\n"); -+ }; -+ %$attr = (); -+ }; -+ # unknown command -+ } else { -+ log_note ("Ignoring garbage '".substr($msg, 0, 100)."'"); -+ }; -+}; -+ -+1; # EOF postfwd2::server -+ -+ -+use warnings; -+use strict; -+use Getopt::Long 2.25 qw(:config no_ignore_case bundling); -+use Pod::Usage; -+# master daemon -+use Net::Server::Daemonize qw(daemonize); -+# own modules -+# program settings, syslogging -+import postfwd2::basic qw(:DEFAULT %postfwd_commands &check_inet &check_unix &wantsdebug &hash_to_list); -+# cache daemon (requests, dns, limits), Net::Server::Multiplex -+import postfwd2::cache qw(); -+# policy daemon, Net::Server::PreFork -+import postfwd2::server qw(&read_config &show_config &process_input); -+ -+# functions to start, override with '--daemons' at command line -+my @daemons = qw[ cache server ]; -+ -+use vars qw( -+ %options %children %failures -+); -+ -+# parse command-line -+GetOptions( \%options, -+ # Ruleset -+ 'rule|r=s' => sub{ my($opt,$value) = @_; push (@{$postfwd_settings{Configs}}, $opt.$postfwd_settings{sepreq}.$value) }, -+ 'file|f=s' => sub{ my($opt,$value) = @_; push (@{$postfwd_settings{Configs}}, $opt.$postfwd_settings{sepreq}.$value) }, -+ 'scores|score|s=s%' => \%{$postfwd_settings{scores}}, -+ "test|t" => \$postfwd_settings{test}, -+ "instantcfg|I" => \$postfwd_settings{instant}, -+ "config_timeout=i" => \$postfwd_settings{timeout}{config}, -+ "showconfig|C", -+ "defaults|settings|D", -+ # Networking -+ "user|u=s" => \$postfwd_settings{base}{user}, -+ "group|g=s" => \$postfwd_settings{base}{group}, -+ "server_socket|socket=s" => sub{ ($postfwd_settings{server}{proto}, $postfwd_settings{server}{host}, $postfwd_settings{server}{port}) = (split ':', $_[1]) }, -+ "interface|i=s" => \$postfwd_settings{server}{host}, -+ "port|p=s" => \$postfwd_settings{server}{port}, -+ "proto=s" => \$postfwd_settings{server}{proto}, -+ "min_servers=i" => \$postfwd_settings{server}{min_servers}, -+ "max_servers=i" => \$postfwd_settings{server}{max_servers}, -+ "min_spare_servers=i" => \$postfwd_settings{server}{min_spare_servers}, -+ "max_spare_servers=i" => \$postfwd_settings{server}{max_spare_servers}, -+ "nodns|n" => \$postfwd_settings{dns}{disabled}, -+ "dns_timeout=i" => \$postfwd_settings{dns}{timeout}, -+ "dns_async_txt" => \$postfwd_settings{dns}{async_txt}, -+ "dns_timeout_max=i" => \$postfwd_settings{dns}{max_timeout}, -+ "dns_timeout_interval=i" => \$postfwd_settings{dns}{max_interval}, -+ "dns_max_ns_lookups=i" => \$postfwd_settings{dns}{max_ns_lookups}, -+ "dns_max_mx_lookups=i" => \$postfwd_settings{dns}{max_mx_lookups}, -+ "cache-rbl-timeout=i" => \$postfwd_settings{dns}{ttl}, -+ "cache-rbl-default=s" => \$postfwd_settings{dns}{mask}, -+ "cleanup-rbls=i" => \$postfwd_settings{dns}{cleanup}, -+ "no_parent_dns_cache" => \$postfwd_settings{dns}{noparent}, -+ "parent_dns_cache" => sub { $postfwd_settings{dns}{noparent} = 0 }, -+ # Stats -+ "summary|stats|S=i" => \$postfwd_settings{summary}, -+ "norulestats" => \$postfwd_settings{syslog}{norulestats}, -+ "no-rulestats" => \$postfwd_settings{syslog}{norulestats}, -+ "noidlestats" => \$postfwd_settings{syslog}{noidlestats}, -+ "no-idlestats" => \$postfwd_settings{syslog}{noidlestats}, -+ "stdoutlog|stdout|L" => \$postfwd_settings{syslog}{stdout}, -+ # Cache -+ "cache_socket=s" => sub{ ($postfwd_settings{cache}{proto}, $postfwd_settings{cache}{host}, $postfwd_settings{cache}{port}) = (split ':', $_[1]) }, -+ "cache_interface=s" => \$postfwd_settings{cache}{host}, -+ "cache_port=s" => \$postfwd_settings{cache}{port}, -+ "cache_proto=s" => \$postfwd_settings{cache}{proto}, -+ "cache|c=i" => \$postfwd_settings{request}{ttl}, -+ "cacheid=s" => sub { push @{$postfwd_settings{cacheid}}, (split /[,\s]+/, $_[1]) }, -+ "cache-rdomain-only" => \$postfwd_settings{request}{rdomain_only}, -+ "cache-no-sender" => \$postfwd_settings{request}{no_sender}, -+ "cache-no-size" => \$postfwd_settings{request}{no_size}, -+ "cleanup-requests=i" => \$postfwd_settings{request}{cleanup}, -+ "no_parent_request_cache" => \$postfwd_settings{request}{noparent}, -+ "no_parent_rate_cache" => \$postfwd_settings{rate}{noparent}, -+ "no_parent_cache" => sub{ $postfwd_settings{request}{noparent} = $postfwd_settings{rate}{noparent} = $postfwd_settings{dns}{noparent} = 1 }, -+ # Limits -+ "cleanup-rates=i" => \$postfwd_settings{rate}{cleanup}, -+ # Control -+ 'version|V' => sub{ print "$postfwd_settings{name} $postfwd_settings{version} (Net::DNS ".(Net::DNS->VERSION || '').", Net::Server ".(Net::Server->VERSION || '').", Sys::Syslog ".($Sys::Syslog::VERSION || '').", Perl ".$]." on ".$^O.")\n"; exit 1; }, -+ 'manual|m' => sub{ # contructing command string (de-tainting $0) -+ $postfwd_settings{manual} .= ($0 =~ /^([-\@\/\w. ]+)$/) ? " \"".$1 : " \"".$postfwd_settings{name}; -+ $postfwd_settings{manual} .= "\" | ".$postfwd_settings{pager}; -+ system ($postfwd_settings{manual}); exit 1; }, -+ "term|kill|stop|k", -+ "hup|reload", -+ "dumpcache", -+ "dumpstats", -+ "pid|pidfile|pid_file=s" => \$postfwd_settings{master}{pid_file}, -+ "watchdog=i" => \$postfwd_settings{master}{watchdog}, -+ "respawn=i" => \$postfwd_settings{master}{respawn}, -+ "failures=i" => \$postfwd_settings{master}{failures}, -+ "daemon|d!" => \$postfwd_settings{daemon}, -+ "daemons=s" => sub { push @{$options{daemons}}, (split /[,\s]+/, $_[1]) }, -+ # Logging -+ "debug=s" => sub { push @{$options{debug}}, (split /[,\s]+/, $_[1]) }, -+ "verbose|v+" => \$postfwd_settings{verbose}, -+ "logname|l=s" => sub{ $postfwd_settings{name} = $_[1]; -+ $postfwd_settings{cache}{syslog_ident} = $_[1].'/cache'; -+ $postfwd_settings{server}{syslog_ident} = $_[1].'/policy'; }, -+ "facility=s" => \$postfwd_settings{base}{syslog_facility}, -+ "nodnslog" => \$postfwd_settings{dns}{nolog}, -+ "no-dnslog" => \$postfwd_settings{dns}{nolog}, -+ "anydnslog" => \$postfwd_settings{dns}{anylog}, -+ "norulelog" => \$postfwd_settings{request}{nolog}, -+ "no-rulelog" => \$postfwd_settings{request}{nolog}, -+ "perfmon|P" => \$postfwd_settings{syslog}{nolog}, -+ # Unused -+ "start", -+ "chroot|R=s", -+ "shortlog", -+ "dns_queuesize=i", -+ "dns_retries=i", -+) or pod2usage (-msg => "\nPlease see \"".$postfwd_settings{name}." -m\" for detailed instructions.\n", -verbose => 1); -+ -+map { $postfwd_settings{syslog}{stdout} = 1 if defined $options{$_} } qw(term hup showconfig dumpcache dumpstats defaults); -+ -+# basic syntax checks -+if ($postfwd_settings{verbose} > 1) { -+ $postfwd_settings{debug}{all} = 1; -+} elsif ($postfwd_settings{verbose}) { -+ $postfwd_settings{debug}{verbose} = 1; -+}; -+map { $postfwd_settings{debug}{$_} = 1 } uniq(@{$options{debug}}); -+map { $postfwd_settings{daemons}{$_} = 1 } ((defined $options{daemons}) ? uniq(@{$options{daemons}}) : uniq(@daemons)); -+map { $postfwd_settings{$_}{check} = ($postfwd_settings{$_}{proto} eq 'unix') ? \&check_unix : \&check_inet } @daemons; -+ -+# terminate at -k or --kill -+if (defined $options{'term'}) { -+ kill "TERM", get_master_pid(); -+ exit (0); -+# reload at --reload -+} elsif (defined $options{'hup'}) { -+ kill "HUP", get_master_pid(); -+ exit (0); -+}; -+ -+# init_log -+init_log ($postfwd_settings{name}."/master"); -+ -+# read and display configuration -+if (defined $options{'showconfig'}) { -+ read_config(1); -+ show_config(); -+ exit 1; -+}; -+ -+# show program settings -+if (defined $options{'defaults'}) { -+ print "\n"; map { print " %$_\n" } hash_to_list ('postfwd_settings', %postfwd_settings); -+ if (wantsdebug (qw[ all verbose ])) { -+ map { print " %$_\n" } hash_to_list ('postfwd_commands', %postfwd_commands); -+ map { print " %$_\n" } hash_to_list ('postfwd_patterns', %postfwd_patterns); -+ }; -+ print "\n"; exit 1; -+}; -+ -+# dump stats -+if (defined $options{'dumpstats'}) { -+ foreach my $daemon (sort keys %{$postfwd_settings{daemons}}) { -+ print "\n"; -+ map { print ("$_\n") } get_stats ($daemon); -+ }; -+ print "\n"; -+ exit 1; -+}; -+ -+# dump cache contents -+if (defined $options{'dumpcache'}) { -+ print "\n".( join "\n", -+ split $postfwd_settings{sepreq}.$postfwd_settings{seplst}, -+ (&{$postfwd_settings{cache}{check}} ('cache', 'CMD=DC;') || '') -+ )."\n\n"; -+ exit 1; -+}; -+ -+# de-taint command-line -+%postfwd_settings = detaint_hash (%postfwd_settings); -+ -+# check for --nodaemon option -+unless ($postfwd_settings{daemon}) { -+ my(%attr) = (); -+ read_config(1); -+ map { $postfwd_settings{daemons}{$_} = 0 } (keys %{$postfwd_settings{daemons}}); -+ $postfwd_settings{request}{noparent} = $postfwd_settings{rate}{noparent} = $postfwd_settings{dns}{noparent} = 1; -+ while (<>) { -+ chomp; -+ process_input (undef, undef, $_, \%attr); -+ }; -+ exit; -+}; -+ -+# daemonize master -+my $arg0 = $0; my $argv = join (' ', @ARGV); -+log_info ($postfwd_settings{name}." " -+ .$postfwd_settings{version}." starting" -+ .((scalar keys %{$postfwd_settings{debug}}) ? " with debug levels: ".(join ',', keys %{$postfwd_settings{debug}}) : '')); -+log_info ("Net::DNS ".(Net::DNS->VERSION || '').", Net::Server ".(Net::Server->VERSION || '').", Sys::Syslog ".($Sys::Syslog::VERSION || '').", Perl ".$]." on ".$^O) if wantsdebug (qw[ all verbose ]); -+daemonize($postfwd_settings{base}{user}, $postfwd_settings{base}{group}, $postfwd_settings{master}{pid_file}); -+$0 = $arg0." ".$argv; -+ -+# prepare shared SIG handlers -+$SIG{__WARN__} = sub { log_warn("warning: $_[0]") }; -+$SIG{__DIE__} = sub { log_crit("FATAL: $_[0]"); die @_; }; -+ -+# fork daemons: cache and server -+foreach my $daemon (sort keys %{$postfwd_settings{daemons}}) { -+ if (my $pid = spawn_daemon ($daemon)) { -+ log_info ("Started $daemon at pid $pid"); -+ $children{$daemon} = $pid; -+ }; -+}; -+ -+# prepare master SIG handlers and enter main loop -+$SIG{TERM} = sub { end_program(); }; -+$SIG{HUP} = sub { reload_program(); }; -+if ($postfwd_settings{summary}) { -+ $SIG{ALRM} = sub { -+ log_stats(); -+ alarm ($postfwd_settings{summary}) -+ }; -+ alarm ($postfwd_settings{summary}); -+}; -+ -+while (1) { -+ # check daemons every seconds -+ if ($postfwd_settings{master}{watchdog}) { -+ sleep ($postfwd_settings{master}{watchdog}); -+ foreach my $daemon (sort keys %{$postfwd_settings{daemons}}) { -+ if (check_daemon ($daemon)) { -+ $failures{$daemon} = 0; -+ } else { -+ if (++$failures{$daemon} >= $postfwd_settings{master}{failures}) { -+ # terminate program -+ log_crit ("$daemon-daemon check failed $failures{$daemon} times - terminating program"); -+ end_program(); -+ } else { -+ # restart daemon -+ log_crit ("$daemon-daemon check failed $failures{$daemon} times - respawning in ".$postfwd_settings{master}{respawn}." seconds"); -+ kill 15, $children{$daemon}; sleep $postfwd_settings{master}{respawn}; -+ if (my $pid = spawn_daemon ($daemon)) { -+ log_info ("Started $daemon at pid $pid"); -+ $children{$daemon} = $pid; -+ }; -+ }; -+ }; -+ }; -+ # no watchdog -> sleep until signal -+ } else { -+ sleep; -+ }; -+}; -+die "master-daemon: should never see me!\n"; -+ -+ -+## SUBS -+ -+# cleanup children and files and terminate -+sub end_program { -+ local $SIG{TERM} = 'IGNORE'; -+ if ($postfwd_settings{summary}) { -+ undef $postfwd_settings{syslog}{noidlestats}; -+ log_stats(); -+ }; -+ log_note ($postfwd_settings{name}." ".$postfwd_settings{version}." terminating..."); -+ unlink $postfwd_settings{master}{pid_file} if (-T $postfwd_settings{master}{pid_file}); -+ # negative signal no. kills the whole process group -+ kill -15, $$; -+ exit (0); -+}; -+ -+# send hup to child processes -+sub reload_program { -+ log_note ($postfwd_settings{name}." ".$postfwd_settings{version}." reloading..."); -+ map { kill 1, $_ } (values %children) if %children; -+}; -+ -+# check a cache or server daemon -+sub check_daemon { return ((&{$postfwd_settings{$_[0]}{check}}($_[0],$postfwd_patterns{ping}) || '') eq $postfwd_patterns{pong}) }; -+ -+# spawn a cache or server daemon -+sub spawn_daemon { -+ my ($type) = @_; -+ my $pid = fork(); -+ die "Can not fork $type: $!\n" unless defined $pid; -+ if ($pid == 0) { -+ my %service = %{$postfwd_settings{$type}}; -+ # Net::Server dies when a unix domain socket without dot "." is used -+ $service{port} .= '|unix' if (($service{proto} eq 'unix') and not($service{port} =~ /\|unix$/)); -+ my %daemonopts = (%{$postfwd_settings{base}}, %service); -+ my $daemon = bless { server => { %daemonopts } }, "postfwd2::$type"; -+ $daemon->run(); -+ die "$type-daemon: should never see me!\n"; -+ }; -+ return $pid; -+}; -+ -+# get pid of running master process -+sub get_master_pid { -+ (-e $postfwd_settings{master}{pid_file}) or die $postfwd_settings{name}.": Can not find pid_file ".$postfwd_settings{master}{pid_file}.": $!\n"; -+ (-T $postfwd_settings{master}{pid_file}) or die $postfwd_settings{name}.": Can not open pid_file ".$postfwd_settings{master}{pid_file}.": not a textfile\n"; -+ open PIDFILE, "<".$postfwd_settings{master}{pid_file} or die $postfwd_settings{name}.": Can open pid_file ".$postfwd_settings{master}{pid_file}.": $!\n"; -+ my $pid = ; -+ ($pid =~ m/^(\d+)$/) or die $postfwd_settings{name}.": Invalid pid_file content '$pid' (pid_file ".$postfwd_settings{master}{pid_file}.")\n"; -+ return $1; -+}; -+ -+# detaints postfwd2 settings -+sub detaint_hash { -+ my (%request) = @_; -+ # cycle through key=value pairs -+ while ( my($s, $v) = each %request ) { -+ my $r = ref $v; -+ # type hash: recursively call ourself -+ if ($r eq 'HASH') { -+ %{$v} = detaint_hash ( %{$v} ); -+ # type array: detaint whole list -+ } elsif ($r eq 'ARRAY') { -+ @{$request{$s}} = map { $_ = (($_ =~ m/^(.*)$/) ? $1 : $_ ) if $_ } @{$v}; -+ # type scalar: detaint argument -+ } elsif ($r eq '') { -+ $request{$s} = (($v =~ m/^(.*)$/) ? $1 : $v) if ($s and $v); -+ }; -+ }; -+ return %request; -+}; -+ -+# send stats to syslog -+sub log_stats { map { &{$postfwd_settings{syslog}{logger}} ('notice', "$_") unless ($_ eq '') } get_stats(sort keys %{$postfwd_settings{daemons}}); }; -+ -+# retrieve status from children -+sub get_stats { -+ my @daemons = @_; my @output = (); -+ map { push @output, (split $postfwd_settings{sepreq}.$postfwd_settings{seplst}, (&{$postfwd_settings{$_}{check}} ($_, 'CMD=DS;') || '')) } @daemons; -+ return @output; -+}; -+ -+# EOF postfwd2 -+ -+__END__ -+ -+=head1 NAME -+ -+postfwd2 - postfix firewall daemon -+ -+=head1 SYNOPSIS -+ -+B [OPTIONS] [SOURCE1, SOURCE2, ...] -+ -+ Ruleset: (at least one, multiple use is allowed): -+ -f, --file reads rules from -+ -r, --rule adds to config -+ -s, --scores = returns when score exceeds -+ -+ Server: -+ -i, --interface listen on interface -+ -p, --port listen on port -+ --proto socket type (tcp or unix) -+ --server_socket e.g. tcp:127.0.0.1:10045 -+ -u, --user set uid to user -+ -g, --group set gid to group -+ --pidfile create pidfile under -+ --min_servers spawn at least children -+ --max_servers do not spawn more than children -+ --min_spare_servers minimum idle children -+ --max_spare_servers maximum idle children -+ -+ Cache: -+ -c, --cache sets the request-cache timeout to seconds -+ --cleanup-requests cleanup interval in seconds for request cache -+ --cache_interface listen on interface -+ --cache_port listen on port -+ --cache_proto socket type (tcp or unix) -+ --cache_socket e.g. tcp:127.0.0.1:10043 -+ --cacheid list of request items for cache-id -+ --cache-rdomain-only skip recipient localpart for cache-id -+ --cache-no-sender skip sender address for cache-id -+ --cache-no-size skip size for cache-id -+ --no_parent_request_cache disable parent request cache -+ --no_parent_rate_cache disable parent rate cache -+ --no_parent_dns_cache disable parent dns cache -+ --no_parent_cache disable all parent caches -+ -+ Rates: -+ --cleanup-rates cleanup interval in seconds for rate cache -+ -+ Control: -+ -k, --kill, --stop terminate postfwd2 -+ --reload, --hup reload postfwd2 -+ --watchdog watchdog timer in seconds -+ --respawn respawn delay in seconds -+ --failures max respawn failure counter -+ --daemons list of daemons to start -+ --dumpcache show cache contents -+ --dumpstats show statistics -+ -+ DNS: -+ -n, --nodns skip any dns based test -+ --dns_timeout dns query timeout in seconds -+ --dns_timeout_max disable dnsbl after timeouts -+ --dns_timeout_interval reenable dnsbl after seconds -+ --cache-rbl-timeout default dns ttl if not specified in ruleset -+ --cache-rbl-default default dns pattern if not specified in ruleset -+ --cleanup-rbls cleanup old dns cache items every seconds -+ --dns_async_txt perform dnsbl A and TXT lookups simultaneously -+ --dns_max_ns_lookups max names to look up with sender_ns_addrs -+ --dns_max_mx_lookups max names to look up with sender_mx_addrs -+ -+ Optional: -+ -t, --test testing, always returns "dunno" -+ -S, --summary show stats every seconds -+ --noidlestats disables statistics when idle -+ --norulestats disables per rule statistics -+ -I, --instantcfg reloads ruleset on every new request -+ --config_timeout parser timeout in seconds -+ -+ Logging: -+ -l, --logname