use DBI;
use Config::General;
use Sys::Syslog qw(:DEFAULT setlogsock);
+use File::Basename;
+use Getopt::Long;
+use Pod::Usage;
+use Carp qw(cluck);
-#
-# Usage: greylist.pl
-#
-# Delegated Postfix SMTPD policy server. This server implements
-# greylisting. State is kept in a Mysql database. Logging is
-# sent to syslogd.
-#
-# How it works: each time a Postfix SMTP server process is started
-# it connects to the policy service socket, and Postfix runs one
-# instance of this PERL script. By default, a Postfix SMTP server
-# process terminates after 100 seconds of idle time, or after serving
-# 100 clients. Thus, the cost of starting this PERL script is smoothed
-# out over time.
-#
-# To run this from /etc/postfix/master.cf:
-#
-# policy unix - n n - - spawn
-# user=nobody argv=/usr/bin/perl /usr/libexec/postfix/greylist.pl
-#
-# To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
-#
-# smtpd_recipient_restrictions =
-# ...
-# reject_unauth_destination
-# check_policy_service unix:private/policy
-# ...
-#
-# NOTE: specify check_policy_service AFTER reject_unauth_destination
-# or else your system can become an open relay.
-#
-# To test this script by hand, execute:
-#
-# % perl greylist.pl
-#
-# Each query is a bunch of attributes. Order does not matter, and
-# the demo script uses only a few of all the attributes shown below:
-#
-# request=smtpd_access_policy
-# protocol_state=RCPT
-# protocol_name=SMTP
-# helo_name=some.domain.tld
-# queue_id=8045F2AB23
-# sender=foo@bar.tld
-# recipient=bar@foo.tld
-# client_address=1.2.3.4
-# client_name=another.domain.tld
-# instance=123.456.7
-# sasl_method=plain
-# sasl_username=you
-# sasl_sender=
-# size=12345
-# [empty line]
-#
-# The policy server script will answer in the same style, with an
-# attribute list followed by a empty line:
-#
-# action=dunno
-# [empty line]
-#
-# database format
-# create table grey ( address varchar( 15 ) not null,
-# sender varchar( 200) not null,
-# recipient varchar(200) not null,
-# count int unsigned default 1 not null,
-# request_time timestamp not null,
-# expire_time timestamp not null,
-# primary key ( address, sender, recipient ) );
-#
-# create table white ( address varchar( 15 ) not null,
-# mask varchar( 15 ) not null,
-# count int unsgined default 0 not null,
-# descr text );
-# create table black ( address varchar( 15 ) not null,
-# mask varchar( 15 ) not null,
-# count int unsgined default 0 not null,
-# descr text );
+=head1 NAME
+
+greylist.pl
+
+=head1 DESCRIPTION
+
+Delegated Postfix SMTPD policy server. This server implements greylisting.
+State is kept in a Mysql database. Logging is sent to syslogd.
+
+=head1 SYNOPSIS
+
+ greylist.pl [-c <configfile>] [-v[ -v...]|-D <debuglevel>]
+ greylist.pl -h
+ greylist.pl -V
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-c <configfile>> - Konfigurationsdatei
+
+Wenn nicht angegeben, wird C</etc/postfix/greylist/greylist.cf> verwendet.
+
+=item B<-v> Verbose-Level (Debug-Level)
+
+Wird durch Mehrfach-Aufzaehlung erhoeht.
+
+=item B<-D level> - Debug-Level
+Numerische Angabe des Debug-Levels.
+
+I<Hinweise>:
+
+Die Parameter C<-v> und C<-D> wirken sich gleich aus.
+Wenn beide angegeben werden, wird der hoehere von beiden verwendet.
+
+=item B<-h|-?>
+
+Gibt diesen Hilfebildschirm aus und beendet sich.
+
+=item B<-V>
+
+Gibt die Versionsnummer dieses Programms aus und beendet sich.
+
+=back
+
+=head1 DESCRIPTION
+
+How it works: each time a Postfix SMTP server process is started
+it connects to the policy service socket, and Postfix runs one
+instance of this PERL script. By default, a Postfix SMTP server
+process terminates after 100 seconds of idle time, or after serving
+100 clients. Thus, the cost of starting this PERL script is smoothed
+out over time.
+
+To run this from /etc/postfix/master.cf:
+
+ policy unix - n n - - spawn
+ user=nobody argv=/usr/bin/perl /usr/libexec/postfix/greylist.pl
+
+To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
+
+ smtpd_recipient_restrictions =
+ ...
+ reject_unauth_destination
+ check_policy_service unix:private/policy
+ ...
+
+NOTE: specify check_policy_service AFTER reject_unauth_destination
+or else your system can become an open relay.
+
+To test this script by hand, execute:
+
+ % perl greylist.pl
+
+Each query is a bunch of attributes. Order does not matter, and
+the demo script uses only a few of all the attributes shown below:
+
+ request=smtpd_access_policy
+ protocol_state=RCPT
+ protocol_name=SMTP
+ helo_name=some.domain.tld
+ queue_id=8045F2AB23
+ sender=foo@bar.tld
+ recipient=bar@foo.tld
+ client_address=1.2.3.4
+ client_name=another.domain.tld
+ instance=123.456.7
+ sasl_method=plain
+ sasl_username=you
+ sasl_sender=
+ size=12345
+ [empty line]
+
+The policy server script will answer in the same style, with an
+attribute list followed by a empty line:
+
+ action=dunno
+ [empty line]
+
+ database format
+ create table grey ( address varchar( 15 ) not null,
+ sender varchar( 200) not null,
+ recipient varchar(200) not null,
+ count int unsigned default 1 not null,
+ request_time timestamp not null,
+ expire_time timestamp not null,
+ primary key ( address, sender, recipient ) );
+
+ create table white ( address varchar( 15 ) not null,
+ mask varchar( 15 ) not null,
+ count int unsgined default 0 not null,
+ descr text );
+ create table black ( address varchar( 15 ) not null,
+ mask varchar( 15 ) not null,
+ count int unsgined default 0 not null,
+ descr text );
+
+=cut
+
+my $Revis = <<'ENDE';
+ $Revision$
+ENDE
+$Revis =~ s/^.*:\s*(\S+)\s*\$.*/$1/s;
+our $VERSION = "1.0." . $Revis;
######################
## Global Variables
######################
-my ( $dbh, $config );
+my ( $dbh, $configfile );
######################
# read configuration
-($config) = $0 =~ m#^(.+\.)pl$#;
-$config .= "cf";
-#
+$configfile = dirname($0) . "/greylist.cf";
+
+$| = 1;
+
+Getopt::Long::Configure('bundling');
+
+my ( $test_mode, $help, $show_version, $cmdline_verbose, $DebugLevel, );
+
+unless (
+ GetOptions(
+ "configfile|conf|c=s" => \$configfile,
+ "test|t" => \$test_mode,
+ "help|h|?" => \$help,
+ "verbose|v+" => \$cmdline_verbose,
+ "version|V" => \$show_version,
+ "DebugLevel|Debug|D=i" => \$DebugLevel,
+ )
+ )
{
- my $conf;
- $conf = new Config::General($config);
- $config = { $conf->getall() };
+ pod2usage( { -exitval => 1, -verbose => 1 } );
+} ## end unless ( GetOptions( "configfile|conf|c=s" => ...
+
+$cmdline_verbose ||= 0;
+$cmdline_verbose = $DebugLevel if $DebugLevel and $DebugLevel > $cmdline_verbose;
+
+my $verbose = $cmdline_verbose;
+
+if ($help) {
+ $verbose ? pod2usage( -exitstatus => 1, -verbose => 2 ) : pod2usage(1);
}
+if ($show_version) {
+ print "Version $0: " . $VERSION . "\n";
+ print "Version BsDaemon::Common: " . $BsDaemon::Common::VERSION . "\n";
+ print "\n";
+ exit 0;
+}
+
+die "Konfiguration '" . $configfile . "' nicht gefunden.\n" unless -f $configfile;
+
+#
+my $config;
+debug( "reading config file '%s'", $configfile );
+eval {
+ my $conf;
+ $conf = new Config::General($configfile);
+ $config = { $conf->getall() };
+};
+die "Konnte Konfiguration '" . $configfile . "' nicht lesen: " . $@ . "\n" if $@;
+
+$verbose = 1 if $config->{'verbose'};
+
$0 = 'postfix/greylist';
#### main ####
#
# Unbuffer standard output.
#
-select((select(STDOUT), $| = 1)[0]);
+select( ( select(STDOUT), $| = 1 )[0] );
#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
{
- my ( $attr, $action );
- while (<STDIN>) {
- if (/([^=]+)=(.*)\n/) {
- $attr->{substr($1, 0, 512)} = substr($2, 0, 512);
- } elsif ($_ eq "\n") {
- if ($config->{'verbose'}) {
- foreach (keys %$attr) {
- syslog $config->{'syslog'}{'priority'}, 'Attribute: %s=%s', $_, $attr->{$_};
+ my ( $attr, $action );
+ while (<STDIN>) {
+ if (/([^=]+)=(.*)\n/) {
+ $attr->{ substr( $1, 0, 512 ) } = substr( $2, 0, 512 );
}
- }
- fatal_exit( "unrecognized request type: '%s'", $attr->{'request'} )
- unless $attr->{'request'} eq 'smtpd_access_policy';
- $action = smtpd_access_policy($attr);
- syslog $config->{'syslog'}{'priority'}, 'Action: %s', $action if $config->{'verbose'};
- print STDOUT "action=$action\n\n";
- $attr = {};
- } else {
- chop;
- syslog $config->{'syslog'}{'priority'}, 'warning: ignoring garbage: %.100s', $_;
- }
- }
- $dbh->disconnect() if $dbh;
+ elsif ( $_ eq "\n" ) {
+ if ($verbose) {
+ foreach ( sort { lc($a) cmp lc($b) } keys %$attr ) {
+ debug( "Attribute: %s=%s", $_, $attr->{$_} );
+ }
+ }
+ fatal_exit( "unrecognized request type: '%s'", $attr->{'request'} )
+ unless $attr->{'request'} eq 'smtpd_access_policy';
+ $action = smtpd_access_policy($attr);
+ debug( "Action: %s", $action );
+ print STDOUT "action=$action\n\n";
+ $attr = {};
+ } ## end elsif ( $_ eq "\n" )
+ else {
+ chop;
+ do_log( "warning: ignoring garbage: %.100s", $_ );
+ }
+ } ## end while (<STDIN>)
+ $dbh->disconnect() if $dbh;
}
#########################################
# table. Request attributes are available via the %attr hash.
#
sub smtpd_access_policy {
- my ( $param ) = @_;
+ my ($param) = @_;
my $age;
+
#my ( $time_stamp, $now, $key );
# Open the database on the fly.
open_database() unless $dbh;
# first look up the whitelist
- if ( $config->{'database'}{'whitelist_table'} && db_read_whitelist( $param ) ) {
- syslog $config->{'syslog'}{'priority'}, 'request address in whitelist';
+ if ( $config->{'database'}{'whitelist_table'} && db_read_whitelist($param) ) {
+ do_log('request address in whitelist');
if ( $config->{'greylist'}{'whitelist_header_text'} ) {
return 'PREPEND X-GreyList: ' . $config->{'greylist'}{'whitelist_header_text'};
- } else {
+ }
+ else {
return 'dunno';
}
}
- if ( $config->{'database'}{'blacklist_table'} && db_read_blacklist( $param ) ) {
- syslog $config->{'syslog'}{'priority'}, 'request address in blacklist';
- return 'defer_if_permit ' . ( $config->{'greylist'}{'blacklist_reason'} || 'Service is unavailable');
+ if ( $config->{'database'}{'blacklist_table'} && db_read_blacklist($param) ) {
+ do_log('request address in blacklist');
+ return 'defer_if_permit ' . ( $config->{'greylist'}{'blacklist_reason'} || 'Service is unavailable' );
}
# timestamps will be generated within the database
# Lookup the time stamp for this client/sender/recipient.
- $age = db_read_greylist( $param );
- unless ( $age ) { # expired or unseen
+ $age = db_read_greylist($param);
+ unless ($age) { # expired or unseen
db_add_greylist($param);
}
# In case of failure, specify ``DEFER_IF_PERMIT optional text...''
# so that mail can still be blocked by other access restrictions.
#
- syslog $config->{'syslog'}{'priority'}, 'request age %d', $age;
+ do_log( "request age %d", $age );
if ( $age > $config->{'greylist'}{'delay'} ) {
return "dunno";
- } else {
+ }
+ else {
return 'defer_if_permit ' . ( $config->{'greylist'}{'delay_message'} || 'Service is unavailable' );
}
-}
+
+} ## end sub smtpd_access_policy
#
# Log an error and abort.
#
sub fatal_exit {
my $first = shift;
- syslog 'err', 'fatal: '.$first, @_;
+ if ($test_mode) {
+ cluck 'fatal: ' . sprintf( $first, @_ ) . "\n";
+ }
+ else {
+ syslog 'err', 'fatal: ' . $first, @_;
+ }
$dbh->disconnect() if $dbh;
exit 1;
+} ## end sub fatal_exit
+
+#
+# Log a debug message
+#
+sub debug {
+ return unless $verbose;
+ do_log(@_);
+}
+
+#
+# Log a message
+#
+sub do_log {
+ my $first = shift;
+ if ($test_mode) {
+ warn sprintf( $first, @_ ) . "\n";
+ }
+ else {
+ syslog $config->{'syslog'}{'priority'}, $first, @_;
+ }
}
#
#
sub open_database {
$dbh = DBI->connect(
- "DBI:".$config->{'database'}{'db_type'}.':'.$config->{'database'}{'db_name'},
+ "DBI:" . $config->{'database'}{'db_type'} . ':' . $config->{'database'}{'db_name'},
$config->{'database'}{'db_user'},
$config->{'database'}{'db_pass'},
{ AutoCommit => 0, RaiseError => 0, PrintError => 0 }
);
fatal_exit( "Cannot open database %s: %s", $config->{'database'}{'db_name'}, $DBI::errstr ) unless $dbh;
- syslog $config->{'syslog'}{'priority'}, "open db %s", $config->{'database'}{'db_name'} if $config->{'verbose'};
-}
+ debug( "open db %s", $config->{'database'}{'db_name'} );
+} ## end sub open_database
#
# Read database. Use a lock to avoid reading the database
-# while it is being changed.
+# while it is being changed.
#
sub db_read_greylist {
my $param = shift;
my ( $sqlst, $sth, $val, $tofast );
- $dbh->do( 'lock table '.$config->{'database'}{'greylist_table'}. ' write' ) or fatal_exit( "Cannot lock table: %s", $dbh->errstr );
+ $dbh->do( 'lock table ' . $config->{'database'}{'greylist_table'} . ' write' ) or fatal_exit( "Cannot lock table: %s", $dbh->errstr );
+
# lc $attr{"client_address"}."/".$attr{"sender"}."/".$attr{"recipient"};
- $sqlst = q( select unix_timestamp(now())-unix_timestamp(request_time) age from ).$config->{'database'}{'greylist_table'} .
- q( where address = ? and sender = ? and recipient = ? and expire_time > now() );
- $sth = $dbh->prepare( $sqlst ) or fatal_exit( 'Cannot prepare statement: %s with error: %s', $sqlst, $dbh->errstr );
+ $sqlst
+ = q( select unix_timestamp(now())-unix_timestamp(request_time) age from )
+ . $config->{'database'}{'greylist_table'}
+ . q( where address = ? and sender = ? and recipient = ? and expire_time > now() );
+ $sth = $dbh->prepare($sqlst) or fatal_exit( 'Cannot prepare statement: %s with error: %s', $sqlst, $dbh->errstr );
$sth->execute( @$param{qw( client_address sender recipient )} ) or fatal_exit( 'Cannot execute: %s', $dbh->errstr );
- $val = ($sth->fetchrow_hashref()||{})->{'age'};
+ $val = ( $sth->fetchrow_hashref() || {} )->{'age'};
$sth->finish();
-
- if ( $val ) {
- $tofast = $val < $config->{'greylist'}{'delay'};
- # generate new expire time
- $sqlst = 'update '.$config->{'database'}{'greylist_table'} . ' set ' .
- ($tofast?'':'request_time = request_time, ') . # keep old time if old enough
- 'expire_time = date_add( now(), interval ? second ), count = count + 1 where address = ? and sender = ? and recipient = ?';
- $dbh->do( $sqlst, {}, $config->{'greylist'}{$tofast?'expire_short':'expire_long'},
- @$param{qw( client_address sender recipient )} ) or
- fatal_exit( "Cannot update record: %s", $dbh->errstr );
- } else {
- $val = 0; # prevent undef
+
+ if ($val) {
+ $tofast = $val < $config->{'greylist'}{'delay'};
+
+ # generate new expire time
+ $sqlst
+ = 'update '
+ . $config->{'database'}{'greylist_table'} . ' set '
+ . ( $tofast ? '' : 'request_time = request_time, ' )
+ . # keep old time if old enough
+ 'expire_time = date_add( now(), interval ? second ), count = count + 1 where address = ? and sender = ? and recipient = ?';
+ unless ($test_mode) {
+ $dbh->do(
+ $sqlst, {},
+ $config->{'greylist'}{ $tofast ? 'expire_short' : 'expire_long' },
+ @$param{qw( client_address sender recipient )}
+ ) or fatal_exit( "Cannot update record: %s", $dbh->errstr );
+ }
+ } ## end if ($val)
+ else {
+ $val = 0; # prevent undef
}
- syslog $config->{'syslog'}{'priority'},
- 'lookup %s: %s', join('/', @$param{qw( client_address sender recipient )} ), $val if $config->{'verbose'};
+ do_log( 'lookup %s: %s', join( '/', @$param{qw( client_address sender recipient )} ), $val );
$dbh->do("unlock tables");
return $val;
-}
+} ## end sub db_read_greylist
# add a new requester to db
sub db_add_greylist {
my $param = shift;
- my ( $sqlst );
+ my ($sqlst);
# replace already existing record because its expired anyway
- $sqlst = 'replace into '.$config->{'database'}{'greylist_table'} .
- ' (address, sender, recipient, expire_time ) values ( ?, ?, ?, date_add( now(), interval ? second ) ) ';
- $dbh->do( $sqlst, {}, @$param{qw( client_address sender recipient )}, $config->{'greylist'}{'expire_short'} ) or
- fatal_exit( 'Cannot insert record: %s', $dbh->errstr );
-}
+ $sqlst
+ = 'replace into '
+ . $config->{'database'}{'greylist_table'}
+ . ' (address, sender, recipient, expire_time ) values ( ?, ?, ?, date_add( now(), interval ? second ) ) ';
+ unless ($test_mode) {
+ $dbh->do( $sqlst, {}, @$param{qw( client_address sender recipient )}, $config->{'greylist'}{'expire_short'} )
+ or fatal_exit( 'Cannot insert record: %s', $dbh->errstr );
+ }
+} ## end sub db_add_greylist
# read whitelist table to avoid greylisting
sub db_read_whitelist {
- my $param = shift;
- open_database() unless $dbh;
+ my $param = shift;
+ open_database() unless $dbh;
- my ( $sqlst, $res );
+ my ( $sqlst, $res );
- $sqlst = 'update ' . $config->{'database'}{'whitelist_table'} . ' set count = count + 1' .
- ' where INET_ATON( address ) & INET_ATON( mask ) = INET_ATON( ? ) & INET_ATON( mask )';
- $res = $dbh->do( $sqlst, {}, $param->{'client_address'} ) or
- fatal_exit( 'Cannot update whitelist, statement is: %s with error %s', $sqlst, $dbh->errstr );
- return $res + 0; # transform number of rows to bool
-}
+ $sqlst
+ = 'update '
+ . $config->{'database'}{'whitelist_table'}
+ . ' set count = count + 1'
+ . ' where INET_ATON( address ) & INET_ATON( mask ) = INET_ATON( ? ) & INET_ATON( mask )';
+ $res = $dbh->do( $sqlst, {}, $param->{'client_address'} )
+ or fatal_exit( 'Cannot update whitelist, statement is: %s with error %s', $sqlst, $dbh->errstr );
+ return $res + 0; # transform number of rows to bool
+} ## end sub db_read_whitelist
# read blacklist table to never let mail through
sub db_read_blacklist {
- my $param = shift;
- open_database() unless $dbh;
+ my $param = shift;
+ open_database() unless $dbh;
- my ( $sqlst, $res );
+ my ( $sqlst, $res );
- $sqlst = 'update ' . $config->{'database'}{'blacklist_table'} . ' set count = count + 1' .
- ' where INET_ATON( address ) & INET_ATON( mask ) = INET_ATON( ? ) & INET_ATON( mask ) limit 1';
- $res = $dbh->do( $sqlst, {}, $param->{'client_address'} ) or
- fatal_exit( 'Cannot prepare statement: %s with error %s', $sqlst, $dbh->errstr );
- return $res + 0; # false if no records where updated
-}
+ $sqlst
+ = 'update '
+ . $config->{'database'}{'blacklist_table'}
+ . ' set count = count + 1'
+ . ' where INET_ATON( address ) & INET_ATON( mask ) = INET_ATON( ? ) & INET_ATON( mask ) limit 1';
+ $res = $dbh->do( $sqlst, {}, $param->{'client_address'} )
+ or fatal_exit( 'Cannot prepare statement: %s with error %s', $sqlst, $dbh->errstr );
+ return $res + 0; # false if no records where updated
+} ## end sub db_read_blacklist
__END__
-#
-# We don't need getopt() for now.
-#
-# maybe later add a switch for config file
-#
-while ($option = shift(@ARGV)) {
- if ($option eq "-v") {
- $verbose = 1;
- } else {
- syslog $syslog_priority, "Invalid option: %s. Usage: %s [-v]",
- $option, $0;
- exit 1;
- }
-}
-
projects / my-stuff / greylist.git / commitdiff