Mail-MtPolicyd-2.02/0000755000175000017500000000000012752672654014507 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/0000755000175000017500000000000012752672654015255 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/0000755000175000017500000000000012752672654016137 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd.pm0000644000175000017500000002700012752672654020400 0ustar werewolfwerewolfpackage Mail::MtPolicyd; use strict; use warnings; use base qw(Net::Server::PreFork); our $VERSION = '2.02'; # VERSION # ABSTRACT: a modular policy daemon for postfix use Data::Dumper; use Mail::MtPolicyd::Profiler; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::VirtualHost; use Mail::MtPolicyd::ConnectionPool; use Mail::MtPolicyd::SessionCache; use DBI; use Time::HiRes qw( usleep tv_interval gettimeofday ); use Getopt::Long; use Tie::IxHash; use Config::General qw(ParseConfig); use IO::Handle; sub _preload_modules { # PRELOAD some modules my @modules = ( 'DBI', 'Moose', 'Moose::Role', 'MooseX::Getopt', 'MooseX::Role::Parameterized', 'namespace::autoclean', ); foreach my $module (@modules) { $module =~ s/::/\//g; $module .= '.pm'; require $module; } } sub _apply_values_from_config { my ( $self, $target, $config ) = ( shift, shift, shift ); while ( my $key = shift ) { if(! defined $config->{$key} ) { next; } $target->{$key} = $config->{$key}; } return; } sub _apply_array_from_config { my ( $self, $target, $config ) = ( shift, shift, shift ); while ( my $key = shift ) { if(! defined $config->{$key} ) { next; } $target->{$key} = [ split(/\s*,\s*/, $config->{$key}) ]; } return; } sub print_usage { print "mtpolicyd [-h|--help] [-c|--config=] [-f|--foreground] [-l|--loglevel=] [-d|--dump_vhosts] [-t|--cron=]\n"; return; } sub configure { my $self = shift; my $server = $self->{'server'}; my $cmdline; return if(@_); if( ! defined $server->{'config_file'} ) { $server->{'config_file'} = '/etc/mtpolicyd/mtpolicyd.conf'; } $server->{'background'} = 1; $server->{'setsid'} = 1; $server->{'no_close_by_child'} = 1; # Parse command line params %{$cmdline} = (); GetOptions( \%{$cmdline}, "help|h", "dump_config|d", "config|c:s", "foreground|f", "loglevel|l:i", "cron|t:s", ); if ($cmdline->{'help'}) { $self->print_usage; exit 0; } if (defined($cmdline->{'config'}) && $cmdline->{'config'} ne "") { $server->{'config_file'} = $cmdline->{'config'}; } if( ! -f $server->{'config_file'} ) { print(STDERR 'configuration file '.$server->{'config_file'}.' does not exist!\n'); exit 1; } # DEFAULTS if( ! defined $server->{'log_level'} ) { $server->{'log_level'} = 2; } if( ! defined $server->{'log_file'} && ! $cmdline->{'foreground'} ) { $server->{'log_file'} = 'Sys::Syslog'; } $server->{'syslog_ident'} = 'mtpolicyd'; $server->{'syslog_facility'} = 'mail'; $server->{'proto'} = 'tcp'; $server->{'host'} = '127.0.0.1'; if( ! defined $server->{'port'} ) { $server->{'port'} = [ '127.0.0.1:12345' ]; } $server->{'min_servers'} = 4; $server->{'min_spare_servers'} = 4; $server->{'max_spare_servers'} = 12; $server->{'max_servers'} = 25; $server->{'max_requests'} = 1000; $self->{'request_timeout'} = 20; $self->{'keepalive_timeout'} = 60; $self->{'max_keepalive'} = 0; $self->{'vhost_by_policy_context'} = 0; $self->{'program_name'} = $0; # APPLY values from configuration file tie my %config_hash, "Tie::IxHash"; %config_hash = ParseConfig( -AllowMultiOptions => 'no', -ConfigFile => $server->{'config_file'}, -Tie => "Tie::IxHash" ); my $config = \%config_hash; $self->_apply_values_from_config($server, $config, 'user', 'group', 'pid_file', 'log_level', 'log_file', 'syslog_ident', 'syslog_facility', 'host', 'min_servers', 'min_spare_servers', 'max_spare_servers', 'max_servers', 'max_requests', 'chroot', ); $self->_apply_array_from_config($server, $config, 'port'); $self->_apply_values_from_config($self, $config, 'request_timeout', 'keepalive_timeout', 'max_keepalive', 'vhost_by_policy_context', 'program_name', ); # initialize connection pool Mail::MtPolicyd::ConnectionPool->initialize; if( defined $config->{'Connection'} ) { Mail::MtPolicyd::ConnectionPool->load_config( $config->{'Connection'} ); } $self->{'session_cache_config'} = $config->{'SessionCache'}; # LOAD VirtualHosts if( ! defined $config->{'VirtualHost'} ) { print(STDERR 'no virtual hosts configured!\n'); exit 1; } my $vhosts = $config->{'VirtualHost'}; $self->{'virtual_hosts'} = {}; foreach my $vhost_port (keys %$vhosts) { my $vhost = $vhosts->{$vhost_port}; $self->{'virtual_hosts'}->{$vhost_port} = Mail::MtPolicyd::VirtualHost->new_from_config($vhost_port, $vhost) } if ($cmdline->{'dump_config'}) { print "----- Virtual Hosts -----\n"; print Dumper( $self->{'virtual_hosts'} ); exit 0; } # foreground mode (cmdline) if ($cmdline->{'foreground'}) { $server->{'background'} = undef; $server->{'setsid'} = undef; } if( $cmdline->{'loglevel'} ) { $server->{'log_level'} = $cmdline->{'loglevel'}; } # if running in cron mode execute cronjobs and exit if( $cmdline->{'cron'} && $cmdline->{'cron'} !~ /^\s*$/ ) { my @tasks = split(/\s*,\s*/, $cmdline->{'cron'}); $self->cron( @tasks ); exit 0; } # change processname in top/ps $self->_set_process_stat('master'); return; } sub cron { my $self = shift; foreach my $vhost ( keys %{$self->{'virtual_hosts'}} ) { $self->{'virtual_hosts'}->{$vhost}->cron( $self, @_ ); } return; } sub pre_loop_hook { my $self = shift; $self->_preload_modules; return; } sub child_init_hook { my $self = shift; $self->_set_process_stat('virgin child'); # recreate connection in child process Mail::MtPolicyd::ConnectionPool->reconnect; # initialize session cache $self->{'session_cache'} = Mail::MtPolicyd::SessionCache->new( server => $self, ); if( defined $self->{'session_cache_config'} && ref($self->{'session_cache_config'}) eq 'HASH') { $self->{'session_cache'}->load_config( $self->{'session_cache_config'} ); } return; } sub child_finish_hook { my $self = shift; $self->_set_process_stat('finish'); Mail::MtPolicyd::ConnectionPool->shutdown; if( defined $self->{'session_cache'} ) { $self->{'session_cache'}->shutdown; } return; } sub get_conn_port { my $self = shift; my $server = $self->{server}; my $client = $server->{client}; my $port; my $is_socket = $client && $client->UNIVERSAL::can('NS_proto') && $client->NS_proto eq 'UNIX'; if( $is_socket ) { $port = Net::Server->VERSION >= 2 ? $client->NS_port : $client->NS_unix_path; } else { $port = $self->{'server'}->{'sockport'}; } return($port); } sub get_virtual_host { my ( $self, $conn_port, $r ) = @_; my $vhost; my $policy_context = $r->attr('policy_context'); if( $self->{'vhost_by_policy_context'} && defined $policy_context && $policy_context ne '' ) { foreach my $vhost_port ( keys %{$self->{'virtual_hosts'}} ) { $vhost = $self->{'virtual_hosts'}->{$vhost_port}; if( $policy_context eq $vhost->name ) { return( $vhost ); } } } $vhost = $self->{'virtual_hosts'}->{$conn_port}; if( ! defined $vhost ) { die('no virtual host defined for port '.$conn_port); } return($vhost); } sub _is_loglevel { my ( $self, $level ) = @_; if( $self->{'server'}->{'log_level'} && $self->{'server'}->{'log_level'} >= $level ) { return(1); } return(0); } our %_LOG_ESCAPE_MAP = ( "\0" => '\0', "\r" => '\r', "\n" => '\n', "\\" => '\\\\', ); our $_LOG_ESCAPE_MAP_RE = '['.join('', map { sprintf('\\x%02x', ord($_)) } keys %_LOG_ESCAPE_MAP ).']'; sub log { my ( $self, $level, $msg, @params ) = @_; $msg =~ s/($_LOG_ESCAPE_MAP_RE)/ $_LOG_ESCAPE_MAP{$1} /gse; $msg =~ s/([\x01-\x08\x0b-\x0c\x0e-\x1f\x7f])/ sprintf('\\x%02X', ord($1)) /gse; return $self->SUPER::log( $level, $msg, @params ); } sub _process_one_request { my ( $self, $conn, $vhost, $r ) = @_; my $port = $vhost->port; my $s; my $error; eval { my $start_t = [gettimeofday]; local $SIG{'ALRM'} = sub { die "Request timeout!" }; my $timeout = $self->{'request_timeout'}; alarm($timeout); if( $self->_is_loglevel(4) ) { $self->log(4, 'request: '.$r->dump_attr); } my $instance = $r->attr('instance'); Mail::MtPolicyd::Profiler->tick('retrieve session'); $s = $self->{'session_cache'}->retrieve_session($instance); if( $self->_is_loglevel(4) ) { $self->log(4, 'session: '.Dumper($s)); } $r->session($s); Mail::MtPolicyd::Profiler->tick('run vhost'); my $result = $vhost->run($r); my $response = $result->as_policyd_response; $conn->print($response); $conn->flush; # convert to ms and round by 0.5/int my $elapsed = int(tv_interval( $start_t, [gettimeofday] ) * 100 + 0.5); my $matched = defined $result->last_match ? $result->last_match : ''; $self->log(1, $vhost->name.': instance='.$instance.', type='.$r->type.', t='.$elapsed.'ms, plugin='.$matched.', result='.$result->as_log); }; if ( $@ ) { $error = $@; } if( defined $s ) { $self->{'session_cache'}->store_session($s); } if( defined $error ) { die( $error ); } return; } sub process_request { my ( $self, $conn ) = @_; my $max_keepalive = $self->{'max_keepalive'}; my $port = $self->get_conn_port; $self->log(4, 'accepted connection on port '.$port ); for( my $alive_count = 0 ; $max_keepalive == 0 || $alive_count < $max_keepalive ; $alive_count++ ) { my $r; $self->_set_process_stat('waiting request'); Mail::MtPolicyd::Profiler->reset; eval { local $SIG{'ALRM'} = sub { die "Keepalive connection timeout" }; my $timeout = $self->{'keepalive_timeout'}; alarm($timeout); Mail::MtPolicyd::Profiler->tick('parsing request'); $r = Mail::MtPolicyd::Request->new_from_fh( $conn, 'server' => $self ); }; if ( $@ =~ /Keepalive connection timeout/ ) { $self->log(3, '['.$port.']: keepalive timeout: closing connection'); last; } elsif($@ =~ /connection closed by peer/) { $self->log(3, '['.$port.']: connection closed by peer'); last; } elsif($@) { $self->log(0, '['.$port.']: error while reading request: '.$@); last; } Mail::MtPolicyd::Profiler->tick('processing request'); my $vhost = $self->get_virtual_host($port, $r); $self->_set_process_stat($vhost->name.', processing request'); eval { $self->_process_one_request( $conn, $vhost, $r ); }; if ( $@ =~ /Request timeout!/ ) { $self->log(1, '['.$port.']: request timed out'); last; } elsif($@) { $self->log(0, 'error while processing request: '.$@); last; } Mail::MtPolicyd::Profiler->stop_current_timer; if( $self->_is_loglevel(4) ) { $self->log(4, Mail::MtPolicyd::Profiler->to_string); } } $self->log(3, '['.$port.']: closing connection'); $self->_set_process_stat('idle'); return; } sub _set_process_stat { my ( $self, $stat ) = @_; $0 = $self->{'program_name'}.' ('.$stat.')' }; sub memcached { die('the global memcached connection does no longer exist in mtpolicyd >= 2.00'); } sub get_dbh { die('the global dbh handle is no longer available in mtpolicyd >= 2.00'); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd - a modular policy daemon for postfix =head1 VERSION version 2.02 =head1 DESCRIPTION Mail::MtPolicyd is the Net::Server class of the mtpolicyd daemon. =head2 SYNOPSIS use Mail::MtPolicyd; Mail::MtPolicyd->run; =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/0000755000175000017500000000000012752672654020043 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Client/0000755000175000017500000000000012752672654021261 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Client/Response.pm0000644000175000017500000000450712752672654023423 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Client::Response; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: a postfix policyd client response class has 'action' => ( is => 'ro', isa => 'Str', required => 1 ); has 'attributes' => ( is => 'ro', isa => 'HashRef[Str]', default => sub { {} }, ); sub as_string { my $self = shift; return join("\n", map { $_.'='.$self->attributes->{$_} } keys %{$self->attributes}, )."\n\n"; } sub new_from_fh { my ( $class, $fh ) = ( shift, shift ); my $attr = {}; my $complete = 0; while( my $line = $fh->getline ) { $line =~ s/\r?\n$//; if( $line eq '') { $complete = 1 ; last; } my ( $name, $value ) = split('=', $line, 2); if( ! defined $value ) { die('error parsing response'); } $attr->{$name} = $value; } if( ! $complete ) { die('could not read response'); } if( ! defined $attr->{'action'} ) { die('no action found in response'); } my $obj = $class->new( 'action' => $attr->{'action'}, 'attributes' => $attr, @_ ); return $obj; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Client::Response - a postfix policyd client response class =head1 VERSION version 2.02 =head1 DESCRIPTION Class to handle a policyd response. =head2 SYNOPSIS use Mail::MtPolicyd::Client::Response; my $response = Mail::MtPolicyd::Client::Response->new_from_fh( $conn ); -- my $response = Mail::MtPolicyd::Client::Response->new( action => 'reject', attributes => { action => 'reject', }, ); print $response->as_string; =head2 METHODS =over =item new_from_fh( $filehandle ) Constructor which reads a response from the supplied filehandle. =item as_string Returns a stringified version of the response. =back =head2 ATTRIBUTES =over =item action (required) The action specified in the reponse. =item attributes Holds a hash with all key/values of the response. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Client/App.pm0000644000175000017500000000412212752672654022336 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Client::App; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: application interface class for Mail::MtPolicyd::Client extends 'Mail::MtPolicyd::Client'; with 'MooseX::Getopt'; use Mail::MtPolicyd::Client::Request; use IO::Handle; has '+host' => ( traits => ['Getopt'], cmd_aliases => "h", documentation => "host:port of a policyd", ); has '+socket_path' => ( traits => ['Getopt'], cmd_aliases => "s", documentation => "path to a socket of a policyd", ); has '+keepalive' => ( traits => ['Getopt'], cmd_aliases => "k", documentation => "use connection keepalive?", ); has 'verbose' => ( is => 'rw', isa => 'Bool', default => 0, traits => ['Getopt'], cmd_aliases => "v", documentation => "be verbose, print input/output to STDERR", ); sub run { my $self = shift; my $stdin = IO::Handle->new; $stdin->fdopen(fileno(STDIN),"r"); while( my $request = Mail::MtPolicyd::Client::Request->new_from_fh( $stdin ) ) { if( $self->verbose ) { $self->_dump('>> ', $request->as_string); } my $response = $self->request( $request ); if( $self->verbose ) { $self->_dump('<< ', $response->as_string); } print $response->action."\n"; } return; } sub _dump { my ( $self, $prefix, $message ) = @_; $message =~ s/^/$prefix/mg; print STDERR $message; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Client::App - application interface class for Mail::MtPolicyd::Client =head1 VERSION version 2.02 =head1 SYNOPSIS use Mail::MtPolicyd::Client::App; my $app = Mail::MtPolicyd::Client::App->new_with_options(); $app->run; =head1 DESCRIPTION This class provides a application interface for Mail::MtPolicyd::Client. =head1 SEE ALSO L, L =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Client/Request.pm0000644000175000017500000000515312752672654023253 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Client::Request; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: a postfix policyd client request class has 'type' => ( is => 'ro', isa => 'Str', default => 'smtpd_access_policy' ); has 'instance' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { return rand; }, ); has 'attributes' => ( is => 'ro', isa => 'HashRef[Str]', default => sub { {} }, ); sub as_string { my $self = shift; return join("\n", 'request='.$self->type, 'instance='.$self->instance, map { $_.'='.$self->attributes->{$_} } keys %{$self->attributes}, )."\n\n"; } sub new_from_fh { my ( $class, $fh ) = ( shift, shift ); my $attr = {}; my $complete = 0; while( my $line = $fh->getline ) { $line =~ s/\r?\n$//; if( $line eq '') { $complete = 1 ; last; } my ( $name, $value ) = split('=', $line, 2); if( ! defined $value ) { die('error parsing response'); } $attr->{$name} = $value; } if( ! $complete ) { die('could not read response'); } my $obj = $class->new( 'attributes' => $attr, @_ ); return $obj; } sub new_proxy_request { my ( $class, $r ) = ( shift, shift ); my %attr = %{$r->attributes}; delete($attr{'type'}); delete($attr{'instance'}); my $obj = $class->new( 'type' => $r->type, 'instance' => $r->attr('instance'), 'attributes' => \%attr, ); return $obj; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Client::Request - a postfix policyd client request class =head1 VERSION version 2.02 =head1 DESCRIPTION Class for construction of policyd requests. =head2 SYNOPSIS use Mail::MtPolicyd::Client::Request; $request = Mail::MtPolicyd::Client::Request->new( 'client_address' => '127.0.0.1', ); =head2 METHODS =over =item as_string Returns the request in as a string in the policyd request format. =back =head2 ATTRIBUTES =over =item type (default: smtpd_access_policy) The type of the request. =item instance (default: rand() ) The instance ID of the mail processed by the MTA. =item attributes (default: {} ) A hashref with contains all key/value pairs of the request. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/ConnectionPool.pm0000644000175000017500000000412412752672654023333 0ustar werewolfwerewolfpackage Mail::MtPolicyd::ConnectionPool; use strict; use warnings; use MooseX::Singleton; our $VERSION = '2.02'; # VERSION # ABSTRACT: a singleton to hold all configure connections has 'pool' => ( is => 'ro', isa => 'HashRef[Mail::MtPolicyd::Connection]', lazy => 1, default => sub { {} }, traits => [ 'Hash' ], handles => { 'get_connection' => 'get', 'add_connection' => 'set', } ); sub get_handle { my ( $self, $name ) = @_; if( defined $self->pool->{$name} ) { return $self->pool->{$name}->handle; } return; } has 'plugin_prefix' => ( is => 'ro', isa => 'Str', default => 'Mail::MtPolicyd::Connection::'); sub load_config { my ( $self, $config ) = @_; foreach my $name ( keys %$config ) { $self->load_connection( $name, $config->{$name} ); } return; } sub load_connection { my ( $self, $name, $params ) = @_; if( ! defined $params->{'module'} ) { die('no module defined for connection '.$name.'!'); } my $module = $params->{'module'}; my $class = $self->plugin_prefix.$module; my $conn; my $code = "require ".$class.";"; eval $code; ## no critic (ProhibitStringyEval) if($@) { die('could not load connection '.$name.': '.$@); } eval { $conn = $class->new( name => $name, %$params, ); $conn->init(); }; if($@) { die('could not initialize connection '.$name.': '.$@); } $self->add_connection( $name => $conn ); return; } sub shutdown { my $self = shift; foreach my $conn ( values %{$self->pool} ) { $conn->shutdown(@_); # cascade } return; } sub reconnect { my $self = shift; foreach my $conn ( values %{$self->pool} ) { $conn->reconnect(@_); # cascade } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::ConnectionPool - a singleton to hold all configure connections =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/AddressList.pm0000644000175000017500000000506212752672654022625 0ustar werewolfwerewolfpackage Mail::MtPolicyd::AddressList; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: a class for IP address lists use NetAddr::IP; has '_localhost_addr' => ( is => 'ro', isa => 'ArrayRef[NetAddr::IP]', lazy => 1, default => sub { return [ map { NetAddr::IP->new( $_ ) } ( '127.0.0.0/8', '::ffff:127.0.0.0/104', '::1' ) ]; }, ); has 'list' => ( is => 'ro', isa => 'ArrayRef[NetAddr::IP]', lazy => 1, default => sub { [] }, traits => [ 'Array' ], handles => { 'add' => 'push', 'is_empty' => 'is_empty', 'count' => 'count', }, ); sub add_localhost { my $self = shift; $self->add( @{$self->_localhost_addr} ); return; } sub add_string { my ( $self, @strings ) = @_; my @addr_strings = map { split( /\s*[, ]\s*/, $_ ) } @strings; my @addr = map { NetAddr::IP->new( $_ ); } @addr_strings; $self->add( @addr ); return; } sub match { my ( $self, $addr ) = @_; if( grep { $_->contains( $addr ) } @{$self->list} ) { return 1; } return 0; } sub match_string { my ( $self, $string ) = @_; my $addr = NetAddr::IP->new( $string ); return( $self->match( $addr ) ); } sub as_string { my $self = shift; return join(',', map { $_->cidr } @{$self->list}); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::AddressList - a class for IP address lists =head1 VERSION version 2.02 =head1 Attributes =head2 list Contains an ArrayRef of NetAddr::IP which holds the all entries of this object. =head1 Methods =head2 add Add a list of NetAddr::IP objects to the list. =head2 is_empty Returns a true value when empty. =head2 count Returns the number of entries. =head2 add_localhost Add localhost addresses to list. =head2 add_string Takes a list of IP address strings. The strings itself can contain a list of comma/space separated addresses. Then a list of NetAddr::IP objects is created and pushed to the list. =head2 match Returns true if the give NetAddr::IP object matches an entry of the list. =head2 match_string Same as match(), but takes an string instead of NetAddr::IP object. =head2 as_string Returns a comma separated string with all addresses. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/VirtualHost.pm0000644000175000017500000000244512752672654022672 0ustar werewolfwerewolfpackage Mail::MtPolicyd::VirtualHost; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: class for a VirtualHost instance use Mail::MtPolicyd::PluginChain; has 'port' => ( is => 'ro', isa => 'Str', required => 1 ); has 'name' => ( is => 'ro', isa => 'Str', required => 1 ); has 'chain' => ( is => 'ro', isa => 'Mail::MtPolicyd::PluginChain', required => 1, handles => [ 'run' ], ); sub new_from_config { my ( $class, $port, $config ) = @_; if( ! defined $config->{'Plugin'} ) { die('no defined for on port '.$port.'!'); } my $vhost = $class->new( 'port' => $port, 'name' => $config->{'name'}, 'chain' => Mail::MtPolicyd::PluginChain->new_from_config( $config->{'name'}, $config->{'Plugin'} ), ); return $vhost; } sub cron { my $self = shift; return $self->chain->cron(@_); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::VirtualHost - class for a VirtualHost instance =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Result.pm0000644000175000017500000000243512752672654021663 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Result; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: class to hold the results of a request returned by plugins has 'plugin_results' => ( is => 'ro', isa => 'ArrayRef[Mail::MtPolicyd::Plugin::Result]', lazy => 1, default => sub { [] }, traits => [ 'Array' ], handles => { 'add_plugin_result' => 'push', }, ); has 'last_match' => ( is => 'rw', isa => 'Maybe[Str]' ); sub actions { my $self = shift; return map { defined $_->action ? $_->action : () } @{$self->plugin_results}; } sub as_log { my $self = shift; return join(',', $self->actions); } sub as_policyd_response { my $self = shift; my @actions = $self->actions; if( ! @actions ) { # we have nothing to say return("action=dunno\n\n"); } return('action='.join("\naction=", @actions)."\n\n"); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Result - class to hold the results of a request returned by plugins =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Connection.pm0000644000175000017500000000136712752672654022507 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Connection; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: base class for mtpolicyd connection modules has 'name' => ( is => 'ro', isa => 'Str', required => 1 ); sub init { my $self = shift; return; } sub reconnect { my $self = shift; return; } sub shutdown { my $self = shift; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection - base class for mtpolicyd connection modules =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin.pm0000644000175000017500000000315712752672654021645 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: a base class for plugins has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); has 'log_level' => ( is => 'ro', isa => 'Int', default => 4 ); has 'vhost_name' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'on_error' => ( is => 'ro', isa => 'Maybe[Str]' ); sub run { my ( $self, $r ) = @_; die('plugin did not implement run method!'); } sub log { my ($self, $r, $msg) = @_; if( defined $self->vhost_name ) { $msg = $self->vhost_name.': '.$msg; } $r->log($self->log_level, $msg); return; } sub init { return; } sub cron { return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin - a base class for plugins =head1 VERSION version 2.02 =head1 ATTRIBUTES =head2 name Contains a string with the name of this plugin as specified in the configuration. =head2 log_level (default: 4) The log_level used when the plugin calls $self->log( $r, $msg ). =head1 METHODS =head2 run( $r ) This method has be implemented by the plugin which inherits from this base class. =head2 log( $r, $msg ) This method could be used by the plugin to log something. Since this is mostly for debugging the default is to log plugin specific messages with log_level=4. (see log_level attribute) =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Request.pm0000644000175000017500000001402612752672654022034 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Request; use Moose; use namespace::autoclean; use Mail::MtPolicyd::Plugin::Result; our $VERSION = '2.02'; # VERSION # ABSTRACT: the request object has 'attributes' => ( is => 'ro', isa => 'HashRef', required => 1, traits => [ 'Hash' ], handles => { 'attr' => 'get' }, ); # gets attached later has 'session' => ( is => 'rw', isa => 'Maybe[HashRef]' ); has 'server' => ( is => 'ro', isa => 'Net::Server', required => 1, handles => { 'log' => 'log', } ); has 'type' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; return( $self->attr('request') ); } ); has 'use_caching' => ( is => 'rw', isa => 'Bool', default => 1 ); sub dump_attr { my $self = shift; my $attr = $self->attributes; return( join(', ', map { $_.'='.$attr->{$_} } keys %$attr ) ); } sub get { my ( $self, $value ) = @_; my ($scope, $name); if( ! defined $value || $value eq '' ) { return; } my @params = split(':', $value, 2); if( scalar(@params) == 2 ) { ( $scope, $name ) = @params; } elsif( scalar(@params) == 1) { ( $scope, $name ) = ( 'request', @params ); } if( $scope eq 'session' || $scope eq 's' ) { if( ! defined $self->session ) { return; } return $self->session->{$name}; } elsif( $scope eq 'request' || $scope eq 'r' ) { return $self->attr( $name ); } die("unknown scope $scope while retrieving variable for $value"); return; } sub new_from_fh { my ( $class, $fh ) = ( shift, shift ); my $attr = {}; my $complete = 0; my $line; while( defined( $line = $fh->getline ) ) { $line =~ s/\r?\n$//; if( $line eq '') { $complete = 1 ; last; } my ( $name, $value ) = split('=', $line, 2); if( ! defined $value ) { die('error parsing request'); } $attr->{$name} = $value; } if( $fh->error ) { die('while reading request: '.$fh->error); } if( ! defined $line && ! $complete ) { die('connection closed by peer'); } if( ! $complete ) { die('could not parse request'); } my $obj = $class->new( 'attributes' => $attr, @_ ); return $obj; } sub do_cached { my ( $self, $key, $call ) = @_; my $session = $self->session; # we cant cache a result without session if( ! defined $session || ! $self->use_caching ) { return( $call->() ); } if( ! defined $session->{$key} ) { $session->{$key} = [ $call->() ]; } return( @{$session->{$key}} ); } sub is_already_done { my ( $self, $key ) = @_; my $session = $self->session; # we cant cache a result without session if( ! defined $session || ! $self->use_caching ) { return 0; } if( defined $session->{$key} ) { return(1); } $session->{$key} = 1; return 0; } sub is_attr_defined { my ( $self, @fields ) = @_; my $a = $self->attributes; foreach my $field ( @fields ) { if( ! defined $a->{$field} || $a->{$field} eq '' || $a->{$field} =~ /^\s+$/ ) { return 0; } } return 1; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Request - the request object =head1 VERSION version 2.02 =head1 ATTRIBUTES =head2 attributes Contains an HashRef with all attributes of the request. To retrieve a single attribute the attr method could be used: $obj->attr('sender'); =head2 session Contains a HashRef with all values stored in the session. mtpolicyd will persist the content of this HashRef across requests with the same instance_id. =head2 server Contains the Net::Server object of mtpolicyd. =head2 type The type of the request. Postfix will always use 'smtpd_access_policy'. =head2 use_caching Could be used to disable caching. Only used within the unit tests. =head1 METHODS =head2 dump_attr Returns an string to dump the content of a request. =head2 get($variable_name) Retrieve value of a session or request variable. The format for the variable name is (:)? If no scope is given it default to the request scope. Valid scopes are: =over =item session, s Session variables. =item request, r Request attributes. =back For example: $r->get('request:sender'); # retrieve sender from request $r->get('r:sender'); # short format $r->get('sender'); # scope defaults to request $r->get('session:user_policy'); # retrieve session variable user_policy $r->get('s:user_policy'); # the same =head2 new_from_fh($fh) An object constructor for creating an request object with the content read for the supplied filehandle $fh. Will die if am error ocours: =over =item error parsing request A line in the request could not be parsed. =item while reading request: The filehandle had an error while reading the request. =item connection closed by peer Connection has been closed while reading the request. =item could not parse request The client did not send a complete request. =back =head2 do_cached( $key, $sub ) This method will execute the function reference give in $sub and store the return values in $key within the session. If there is already a cached result stored within $key of the session it will return the content instead of calling the reference again. Returns an Array with the return values of the function call. Example: my ( $ip_result, $info ) = $r->do_cached('rbl-'.$self->name.'-result', sub { $self->_rbl->check( $ip ) } ); =head2 is_already_done( $key ) This function will raise an flag with name of $key within the session and return true if the flag is already set. False otherwise. This could be used to prevent scores or headers from being applied a second time. Example: if( defined $self->score && ! $r->is_already_done('rbl-'.$self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } =head2 is_attr_defined Returns true if all given attribute names are defined and non-empty. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Cookbook/0000755000175000017500000000000012752672654021611 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Cookbook/HowtoAccountingQuota.pod0000644000175000017500000001352612752672654026451 0ustar werewolfwerewolf# PODNAME: Mail::MtPolicyd::Cookbook::HowtoAccountingQuota # ABSTRACT: How to setup smtp level accounting and quotas __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::HowtoAccountingQuota - How to setup smtp level accounting and quotas =head1 VERSION version 2.02 =head1 SMTP level accounting and quotas with mtpolicyd The mtpolicyd could be used to implement a smtp level accounting and quota system. This guide explains how to setup accounting and quotas based on the sender ip on a monthly base and configurable quota limits. The how to expects that mtpolicyd is already installed, working and assumes a MySQL database is used to hold accounting data and quota configuration. =head2 Set up Accounting The accounting and quota checks should be implemented in postfix smtpd_end_of_data_restrictions. If you're already using mtpolicyd for other check it may be necessary to setup a second virtual host for the accounting/quota configuration. Otherwise you can use the default port 12345 virual host. =head3 Setup a second virtual host First tell mtpolicyd to also listen on an addition port. In the global configuration add the new port to the port option: port="127.0.0.1:12345,127.0.0.1:12346" Then add a new virtual host at the end of the configuration file: name="accounting" # TODO: add plugins... =head3 Configure the Accounting plugin Now add the Accounting plugin to your virtual host: module = "Accounting" fields = "client_address" # time_pattern = "%Y-%m" # table_prefix = "acct_" And the restart mtpolicyd to reload the configuration. The plugin will create a table for every field listed in "fields". By default the table prefix is acct_ so the table name will be acct_client_address in our example. The plugin will create a row within this table for every client_address and expanded time_pattern: mysql> select * from acct_client_address; +----+-------------------+---------+-------+------------+---------+-----------+ | id | key | time | count | count_rcpt | size | size_rcpt | +----+-------------------+---------+-------+------------+---------+-----------+ | 1 | 2604:8d00:0:1::3 | 2015-01 | 18 | 18 | 95559 | 95559 | | 2 | 2604:8d00:0:1::4 | 2015-01 | 21 | 21 | 99818 | 99818 | ... +----+-------------------+---------+-------+------------+---------+-----------+ =head3 Activate the check in postfix To active the check add the policyd to your smtpd_end_of_data_restrictions in main.cf: smtpd_end_of_data_restrictions = check_policy_service inet:127.0.0.1:12346 If you have multiple smtpd process configured in a smtp-filter setup make sure only one smtpd is doing accounting/quota checks. Deactivate the restrictions by adding the following option the the re-inject smtpd processes in master.cf: -o smtpd_end_of_data_restrictions= =head2 Setup quota limits To limit the number of messages a client_address is allowed to send add the following Quota plugin to your virtual host configuration B the Accounting plugin: module = "Quota" field = "client_address" metric = "count" threshold = 1000 action = "defer you exceeded your monthly limit, please insert coin" # time_pattern = "%Y-%m" # table_prefix = "acct_" =head2 Using per client_address quota limits Create the following table structure in your MySQL database: CREATE TABLE `relay_policies` ( `id` int(11) NOT NULL auto_increment, `desc` VARCHAR(64) NOT NULL, `config` TEXT NOT NULL, PRIMARY KEY (`id`) ) ENGINE=InnoDB; INSERT INTO relay_policies VALUES(1, 'standard relay host', '{"quota_count":"10000"}'); INSERT INTO relay_policies VALUES(2, 'premium relay host', '{"quota_count":"100000"}'); CREATE TABLE `relay_hosts` ( `id` int(11) NOT NULL auto_increment, `client_address` VARCHAR(64) NOT NULL, `relay_policy` int(11) NOT NULL, PRIMARY KEY (`id`), KEY `relay_policy` (`relay_policy`), CONSTRAINT `relay_hosts_ibfk_1` FOREIGN KEY (`relay_policy`) REFERENCES `relay_policies` (`id`) ) ENGINE=InnoDB; INSERT INTO relay_hosts VALUES(NULL, '2604:8d00:0:1::3', 1); INSERT INTO relay_hosts VALUES(NULL, '2604:8d00:0:1::4', 2); You can use the following SELECT statement to retrieve the configuration for a relay_host: mysql> SELECT p.config FROM relay_policies p JOIN relay_hosts h ON (h.relay_policy = p.id) WHERE h.client_address = '2604:8d00:0:1::4'; +--------------------------+ | config | +--------------------------+ | {"quota_count":"100000"} | +--------------------------+ 1 row in set (0.00 sec) To load the (JSON) configuration into the mtpolicyd session variables use the SqlUserConfig plugin and this SQL statement: module = "SqlUserConfig" sql_query = "SELECT p.config FROM relay_policies p JOIN relay_hosts h ON (h.relay_policy = p.id) WHERE h.client_address=?" field = "client_address" This plugin must be added B your Accounting and Quota plugins. To use the quota_count value instead of the default threshold adjust your Quota plugin configuration: module = "Quota" field = "client_address" metric = "count" threshold = 1000 uc_threshold = "quota_count" action = "defer you exceeded your monthly limit, please insert coin" # time_pattern = "%Y-%m" # table_prefix = "acct_" If the session variable quota_count is defined it will be used as threshold instead of the value configured in mtpolicyd.conf. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Cookbook/BasicPlugin.pod0000644000175000017500000000631712752672654024524 0ustar werewolfwerewolf# PODNAME: Mail::MtPolicyd::Cookbook::BasicModule # ABSTRACT: how to write your own mtpolicyd plugin __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::BasicModule - how to write your own mtpolicyd plugin =head1 VERSION version 2.02 =head1 How to write your own mtpolicyd plugin mtpolicyd makes use of L. If you're not yet familiar with L you should start reading the L first. =head2 Basic skeleton of a mtpolicyd plugin A plugin in mtpolicyd is basicly a class which inherits from L and is located below the Mail::MtPolicyd::Plugin:: namespace: package Mail::MtPolicyd::Plugin::HelloWorld; use Moose; use namespace::autoclean; # VERSION # ABSTRACT: a mtpolicyd plugin which just returns a hello world reject extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; sub run { my ( $self, $r ) = @_; return Mail::MtPolicyd::Plugin::Result->new( action => 'reject Hello World!', abort => 1, ); } __PACKAGE__->meta->make_immutable; 1; Every plugin must implement a run() method. mtpolicyd will call run() everytime your module is called from the configuration to process a request. A L object containing the current request is passed to the method. The run() method must return undef or a object. If undef is return mtpolicyd will continue with the next plugin. If a result is returned mtpolicyd will push the result to the list of results and abort processing the request if abort is set. After you placed the module with your lib search path you should be able to use the plugin within mtpolicyd.conf: module = "HelloWorld" For now our plugin will just return an "reject Hello World!" action to the MTA. =head2 Adding configuration options All options defined in the configuration file will be passed to the object constructor new() when creating an object of your plugin class. The parameter "module" is not passed to the object constructor because it contains the name of your class. You can defined configuration parameters by adding attributes to your class. You're class already inherits 3 attributes from the Plugin base class: =over =item name (required) Which contains the name of your section. =item log_level (default: 4) Which contains the level used when your plugin calls $self->log( $r, '...');. =item on_error (default: undef) Tells mtpolicyd what to do when the plugin dies. If set to "continue" mtpolicyd will continue processing and just leaves a line in the log. =back Add a new attribute to your plugin class: has 'text' => ( is => 'rw', isa => 'Str', default => 'Hello World!'); Return this string instead of the hard coded string: action => 'reject '.$self->text, The string is now configurable from the config: module = "HelloWorld" text = "Hello Universe!" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Cookbook/Installation.pod0000644000175000017500000000747112752672654024767 0ustar werewolfwerewolf# PODNAME: Mail::MtPolicyd::Cookbook::Installation # ABSTRACT: How to install mtpolicyd __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::Installation - How to install mtpolicyd =head1 VERSION version 2.02 =head1 GET STARTED WITH BASIC MTPOLICYD INSTALLATION =head2 INSTALL MEMCACHED memcached is required for mtpolicyd. A package of memcached should come with your os distribution. On Debian based distributions it can be installed by: apt-get install memcached Check /etc/default/memcached if the service is enabled: ENABLE_MEMCACHED=yes Start the memcached service /etc/init.d/memcached start =head2 INSTALL MTPOLICYD =head3 FROM PACKAGE (RECOMMENDED) There are prebuild packages of mtpolicyd available for several linux distributions. The easiest way is to install mtpolicyd by installing the package build for your distribution. You can download the packages at: http://www.mtpolicyd.org/download.html Installing the package will create a system user/group mtpolicyd on your system, an init script and a default configuration. After installing the package you should be able to start mtpolicyd by just executing the startup script: /etc/init.d/mtpolicyd start =head3 FROM SOURCE/CPAN Since mtpolicyd source is shipped as a perl/CPAN package it could be installed from CPAN. To install the Mail::Mtpolicyd package with all dependencies required make sure you have installed cpanminus: apt-get install cpanminus Then install the Mail::Mtpolicyd distribution with: cpanm Mail::MtPolicyd It is recommended to create an system user and group for the daemon. You can get a default configuration file etc/mtpolicyd.conf from the tarball. The init scripts for the debian packages are located at debian/mtpolicyd.init and for redhat systems at rpm/mtpolicyd.init within the tarball. =head2 TEST MTPOLICYD Now the daemon should be up: $ ps -u mtpolicyd f PID TTY STAT TIME COMMAND 2566 ? Ss 0:12 /usr/bin/mtpolicyd (master) 2731 ? S 0:28 \_ /usr/bin/mtpolicyd (idle) 19464 ? S 0:26 \_ /usr/bin/mtpolicyd (idle) 28858 ? S 0:26 \_ /usr/bin/mtpolicyd (idle) 32372 ? S 0:24 \_ /usr/bin/mtpolicyd (idle) And it should be listening on localhost:12345: $ netstat -aenpt | grep :12345 tcp 0 0 127.0.0.1:12345 0.0.0.0:* LISTEN 0 17333578 - Now test it with a simple query: $ policyd-client -h localhost:12345 Paste the following request to the command: reverse_client_name=smtp.google.com sender=bob@gmail.com client_address=192.168.1.1 recipient=ich@markusbenning.de helo_name=smtp.google.com Terminate the request by a blank line. Just press enter. The mtpolicyd should respond with a action like: PREPEND X-MtScore: NO score =head2 ADD A MTPOLICYD QUERY TO YOUR POSTFIX SMTPD Open you postfix main.cf configuration file in a text editor. It should be located below /etc/postfix. Add a 'check_policyd_service inet:127.0.0.1:12345' check to your smtpd_recipient_restrictions. It should look like this one: smtpd_recipient_restrictions = permit_mynetworks, permit_sasl_authenticated, reject_unauth_destination, check_policy_service inet:127.0.0.1:12345 Now restart postfix. Now follow your maillog as new mails arrive. There should be a mtpolicyd line for every query. =head2 CONGRATULATIONS Your mtpolicyd is now configured and running with the default configuration. You may now want to continue with reading L which explains what the default configuration does. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Cookbook/ExtendedPlugin.pod0000644000175000017500000001365212752672654025243 0ustar werewolfwerewolf# PODNAME: Mail::MtPolicyd::Cookbook::ExtendedModule # ABSTRACT: how to archieve certain tasks within a plugin __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::ExtendedModule - how to archieve certain tasks within a plugin =head1 VERSION version 2.02 =head1 Extending your mtpolicyd plugin How to archieve common task within your plugin. =head2 Logging You can output log messages to the mail.log from within your plugin by calling: $self->log( $r, '' ); The log() method is inherited from the Plugin base class. The default log_level used is 4. To debug your plugin you can overwrite the log_level in your plugins configuration: module = "HelloWorld" log_level = 2 This will cause your plugin to log with an higher log_level of 2. =head2 Caching lookup results If your plugin is called from the smtpd_recipient_restrictions if will be called once for every recipient. If your plugin does an lookup (dns, database, ...) should cache the result. The L object implements the method do_cached() to archieve this: my ( $ip_result, $info ) = $r->do_cached('rbl-'.$self->name.'-result', sub { $self->_rbl->check( $ip ) } ); The first parameter is the key in the session to store the cached result. The second parameter is a function reference. It will check if theres already an result stored in the given key within the session. In this case it will return the cached result as an array. If there is no result it will execute the code reference, store the result within the session and will also return an array containing the return values of the result. =head2 Doing things only once per mail If your plugin is called from the smtpd_recipient_restrictions if will be called once for every recipient but some tasks should only be performed once per mail. The L object implements the method is_already_done() to archieve this: if( defined $self->score && ! $r->is_already_done( $self->name.'-score' ) ) { $self->add_score($r, $self->name => $self->score); } The method takes the key in the session in which the flag is stored. The example above will add a new score to the scoring, but only once per mail since the session is persisted across different checks. =head2 Use scoring To add scoring to your plugin your plugin needs to consume the role L. This will add the method add_score( $r, $key, $value ) to your plugin class. The $key is a name for the score you'll see when you display the detailed scores. eg. with the AddScoreHeader or ScoreAction plugin. The $value is positive or negative number. In most cases you want to make this value configurable. It is also recommended that you check that you add an score only once. See is_already_done() method above. Here is an example: with 'Mail::MtPolicyd::Plugin::Role::Scoring'; has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); And somewhere in your run() method: if( defined $self->score && ! $r->is_already_done( $self->name.'-score' ) ) { $self->add_score( $r, $self->name => $self->score ); } =head2 Make a configuration value user-configurable To add user configurable parameters to your plugin the class must consume the L role. with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; The regular attributes: has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); The UserConfig role adds the get_uc( $session, $param ) method to your class. To retrieve the user-configurable values for this attributes use: my $session = $r->session; my $mode = $self->get_uc( $session, 'mode' ); my $enabled = $self->get_uc( $session, 'enabled' ); Per user configuration in mtpolicyd works like this: =over =item Retrieve configuration values and store them in the session A plugin like SqlUserConfig retrieves configuration values and stores them in the current session. For example it may set the following key value: hello_world_enabled = off =item A Plugin with user configurable parameters Our HelloWorld plugin may be configured like this: module = "HelloWorld" enabled = on uc_enabled = "hello_world_enabled" If the key "hello_world_enabled" is defined in the session it will use its value for $mode. If it is not defined it will fall back to value of the "enabled" attribute. =back =head2 Set a mail header The L object has an extra constructor for returning a PREPEND action for setting a header: Mail::MtPolicyd::Plugin::Result->new_header_once( $is_already_done, $header_name, $value ); It could be used like this: return Mail::MtPolicyd::Plugin::Result->new_header_once( $r->is_already_done( $self->name.'-tag' ), $header_name, $value ); =head2 Adding periodically scheduled tasks When mtpolicyd is called with the option --cron it will execute all plugins that implement a cron() function. The function is expected to take the following parameters: $plugin->cron( $server, @tasks ); By default mtpolicyd ships with a crontab that will execute the tasks hourly,daily,weekly and monthly. A plugin that implements a weekly task may look like this: sub cron { my $self = shift; my $server = shift; if( grep { $_ eq 'weekly' } @_ ) { # do some weekly tasks $server->log(3, 'i am a weekly task'); } } The $server object could be used for logging. To see the output on the commandline you may call mtpolicyd like this: mtpolicyd -f -l 4 --cron=weekly =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Role/0000755000175000017500000000000012752672654020744 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Role/Connection.pm0000644000175000017500000000326712752672654023411 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Role::Connection; use strict; use MooseX::Role::Parameterized; use Mail::MtPolicyd::ConnectionPool; # ABSTRACT: role to consume connections from connection pool our $VERSION = '2.02'; # VERSION parameter name => ( isa => 'Str', default => 'db', ); parameter type => ( isa => 'Str', default => 'Sql', ); parameter initialize_early => ( isa => 'Bool', default => 1, ); role { my $p = shift; my $name = $p->name; my $conn_attr = '_'.$p->name; my $handle_attr = $conn_attr.'_handle'; my $conn_class = 'Mail::MtPolicyd::Connection::'.$p->type; if( $p->initialize_early ) { before 'init' => sub { my $self = shift; $self->$conn_attr; return; }; } has $name => ( is => 'ro', isa => 'Str', default => $name, ); has $conn_attr => ( is => 'ro', isa => $conn_class, lazy => 1, default => sub { my $self = shift; my $conn = Mail::MtPolicyd::ConnectionPool->get_connection($self->$name); if( ! defined $conn ) { die("no connection $name configured!"); } return $conn; }, ); has $handle_attr => ( is => 'ro', lazy => 1, default => sub { my $self = shift; return $self->$conn_attr->handle; }, ); }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Role::Connection - role to consume connections from connection pool =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Connection/0000755000175000017500000000000012752672654022142 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Connection/Sql.pm0000644000175000017500000000361212752672654023241 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Connection::Sql; use Moose; extends 'Mail::MtPolicyd::Connection'; # ABSTRACT: Connection pool sql connection object our $VERSION = '2.02'; # VERSION use DBI; has 'dsn' => ( is => 'ro', isa => 'Str', required => 1 ); has 'user' => ( is => 'ro', isa => 'Str', default => '' ); has 'password' => ( is => 'ro', isa => 'Str', default => '' ); has 'handle' => ( is => 'rw', isa => 'DBI::db', lazy => 1, default => sub { my $self = shift; return $self->_create_handle; }, handles => [ 'disconnect' ], ); sub _create_handle { my $self = shift; my $handle = DBI->connect( $self->dsn, $self->user, $self->password, { RaiseError => 1, PrintError => 0, AutoCommit => 1, mysql_auto_reconnect => 1, }, ); return $handle; } sub reconnect { my $self = shift; $self->handle( $self->_create_handle ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection::Sql - Connection pool sql connection object =head1 VERSION version 2.02 =head1 SYNOPSIS module = "Sql" # see perldoc DBI for syntax of dsn connection string dsn = "dbi:SQLite:dbname=/var/lib/mtpolicyd/mtpolicyd.sqlite" # user = "mtpolicyd" # user = "secret" =head1 PARAMETERS =over =item dsn (required) A perl DBI connection string. Examples: dbi:SQLite:dbname=/var/lib/mtpolicyd/mtpolicyd.sqlite dbi:SQLite::memory: DBI:mysql:database=test;host=localhost see L =item user (default: '') A username if required for connection. =item password (default: '') A password if required for user/connection. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Connection/Memcached.pm0000644000175000017500000000361712752672654024355 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Connection::Memcached; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: a memcached connection plugin for mtpolicyd extends 'Mail::MtPolicyd::Connection'; use Cache::Memcached; has 'servers' => ( is => 'ro', isa => 'Str', default => '127.0.0.1:11211' ); has '_servers' => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->servers) ]; }, ); has 'debug' => ( is => 'ro', isa => 'Bool', default => 0 ); has 'namespace' => ( is => 'ro', isa => 'Str', default => ''); sub _create_handle { my $self = shift; return Cache::Memcached->new( { 'servers' => $self->_servers, 'debug' => $self->debug, 'namespace' => $self->namespace, } ); } has 'handle' => ( is => 'rw', isa => 'Cache::Memcached', lazy => 1, default => sub { my $self = shift; $self->_create_handle }, ); sub reconnect { my $self = shift; $self->handle( $self->_create_handle ); return; } sub shutdown { my $self = shift; $self->handle->disconnect_all; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection::Memcached - a memcached connection plugin for mtpolicyd =head1 VERSION version 2.02 =head1 SYNOPSIS module = "Memcached" servers = "127.0.0.1:11211" # namespace = "mt-" =head1 PARAMETERS =over =item servers (default: 127.0.0.1:11211) Comma seperated list for memcached servers to connect. =item debug (default: 0) Enable to debug memcached connection. =item namespace (default: '') Set a prefix used for all keys of this connection. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Connection/Redis.pm0000644000175000017500000000355612752672654023557 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Connection::Redis; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: a mtpolicy connection for redis databases extends 'Mail::MtPolicyd::Connection'; use Redis; has 'server' => ( is => 'ro', isa => 'Str', default => '127.0.0.1:6379' ); has 'debug' => ( is => 'ro', isa => 'Bool', default => 0 ); has 'password' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'db' => ( is => 'ro', isa => 'Int', default => 0 ); sub _create_handle { my $self = shift; my $redis = Redis->new( 'server' => $self->server, 'debug' => $self->debug, defined $self->password ? ( 'password' => $self->password ) : (), ); $redis->select( $self->db ); return $redis; } has 'handle' => ( is => 'rw', isa => 'Redis', lazy => 1, default => sub { my $self = shift; return $self->_create_handle; }, ); sub reconnect { my $self = shift; $self->handle( $self->_create_handle ); return; } sub shutdown { my $self = shift; $self->handle->wait_all_responses; $self->handle->quit; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection::Redis - a mtpolicy connection for redis databases =head1 VERSION version 2.02 =head1 SYNOPSIS server = "127.0.0.1:6379" db = 0 # password = "secret" =head1 PARAMETERS =over =item server (default: 127.0.0.1:6379) The redis server to connect. =item debug (default: 0) Set to 1 to enable debugging of redis connection. =item password (default: undef) Set password if required for redis connection. =item db (default: 0) Select a redis database to use. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Connection/Ldap.pm0000644000175000017500000000543412752672654023366 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Connection::Ldap; use Moose; extends 'Mail::MtPolicyd::Connection'; # ABSTRACT: a LDAP connection plugin for mtpolicyd our $VERSION = '2.02'; # VERSION use Net::LDAP; has 'host' => ( is => 'ro', isa => 'Str', default => 'localhost' ); has 'port' => ( is => 'ro', isa => 'Int', default => 389 ); has 'keepalive' => ( is => 'ro', isa => 'Bool', default => 1 ); has 'timeout' => ( is => 'ro', isa => 'Int', default => 120 ); has 'binddn' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'password' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'starttls' => ( is => 'ro', isa => 'Bool', default => 1 ); has 'handle' => ( is => 'rw', isa => 'Net::LDAP', lazy => 1, default => sub { my $self = shift; return $self->_connect_ldap; }, handles => { 'disconnect' => 'unbind', }, ); has 'connection_class' => ( is => 'ro', isa => 'Maybe[Str]' ); sub _connect_ldap { my $self = shift; my $ldap_class = 'Net::LDAP'; if( defined $self->connection_class ) { $ldap_class = $self->connection_class; eval "require $ldap_class;"; ## no critic } my $ldap = $ldap_class->new( $self->host, port => $self->port, keepalive => $self->keepalive, timeout => $self->timeout, onerror => 'die', ) or die ('cant connect ldap: '.$@); if( $self->starttls ) { eval{ $ldap->start_tls( verify => 'require' ); }; if( $@ ) { die('starttls on ldap connection failed: '.$@); } } if( defined $self->binddn ) { $ldap->bind( $self->binddn, password => $self->password ); } else { $ldap->bind; # anonymous bind } return $ldap; } sub reconnect { my $self = shift; $self->handle( $self->_connect_ldap ); return; } sub shutdown { my $self = shift; $self->handle->unbind; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection::Ldap - a LDAP connection plugin for mtpolicyd =head1 VERSION version 2.02 =head1 SYNOPSIS module = "Ldap" host = "localhost" =head1 PARAMETERS =over =item host (default: 'localhost') LDAP server to connect to. =item port (default: 389) LDAP servers port number to connect to. =item keepalive (default: 1) Enable connection keepalive for this connection. =item timeout (default: 120) Timeout in seconds for operations on this connection. =item binddn (default: undef) If set a bind with this binddn is done when connecting. =item password (default: undef) =item starttls (default: 1) Enable or disabled the use of starttls. (TLS/SSL encryption) =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/SessionCache.pm0000644000175000017500000000310512752672654022747 0ustar werewolfwerewolfpackage Mail::MtPolicyd::SessionCache; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: class for handling session cache use Mail::MtPolicyd::SessionCache::None; has 'server' => ( is => 'ro', isa => 'Net::Server', required => 1, handles => { 'log' => 'log', } ); has 'cache' => ( is => 'rw', isa => 'Mail::MtPolicyd::SessionCache::Base', lazy => 1, default => sub { Mail::MtPolicyd::SessionCache::None->new }, handles => [ 'retrieve_session', 'store_session', 'shutdown', ], ); sub load_config { my ( $self, $config ) = @_; if( ! defined $config->{'module'} ) { die('no module defined for SessionCache!'); } my $module = $config->{'module'}; my $class = 'Mail::MtPolicyd::SessionCache::'.$module; my $cache; $self->log(1, 'loading SessionCache '.$module); my $code = "require ".$class.";"; eval $code; ## no critic (ProhibitStringyEval) if($@) { die('could not load SessionCache '.$module.': '.$@); } $self->log(1, 'initializing SessionCache '.$module); eval { $cache = $class->new( %$config, ); $cache->init(); }; if($@) { die('could not initialize SessionCache: '.$@); } $self->cache( $cache ); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache - class for handling session cache =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/0000755000175000017500000000000012752672654021301 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/SaAwlAction.pm0000644000175000017500000001564612752672654024020 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::SaAwlAction; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for checking spamassassin AWL reputation extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; use Mail::MtPolicyd::Plugin::Result; has 'result_from' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'reject_message' => ( is => 'ro', isa => 'Str', default => 'sender address/ip has bad reputation', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'score_factor' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'min_count' => ( is => 'rw', isa => 'Int', default => 10 ); has 'threshold' => ( is => 'rw', isa => 'Num', default => 5 ); has 'match' => ( is => 'rw', isa => 'Str', default => 'gt'); sub matches { my ( $self, $score ) = @_; if( $self->match eq 'gt' && $score >= $self->threshold ) { return 1; } elsif ( $self->match eq 'lt' && $score <= $self->threshold ) { return 1; } return 0; } sub run { my ( $self, $r ) = @_; my $addr = $r->attr('sender'); my $ip = $r->attr('client_address'); my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } my $result_key = 'sa-awl-'.$self->result_from.'-result'; if( ! defined $session->{$result_key} ) { $self->log( $r, 'no SaAwlLookup result for '.$self->result_from.' found!'); return; } my ( $count, $score ) = @{$session->{$result_key}}; if( ! defined $count || ! defined $score) { return; # there was no entry in AWL } if( $count < $self->min_count ) { $self->log( $r, 'sender awl reputation below min_count' ); return; } if( ! $self->matches( $score ) ) { return; } $self->log( $r, 'matched SA AWL threshold action '.$self->name ); if( ! $r->is_already_done('sa-awl-'.$self->name.'-score') ) { if( $self->score ) { $self->add_score($r, $self->name => $self->score); } elsif( $self->score_factor ) { $self->add_score($r, $self->name => $score * $self->score_factor); } } my $mode = $self->get_uc( $session, 'mode' ); if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action( $addr, $ip, $score ), abort => 1, ); } if( $mode eq 'accept' || $mode eq 'dunno' ) { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } sub _get_reject_action { my ( $self, $sender, $ip, $score ) = @_; my $message = $self->reject_message; $message =~ s/%IP%/$ip/; $message =~ s/%SENDER%/$sender/; $message =~ s/%SCORE%/$score/; return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SaAwlAction - mtpolicyd plugin for checking spamassassin AWL reputation =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin will execute an action or score based on a previous lookup done with SaAwlLookup plugin. =head1 PARAMETERS =over =item result_from (required) Take the AWL information from the result of this plugin. The plugin in must be executed before this plugin. =item (uc_)enabled (default: on) Enable/disable this plugin. =item (uc_)mode (default: reject) If set to 'passive' no action will be returned. =item reject_message (default: 'sender address/ip has bad reputation') Could be used to specify an custom reject message. =item score (default: empty) A score to apply to the message. =item score_factor (default: empty) A factor to apply the SA score to the message. Do not configure a score if you want to use the factor. =item min_count (default: 10) The minimum count of mails/scores spamassassin must have done on this sender/ip before the AWL entry is used. If the count in AWLs auto-whitelist table is below this count the test will be skipped. =item threshold (default: 5) At this threshold the action or score will be applied. =item match (default: gt) The default is to match values greater("gt") than the threshold. When configured with 'lt' AWL scores less than the threshold will be matched. =back =head1 EXAMPLE Check that AWL is active in your SA/amavis configuration: loadplugin Mail::SpamAssassin::Plugin::AWL use_auto_whitelist 1 Make sure that mtpolicyd has permissions to read the auto-whitelist db: $ usermod -G amavis mtpolicyd $ chmod g+rx /var/lib/amavis/.spamassassin $ chmod g+r /var/lib/amavis/.spamassassin/auto-whitelist Make sure it stays like this when its recreated in your SA local.cf: auto_whitelist_file_mode 0770 Net::Server does not automatically set supplementary groups. You have to do that in mtpolicyd.conf: group="mtpolicyd amavis" Permissions may be different on your system. To check that mtpolicyd can access the file try: $ sudo -u mtpolicyd -- head -n0 /var/lib/amavis/.spamassassin/auto-whitelist Now use it in mtpolicyd.conf: module = "SaAwlLookup" db_file = "/var/lib/amavis/.spamassassin/auto-whitelist" For whitelisting you may configure it like: module = "SaAwlAction" result_from = "amavis-reputation" mode = "accept" match = "lt" threshold = "0" Or apply a score based for bad AWL reputation (score > 5): module = "SaAwlAction" result_from = "amavis-reputation" mode = "passive" match = "gt" threshold = 6 score = 5 Or apply the score value from AWL with an factor: module = "SaAwlAction" result_from = "amavis-reputation" mode = "passive" match = "gt" threshold = 5 score_factor = 0.5 If the score in AWL is >5 it will apply the score with an factor of 0.5. When the score in AWL is 8 it will apply a score of 4. Or just reject all mail with a bad reputation: module = "SaAwlAction" result_from = "amavis-reputation" mode = "reject" match = "gt" threshold = 5 reject_message = "bye bye..." =head1 Troubleshooting =head2 Check content of spamassassin AWL auto-whitelist To check the content of the auto-whitelist database use the sa-awl command: $ sa-awl /var/lib/amavis/.spamassassin/auto-whitelist | grep =head1 SEE ALSO =over =item Spamassassin AutoWhitelist manual L =item Spamassassin AWL plugin reference L =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/SaAwlLookup.pm0000644000175000017500000000655312752672654024051 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::SaAwlLookup; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for querying a spamassassin AWL database for reputation extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use BerkeleyDB; use BerkeleyDB::Hash; use NetAddr::IP; has 'db_file' => ( is => 'rw', isa => 'Str', default => '/var/lib/amamvis/.spamassassin/auto-whitelist' ); has '_awl' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { my $self = shift; my %map; my $db = tie %map, 'BerkeleyDB::Hash', -Filename => $self->db_file, -Flags => DB_RDONLY or die "Cannot open ".$self->db_file.": $!\n" ; return(\%map); }, ); sub truncate_ip_v4 { my ( $self, $ip ) = @_; if( $ip =~ m/^(\d+\.\d+).\d+.\d+$/ ) { return( $1 ); } return; } sub truncate_ip_v6 { my ( $self, $ip ) = @_; my $addr = NetAddr::IP->new6( $ip.'/48' ); if( ! defined $addr ) { return; } my $result = $addr->network->full6; $result =~ s/(:0000)+/::/; return $result; } sub truncate_ip { my ( $self, $ip ) = @_; if( $ip =~ /:/) { return $self->truncate_ip_v6($ip); } return $self->truncate_ip_v4($ip); } sub query_awl { my ( $self, $addr, $ip ) = @_; my $ip_key = $self->truncate_ip( $ip ); if( ! defined $ip_key ) { return; } my $count = $self->_awl->{$addr.'|ip='.$ip_key}; if( ! defined $count ) { return; } my $total = $self->_awl->{$addr.'|ip='.$ip_key.'|totscore'}; if( ! defined $total ) { return; } my $score = $total / $count; return( $count, $score ); } sub run { my ( $self, $r ) = @_; my $addr = $r->attr('sender'); my $ip = $r->attr('client_address'); my $session = $r->session; if( ! defined $addr || ! defined $ip ) { return; } my ( $count, $score ) = $r->do_cached('sa-awl-'.$self->name.'-result', sub { $self->query_awl( $addr, $ip ) } ); if( ! defined $count || ! defined $score ) { $self->log($r, 'no AWL record for '.$addr.'/'.$ip.' found'); return; } $self->log($r, 'AWL record for '.$addr.'/'.$ip.' count='.$count.', score='.$score); return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SaAwlLookup - mtpolicyd plugin for querying a spamassassin AWL database for reputation =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin queries the auto_whitelist database used by spamassassins AWL plugin for the reputation of sender ip/address combination. Based on the AWL score a score or action in mtpolicyd can be applied in combination with the SaAwlAction plugin. =head1 PARAMETERS =over =item db_file (default: /var/lib/amavis/.spamassassin/auto-whitelist) The path to the auto-whitelist database file. =back =head1 EXAMPLE To read reputation from amavis/spamassassin AWL use: module = "SaAwlLookup" db_file = "/var/lib/amamvis/.spamassassin/auto-whitelist" The location of auto-whitelist may be different on your system. Make sure mtpolicyd is allowed to read the db_file. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/AddScoreHeader.pm0000644000175000017500000000440012752672654024432 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::AddScoreHeader; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for adding the score as header to the mail extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'spam_score' ], }; use Mail::MtPolicyd::Plugin::Result; has 'header_name' => ( is => 'ro', isa => 'Str', default => 'X-MtScore', ); has 'spam_score' => ( is => 'ro', isa => 'Num', default => '5' ); sub run { my ( $self, $r ) = @_; my $score = $self->_get_score($r); my $spam_score = $self->get_uc($r->session, 'spam_score'); my $value; if( ! defined $score ) { $self->log($r, 'score is undefined'); } if( $score >= $spam_score ) { $value = 'YES '; } else { $value = 'NO '; } $value .= 'score='.$score; if( my $details = $self->_get_score_detail($r) ) { $value .= ' ['.$details.']'; } return Mail::MtPolicyd::Plugin::Result->new_header_once( $r->is_already_done('score-'.$self->score_field.'-tag'), $self->header_name, $value ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::AddScoreHeader - mtpolicyd plugin for adding the score as header to the mail =head1 VERSION version 2.02 =head1 DESCRIPTION Adds an header with the current score and score details to the mail. =head1 PARAMETERS =over =item (uc_)spam_score (default: 5) If the score is higher than this value it'll be tagged as 'YES'. Otherwise 'NO'. =item score_field (default: score) Specifies the name of the field the score is stored in. Could be set if you need multiple scores. =item header_name (default: X-MtScore) The name of the header to set. =back =head1 EXAMPLE module = "AddScoreHeader" # score_field = "score" # header_name = "X-MtScore" spam_score = 5 Will return an action like: X-MtScore: YES score=7.5 [CTIPREP_TEMP=2.5, spamhaus-rbl=5] =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/SqlList.pm0000644000175000017500000001071212752672654023233 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::SqlList; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for accessing a SQL white/black/access list extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'sql_query' => ( is => 'rw', isa => 'Str', default => 'SELECT client_ip FROM whitelist WHERE client_ip=INET_ATON(?)', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'match_action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'not_match_action' => ( is => 'rw', isa => 'Maybe[Str]' ); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub _query_db { my ( $self, $ip ) = @_; return $self->execute_sql($self->sql_query, $ip)->fetchrow_array; } sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $config; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } if( ! defined $ip) { $self->log($r, 'no attribute \'client_address\' in request'); return; } my $value = $r->do_cached( $self->name.'-result', sub { $self->_query_db($ip) } ); if( $value ) { $self->log($r, 'client_address '.$ip.' matched SqlList '.$self->name); if( defined $self->score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name , $self->score); } if( defined $self->match_action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->match_action, abort => 1, ); } } else { $self->log($r, 'client_address '.$ip.' did not match SqlList '.$self->name); if( defined $self->not_match_action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->not_match_action, abort => 1, ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SqlList - mtpolicyd plugin for accessing a SQL white/black/access list =head1 VERSION version 2.02 =head1 SYNOPSIS module="SqlList" sql_query="SELECT client_ip FROM whitelist WHERE client_ip=?" match_action=dunno module="SqlList" sql_query="SELECT client_ip FROM blacklist WHERE client_ip=?" match_action="reject you are blacklisted!" =head1 DESCRIPTION Plugin checks the client_address against a SQL table. Depending on wether a supplied SQL query matched actions can be taken. =head2 PARAMETERS The module takes the following parameters: =over =item (uc_)enabled (default: "on") Could be set to 'off' to deactivate check. Could be used to activate/deactivate check per user. =item sql_query (default: "SELECT client_ip FROM whitelist WHERE client_ip=INET_ATON(?)") Prepared SQL statement to use for checking an IP address. ? will be replaced by the IP address. The module will match if the statement returns one or more rows. =back By default the plugin will do nothing. One of the following actions should be specified: =over =item match_action (default: empty) If given this action will be returned to the MTA if the SQL query matched. =item not_match_action (default: empty) If given this action will be returned to the MTA if the SQL query DID NOT matched. =item score (default: empty) If given this score will be applied to the session. =back =head1 EXAMPLE WITH A MYSQL TABLE You may use the following table for storing ipv4 addresses in MySQL: CREATE TABLE `whitelist` ( `id` int(11) NOT NULL AUTO_INCREMENT, `client_ip` INT UNSIGNED NOT NULL, PRIMARY KEY (`id`), UNIQUE KEY `client_ip` (`client_ip`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1 INSERT INTO whitelist VALUES(NULL, INET_ATON('127.0.0.1')); And use it as a whitelist in mtpolicyd: name="reputation" module="SqlList" sql_query="SELECT client_ip FROM whitelist WHERE client_ip=INET_ATON(?)" match_action="dunno" ... =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/SPF.pm0000644000175000017500000002232112752672654022267 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::SPF; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin to apply SPF checks extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'fail_mode', 'softfail_mode', 'pass_mode' ], }; use Mail::MtPolicyd::Plugin::Result; use Mail::MtPolicyd::AddressList; use Mail::SPF; use Net::DNS::Resolver; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'pass_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'pass_mode' => ( is => 'rw', isa => 'Str', default => 'passive' ); has 'softfail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'softfail_mode' => ( is => 'rw', isa => 'Str', default => 'passive' ); has 'fail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'fail_mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'reject_message' => ( is => 'rw', isa => 'Str', default => 'SPF validation failed: %LOCAL_EXPL%' ); has 'default_authority_explanation' => ( is => 'ro', isa => 'Str', default => 'See http://www.%{d}/why/id=%{S};ip=%{I};r=%{R}' ); has 'hostname' => ( is => 'ro', isa => 'Str', default => '' ); has 'whitelist' => ( is => 'rw', isa => 'Str', default => ''); has '_whitelist' => ( is => 'ro', isa => 'Mail::MtPolicyd::AddressList', lazy => 1, default => sub { my $self = shift; my $list = Mail::MtPolicyd::AddressList->new; $list->add_localhost; $list->add_string( $self->whitelist ); return $list; }, ); # use a custom resolver to be able to provide a mock in unit tests has '_dns_resolver' => ( is => 'ro', isa => 'Net::DNS::Resolver', lazy => 1, default => sub { Net::DNS::Resolver->new; }, ); has '_spf' => ( is => 'ro', isa => 'Mail::SPF::Server', lazy => 1, default => sub { my $self = shift; return Mail::SPF::Server->new( default_authority_explanation => $self->default_authority_explanation, hostname => $self->hostname, dns_resolver => $self->_dns_resolver, ); }, ); has 'check_helo' => ( is => 'rw', isa => 'Str', default => 'on'); sub run { my ( $self, $r ) = @_; if( $self->get_uc($r->session, 'enabled') eq 'off' ) { return; } if( ! $r->is_attr_defined('client_address') ) { $self->log( $r, 'cant check SPF without client_address'); return; } if( $self->_whitelist->match_string( $r->attr('client_address') ) ) { $self->log( $r, 'skipping SPF checks for local or whitelisted ip'); return; } my $sender = $r->attr('sender'); if( $r->is_attr_defined('helo_name') && $self->check_helo ne 'off' ) { my $helo_result = $self->_check_helo( $r ); if( defined $helo_result ) { return( $helo_result ); # return action if present } if( ! $r->is_attr_defined('sender') ) { $sender = 'postmaster@'.$r->attr('helo_name'); $self->log( $r, 'null sender, building sender from HELO: '.$sender ); } } if( ! defined $sender ) { $self->log( $r, 'skipping SPF check because of null sender, consider setting check_helo=on'); return; } return $self->_check_mfrom( $r, $sender ); } sub _check_helo { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $helo = $r->attr('helo_name'); my $session = $r->session; my $request = Mail::SPF::Request->new( scope => 'helo', identity => $helo, ip_address => $ip, ); my $result = $self->_spf->process($request); return $self->_check_spf_result( $r, $result, 1 ); } sub _check_mfrom { my ( $self, $r, $sender ) = @_; my $ip = $r->attr('client_address'); my $helo = $r->attr('helo_name'); my $request = Mail::SPF::Request->new( scope => 'mfrom', identity => $sender, ip_address => $ip, defined $helo && length($helo) ? ( helo_identity => $helo ) : (), ); my $result = $self->_spf->process($request); return $self->_check_spf_result( $r, $result, 0 ); } sub _check_spf_result { my ( $self, $r, $result, $no_pass_action ) = @_; my $scope = $result->request->scope; my $session = $r->session; my $fail_mode = $self->get_uc($session, 'fail_mode'); my $softfail_mode = $self->get_uc($session, 'softfail_mode'); my $pass_mode = $self->get_uc($session, 'pass_mode'); if( $result->code eq 'neutral') { $self->log( $r, 'SPF '.$scope.' status neutral. (no SPF records)'); return; } elsif( $result->code eq 'fail') { $self->log( $r, 'SPF '.$scope.' check failed: '.$result->local_explanation); if( defined $self->fail_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score( $r, $self->name => $self->fail_score ); } if( $fail_mode eq 'reject') { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($result), abort => 1, ); } return; } elsif( $result->code eq 'softfail') { $self->log( $r, 'SPF '.$scope.' check returned softfail '.$result->local_explanation); if( defined $self->softfail_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score( $r, $self->name => $self->softfail_score ); } if( $softfail_mode eq 'reject') { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($result), abort => 1, ); } elsif( $softfail_mode eq 'accept' || $softfail_mode eq 'dunno') { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } elsif( $result->code eq 'pass' ) { $self->log( $r, 'SPF '.$scope.' check passed'); if( $no_pass_action ) { return; } if( defined $self->pass_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score( $r, $self->name => $self->pass_score ); } if( $pass_mode eq 'accept' || $pass_mode eq 'dunno') { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } $self->log( $r, 'spf '.$scope.' check failed: '.$result->local_explanation ); return; } sub _get_reject_action { my ( $self, $result ) = @_; my $message = $self->reject_message; if( $message =~ /%LOCAL_EXPL%/) { my $expl = $result->local_explanation; $message =~ s/%LOCAL_EXPL%/$expl/; } if( $message =~ /%AUTH_EXPL%/) { my $expl = ''; if( $result->can('authority_explanation') ) { $expl = $result->authority_explanation; } $message =~ s/%AUTH_EXPL%/$expl/; } return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SPF - mtpolicyd plugin to apply SPF checks =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin applies Sender Policy Framework(SPF) checks. Checks are implemented using the Mail::SPF perl module. Actions based on the SPF result can be applied for: =over =item pass (pass_mode, default: passive) =item softfail (softfail_mode, default: passive) =item fail (fail_mode, default: reject) =back For status 'neutral' no action or score is applied. =head1 PARAMETERS =over =item (uc_)enabled (default: on) Enable/disable the plugin. =item (uc_)pass_mode (default: passive) How to behave if the SPF checks passed successfully: =over =item passive Just apply score. Do not return an action. =item accept, dunno Will return an 'dunno' action. =back =item pass_score (default: empty) Score to apply when the sender has been successfully checked against SPF. =item (uc_)softfail_mode (default: passive) How to behave if the SPF checks returned a softfail status. =over =item passive Just apply score. Do not return an action. =item accept, dunno Will return an 'dunno' action. =item reject Return an reject action. =back =item softfail_score (default: empty) Score to apply when the SPF check returns an softfail status. =item (uc_)fail_mode (default: reject) =over =item reject Return an reject action. =item passive Just apply score and do not return an action. =back =item reject_message (default: ) If fail_mode is set to 'reject' this message is used in the reject. The following pattern will be replaced in the string: =over =item %LOCAL_EXPL% Will be replaced with a (local) explanation of the check result. =item %AUTH_EXPL% Will be replaced with a URL to the explanation of the result. This URL could be configured with 'default_authority_explanation'. =back =item fail_score (default: empty) Score to apply if the sender failed the SPF checks. =item default_authority_explanation (default: See http://www.%{d}/why/id=%{S};ip=%{I};r=%{R}) String to return as an URL pointing to an explanation of the SPF check result. See Mail::SPF::Server for details. =item hostname (default: empty) An hostname to show in the default_authority_explanation as generating server. =item whitelist (default: '') A comma separated list of IP addresses to skip. =item check_helo (default: "on") Set to 'off' to disable SPF check on helo. =back =head1 EXAMPLE module = "SPF" pass_mode = passive pass_score = -10 fail_mode = reject #fail_score = 10 =head1 SEE ALSO L, OpenSPF L, RFC 7209 L =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/PostfixMap.pm0000644000175000017500000001163712752672654023741 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::PostfixMap; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for accessing a postfix access map extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; use BerkeleyDB; use BerkeleyDB::Hash; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'db_file' => ( is => 'rw', isa => 'Str', required => 1 ); has _map => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { my $self = shift; my %map; my $db = tie %map, 'BerkeleyDB::Hash', -Filename => $self->db_file, -Flags => DB_RDONLY or die "Cannot open ".$self->db_file.": $!\n" ; $db->filter_fetch_key ( sub { s/\0$// } ) ; $db->filter_store_key ( sub { $_ .= "\0" } ) ; $db->filter_fetch_value( sub { s/\0$// } ) ; $db->filter_store_value( sub { $_ .= "\0" } ) ; return(\%map); }, ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'match_action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'not_match_action' => ( is => 'rw', isa => 'Maybe[Str]' ); sub _match_ipv4 { my ( $self, $ip ) = @_; my @octs = split('\.', $ip); while( @octs ) { my $key = join('.', @octs); my $value = $self->_map->{$key}; if( defined $value ) { return( $key, $value ); } pop(@octs); } return; } sub _match_ipv6 { my ( $self, $ip ) = @_; for(;;) { my $value = $self->_map->{$ip}; if( $value ) { return( $ip, $value ); } if( $ip !~ m/:/) { last; } # remove last part $ip =~ s/:+[^:]+$//; } return; } sub _query_db { my ( $self, $ip ) = @_; my ( $key, $value ); if( $ip =~ m/^\d+\.\d+\.\d+\.\d+$/) { ( $key, $value ) = $self->_match_ipv4( $ip ); } elsif( $ip =~ m/^[:0-9a-f]+$/) { ( $key, $value ) = $self->_match_ipv6( $ip ); } else { die('ip is neither a valid ipv4 nor ipv6 address.'); } if( ! defined $value ) { return; } if( $value eq 'OK' || $value =~ m/^\d+$/) { return( 1, $key, $value ); } return(0, $key, $value); } sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $config; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } if( ! defined $ip) { $self->log($r, 'no attribute \'client_address\' in request'); return; } my ( $match, $key, $value ) = $r->do_cached( $self->name.'-result', sub { $self->_query_db($ip) } ); if( $match ) { $self->log($r, 'client_address '.$ip.' matched '.$self->name.' ('. $key.' '.$value.')' ); if( defined $self->score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( defined $self->match_action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->match_action, abort => 1, ); } } else { $self->log($r, 'client_address '.$ip.' did not match '.$self->name); if( defined $self->not_match_action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->not_match_action, abort => 1, ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::PostfixMap - mtpolicyd plugin for accessing a postfix access map =head1 VERSION version 2.02 =head1 SYNOPSIS module="PostfixMap" db_file="/etc/postfix/whitelist.db" match_action=dunno moduel="PostfixMap" db_file="/etc/postfix/blacklist.db" match_action="reject you are blacklisted!" =head1 DESCRIPTION Plugin checks the client_address against a postfix hash table. It will only check if the IP address matches the list. 'OK' or a numerical value will be interpreted as a 'true' value. All other actions or values will be treaded as 'false'. =head1 EXAMPLE TABLE /etc/postfix/whitelist: 123.123.123.123 OK 123.123.122 OK 123.12 OK fe80::250:56ff:fe85:56f5 OK fe80::250:56ff:fe83 OK generate whitelist.db: $ postmap whitelist =head2 PARAMETERS The module takes the following parameters: =over =item (uc_)enabled (default: "on") Could be set to 'off' to deactivate check. Could be used to activate/deactivate check per user. =back By default the plugin will do nothing. One of the following actions should be specified: =over =item match_action (default: empty) If given this action will be returned to the MTA if the SQL query matched. =item not_match_action (default: empty) If given this action will be returned to the MTA if the SQL query DID NOT matched. =item score (default: empty) If given this score will be applied to the session. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Result.pm0000644000175000017500000000221012752672654023110 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Result; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: result returned by a plugin has 'action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'abort' => ( is => 'rw', isa => 'Bool', default => 0 ); sub new_dunno { my $class = shift; my $obj = $class->new( action => 'dunno', abort => 1, ); return($obj); } sub new_header { my ( $class, $header, $value ) = @_; my $obj = $class->new( action => 'PREPEND '.$header.': '.$value, abort => 1, ); return($obj); } sub new_header_once { my ( $class, $is_done, $header, $value ) = @_; if( $is_done ) { return $class->new_dunno; } return $class->new_header($header, $value); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Result - result returned by a plugin =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/SetField.pm0000644000175000017500000000217212752672654023340 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::SetField; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin which just sets and key=value in the session extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; has 'key' => ( is => 'rw', isa => 'Str', required => 1 ); has 'value' => ( is => 'rw', isa => 'Str', required => 1 ); sub run { my ( $self, $r ) = @_; $r->session->{$self->key} = $self->value; return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SetField - mtpolicyd plugin which just sets and key=value in the session =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin can be used to set key/values within the session. =head1 EXAMPLE module = "SetField" key=mail-is-scanned value=1 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Condition.pm0000644000175000017500000001215212752672654023566 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Condition; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for conditions based on session values extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'score', 'action' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; has 'key' => ( is => 'rw', isa => 'Str', required => 1 ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'match' => ( is => 'rw', isa => 'Maybe[Str]' ); has 're_match' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'gt_match' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'lt_match' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'invert' => ( is => 'rw', isa => 'Bool', default => 0 ); sub _match { my ( $self, $value ) = @_; if( defined $self->match && $value eq $self->match ) { return 1; } my $regex = $self->re_match; if( defined $regex && $value =~ m/$regex/ ) { return 1; } if( defined $self->lt_match && $value < $self->lt_match ) { return 1; } if( defined $self->gt_match && $value > $self->gt_match ) { return 1; } return 0; } sub run { my ( $self, $r ) = @_; my $key = $self->key; my $session = $r->session; my $value = $r->get( $key ); if( ! defined $value ) { return; } my $matched = $self->_match($value); if( $self->invert ) { $matched = ! $matched; } if( $matched ) { $self->log($r, $key.' matched '.$value); my $score = $self->get_uc($session, 'score'); if( defined $score ) { $self->add_score($r, $self->name => $score); } my $action = $self->get_uc($session, 'action'); if( defined $action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Condition - mtpolicyd plugin for conditions based on session values =head1 VERSION version 2.02 =head1 DESCRIPTION Will return an action, score or execute futher plugins if the specified condition matched. =head1 PARAMETERS =over =item key (required) The name of the variable to check. Syntax is (:)? If no scope is give it defaults to request. Possible scopes are: =over =item session, s Session variables. =item request, r Request attribute variables. =back Examples: session:user_policy s:user_policy request:queue_id r:queue_id queue_id =back At least one of the following parameters should be given or your condition will never match: =over =item match (default: empty) Simple string equal match. =item re_match (default: empty) Match content of the session variable against an regex. =item lt_match (default: empty) Match if numerical less than. =item gt_match (default: empty) Match if numerical greater than. =item invert (default: 0) If set to 1 the logic will be inverted. =back Finally an action must be specified. First the score will be applied the the action will be executed or if specified additional plugins will be executed. =over =item action (default: empty) The action to return when the condition matched. =item score (default: empty) The score to add if the condition matched. =item Plugin (default: empty) Execute this plugins when the condition matched. =back =head1 EXAMPLE: use of postfix policy_context The policy_context of postfix could be used to trigger checks in mtpolicyd. To activate additional checks in mtpolicyd from within postfix use may use a configuration in postfix main.cf like: # check, no additional checks check_policy_service inet:localhost:12345 ... # check with additional checks! check_policy_service { inet:localhost:12345, policy_context=strict_checks } In mtpolicyd.conf: module = "Condition" key = "policy_context" match = "strict_checks" # ... # more checks ... The policy_context feature will be available in postfix 3.1 and later. If you need completely different checks consider using the vhost_by_policy_context (L) option with different virtual hosts. =head1 EXAMPLE: execute postgrey action in postfix If the session variable "greylisting" is "on" return the postfix action "postgrey": module = "Condition" key = "greylisting" match = "on" action = "postgrey" The variable may be set by a UserConfig module like SqlUserConfig. The postgrey action in postfix may look like: smtpd_restriction_classes = postgrey postgrey = check_policy_service inet:127.0.0.1:11023 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Accounting.pm0000644000175000017500000001723012752672654023734 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Accounting; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for accounting in sql tables extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; use Time::Piece; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'fields' => ( is => 'rw', isa => 'Str', required => 1); has '_fields' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ split('\s*,\s*', $self->fields) ]; }, ); has 'time_pattern' => ( is => 'rw', isa => 'Str', default => '%Y-%m'); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub get_timekey { my $self = shift; return Time::Piece->new->strftime( $self->time_pattern ); } has 'table_prefix' => ( is => 'rw', isa => 'Str', default => 'acct_'); sub run { my ( $self, $r ) = @_; my $session = $r->session; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } if( $r->is_already_done( $self->name.'-acct' ) ) { $self->log( $r, 'accounting already done for this mail, skipping...'); return; } my $metrics = $self->get_request_metrics( $r ); foreach my $field ( @{$self->_fields} ) { my $key = $r->attr($field); if( ! defined $key || $key =~ /^\s*$/ ) { $self->log( $r, $field.' not defined in request, skipping...'); next; } $self->log( $r, 'updating accounting info for '.$field.' '.$key); $self->update_accounting($field, $key, $metrics); } return; } sub init { my $self = shift; $self->check_sql_tables( %{$self->_table_definitions} ); return; } has '_single_table_create' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { { 'mysql' => 'CREATE TABLE %TABLE_NAME% ( `id` int(11) NOT NULL AUTO_INCREMENT, `key` VARCHAR(255) NOT NULL, `time` VARCHAR(255) NOT NULL, `count` INT UNSIGNED NOT NULL, `count_rcpt` INT UNSIGNED NOT NULL, `size` INT UNSIGNED NOT NULL, `size_rcpt` INT UNSIGNED NOT NULL, PRIMARY KEY (`id`), UNIQUE KEY `time_key` (`key`, `time`), KEY(`key`), KEY(`time`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1', 'SQLite' => 'CREATE TABLE %TABLE_NAME% ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `key` VARCHAR(255) NOT NULL, `time` VARCHAR(255) NOT NULL, `count` INT UNSIGNED NOT NULL, `count_rcpt` INT UNSIGNED NOT NULL, `size` INT UNSIGNED NOT NULL, `size_rcpt` INT UNSIGNED NOT NULL )', } } ); sub get_table_name { my ( $self, $field ) = @_; return( $self->table_prefix . $field ); } has '_table_definitions' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { my $self = shift; my $tables = {}; foreach my $field ( @{$self->_fields} ) { my $table_name = $self->get_table_name($field); $tables->{$table_name} = $self->_single_table_create; } return $tables; }, ); sub get_request_metrics { my ( $self, $r ) = @_; my $recipient_count = $r->attr('recipient_count'); my $size = $r->attr('size'); my $metrics = {}; my $rcpt_cnt = defined $recipient_count ? $recipient_count : 1; $metrics->{'size'} = defined $size ? $size : 0; $metrics->{'count'} = 1; $metrics->{'count_rcpt'} = $rcpt_cnt ? $rcpt_cnt : 1; $metrics->{'size_rcpt'} = $rcpt_cnt ? $size * $rcpt_cnt : $size; return( $metrics ); } sub update_accounting { my ( $self, $field, $key, $metrics ) = @_; eval { $self->update_accounting_row($field, $key, $metrics); }; if( $@ =~ /^accounting row does not exist/ ) { $self->insert_accounting_row($field, $key, $metrics); } elsif( $@ ) { die( $@ ); } return; } sub insert_accounting_row { my ( $self, $field, $key, $metrics ) = @_; my $dbh = $self->_db_handle; my $table_name = $dbh->quote_identifier( $self->get_table_name($field) ); my $values = { 'key' => $key, 'time' => $self->get_timekey, %$metrics, }; my $col_str = join(', ', map { $dbh->quote_identifier($_) } keys %$values); my $values_str = join(', ', map { $dbh->quote($_) } values %$values); my $sql = "INSERT INTO $table_name ($col_str) VALUES ($values_str)"; $self->execute_sql($sql); return; } sub update_accounting_row { my ( $self, $field, $key, $metrics ) = @_; my $dbh = $self->_db_handle; my $table_name = $dbh->quote_identifier( $self->get_table_name($field) ); my $where = { 'key' => $key, 'time' => $self->get_timekey, }; my $values_str = join(', ', map { $dbh->quote_identifier($_).'='. $dbh->quote_identifier($_).'+'.$dbh->quote($metrics->{$_}) } keys %$metrics); my $where_str = join(' AND ', map { $dbh->quote_identifier($_).'='.$dbh->quote($where->{$_}) } keys %$where ); my $sql = "UPDATE $table_name SET $values_str WHERE $where_str"; my $rows = $dbh->do($sql); if( $rows == 0 ) { die('accounting row does not exist'); } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Accounting - mtpolicyd plugin for accounting in sql tables =head1 VERSION version 2.02 =head1 SYNOPSIS module = "Accounting" # per ip and user fields = "client_address,sasl_username" # statistics per month time_pattern = "%Y-%m" table_prefix = "acct_" This will create a table acct_client_address and a table acct_sasl_username. If a request is received containing the field the plugin will update the row in the fields table. The key is the fields value(ip or username) and the time string build from the time_pattern. For each key the following counters are stored: * count * count_rcpt (count per recipient) * size * size_rcpt (size * recipients) The resulting tables will look like: mysql> select * from acct_client_address; +----+--------------+---------+-------+------------+--------+-----------+ | id | key | time | count | count_rcpt | size | size_rcpt | +----+--------------+---------+-------+------------+--------+-----------+ | 1 | 192.168.0.1 | 2014-12 | 11 | 11 | 147081 | 147081 | | 2 | 192.168.1.1 | 2014-12 | 1 | 1 | 13371 | 13371 | | 12 | 192.168.2.1 | 2014-12 | 10 | 100 | 133710 | 1337100 | ... =head2 PARAMETERS The module takes the following parameters: =over =item (uc_)enabled (default: on) Enable/disable this check. =item fields (required) A comma separated list of fields used for accounting. For each field a table will be created. For a list of available fields see postfix documentation: http://www.postfix.org/SMTPD_POLICY_README.html =item time_pattern (default: "%Y-%m") A format string for building the time key used to store counters. Default is to build counters on a monthly base. For example use: * "%Y-%W" for weekly * "%Y-%m-%d" for daily See "man date" for format string sequences. =item table_prefix (default: "acct_") A prefix to add to every table. The table name will be the prefix + field_name. =back =head1 DESCRIPTION This plugin can be used to do accounting based on request fields. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Proxy.pm0000644000175000017500000000414312752672654022762 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Proxy; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin to forward request to another policy daemon extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use Mail::MtPolicyd::Client; use Mail::MtPolicyd::Client::Request; has 'socket_path' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'host' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'keepalive' => ( is => 'rw', isa => 'Bool', default => 0 ); has _client => ( is => 'ro', isa => 'Mail::MtPolicyd::Client', lazy => 1, default => sub { my $self = shift; my %opts = ( keepalive => $self->keepalive, ); if( defined $self->socket_path ) { $opts{'socket_path'} = $self->socket_path; } elsif( defined $self->host ) { $opts{'host'} = $self->host; } else { $self->logdie('no host and no socket_path configured!'); } return Mail::MtPolicyd::Client->new( %opts ); }, ); sub run { my ( $self, $r ) = @_; my $proxy_request = Mail::MtPolicyd::Client::Request->new_proxy_request( $r ); my $response = $self->_client->request( $proxy_request ); return Mail::MtPolicyd::Plugin::Result->new( action => $response->action, abort => 1, ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Proxy - mtpolicyd plugin to forward request to another policy daemon =head1 VERSION version 2.02 =head1 DESCRIPTION This module forwards the request to another policy daemon. =head1 PARAMETERS =over =item host (default: empty) The : of the target policy daemon. =item socket_path (default: empty) The path to the socket of the target policy daemon. =item keepalive (default: 0) Keep connection open across requests. =back =head1 EXAMPLE module = "Proxy" host="localhost:10023" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/GeoIPAction.pm0000644000175000017500000000715312752672654023746 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::GeoIPAction; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for checking geo information of an ip extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; use Mail::MtPolicyd::Plugin::Result; has 'result_from' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'country_codes' => ( is => 'rw', isa => 'Str', required => 1 ); has '_country_codes' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->country_codes) ]; }, ); sub is_in_country_codes { my ( $self, $cc ) = @_; if ( grep { $_ eq $cc } @{$self->_country_codes} ) { return(1); } return(0); } has 'reject_message' => ( is => 'ro', isa => 'Str', default => 'delivery from %CC% (%IP%) rejected', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $mode = $self->get_uc( $session, 'mode' ); my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } my $result_key = 'geoip-'.$self->result_from.'-result'; if( ! defined $session->{$result_key} ) { $self->log( $r, 'no GeoIP check result for '.$self->name.' found!'); return; } my ( $country_code ) = @{$session->{$result_key}}; if( ! defined $country_code ) { return; } if( ! $self->is_in_country_codes( $country_code ) ) { $self->log( $r, 'country_code '.$country_code.' of IP not in country_code list'.$self->name); return; } $self->log( $r, 'country code '.$country_code.' on list'.$self->name ); if( defined $self->score && ! $r->is_already_done('geoip-'.$self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($ip, $country_code ), abort => 1, ); } if( $mode eq 'accept' || $mode eq 'dunno' ) { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } sub _get_reject_action { my ( $self, $ip, $cc ) = @_; my $message = $self->reject_message; $message =~ s/%IP%/$ip/; $message =~ s/%CC%/$cc/; return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::GeoIPAction - mtpolicyd plugin for checking geo information of an ip =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin will execute an action or score based on a previous lookup done with GeoIPLookup plugin. =head1 PARAMETERS =over =item result_from (required) Take the GeoIP information from the result of this plugin. The plugin in must be executed before this plugin. =item (uc_)enabled (default: on) Enable/disable this plugin. =item country_codes (required) A comma separated list of 2 letter country codes to match. =item (uc_)mode (default: reject) If set to 'passive' no action will be returned. =item reject_message (default: 'delivery from %CC% (%IP%) rejected) Could be used to specify an custom reject message. =item score (default: empty) A score to apply to the message. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/GeoIPLookup.pm0000644000175000017500000000364512752672654024004 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::GeoIPLookup; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for checking geo information of an client_address extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use Geo::IP; has '_geoip' => ( is => 'ro', isa => 'Geo::IP', lazy => 1, default => sub { my $self = shift; Geo::IP->open( $self->database, GEOIP_STANDARD ); }, ); has 'database' => ( is => 'rw', isa => 'Str', default => '/usr/share/GeoIP/GeoIP.dat'); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my ( $result ) = $r->do_cached('geoip-'.$self->name.'-result', sub { $self->_geoip->country_code_by_addr( $ip ) } ); if( ! defined $result ) { $self->log($r, 'no GeoIP record for '.$ip.' found'); } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::GeoIPLookup - mtpolicyd plugin for checking geo information of an client_address =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin queries a GeoIP for the country code of the client_address. The plugin is divided in this plugin which does the Lookup and the GeoIPAction plugin which can be used to take actions based on country code. =head1 PARAMETERS =over =item database (default: /usr/share/GeoIP/GeoIP.dat) The path to the geoip country database. =back =head1 MAXMIND GEOIP COUNTRY DATABASE On a debian system you can install the country database with the geoip-database package. You also download it directly from Maxmind: http://dev.maxmind.com/geoip/geoip2/geolite2/ (choose "GeoLite2 Country/DB") =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Fail2Ban.pm0000644000175000017500000000704412752672654023222 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Fail2Ban; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin to block an address with fail2ban extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use IO::Socket::UNIX; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'socket' => ( is => 'ro', isa => 'Str', default => '/var/run/fail2ban/fail2ban.sock' ); has 'jail' => ( is => 'ro', isa => 'Str', default => 'postfix' ); has '_socket' => ( is => 'ro', isa => 'IO::Socket::UNIX', lazy => 1, default => sub { my $self = shift; my $socket = IO::Socket::UNIX->new( Peer => $self->socket, ) or die "cant connect fail2ban socket: $!"; return( $socket ); }, ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } if( ! $r->is_already_done($self->name.'-fail2ban') ) { $self->log( $r, 'adding ip '.$ip.' to fail2ban jail '.$self->jail ); $self->add_fail2ban( $r, $ip ); } return; } # The protocol used is based in tickle, an python specific serialization protocol # this command is captured from the output of: # strace -s 1024 -f fail2ban-client set postfix banip 123.123.123.123 # ... # sendto(3, "\200\2]q\0(U\3setq\1U\7postfixq\2U\5banipq\3U\017123.123.123.123q\4e.", 71, 0, NU has '_command_pattern' => ( is => 'ro', isa => 'Str', default => "\200\2]q\0(U\3setq\1U%c%sq\2U\5banipq\3U%c%sq\4e.", ); sub add_fail2ban { my ( $self, $r, $ip ) = @_; $self->_socket->print( sprintf($self->_command_pattern, length($self->jail), $self->jail, length($ip), $ip ) ); return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Fail2Ban - mtpolicyd plugin to block an address with fail2ban =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin can be used to block an ip with iptable thru the fail2ban daemon. For more information abount fail2ban read: http://www.fail2ban.org/ This plugin will directly talk to the daemon thru the unix domain socket and execute an banip command: set banip =head1 PARAMETERS =over =item socket (default: /var/run/fail2ban/fail2ban.sock) Path to the fail2ban unix socket. Make sure mtpolicyd is allowed to write to this socket! =item jail (default: postfix) The jail in which the ip should be banned. =back =head1 EXAMPLE Execute a ban on all client-ips which send a mail with a score of >=15: module = "ScoreAction" threshold = 15 module = "Fail2Ban" socket = "/var/run/fail2ban/fail2ban.sock" jail = "postfix" =head1 FAIL2BAN CONFIGURATION To allow mtpolicyd to access fail2ban you must make sure fail2ban can write to the fail2ban unix socket. chgrp mtpolicyd /var/run/fail2ban/fail2ban.sock chmod g+rwx /var/run/fail2ban/fail2ban.sock You may want to add this to the fail2ban startup script. You may want to use the predefined postfix jail. To activate it create /etc/fail2ban/jail.local and enable the postfix fail by setting enabled=true. [postfix] enabled = true =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Honeypot.pm0000644000175000017500000001177312752672654023455 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Honeypot; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for creating an honeypot extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject'); has 'recipients' => ( is => 'rw', isa => 'Str', default => '' ); has 'recipients_re' => ( is => 'rw', isa => 'Str', default => '' ); has _recipients => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->recipients) ]; }, ); has _recipients_re => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->recipients_re) ]; }, ); has 'reject_message' => ( is => 'rw', isa => 'Str', default => 'trapped by honeypod' ); has 'expire' => ( is => 'rw', isa => 'Int', default => 60*60*2 ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $recipient = $r->attr('recipient'); my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } if( $self->is_in_honeypot( $r, $ip ) ) { return $self->trapped_action; } if( $self->is_honeypot_recipient( $recipient ) ) { $self->add_to_honeypot( $r, $ip ); return $self->trapped_action; } return; } sub trapped_action { my ( $self, $r ) = @_; if( $self->mode eq 'reject' ) { return( Mail::MtPolicyd::Plugin::Result->new( action => 'reject '.$self->reject_message, abort => 1, ) ); } if( defined $self->score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } return; } sub is_honeypot_recipient { my ( $self, $recipient ) = @_; if( $self->is_in_recipients( $recipient ) || $self->is_in_recipients_re( $recipient ) ) { return(1); } return(0); } sub is_in_recipients { my ( $self, $recipient ) = @_; if( grep { $_ eq $recipient } @{$self->_recipients} ) { return(1); } return(0); } sub is_in_recipients_re { my ( $self, $recipient ) = @_; if( grep { $recipient =~ /$_/ } @{$self->_recipients_re} ) { return(1); } return(0); } sub is_in_honeypot { my ( $self, $r, $ip ) = @_; my $key = join(",", $self->name, $ip ); if( my $ticket = $r->server->memcached->get( $key ) ) { return( 1 ); } return; } sub add_to_honeypot { my ( $self, $r, $ip ) = @_; my $key = join(",", $self->name, $ip ); $r->server->memcached->set( $key, '1', $self->expire ); return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Honeypot - mtpolicyd plugin for creating an honeypot =head1 VERSION version 2.02 =head1 DESCRIPTION The Honeypot plugin creates an honeypot to trap IPs sending to unused recipient addresses. The plugin requires that you define unused recipient addresses as honeypots. These addresses can be specified by the recipients and recipients_re parameters. Each time an IP tries to send an mail to one of these honeypots the message will be reject if mode is 'reject' and an scoring is applied. The IP is also added to a temporary IP blacklist till an timeout is reached (parameter expire). All IPs on this blacklist will also be rejected if mode is 'reject' and scoring is applied. =head1 EXAMPLE module = "Honeypot" recipients = "bob@company.com,joe@company.com" recipients_re = "^(tic|tric|trac)@(gmail|googlemail)\.de$" =head1 PARAMETERS =over =item (uc_)enabled (default: on) Enable/disable this check. =item score (default: empty) Apply an score to this message if it is send to an honeypot address or it has been added to the honeypot before by sending an mail to an honeypot. =item mode (default: reject) The default is to return an reject. Change to 'passive' if you just want scoring. =item recipients (default: '') A comma separated list of recipients to use as honeypots. =item recipients_re (default: '') A comma separated list of regular expression to match against the recipient to use them as honeypots. =item reject_message (default: 'trapped by honeypod') A string to return with the reject action. =item expire (default: 7200 (2h)) Time in seconds till the client_ip is removed from the honeypot. =item Plugin (default: empty) Execute this plugins when the condition matched. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Action.pm0000644000175000017500000000226512752672654023061 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Action; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin which just returns an action extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; has 'action' => ( is => 'ro', isa => 'Str', required => 1 ); sub run { my ( $self, $r ) = @_; return Mail::MtPolicyd::Plugin::Result->new( action => $self->action, abort => 1, ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Action - mtpolicyd plugin which just returns an action =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin just returns the specified string as action. =head1 PARAMETERS =over =item action (required) A string with the action to return. =back =head1 EXAMPLE module = "action" # any postfix action will do action=reject no reason =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Role/0000755000175000017500000000000012752672654022202 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Role/ConfigurableFields.pm0000644000175000017500000000373312752672654026275 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Role::ConfigurableFields; use strict; # make critic happy use MooseX::Role::Parameterized; use Moose::Util::TypeConstraints; our $VERSION = '2.02'; # VERSION # ABSTRACT: role for plugins using configurable fields parameter fields => ( isa => 'HashRef[HashRef]', required => 1, ); role { my $p = shift; foreach my $attr ( keys %{$p->fields} ) { my $value_isa = $p->fields->{$attr}->{'value_isa'}; delete $p->fields->{$attr}->{'value_isa'}; has $attr.'_field' => ( is => 'rw', isa => 'Maybe[Str]', %{$p->fields->{$attr}}, ); method 'get_'.$attr.'_value' => sub { my ( $self, $r ) = @_; return $self->get_configurable_field_value( $r, $attr, $value_isa ); }; } }; sub get_configurable_field_value { my ( $self, $r, $name, $type ) = @_; my $conf_field = $name.'_field'; my $request_field = $self->$conf_field; if( ! defined $request_field || $request_field eq '' ) { $self->log( $r, 'no request field configured in '.$conf_field ); return; } my $value = $r->attr( $request_field ); if( ! defined $value || $value eq '' ) { $self->log( $r, 'value of field '.$request_field. ' not defined or empty' ); return; } if( defined $type ) { my $constraint = find_type_constraint( $type ); my $err = $constraint->validate( $value ); if( defined $err ) { $self->log( $r, 'value of field '.$request_field. ' failed validation for '.$type.': '.$err ); return; } } return $value; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::ConfigurableFields - role for plugins using configurable fields =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Role/UserConfig.pm0000644000175000017500000000236712752672654024614 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Role::UserConfig; use strict; # make critic happy use MooseX::Role::Parameterized; our $VERSION = '2.02'; # VERSION # ABSTRACT: role for plugins using per user/request configuration parameter uc_attributes => ( isa => 'ArrayRef', required => 1, ); role { my $p = shift; foreach my $attribute ( @{$p->uc_attributes} ) { has 'uc_'.$attribute => ( is => 'rw', isa => 'Maybe[Str]', ); } }; sub get_uc { my ($self, $session, $attr) = @_; my $uc_attr = 'uc_'.$attr; if( ! $self->can($uc_attr) ) { die('there is no user config attribute '.$uc_attr.'!'); } if( ! defined $self->$uc_attr ) { return $self->$attr; } my $session_value = $session->{$self->$uc_attr}; if( ! defined $session_value ) { return $self->$attr; } return $session_value; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::UserConfig - role for plugins using per user/request configuration =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Role/Scoring.pm0000644000175000017500000000300712752672654024144 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Role::Scoring; use Moose::Role; our $VERSION = '2.02'; # VERSION # ABSTRACT: role for plugins using scoring has 'score_field' => ( is => 'ro', isa => 'Str', default => 'score', ); sub _get_score { my ( $self, $r ) = @_; my $session = $r->session; if( defined $session->{$self->score_field} ) { return $session->{$self->score_field}; } return 0; } sub _set_score { my ( $self, $r, $value ) = @_; my $session = $r->session; return $session->{$self->score_field} = $value; } sub _push_score_detail { my ( $self, $r, $string ) = @_; my $session = $r->session; my $field = $self->score_field . '_detail'; if( ! defined $session->{$field} ) { $session->{$field} = $string; return; } $session->{$field} .= ', '.$string; return; } sub _get_score_detail { my ( $self, $r ) = @_; my $field = $self->score_field . '_detail'; return( $r->session->{$field} ); } sub add_score { my ( $self, $r, $key, $value ) = @_; my $score = $self->_get_score($r); $score += $value; $self->_set_score($r, $score); $self->_push_score_detail($r, $key.'='.$value); return $score; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::Scoring - role for plugins using scoring =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Role/SqlUtils.pm0000644000175000017500000000365212752672654024326 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Role::SqlUtils; use strict; use Moose::Role; # ABSTRACT: role with support function for plugins using sql our $VERSION = '2.02'; # VERSION requires '_db_handle'; sub sql_table_exists { my ( $self, $name ) = @_; my $dbh = $self->_db_handle; my $sql = 'SELECT * FROM '.$dbh->quote_identifier($name).' WHERE 1=0;'; eval { $dbh->do($sql); }; if( $@ ) { return 0; } return 1; } sub create_sql_table { my ( $self, $name, $definitions ) = @_; my $dbh = $self->_db_handle; my $table_name = $dbh->quote_identifier($name); my $sql; my $driver = $dbh->{Driver}->{Name}; if( defined $definitions->{$driver} ) { $sql = $definitions->{$driver}; } elsif ( defined $definitions->{'*'} ) { $sql = $definitions->{'*'}; } else { die('no data definition for table '.$name.'/'.$driver.' found'); } $sql =~ s/%TABLE_NAME%/$table_name/g; $dbh->do( $sql ); return; } sub check_sql_tables { my ( $self, %tables ) = @_; foreach my $table ( keys %tables ) { if( ! $self->sql_table_exists( $table ) ) { eval { $self->create_sql_table( $table, $tables{$table} ) }; if( $@ ) { die('sql table '.$table.' does not exist and creating it failed: '.$@); } } } } sub execute_sql { my ( $self, $sql, @params ) = @_; my $dbh = $self->_db_handle; my $sth = $dbh->prepare( $sql ); $sth->execute( @params ); return $sth; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::SqlUtils - role with support function for plugins using sql =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Role/PluginChain.pm0000644000175000017500000000214312752672654024741 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Role::PluginChain; use Moose::Role; our $VERSION = '2.02'; # VERSION # ABSTRACT: role for plugins to support a nested plugin chain use Mail::MtPolicyd::PluginChain; has 'chain' => ( is => 'ro', isa => 'Maybe[Mail::MtPolicyd::PluginChain]', lazy => 1, default => sub { my $self = shift; if( defined $self->Plugin ) { return Mail::MtPolicyd::PluginChain->new_from_config( $self->vhost_name, $self->Plugin, ); } return; }, ); has 'Plugin' => ( is => 'rw', isa => 'Maybe[HashRef]' ); after 'cron' => sub { my $self = shift; if( defined $self->chain ) { return $self->chain->cron(@_); } return; }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::PluginChain - role for plugins to support a nested plugin chain =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/SqlUserConfig.pm0000644000175000017500000000627712752672654024377 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::SqlUserConfig; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for retrieving the user config of a user extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use JSON; has 'sql_query' => ( is => 'rw', isa => 'Str', default => 'SELECT config FROM user_config WHERE address=?', ); has '_json' => ( is => 'ro', isa => 'JSON', lazy => 1, default => sub { return JSON->new; } ); has 'field' => ( is => 'rw', isa => 'Str', default => 'recipient' ); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub _get_config { my ( $self, $r ) = @_; my $key = $r->attr( $self->field ); if( ! defined $key || $key =~ /^\s*$/ ) { die('key field '.$self->field.' not defined or empty in request'); } my $sth = $self->execute_sql( $self->sql_query, $key ); my ( $json ) = $sth->fetchrow_array; if( ! defined $json ) { die( 'no user-config found for '.$key ); } return $self->_json->decode( $json ); } sub run { my ( $self, $r ) = @_; my $config; eval { $config = $self->_get_config($r) }; if( $@ ) { $self->log($r, 'unable to retrieve user-config: '.$@); return; } foreach my $key ( keys %$config ) { $r->session->{$key} = $config->{$key}; } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SqlUserConfig - mtpolicyd plugin for retrieving the user config of a user =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin will retrieve a JSON string from an SQL database and will merge the data structure into the current session. This could be used to retrieve configuration values for users from a database. =head1 PARAMETERS =over =item sql_query (default: SELECT config FROM user_config WHERE address=?) The SQL query to retrieve the JSON configuration string. The content of the first row/column is used. =item field (default: recipient) The request field used in the sql query to retrieve the user configuration. =back =head1 EXAMPLE USER SPECIFIC GREYLISTING Create the following table in the SQL database: CREATE TABLE `user_config` ( `id` int(11) NOT NULL AUTO_INCREMENT, `address` varchar(255) DEFAULT NULL, `config` TEXT NOT NULL, PRIMARY KEY (`id`), UNIQUE KEY `address` (`address`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1 INSERT INTO TABLE `user_config` VALUES( NULL, 'karlson@vomdach.de', '{"greylisting":"on"}' ); In mtpolicyd.conf: db_dsn="dbi:mysql:mail" db_user=mail db_password=password module = "SqlUserConfig" sql_query = "SELECT config FROM user_config WHERE address=?" enabled = "off" # off by default uc_enabled = "greylisting" # override with value of key 'greylisting' is set in session module = "Greylist" score = -5 mode = "passive" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/LdapUserConfig.pm0000644000175000017500000000760212752672654024511 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::LdapUserConfig; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for retrieving per user configuration from LDAP extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use Net::LDAP::Util qw( escape_filter_value ); has 'basedn' => ( is => 'rw', isa => 'Str', default => '' ); has 'filter' => ( is => 'rw', isa => 'Str', required => 1 ); with 'Mail::MtPolicyd::Plugin::Role::ConfigurableFields' => { 'fields' => { 'filter' => { isa => 'Str', default => 'sasl_username', value_isa => 'Str', }, }, }; has 'config_fields' => ( is => 'rw', isa => 'Str', required => 1 ); has '_config_fields' => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->config_fields ) ]; }, ); has 'connection' => ( is => 'ro', isa => 'Str', default => 'ldap' ); has 'connection_type' => ( is => 'ro', isa => 'Str', default => 'Ldap' ); with 'Mail::MtPolicyd::Role::Connection' => { name => 'ldap', type => 'Ldap', }; sub retrieve_ldap_entry { my ( $self, $r ) = @_; my $ldap = $self->_ldap_handle; my $value = $self->get_filter_value( $r ); if( ! defined $value ) { $self->log( $r, 'filter_field('.$self->filter_field.') is not defined in request. skipping ldap search.'); return; } my $filter = $self->filter; my $filter_value = escape_filter_value($value); $filter =~ s/%s/$filter_value/g; $self->log( $r, 'ldap filter is: '.$filter); my $msg; eval { $msg = $ldap->search( base => $self->basedn, filter => $filter, ); }; if( $@ ) { $self->log( $r, 'ldap search failed: '.$@ ); return; } if( $msg->count != 1 ) { $self->log( $r, 'ldap search return '.$msg->count.' entries' ); return; } my $entry = $msg->entry( 0 ); $self->log( $r, 'found in ldap: '.$entry->dn ); return $entry; } sub run { my ( $self, $r ) = @_; my $entry = $self->retrieve_ldap_entry( $r ); if( defined $entry ) { foreach my $field ( @{$self->_config_fields} ) { my ($value) = $entry->get_value( $field ); if( defined $value && $value ne '' ) { $self->log( $r, 'retrieved ldap attribute: '.$field.'='.$value ); $r->session->{$field} = $value; } else { $self->log( $r, 'LDAP attribute '.$field.' is empty. skipping.' ); } } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::LdapUserConfig - mtpolicyd plugin for retrieving per user configuration from LDAP =head1 VERSION version 2.02 =head1 SYNOPSIS ldap_host="localhost" ldap_binddn="cn=readonly,dc=domain,dc=com" ldap_password="secret" module="LdapUserConfig" basedn="ou=users,dc=domain,dc=com" filter="(mail=%s)" filter_field="sasl_username" config_fields="mailMessageLimit,mailSendExternal" =head1 DESCRIPTION This plugin could be used to retrieve session variables/user configuration from a LDAP server. =head1 PARAMETERS The LDAP connection must be configured in the global configuration section of mtpolicyd. See L. =over =item basedn (default: '') The basedn to use for the search. =item filter (required) The filter to use for the search. The pattern %s will be replaced with the content of filter_field. =item filter_field (required) The content of this request field will be used to replace %s in the filter string. =item config_fields (required) A comma seperated list of LDAP attributes to retrieve and copy into the current mtpolicyd session. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Stress.pm0000644000175000017500000000401512752672654023122 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Stress; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for postfix stress mode extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'action' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; has 'action' => ( is => 'rw', isa => 'Maybe[Str]' ); sub run { my ( $self, $r ) = @_; my $session = $r->session; my $stress = $r->attr('stress'); if( defined $stress && $stress eq 'yes' ) { $self->log($r, 'MTA has stress feature turned on'); my $action = $self->get_uc($session, 'action'); if( defined $action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Stress - mtpolicyd plugin for postfix stress mode =head1 VERSION version 2.02 =head1 DESCRIPTION Will return an action or execute futher plugins if postfix signals stress. See postfix STRESS_README. =head1 PARAMETERS An action must be specified: =over =item action (default: empty) The action to return when under stress. =item Plugin (default: empty) Execute this plugins when under stress. =back =head1 EXAMPLE: defer clients when under stress To defer clients under stress: module = "Stress" action = "defer please try again later" This will return an defer action and execute no futher tests. You may want to do some whitelisting for preferred clients before this action. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/ClearFields.pm0000644000175000017500000000435012752672654024016 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::ClearFields; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin to unset session variables extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; has 'fields' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'fields_prefix' => ( is => 'rw', isa => 'Maybe[Str]' ); sub clear_fields { my ( $self, $r ) = @_; my @fields = split(/\s*,\s*/, $self->fields); $self->log($r, 'clearing fields '.join(', ', @fields)); foreach my $field ( @fields ) { delete $r->session->{$field}; } return; } sub clear_fields_prefix { my ( $self, $r ) = @_; my @prefixes = split(/\s*,\s*/, $self->fields_prefix); $self->log($r, 'clearing fields with prefixes: '.join(', ', @prefixes)); foreach my $prefix ( @prefixes ) { foreach my $field ( keys %{$r->session} ) { if( $field !~ /^\Q$prefix\E/) { next; } delete $r->session->{$field}; } } return; } sub run { my ( $self, $r ) = @_; if( defined $self->fields) { $self->clear_fields( $r ); } if( defined $self->fields_prefix) { $self->clear_fields_prefix( $r ); } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::ClearFields - mtpolicyd plugin to unset session variables =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin could be used to reset some session variables. =head1 PARAMETERS =over =item fields (default: empty) A comma separated list of session variables to unset. =item fields_prefix (default: empty) A comma separated list of prefixes. All session variables with this prefixes will be unset. =back =head1 EXAMPLE module = "ClearFields" fields = "spamhaus-rbl,spamhaus-dbl" Will remove both fields from the session. module = "ClearFields" fields_prefix = "spamhaus-" Will also remove both fields and everything else starting with "spamhaus-" from the session. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Eval.pm0000644000175000017500000000322412752672654022527 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Eval; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin to capture the output of plugins extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; has 'store_in' => ( is => 'ro', isa => 'Str', required => 1 ); sub run { my ( $self, $r ) = @_; my $field = $self->store_in; if( ! defined $self->chain ) { return; } my $chain_result = $self->chain->run( $r ); my @actions = $chain_result->actions; if( scalar @actions ) { $r->session->{$field} = join("\n", @actions) } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Eval - mtpolicyd plugin to capture the output of plugins =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin executes a list of configured plugins but will not return the action back to mtpolicyd. Instead it writes the output of the plugins to a variable within the session. =head1 PARAMETERS =over =item store_in (required) The name of the key in the session to store the result of the eval'ed checks. =item Plugin (required) A list of checks to execute. =back =head1 EXAMPLE module = "Eval" # store result in spf_action store_in="spf_action" module = "Proxy" host = "localhost:10023" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/ScoreAction.pm0000644000175000017500000000642412752672654024056 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::ScoreAction; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for running an action based on the score extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'threshold' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; has 'threshold' => ( is => 'ro', isa => 'Num', required => 1 ); has 'match' => ( is => 'rw', isa => 'Str', default => 'gt' ); has 'action' => ( is => 'ro', isa => 'Maybe[Str]' ); sub run { my ( $self, $r ) = @_; my $score = $self->_get_score($r); my $score_detail = $self->_get_score_detail($r); my $threshold = $self->get_uc( $r->session, 'threshold' ); if( $self->match eq 'gt' && $score < $threshold ) { return; } elsif( $self->match eq 'lt' && $score > $threshold ) { return; } elsif( $self->match !~ m/^[lg]t$/) { die('unknown value for parameter match.'); } my $action = $self->action; if( defined $action ) { my $ip = $r->attr('client_address'); if( defined $ip ) { $action =~ s/%IP%/$ip/; } else { $action =~ s/%IP%/unknown/; } $action =~ s/%SCORE%/$score/; if( defined $score_detail ) { $action =~ s/%SCORE_DETAIL%/, $score_detail/; } else { $action =~ s/%SCORE_DETAIL%//; } return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::ScoreAction - mtpolicyd plugin for running an action based on the score =head1 VERSION version 2.02 =head1 DESCRIPTION Returns a action based on the score. =head1 PARAMETERS =over =item threshold (required) If the score is higher than this value the action will be executed. =item match (default: gt) If it should match if the score if >= or <= the threshold. Possible values: gt, lt =item uc_threshold (default: undef) If set the value for threshold will be fetched from this user-config value if defined. =item score_field (default: score) Specifies the name of the field the score is stored in. Could be set if you need multiple scores. =item action (default: empty) The action to be executed. The following patterns in the string will be replaced: %IP%, %SCORE%, %SCORE_DETAIL% =item Plugin (default: empty) Execute this plugins when the condition matched. =back =head1 EXAMPLE Reject everything with a score >= 15. and do greylisting for the remaining request with a score >=5. module = "ScoreAction" threshold = 15 action = "reject sender ip %IP% is blocked (score=%SCORE%%SCORE_DETAIL%)" module = "ScoreAction" threshold = 5 module = "Greylist" score = -5 mode = "passive" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Quota.pm0000644000175000017500000001161212752672654022731 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Quota; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for accounting in sql tables extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'field', 'threshold', 'action', 'metric' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; use Time::Piece; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'field' => ( is => 'rw', isa => 'Str', required => 1); has 'metric' => ( is => 'rw', isa => 'Str', required => 1); has 'time_pattern' => ( is => 'rw', isa => 'Str', default => '%Y-%m'); has 'threshold' => ( is => 'rw', isa => 'Int', required => 1); has 'action' => ( is => 'rw', isa => 'Str', default => 'defer smtp traffic quota has been exceeded'); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub get_timekey { my $self = shift; return Time::Piece->new->strftime( $self->time_pattern ); } has 'table_prefix' => ( is => 'rw', isa => 'Str', default => 'acct_'); sub run { my ( $self, $r ) = @_; my $session = $r->session; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } my $field = $self->get_uc( $session, 'field'); my $metric = $self->get_uc( $session, 'metric'); my $action = $self->get_uc( $session, 'action'); my $threshold = $self->get_uc( $session, 'threshold'); my $key = $r->attr( $field ); if( ! defined $key || $key =~ /^\s*$/ ) { $self->log( $r, 'field '.$field.' is empty in request. skipping quota check.'); return; } my $count = $self->get_accounting_count( $r, $field, $metric, $key ); if( $count >= $threshold ) { if( defined $action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } } return; } sub get_table_name { my ( $self, $field ) = @_; return( $self->table_prefix . $field ); } sub get_accounting_count { my ( $self, $r, $field, $metric, $key ) = @_; my $dbh = $self->_db_handle; my $where = { 'key' => $key, 'time' => $self->get_timekey, }; my $table_name = $dbh->quote_identifier( $self->get_table_name($field) ); my $where_str = join(' AND ', map { $dbh->quote_identifier($_).'='.$dbh->quote($where->{$_}) } keys %$where ); my $column_name = $dbh->quote_identifier( $metric ); my $sql = "SELECT $column_name FROM $table_name WHERE $where_str"; my $count = $dbh->selectrow_array($sql); if( defined $count && $count =~ /^\d+$/ ) { return $count; } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Quota - mtpolicyd plugin for accounting in sql tables =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin can be used to do accounting based on request fields. =head1 Example module = "Quota" table_prefix = "acct_" # per month time_pattern = "%Y-%m" # per ip field = "client_address" # allow 1000 mails metric = "count" threshold = 1000 action = "defer you exceeded your monthly limit, please insert coin" =head1 Configuration =head2 Parameters The module takes the following parameters: =over =item (uc_)enabled (default: on) Enable/disable this check. =item (uc_)field (required) The field used for accounting/quota. =item (uc_)metric (required) The metric on which the quota should be based. The Accounting module stores the following metrics: =over =item count Number of mails recivied. =item count_rcpt Number of mails recivied multiplied with number of recipients. =item size Size of mails recivied. =item size_rcpt Size of mails recivied multiplied with number of recipients. =back =item time_pattern (default: "%Y-%m") A format string for building the time key used to store counters. Default is to build counters on a monthly base. For example use: * "%Y-%W" for weekly * "%Y-%m-%d" for daily See "man date" for format string sequences. You must use the same time_pattern as used in for the Accounting module. =item threshold (required) The quota limit. =item action (default: defer smtp traffic quota has been exceeded) The action to return when the quota limit has been reached. =item table_prefix (default: "acct_") A prefix to add to every table. The table name will be the prefix + field_name. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/DBL.pm0000644000175000017500000001214112752672654022237 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::DBL; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for checking helo,sender domain,rdns against an DBL extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'sender_mode', 'helo_name_mode', 'reverse_client_name_mode' ], }; use Mail::MtPolicyd::Plugin::Result; use Mail::RBL; has 'domain' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'sender_mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'sender_score' => ( is => 'rw', isa => 'Maybe[Num]', default => 5 ); has 'reverse_client_name_mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'reverse_client_name_score' => ( is => 'rw', isa => 'Maybe[Num]', default => 2.5 ); has 'helo_name_mode' => ( is => 'rw', isa => 'Str', default => 'passive' ); has 'helo_name_score' => ( is => 'rw', isa => 'Maybe[Num]', default => 1 ); has 'reject_message' => ( is => 'rw', isa => 'Str', default => '%CHECK% rejected (%HOSTNAME%%INFO%)' ); has '_rbl' => ( is => 'ro', isa => 'Mail::RBL', lazy => 1, default => sub { my $self = shift; Mail::RBL->new($self->domain) }, ); sub run { my ( $self, $r ) = @_; my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } foreach my $check ( 'sender', 'reverse_client_name', 'helo_name') { my $hostname = $self->_get_hostname($r, $check); if( ! defined $hostname ) { next; } my ( $ip_result, $info ) = $r->do_cached( $self->name.'-'.$check.'-result', sub { $self->_rbl->check_rhsbl( $hostname ) } ); if( ! defined $ip_result ) { $self->log($r, 'domain '.$hostname.' not on '.$self->domain.' blacklist'); next; } $self->log($r, 'domain '.$hostname.' is on '.$self->domain.' blacklist'. ( defined $info ? " ($info)" : '' ) ); my $score_attr = $check.'_score'; if( defined $self->$score_attr && ! $r->is_already_done($self->name.'-'.$check.'-score') ) { $self->add_score($r, $self->name.'-'.$check => $self->$score_attr ); } my $mode = $self->get_uc( $session, $check.'_mode' ); if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($check, $hostname, $info), abort => 1, ); } } return; } sub _get_hostname { my ( $self, $r, $field ) = @_; my $value = $r->attr($field); if( ! defined $value ) { die($field.' not defined in request!'); } # skip unknown and empty fields if( $value eq 'unknown' || $value eq '' ) { return; } # skip ip addresses if( $value =~ m/^\d+\.\d+\.\d+\.\d+$/) { return; } # skip ip6 addresses if( $value =~ m/:/) { return; } # skip unqualified hostnames if( $value !~ m/\./) { return; } if( $field eq 'sender') { $value =~ s/^[^@]*@//; } return($value); } sub _get_reject_action { my ( $self, $check, $hostname, $info ) = @_; my $msg = $self->reject_message; $msg =~ s/%CHECK%/$check/; $msg =~ s/%HOSTNAME%/$hostname/; if( defined $info ) { $msg =~ s/%INFO%/, $info/; } else { $msg =~ s/%INFO%//; } return 'reject '.$msg; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::DBL - mtpolicyd plugin for checking helo,sender domain,rdns against an DBL =head1 VERSION version 2.02 =head1 DESCRIPTION Will check the sender, helo and reverse_client_name against an domain black list. =head1 PARAMETERS =over =item domain (required) The domain of the blacklist to query. =item enabled (default: on) Set to 'off' to disable plugin. Possible values: on,off =item uc_enabled (default: empty) If specified the give variable within the session will overwrite the value of 'enabled' if set. =item (uc_)sender_mode (default: reject), (uc_)helo_name_mode (default: passive), (uc_)reverse_client_name_mode (default: reject) Should the plugin return an reject if the check matches (reject) or just add an score (passive). Possible values: reject, passive =item sender_score (default: 5) =item helo_name_score (default: 1) =item reverse_client_name_score (default: 2.5) Add the given score if check matched. =item score_field (default: score) Name of the session variable the score is stored in. Could be used if multiple scores are needed. =back =head1 EXAMPLE Only the sender and the reverse_client_name check will cause an action to be executed (mode). The helo check will only add an score. module = "RBL" #enabled = "on" uc_enabled = "spamhaus" domain="dbl.spamhaus.org" # do not reject based on helo #helo_name_mode=passive #helo_name_score=1 #sender_mode=reject #sender_score=5 #reverse_client_name_mode=reject #reverse_client_name_score=2.5 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/Greylist.pm0000644000175000017500000002777112752672654023457 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::Greylist; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: This plugin implements a greylisting mechanism with an auto whitelist. extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; use Time::Piece; use Time::Seconds; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'passive'); has 'defer_message' => ( is => 'rw', isa => 'Str', default => 'defer greylisting is active'); has 'append_waittime' => ( is => 'rw', isa => 'Bool', default => 1 ); has 'min_retry_wait' => ( is => 'rw', isa => 'Int', default => 60*5 ); has 'max_retry_wait' => ( is => 'rw', isa => 'Int', default => 60*60*2 ); has 'use_autowl' => ( is => 'rw', isa => 'Bool', default => 1 ); has 'autowl_threshold' => ( is => 'rw', isa => 'Int', default => 3 ); has 'autowl_expire_days' => ( is => 'rw', isa => 'Int', default => 60 ); has 'autowl_table' => ( is => 'rw', isa => 'Str', default => 'autowl' ); has 'query_autowl' => ( is => 'rw', isa => 'Bool', default => 1 ); has 'create_ticket' => ( is => 'rw', isa => 'Bool', default => 1 ); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Role::Connection' => { name => 'memcached', type => 'Memcached', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $sender = $r->attr('sender'); my $recipient = $r->attr('recipient'); my @triplet = ($sender, $ip, $recipient); my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } if( $self->use_autowl && $self->query_autowl ) { my ( $is_autowl ) = $r->do_cached('greylist-is_autowl', sub { $self->is_autowl( $r, @triplet ); } ); if( $is_autowl ) { $self->log($r, 'client on greylist autowl'); return $self->success( $r ); } } my ( $ticket ) = $r->do_cached('greylist-ticket', sub { $self->get_ticket($r, @triplet) } ); if( defined $ticket ) { if( $self->is_valid_ticket( $ticket ) ) { $self->log($r, join(',', @triplet).' has a valid greylisting ticket'); if( $self->use_autowl && ! $r->is_already_done('greylist-autowl-add') ) { $self->add_autowl( $r, @triplet ); } $self->remove_ticket( $r, @triplet ); return $self->success( $r ); } $self->log($r, join(',', @triplet).' has a invalid greylisting ticket. wait again'); return( $self->defer( $ticket ) ); } if( $self->create_ticket ) { $self->log($r, 'creating new greylisting ticket'); $self->do_create_ticket($r, @triplet); return( $self->defer ); } return; } sub defer { my ( $self, $ticket ) = @_; my $message = $self->defer_message; if( defined $ticket && $self->append_waittime ) { $message .= ' ('.( $ticket - time ).'s left)' } return( Mail::MtPolicyd::Plugin::Result->new( action => $message, abort => 1, ) ); } sub success { my ( $self, $r ) = @_; if( defined $self->score && ! $r->is_already_done('greylist-score') ) { $self->add_score($r, $self->name => $self->score); } if( $self->mode eq 'accept' || $self->mode eq 'dunno' ) { return( Mail::MtPolicyd::Plugin::Result->new( action => $self->mode, abort => 1, ) ); } return; } sub _extract_sender_domain { my ( $self, $sender ) = @_; my $sender_domain; if( $sender =~ /@/ ) { ( $sender_domain ) = $sender =~ /@([^@]+)$/; } else { # fallback to just the sender? $sender_domain = $sender; } return($sender_domain); } sub is_autowl { my ( $self, $r, $sender, $client_ip ) = @_; my $sender_domain = $self->_extract_sender_domain( $sender ); my ( $row ) = $r->do_cached('greylist-autowl-row', sub { $self->get_autowl_row( $sender_domain, $client_ip ); } ); if( ! defined $row ) { $self->log($r, 'client is not on autowl'); return(0); } my $last_seen = $row->{'last_seen'}; my $expires = $last_seen + ( ONE_DAY * $self->autowl_expire_days ); my $now = Time::Piece->new->epoch; if( $now > $expires ) { $self->log($r, 'removing expired autowl row'); $self->remove_autowl_row( $sender_domain, $client_ip ); return(0); } if( $row->{'count'} < $self->autowl_threshold ) { $self->log($r, 'client has not yet reached autowl_threshold'); return(0); } $self->log($r, 'client has valid autowl row. updating row'); $self->incr_autowl_row( $sender_domain, $client_ip ); return(1); } sub add_autowl { my ( $self, $r, $sender, $client_ip ) = @_; my $sender_domain = $self->_extract_sender_domain( $sender ); my ( $row ) = $r->do_cached('greylist-autowl-row', sub { $self->get_autowl_row( $sender_domain, $client_ip ); } ); if( defined $row ) { $self->log($r, 'client already on autowl, just incrementing count'); $self->incr_autowl_row( $sender_domain, $client_ip ); return; } $self->log($r, 'creating initial autowl entry'); $self->create_autowl_row( $sender_domain, $client_ip ); return; } sub get_autowl_row { my ( $self, $sender_domain, $client_ip ) = @_; my $sql = sprintf("SELECT * FROM %s WHERE sender_domain=? AND client_ip=?", $self->autowl_table ); return $self->execute_sql($sql, $sender_domain, $client_ip)->fetchrow_hashref; } sub create_autowl_row { my ( $self, $sender_domain, $client_ip ) = @_; my $timestamp = my $sql = sprintf("INSERT INTO %s VALUES(NULL, ?, ?, 1, %d)", $self->autowl_table, Time::Piece->new->epoch ); $self->execute_sql($sql, $sender_domain, $client_ip); return; } sub incr_autowl_row { my ( $self, $sender_domain, $client_ip ) = @_; my $sql = sprintf( "UPDATE %s SET count=count+1, last_seen=%d WHERE sender_domain=? AND client_ip=?", $self->autowl_table, Time::Piece->new->epoch ); $self->execute_sql($sql, $sender_domain, $client_ip); return; } sub remove_autowl_row { my ( $self, $sender_domain, $client_ip ) = @_; my $sql = sprintf("DELETE FROM %s WHERE sender_domain=? AND client_ip=?", $self->autowl_table ); $self->execute_sql($sql, $sender_domain, $client_ip); return; } sub expire_autowl_rows { my ( $self ) = @_; my $timeout = ONE_DAY * $self->autowl_expire_days; my $now = Time::Piece->new->epoch; my $sql = sprintf("DELETE FROM %s WHERE ? > last_seen + ?", $self->autowl_table ); $self->execute_sql($sql, $now, $timeout); return; } sub get_ticket { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $key = join(",", $sender, $ip, $rcpt ); if( my $ticket = $self->_memcached_handle->get( $key ) ) { return( $ticket ); } return; } sub is_valid_ticket { my ( $self, $ticket ) = @_; if( time > $ticket ) { return 1; } return 0; } sub remove_ticket { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $key = join(",", $sender, $ip, $rcpt ); $self->_memcached_handle->delete( $key ); return; } sub do_create_ticket { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $ticket = time + $self->min_retry_wait; my $key = join(",", $sender, $ip, $rcpt ); $self->_memcached_handle->set( $key, $ticket, $self->max_retry_wait ); return; } sub init { my $self = shift; if( $self->use_autowl ) { $self->check_sql_tables( %{$self->_table_definitions} ); } } has '_table_definitions' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { { 'autowl' => { 'mysql' => 'CREATE TABLE %TABLE_NAME% ( `id` int(11) NOT NULL AUTO_INCREMENT, `sender_domain` VARCHAR(255) NOT NULL, `client_ip` VARCHAR(39) NOT NULL, `count` INT UNSIGNED NOT NULL, `last_seen` INT UNSIGNED NOT NULL, PRIMARY KEY (`id`), UNIQUE KEY `domain_ip` (`client_ip`, `sender_domain`), KEY(`client_ip`), KEY(`sender_domain`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1', 'SQLite' => 'CREATE TABLE %TABLE_NAME% ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `sender_domain` VARCHAR(255) NOT NULL, `client_ip` VARCHAR(39) NOT NULL, `count` INT UNSIGNED NOT NULL, `last_seen` INTEGER NOT NULL )', }, } }, ); sub cron { my $self = shift; my $server = shift; if( grep { $_ eq 'hourly' } @_ ) { $server->log(3, 'expiring greylist autowl...'); $self->expire_autowl_rows; } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Greylist - This plugin implements a greylisting mechanism with an auto whitelist. =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin implements a greylisting mechanism with an auto whitelist. If a client connects it will return an defer and create a greylisting "ticket" for the combination of the address of the sender, the senders address and the recipient address. The ticket will be stored in memcached and will contain the time when the client was seen for the first time. The ticket will expire after the max_retry_wait timeout. The client will be defered until the min_retry_wait timeout has been reached. Only in the time between the min_retry_wait and max_retry_wait the request will pass the greylisting test. When the auto-whitelist is enabled (default) a record for every client which passes the greylisting test will be stored in the autowl_table. The table is based on the combination of the sender domain and client_address. If a client passed the test at least autowl_threshold (default 3) times the greylisting test will be skipped. Additional an last_seen timestamp is stored in the record and records which are older then the autowl_expire_days will expire. Please note the greylisting is done on a triplet based on the client_address + sender + recipient The auto-white list is based on the client_address + sender_domain =head1 PARAMETERS =over =item (uc_)enabled (default: on) Enable/disable this check. =item score (default: empty) Apply an score to this message if it _passed_ the greylisting test. In most cases you want to assign a negative score. (eg. -10) =item mode (default: passive) The default is to return no action if the client passed the greylisting test and continue. You can set this 'accept' or 'dunno' if you want skip further checks. =item defer_message (default: defer greylisting is active) This action is returned to the MTA if a message is defered. If a client retries too fast the time left till min_retry_wait is reach will be appended to the string. =item min_retry_wait (default: 300 (5m)) A client will have to wait at least for this timeout. (in seconds) =item max_retry_wait (default: 7200 (2h)) A client must retry to deliver the message before this timeout. (in seconds) =item use_autowl (default: 1) Could be used to disable the use of the auto-whitelist. =item autowl_threshold (default: 3) How often a client/sender_domain pair must pass the check before it is whitelisted. =item autowl_expire_days (default: 60) After how many days an auto-whitelist entry will expire if no client with this client/sender pair is seen. =item autowl_table (default: autowl) The name of the table to use. The database handle specified in the global configuration will be used. (see man mtpolicyd) =item query_autowl, create_ticket (default: 1) This options could be used to disable the creation of a new ticket or to query the autowl. This can be used to catch early retries at the begin of your configuration before more expensive checks a processes. Example: module = "Greylist" score = -5 mode = "passive" create_ticket = 0 query_autowl = 0 # ... a lot of RBL checks, etc... module = "ScoreAction" threshold = 5 module = "Greylist" score = -5 mode = "passive" This will prevent early retries from running thru all checks. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/RBL.pm0000644000175000017500000000675312752672654022271 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::RBL; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for checking the client-address against an RBL extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; use Mail::MtPolicyd::Plugin::Result; use Mail::RBL; has 'domain' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'reject_message' => ( is => 'ro', isa => 'Str', default => 'delivery from %IP% rejected %INFO%', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has '_rbl' => ( is => 'ro', isa => 'Mail::RBL', lazy => 1, default => sub { my $self = shift; Mail::RBL->new($self->domain) }, ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $mode = $self->get_uc( $session, 'mode' ); my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } my ( $ip_result, $info ) = $r->do_cached('rbl-'.$self->name.'-result', sub { $self->_rbl->check( $ip ) } ); if( ! defined $ip_result ) { $self->log($r, 'ip '.$ip.' not on '.$self->domain.' blacklist'); return; # host is not on the list } $self->log($r, 'ip '.$ip.' on '.$self->domain.' blacklist'.( defined $info ? ' ('.$info.')' : '' ) ); if( defined $self->score && ! $r->is_already_done('rbl-'.$self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($ip, $info), abort => 1, ); } if( $mode eq 'accept' ) { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } sub _get_reject_action { my ( $self, $ip, $info ) = @_; my $message = $self->reject_message; $message =~ s/%IP%/$ip/; if( defined $info && $info ne '' ) { $message =~ s/%INFO%/($info)/; } else { $message =~ s/%INFO%//; } return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::RBL - mtpolicyd plugin for checking the client-address against an RBL =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin queries a DNS black/white list. =head1 PARAMETERS =over =item domain (required) The domain of the blacklist to query. =item (uc_)enabled (default: on) Enable/disable this check. =item (uc_)mode (default: reject) =over =item reject Reject the message. (reject) =item accept Stop processing an accept this message. (dunno) =item passive Only apply the score if one is given. =back =item reject_message (default: delivery from %IP% rejected %INFO%) A pattern for the reject message if mode is set to 'reject'. =item score (default: empty) Apply this score if the check matched. =back =head1 EXAMPLE DNS BLACKLIST module = "RBL" mode = "passive" domain="dnsbl.sorbs.net" score = 5 =head1 EXAMPLE DNS WHITELIST module = "RBL" mode = "accept" # will stop here domain="list.dnswl.org" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/CtIpRep.pm0000644000175000017500000001270312752672654023150 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::CtIpRep; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for the Commtouch IP reputation service (ctipd) extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'tempfail_mode', 'permfail_mode' ], }; use Mail::MtPolicyd::Plugin::Result; use LWP::UserAgent; use HTTP::Request::Common; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has '_agent' => ( is => 'ro', isa => 'LWP::UserAgent', lazy => 1, default => sub { LWP::UserAgent->new } ); has 'url' => ( is => 'ro', isa => 'Str', default => 'http://localhost:8080/ctipd/iprep', ); has 'key' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'reject_message' => ( is => 'rw', isa => 'Str', default => '550 delivery from %IP% is rejected. Check at http://www.commtouch.com/Site/Resources/Check_IP_Reputation.asp. Reference code: %REFID%', ); has 'defer_message' => ( is => 'rw', isa => 'Str', default => '450 delivery from %IP% is deferred,repeatedly. Send again or check at http://www.commtouch.com/Site/Resources/Check_IP_Reputation.asp. Reference code: %REFID%', ); has 'permfail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'permfail_mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'tempfail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'tempfail_mode' => ( is => 'rw', isa => 'Str', default => 'defer' ); sub _scan_ip { my ( $self, $ip ) = @_; my $request = "x-ctch-request-type: classifyip\r\n". "x-ctch-pver: 1.0\r\n"; if( defined $self->key ) { $request .= 'x-ctch-key: '.$self->key."\r\n"; } $request .= "\r\n"; $request .= 'x-ctch-ip: '.$ip."\r\n"; my $response = $self->_agent->request(POST $self->url, Content => $request ); if( $response->code ne 200 ) { die('error while accessing Commtouch ctipd: '.$response->status_line); } my $content = $response->content; my ( $action ) = $content =~ m/^x-ctch-dm-action:(.*)\r$/m; my ( $refid ) = $content =~ m/^x-ctch-refid:(.*)\r$/m; if( ! defined $action ) { die('could not find action in response: '.$content); } return( $action, $refid ); } sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $mode; if( ! defined $ip ) { die('no client_address in request!'); } my $enabled = $self->get_uc($session, 'enabled'); if( $enabled eq 'off' ) { return; } my ( $result, $refid ) = $r->do_cached( $self->name.'-result', sub{ $self->_scan_ip( $ip ) } ); if( $result eq 'accept') { $self->log( $r, 'CtIpRep: sender IP is ok' ); return; # do nothing } elsif( $result eq 'permfail' ) { $mode = $self->get_uc( $session, 'permfail_mode' ); if( $self->permfail_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $self->permfail_score); } } elsif ($result eq 'tempfail' ) { $mode = $self->get_uc( $session, 'tempfail_mode' ); if( $self->tempfail_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $self->tempfail_score); } } else { die('unknown ctiprep action: '.$result); } $self->log($r, 'CtIpRep: result='.$result.', mode='.$mode); if ( $mode eq 'reject' || $mode eq 'defer' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_build_action($mode, $ip, $refid), abort => 1, ); } return; } sub _build_action { my ( $self, $action, $ip, $refid ) = @_; my $message; if( $action eq 'reject' ) { $message = $self->reject_message; } elsif ( $action eq 'defer' ) { $message = $self->defer_message; } else { die('unknown action: '.$action); } $message =~ s/%IP%/$ip/; $message =~ s/%REFID%/$refid/; return($action.' '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::CtIpRep - mtpolicyd plugin for the Commtouch IP reputation service (ctipd) =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin will query the Commtouch IP Reputation service (ctipd). The used protocol is HTTP. The services will return a status permfail or tempfail. =head1 PARAMETERS =over =item (uc_)enabled (default: on) Enable/disable the plugin. =item url (default: http://localhost:8080/ctipd/iprep) The URL to access the ctipd daemon. =item key (default: empty) If an authentication key is required by the ctipd. =item reject_message (default: 550 delivery from %IP% is rejected. Check at http://www.commtouch.com/Site/Resources/Check_IP_Reputation.asp. Reference code: %REFID%) This parameter could be used to specifiy a custom reject message if message is rejected. =item defer_message (default: 450 delivery from %IP% is deferred,repeatedly. Send again or check at http://www.commtouch.com/Site/Resources/Check_IP_Reputation.asp. Reference code: %REFID%) This parameter could be used to specifiy a custom message is a message is to be defered. =item (uc_)permfail_mode, (uc_)tempfail_mode (default: reject, defer) Action to take when the service return permfail/tempfail status: =over =item reject =item defer =item passive =back =item permfail_score, tempfail_score (default: empty) Apply the specified score. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/RBLAction.pm0000644000175000017500000001042512752672654023416 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::RBLAction; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for checking the client-address against an RBL extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; use Mail::MtPolicyd::Plugin::Result; use Mail::RBL; has 'result_from' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 're_match' => ( is => 'rw', isa => 'Str', required => 1 ); has 'reject_message' => ( is => 'ro', isa => 'Str', default => 'delivery from %IP% rejected %INFO%', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $mode = $self->get_uc( $session, 'mode' ); my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } my $result_key = 'rbl-'.$self->result_from.'-result'; if( ! defined $session->{$result_key} || ref( $session->{$result_key} ) ne 'ARRAY' ) { $self->log( $r, 'no RBL check result for '.$self->name.' found!'); return; } my ( $ip_result, $info ) = @{$session->{$result_key}}; if( ! defined $ip_result ) { return; } my $regex = $self->re_match; if( $ip_result->addr !~ m/$regex/ ) { $self->log( $r, $ip_result->addr.' did not match regex '.$regex); return; } $self->log( $r, $ip_result->addr.' match regex '.$regex); if( defined $self->score && ! $r->is_already_done('rbl-'.$self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($ip, $info), abort => 1, ); } if( $mode eq 'accept' ) { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } sub _get_reject_action { my ( $self, $ip, $info ) = @_; my $message = $self->reject_message; $message =~ s/%IP%/$ip/; if( defined $info && $info ne '' ) { $message =~ s/%INFO%/($info)/; } else { $message =~ s/%INFO%//; } return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::RBLAction - mtpolicyd plugin for checking the client-address against an RBL =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin can be used when a more complex evaluation of an RBL result is needed that just match/not-match. With this plugin you can take the same actions as with the RBL plugin, but it can match the result with a regular expression. This allows one to take action based on the category in combined blacklists. =head1 PARAMETERS =over =item result_from (required) Use the query result of this RBL check. =item (uc_)enabled (default: on) Enable/disable this check. =item (uc_)mode (default: reject) =over =item reject Reject the message. (reject) =item accept Stop processing an accept this message. (dunno) =item passive Only apply the score if one is given. =back =item re_match (required) An regular expression to check the RBL result. =item reject_message (default: delivery from %IP% rejected %INFO%) A pattern for the reject message if mode is set to 'reject'. =item score (default: empty) Apply this score if the check matched. =back =head1 EXAMPLE module = "RBL" mode = "passive" domain="zen.spamhaus.org" module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[23]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[4-7]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.1[01]$" score = 3 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Plugin/SMTPVerify.pm0000644000175000017500000002136712752672654023620 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Plugin::SMTPVerify; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: mtpolicyd plugin for remote SMTP address checks extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; use Net::SMTP::Verify; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'host' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'port' => ( is => 'ro', isa => 'Maybe[Int]' ); has 'check_tlsa' => ( is => 'ro', isa => 'Str', default => 'off' ); has 'check_openpgp' => ( is => 'ro', isa => 'Str', default => 'off' ); with 'Mail::MtPolicyd::Plugin::Role::ConfigurableFields' => { 'fields' => { 'size' => { isa => 'Str', default => 'size', value_isa => 'Int', }, 'sender' => { isa => 'Str', default => 'recipient', value_isa => 'Str', }, 'recipient' => { isa => 'Str', default => 'sender', value_isa => 'Str', }, }, }; has 'temp_fail_action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'temp_fail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'perm_fail_action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'perm_fail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'has_starttls_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'no_starttls_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'has_tlsa_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'no_tlsa_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'has_openpgp_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'no_openpgp_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'sender' => ( is => 'ro', isa => 'Maybe[Str]' ); # store current request for logging_callback has '_current_request' => ( is => 'rw', isa => 'Maybe[Mail::MtPolicyd::Request]' ); has '_verify' => ( is => 'ro', isa => 'Net::SMTP::Verify', lazy => 1, default => sub { my $self = shift; return Net::SMTP::Verify->new( defined $self->host ? ( host => $self->host ) : (), defined $self->port ? ( port => $self->port ) : (), $self->check_tlsa eq 'on' ? ( tlsa => 1 ) : (), $self->check_openpgp eq 'on' ? ( openpgp => 1 ) : (), logging_callback => sub { my $msg = shift; my $r = $self->_current_request; if( defined $r ) { $self->log( $r, $msg ); } return; }, ); }, ); sub get_sender { my ( $self, $r ) = @_; if( defined $self->sender ) { return( $self->sender ); } return $self->get_sender_value( $r ); } sub run { my ( $self, $r ) = @_; $self->_current_request( $r ); my $session = $r->session; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } my $size = $self->get_size_value( $r ); my $sender = $self->get_sender( $r ); my $recipient = $self->get_recipient_value( $r ); if( $r->is_already_done('verify-'.$recipient) ) { return; } my $result = $self->_verify->check( $size, $sender, $recipient ); if( ! $result->count ) { die('Net::SMTP::Verify returned empty resultset!'); # should not happen } my ( $rcpt ) = $result->entries; $self->_apply_score( $r, $rcpt, 'starttls' ); if( $self->check_tlsa eq 'on' ) { $self->_apply_score( $r, $rcpt, 'tlsa' ); } if( $self->check_openpgp eq 'on' ) { $self->_apply_score( $r, $rcpt, 'openpgp' ); } if( $rcpt->is_error ) { return $self->_handle_rcpt_error( $r, $rcpt ); } $self->_current_request( undef ); return; } sub _apply_score { my ( $self, $r, $rcpt, $name ) = @_; my $field = 'has_'.$name; my $value = $rcpt->$field; if( ! defined $value ) { return; } my $score_field; if( $value ) { $score_field = 'has_'.$name.'_score'; } else { $score_field = 'no_'.$name.'_score'; } my $score = $self->$score_field; if( ! defined $score ) { return; } $self->add_score($r, $self->name.'-'.$rcpt->address.'-'.$name => $score ); return; } sub _handle_rcpt_error { my ( $self, $r, $rcpt ) = @_; my $action; if( $rcpt->is_perm_error ) { if( defined $self->perm_fail_action ) { $action = $self->perm_fail_action; } if( defined $self->perm_fail_score ) { $self->add_score($r, $self->name.'-'.$rcpt->address => $self->perm_fail_score); } } elsif( $rcpt->is_temp_error ) { if( defined $self->temp_fail_action ) { $action = $self->temp_fail_action; } if( defined $self->temp_fail_score ) { $self->add_score($r, $self->name.'-'.$rcpt->address => $self->temp_fail_score ); } } else { return; } if( ! defined $action ) { return; } my $msg = $rcpt->smtp_message; $action =~ s/%MSG%/$msg/; return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SMTPVerify - mtpolicyd plugin for remote SMTP address checks =head1 VERSION version 2.02 =head1 DESCRIPTION This plugin can be used to do remote SMTP verification of addresses. =head1 Example To check if the recipient exists on a internal relay and mailbox is able to recieve a message of this size: module = "SMTPVerify" host = "mail.company.internal" sender_field = "sender" recipient_field = "recipient" # send SIZE to check quota size_field = "size" temp_fail_action = "defer %MSG%" perm_fail_action = "reject %MSG%" Do some very strict checks on sender address: module = "SMTPVerify" # use a verifiable address in MAIL FROM: sender = "horst@mydomain.tld" recipient_field = "sender" no_starttls_action = "reject sender address does not support STARTTLS" temp_fail_action = "defer sender address failed verification: %MSG%" perm_fail_action = "reject sender address does not accept mail: %MSG%" Or do advanced checking of sender address and apply a score: module = "SMTPVerify" # use a verifiable address in MAIL FROM: sender = "horst@mydomain.tld" recipient_field = "sender" check_tlsa = "on" check_openpgp = "on" temp_fail_score = "1" perm_fail_score = "3" has_starttls_score = "-1" no_starttls_score = "5" has_tlsa_score = "-3" has_openpgp_score = "-3" Based on the score you can later apply greylisting or other actions. =head1 Configuration =head2 Parameters The module takes the following parameters: =over =item (uc_)enabled (default: on) Enable/disable this check. =item host (default: empty) If defined this host will be used for checks instead of a MX. =item port (default: 25) Port to use for connection. =item check_tlsa (default: off) Set to 'on' to enable check if an TLSA record for the MX exists. This requires that your DNS resolver returnes the AD flag for DNSSEC secured records. =item check_openpgp (default: off) Set to 'on' to enable check if an OPENPGPKEY records for the recipients exists. =item sender_field (default: recipient) Field to take the MAIL FROM address from. =item sender (default: empty) If set use this fixed sender in MAIL FROM instead of sender_field. =item recipient_field (default: sender) Field to take the RCPT TO address from. =item size_field (default: size) Field to take the message SIZE from. =item perm_fail_action (default: empty) Action to return if the remote server returned an permanent error for this recipient. The string "%MSG%" will be replaced by the smtp message: perm_fail_action = "reject %MSG%" =item temp_fail_action (default: empty) Like perm_fail_action but this message is returned when an temporary error is returned by the remote smtp server. temp_fail_action = "defer %MSG%" =item perm_fail_score (default: empty) Score to apply when a permanent error is returned for this recipient. =item temp_fail_score (default: empty) Score to apply when a temporary error is returned for this recipient. =item has_starttls_score (default: emtpy) =item no_starttls_score (default: emtpy) Score to apply when the smtp server of the recipient announces support for STARTTLS extension. =item has_tlsa_score (default: empty) =item no_tlsa_score (default: empty) Score to apply when there is a TLSA or no TLSA record for the remote SMTP server. =item has_openpgp_score (default: empty) =item no_openpgp_score (default: empty) Score to apply when a OPENPGPKEY record for the recpient exists or not exists. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Cookbook.pod0000644000175000017500000000214112752672654022313 0ustar werewolfwerewolf# PODNAME: Mail::MtPolicyd::Cookbook # ABSTRACT: How to cook with mtpolicyd __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook - How to cook with mtpolicyd =head1 VERSION version 2.02 =head1 DESCRIPTION The mtpolicyd cookbook is a series of guides for learning mtpolicyd. =head1 RECIPES =head2 BASICS =over =item L How to do a basic installation of mtpolicyd in postfix. =item L Explains the default configuration that mtpolicyd comes with. =back =head2 PLUGIN DEVELOPMENT =over =item L How to write your own mtpolicyd plugin. =item L This receipt shows how to achieve tasks like scoring, per user configuration, SQL database queries, caching. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Client.pm0000644000175000017500000000537212752672654021626 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Client; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: a policyd client class use IO::Socket::UNIX; use IO::Socket::INET; use Mail::MtPolicyd::Client::Response; has 'socket_path' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'host' => ( is => 'rw', isa => 'Str', default => 'localhost:12345' ); has 'keepalive' => ( is => 'rw', isa => 'Bool', default => 0 ); has '_fh' => ( is => 'rw', isa => 'Maybe[IO::Handle]' ); sub _connect { my $self = shift; my $fh; if( defined $self->socket_path ) { $fh = IO::Socket::UNIX->new( Peer => $self->socket_path, autoflush => 0, ) or die('could not connect to socket: '.$!); } else { $fh = IO::Socket::INET->new( PeerAddr => $self->host, Proto => 'tcp', autoflush => 0, ) or die('could not connect to host: '.$!); } $self->_fh( $fh ); } sub _disconnect { my $self = shift; $self->_fh->close; $self->_fh( undef ); } sub _is_connected { my $self = shift; if( defined $self->_fh ) { return(1); } return(0); } sub request { my ( $self, $request ) = @_; if( ! $self->_is_connected ) { $self->_connect; } $self->_fh->print( $request->as_string ); $self->_fh->flush; my $response = Mail::MtPolicyd::Client::Response->new_from_fh( $self->_fh ); # close connection we're not doing keepalive # or if the server already closed connection (server side keepalive off) if( ! $self->keepalive || $self->_fh->eof ) { $self->_disconnect; } return $response; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Client - a policyd client class =head1 VERSION version 2.02 =head1 DESCRIPTION Client class to query a policyd server. =head2 SYNOPSIS use Mail::MtPolicyd::Client; use Mail::MtPolicyd::Client::Request; my $client = Mail::MtPolicyd::Client->new( host => 'localhost:12345', keepalive => 1, ); my $request = Mail::MtPolicyd::Client::Request->new( 'client_address' => '192.168.0.1', ); my $response = $client->request( $request ); print $response->as_string; =head2 METHODS =over =item request ( $request ) Will send a Mail::MtPolicyd::Client::Request to the remote host and return a Mail::MtPolicyd::Client::Response. =back =head2 ATTRIBUTES =over =item socket_path (default: undef) Path of a socket of the policyd server. If defined this socket will be used instead of a tcp connection. =item host (default: localhost:12345) Remote address/port of the policyd server. =item keepalive (default: 0) Keep connection open for multiple requests. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/PluginChain.pm0000644000175000017500000000650512752672654022610 0ustar werewolfwerewolfpackage Mail::MtPolicyd::PluginChain; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: class for a VirtualHost instance use Mail::MtPolicyd::Profiler; use Mail::MtPolicyd::Result; has 'plugins' => ( is => 'ro', isa => 'ArrayRef[Mail::MtPolicyd::Plugin]', default => sub { [] }, traits => [ 'Array' ], handles => { 'add_plugin' => 'push', } ); has 'plugin_prefix' => ( is => 'ro', isa => 'Str', default => 'Mail::MtPolicyd::Plugin::', ); has 'vhost_name' => ( is => 'rw', isa => 'Maybe[Str]' ); sub run { my ( $self, $r ) = @_; my $result = Mail::MtPolicyd::Result->new; foreach my $plugin ( @{$self->plugins} ) { my $abort = 0; Mail::MtPolicyd::Profiler->new_timer('plugin '.$plugin->name); my @plugin_results; eval { @plugin_results = $plugin->run($r); }; my $e = $@; if( $e ) { my $msg = 'plugin '.$plugin->name.' failed: '.$e; if( ! defined $plugin->on_error || $plugin->on_error ne 'continue' ) { die($msg); } $r->log(0, $msg); } Mail::MtPolicyd::Profiler->stop_current_timer; if( scalar @plugin_results ) { $result->last_match( $plugin->name ); } foreach my $plugin_result ( @plugin_results ) { $result->add_plugin_result($plugin_result); if( $plugin_result->abort ) { $abort = 1; } } if( $abort ) { last; } } return $result; } sub cron { my $self = shift; my $server = shift; foreach my $plugin ( @{$self->plugins} ) { $server->log(3, 'running cron for plugin '.$plugin->name); eval { $plugin->cron( $server, @_ ); }; my $e = $@; if( $e ) { $server->log(0, 'plugin '.$plugin->name.' failed in cron: '.$e ); } } return; } sub load_plugin { my ( $self, $plugin_name, $params ) = @_; if( ! defined $params->{'module'} ) { die('no module defined for plugin '.$plugin_name.'!'); } my $module = $params->{'module'}; my $plugin_class = $self->plugin_prefix.$module; my $plugin; my $code = "require ".$plugin_class.";"; eval $code; ## no critic (ProhibitStringyEval) if($@) { die('could not load module '.$module.' for plugin '.$plugin_name.': '.$@); } eval { $plugin = $plugin_class->new( name => $plugin_name, vhost_name => $self->vhost_name, %$params, ); $plugin->init(); }; if($@) { die('could not initialize plugin '.$plugin_name.': '.$@); } $self->add_plugin($plugin); return; } sub new_from_config { my ( $class, $vhost_name, $config ) = @_; my $self = $class->new( vhost_name => $vhost_name ); if( ! defined $config ) { return( $self ); } if( ref($config) ne 'HASH' ) { die('config must be an hashref!'); } foreach my $plugin_name ( keys %{$config} ) { $self->load_plugin($plugin_name, $config->{$plugin_name} ); } return $self; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::PluginChain - class for a VirtualHost instance =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Profiler/0000755000175000017500000000000012752672654021625 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Profiler/Timer.pm0000644000175000017500000000407712752672654023253 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Profiler::Timer; use Moose; use namespace::autoclean; our $VERSION = '2.02'; # VERSION # ABSTRACT: a profiler for the mtpolicyd use Time::HiRes 'gettimeofday', 'tv_interval'; has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); has 'start_time' => ( is => 'rw', isa => 'ArrayRef', default => sub { [gettimeofday()] }, ); has 'ticks' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { [] }, ); has 'parent' => ( is => 'ro', isa => 'Maybe[Mail::MtPolicyd::Profiler::Timer]' ); around BUILDARGS => sub { my $orig = shift; my $class = shift; if ( @_ == 1 && !ref $_[0] ) { return $class->$orig( name => $_[0] ); } else { return $class->$orig(@_); } }; sub tick { my ( $self, $msg ) = @_; my $now = [gettimeofday()]; my $delay = tv_interval($self->start_time, $now); push( @{$self->ticks}, [ $delay, $msg ] ); return; } sub stop { my $self = shift; $self->tick('timer stopped'); } sub new_child { my $self = shift; my $timer = __PACKAGE__->new( parent => $self, @_ ); $self->tick('started timer '.$timer->name); push( @{$self->ticks}, $timer ); return( $timer ); } sub to_string { my $self = shift; my $str = ''; foreach my $tick ( @{$self->ticks} ) { if( ref $tick eq 'ARRAY' ) { $str .= sprintf("%0f %s\n", @$tick ); } elsif( ref $tick eq 'Mail::MtPolicyd::Profiler::Timer' ) { my $substr = $tick->to_string; $substr =~ s/^/ /msg; $str .= $substr; } } return( $str ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Profiler::Timer - a profiler for the mtpolicyd =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/SessionCache/0000755000175000017500000000000012752672654022412 5ustar werewolfwerewolfMail-MtPolicyd-2.02/lib/Mail/MtPolicyd/SessionCache/Memcached.pm0000644000175000017500000000600612752672654024620 0ustar werewolfwerewolfpackage Mail::MtPolicyd::SessionCache::Memcached; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: session cache adapter for memcached extends 'Mail::MtPolicyd::SessionCache::Base'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'memcached', type => 'Memcached', }; use Time::HiRes qw(usleep); has 'expire' => ( is => 'ro', isa => 'Int', default => 5 * 60 ); has 'lock_wait' => ( is => 'rw', isa => 'Int', default => 50 ); has 'lock_max_retry' => ( is => 'rw', isa => 'Int', default => 50 ); has 'lock_timeout' => ( is => 'rw', isa => 'Int', default => 10 ); sub _acquire_session_lock { my ( $self, $instance ) = @_; my $lock = 'lock_'.$instance; for( my $try = 1 ; $try < $self->lock_max_retry ; $try++ ) { if( $self->_memcached_handle->add($lock, 1, $self->lock_timeout) ) { return; # lock created } usleep( $self->lock_wait * $try ); } die('could not acquire lock for session '.$instance); return; } sub _release_session_lock { my ( $self, $instance ) = @_; my $lock = 'lock_'.$instance; $self->_memcached_handle->delete($lock); return; } sub retrieve_session { my ($self, $instance ) = @_; if( ! defined $instance ) { return; } $self->_acquire_session_lock( $instance ); if( my $session = $self->_memcached_handle->get($instance) ) { return($session); } return( { '_instance' => $instance } ); } sub store_session { my ($self, $session ) = @_; my $instance = $session->{'_instance'}; if( ! defined $session || ! defined $instance ) { return; } $self->_memcached_handle->set($instance, $session, $self->expire); $self->_release_session_lock($instance); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache::Memcached - session cache adapter for memcached =head1 VERSION version 2.02 =head1 SYNOPSIS module = "Memcached" #memcached = "memcached" # expire session cache entries expire = "300" # wait timeout will be increased each time 50,100,150,... (usec) lock_wait=50 # abort after n retries lock_max_retry=50 # session lock times out after (sec) lock_timeout=10 =head1 PARAMETERS =over =item memcached (default: memcached) Name of the database connection to use. You have to define this connection first. see L =item expire (default: 5*60) Timeout in seconds for sessions. =item lock_wait (default: 50) Timeout for retry when session is locked in milliseconds. The retry will be done in multiples of this timeout. When set to 50 retry will be done in 50, 100, 150ms... =item lock_max_retry (default: 50) Maximum number of retries before giving up to obtain lock on a session. =item lock_timeout (default: 10) Timeout of session locks in seconds. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/SessionCache/Base.pm0000644000175000017500000000142212752672654023621 0ustar werewolfwerewolfpackage Mail::MtPolicyd::SessionCache::Base; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: base class for session cache adapters sub retrieve_session { my ($self, $instance ) = @_; return {}; } sub store_session { my ($self, $session ) = @_; return; } sub init { my ( $self ) = @_; return; } sub shutdown { my ( $self ) = @_; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache::Base - base class for session cache adapters =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/SessionCache/None.pm0000644000175000017500000000112212752672654023643 0ustar werewolfwerewolfpackage Mail::MtPolicyd::SessionCache::None; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: dummy session caching adapter extends 'Mail::MtPolicyd::SessionCache::Base'; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache::None - dummy session caching adapter =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/SessionCache/Redis.pm0000644000175000017500000000623212752672654024021 0ustar werewolfwerewolfpackage Mail::MtPolicyd::SessionCache::Redis; use Moose; our $VERSION = '2.02'; # VERSION # ABSTRACT: a session cache adapter for redis use Time::HiRes qw(usleep); use Storable; extends 'Mail::MtPolicyd::SessionCache::Base'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'redis', type => 'Redis', }; has 'expire' => ( is => 'ro', isa => 'Int', default => 5 * 60 ); has 'lock_wait' => ( is => 'rw', isa => 'Int', default => 50 ); has 'lock_max_retry' => ( is => 'rw', isa => 'Int', default => 50 ); has 'lock_timeout' => ( is => 'rw', isa => 'Int', default => 10 ); sub _acquire_session_lock { my ( $self, $instance ) = @_; my $lock = 'lock_'.$instance; for( my $try = 1 ; $try < $self->lock_max_retry ; $try++ ) { if( $self->_redis_handle->set($lock, 1, 'EX', $self->lock_timeout, 'NX' ) ) { return; # lock created } usleep( $self->lock_wait * $try ); } die('could not acquire lock for session '.$instance); return; } sub _release_session_lock { my ( $self, $instance ) = @_; my $lock = 'lock_'.$instance; $self->_redis_handle->del($lock); return; } sub retrieve_session { my ($self, $instance ) = @_; if( ! defined $instance ) { return; } $self->_acquire_session_lock( $instance ); if( my $blob = $self->_redis_handle->get($instance) ) { my $session; eval { $session = Storable::thaw( $blob ) }; if( $@ ) { die("could not restore session $instance: $@"); } return($session); } return( { '_instance' => $instance } ); } sub store_session { my ($self, $session ) = @_; my $instance = $session->{'_instance'}; if( ! defined $session || ! defined $instance ) { return; } my $data = Storable::freeze( $session ); $self->_redis_handle->set($instance, $data, 'EX', $self->expire); $self->_release_session_lock($instance); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache::Redis - a session cache adapter for redis =head1 VERSION version 2.02 =head1 SYNOPSIS module = "Redis" #redis = "redis" # expire session cache entries expire = "300" # wait timeout will be increased each time 50,100,150,... (usec) lock_wait=50 # abort after n retries lock_max_retry=50 # session lock times out after (sec) lock_timeout=10 =head1 PARAMETERS =over =item redis (default: redis) Name of the database connection to use. You have to define this connection first. see L =item expire (default: 5*60) Timeout in seconds for sessions. =item lock_wait (default: 50) Timeout for retry when session is locked in milliseconds. The retry will be done in multiples of this timeout. When set to 50 retry will be done in 50, 100, 150ms... =item lock_max_retry (default: 50) Maximum number of retries before giving up to obtain lock on a session. =item lock_timeout (default: 10) Timeout of session locks in seconds. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/lib/Mail/MtPolicyd/Profiler.pm0000644000175000017500000000330712752672654022166 0ustar werewolfwerewolfpackage Mail::MtPolicyd::Profiler; use strict; use warnings; use MooseX::Singleton; use namespace::autoclean; use Mail::MtPolicyd::Profiler::Timer; use JSON; our $VERSION = '2.02'; # VERSION # ABSTRACT: a application level profiler for mtpolicyd has 'root' => ( is => 'rw', isa => 'Mail::MtPolicyd::Profiler::Timer', lazy => 1, default => sub { Mail::MtPolicyd::Profiler::Timer->new( name => 'main timer' ); }, ); has 'current' => ( is => 'rw', isa => 'Mail::MtPolicyd::Profiler::Timer', handles => { 'tick' => 'tick', }, lazy => 1, default => sub { my $self = shift; return $self->root; }, ); sub reset { my ( $self, $name ) = @_; my $timer = Mail::MtPolicyd::Profiler::Timer->new( name => 'main timer' ); $self->root( $timer ); $self->current( $timer ); return; } sub new_timer { my ( $self, $name ) = @_; my $timer = $self->current->new_child( name => $name ); $self->current( $timer ); return; } sub stop_current_timer { my ( $self, $name ) = @_; $self->current->stop; if( defined $self->current->parent ) { $self->current($self->current->parent); } return; } sub to_string { my $self = shift; return $self->root->to_string; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Profiler - a application level profiler for mtpolicyd =head1 VERSION version 2.02 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Mail-MtPolicyd-2.02/rpm/0000755000175000017500000000000012752672654015305 5ustar werewolfwerewolfMail-MtPolicyd-2.02/rpm/mtpolicyd.spec0000644000175000017500000000551612752672654020174 0ustar werewolfwerewolf%define module_name Mail-MtPolicyd Name: mtpolicyd Version: 2.02 Release: %(date +%Y%m%d)%{dist} Summary: a modular policy daemon for postfix Group: Applications/CPAN License: GPLv2 Vendor: Markus Benning Packager: Markus Benning BuildArch: noarch BuildRoot: %{_tmppath}/%{name}-%{version}-build Source0: %{module_name}-%{version}.tar.gz #AutoProv: 0 # only require core dependencies AutoReq: 0 Requires: perl(Cache::Memcached), perl(Config::General), perl(Moose), perl(Tie::IxHash), perl(Time::HiRes), perl(DBI), perl(Mail::RBL), perl(JSON), perl(MooseX::Singleton) BuildRequires: perl, perl(ExtUtils::MakeMaker) Requires(pre): /usr/sbin/useradd, /usr/sbin/groupadd %description A modular policy daemon for postfix written in perl. %prep rm -rf $RPM_BUILD_ROOT %setup -q -n %{module_name}-%{version} %build %{__perl} Makefile.PL INSTALLDIRS=vendor make %{?_smp_mflags} %install if [ -d "$RPM_BUILD_ROOT" ] ; then rm -rf $RPM_BUILD_ROOT fi make install DESTDIR=$RPM_BUILD_ROOT find $RPM_BUILD_ROOT -type f -name .packlist -exec rm -f {} \; find $RPM_BUILD_ROOT -type f -name perllocal.pod -exec rm -f {} \; find $RPM_BUILD_ROOT -depth -type d -exec rmdir {} 2>/dev/null \; mkdir -p "$RPM_BUILD_ROOT/%{_sysconfdir}/init.d" mkdir -p "$RPM_BUILD_ROOT/%{_sysconfdir}/mtpolicyd" mkdir -p "$RPM_BUILD_ROOT/%{_sysconfdir}/cron.d" mkdir -p "$RPM_BUILD_ROOT/var/run/mtpolicyd" install -m755 rpm/mtpolicyd.init-redhat "$RPM_BUILD_ROOT/%{_sysconfdir}/init.d/mtpolicyd" install -m640 etc/mtpolicyd.conf "$RPM_BUILD_ROOT/%{_sysconfdir}/mtpolicyd/mtpolicyd.conf" install -m640 etc/mtpolicyd.crontab "$RPM_BUILD_ROOT/%{_sysconfdir}/cron.d/mtpolicyd" %{_fixperms} $RPM_BUILD_ROOT/* %clean if [ "$RPM_BUILD_ROOT" = "" -o "$RPM_BUILD_ROOT" = "/" ]; then RPM_BUILD_ROOT=/var/tmp/rpm-build-root export RPM_BUILD_ROOT fi rm -rf $RPM_BUILD_ROOT %pre ( /usr/sbin/groupadd \ -r mtpolicyd \ && /usr/sbin/useradd \ -c 'mtpolicyd daemon' \ -d /var/run/mtpolicyd \ -M -r \ -s /bin/false \ -g mtpolicyd \ mtpolicyd 2>&1 >/dev/null || exit 0 ) %post /sbin/chkconfig --add mtpolicyd %preun if [ "$1" = 0 ]; then /sbin/service mtpolicyd stop &>/dev/null /sbin/chkconfig --del mtpolicyd fi %files %defattr(-,root,root) %doc README %attr(755,root,root) %{_bindir}/mtpolicyd %attr(755,root,root) %{_bindir}/policyd-client %attr(755,root,root) %{_sysconfdir}/init.d/mtpolicyd %dir %ghost %{_sysconfdir}/mtpolicyd %attr(640,root,mtpolicyd) %config(noreplace) %{_sysconfdir}/mtpolicyd/mtpolicyd.conf %attr(640,root,root) %config %{_sysconfdir}/cron.d/mtpolicyd %attr(750,mtpolicyd,mtpolicyd) %dir /var/run/mtpolicyd %{perl_vendorlib} %{_mandir}/man1/* %{_mandir}/man3/* %changelog * Fri Mar 20 2015 Markus Benning 2.02 - generate spec file from upstream release Mail-MtPolicyd-2.02/rpm/mtpolicyd.init-redhat0000750000175000017500000000336212752672654021445 0ustar werewolfwerewolf#!/bin/bash # # mtpolicyd Startup script for mtpolicyd. # # chkconfig: - 79 31 # description: a postfix policy daemon used by the mailteam ### BEGIN INIT INFO # Provides: $mtpolicyd # Default-Start: 2 3 4 5 # Default-Stop: 0 1 6 # Short-Description: a postfix policy daemon used by the mailteam # Description: mtpolicyd is a postfix policy daemon able to provide # advanced checks into postfix. ### END INIT INFO # Source function library. . /etc/init.d/functions RETVAL=0 PIDFILE=/var/run/mtpolicyd/mtpolicyd.pid prog=mtpolicyd exec=/usr/bin/mtpolicyd lockfile=/var/lock/subsys/$prog # Source config if [ -f /etc/sysconfig/$prog ] ; then . /etc/sysconfig/$prog fi start() { [ -x $exec ] || exit 5 umask 077 echo -n $"Starting mtpolicyd: " daemon $exec RETVAL=$? echo [ $RETVAL -eq 0 ] && touch $lockfile return $RETVAL } stop() { echo -n $"Shutting down mtpolicyd: " killproc -p "$PIDFILE" $exec RETVAL=$? echo [ $RETVAL -eq 0 ] && rm -f $lockfile return $RETVAL } rhstatus() { status -p "$PIDFILE" -l $prog $exec } restart() { stop start } reload() { echo -n $"Reloading mtpolicyd: " killproc -p "$PIDFILE" $exec -HUP RETVAL=$? echo } case "$1" in start) start ;; stop) stop ;; restart) restart ;; reload) reload ;; force-reload) restart ;; status) rhstatus ;; condrestart|try-restart) rhstatus >/dev/null 2>&1 || exit 0 restart ;; *) echo $"Usage: $0 {start|stop|restart|condrestart|try-restart|reload|force-reload|status}" exit 3 esac exit $? Mail-MtPolicyd-2.02/META.json0000644000175000017500000003062312752672654016134 0ustar werewolfwerewolf{ "abstract" : "a modular policy daemon for postfix", "author" : [ "Markus Benning " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.020, CPAN::Meta::Converter version 2.142690", "license" : [ "gpl_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Mail-MtPolicyd", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Dist::Zilla::Plugin::ChangelogFromGit" : "0", "Dist::Zilla::Plugin::ChangelogFromGit::Debian" : "0", "Dist::Zilla::Plugin::FileFinder::ByName" : "0", "Dist::Zilla::Plugin::Git::NextVersion" : "0", "Dist::Zilla::Plugin::MetaJSON" : "0", "Dist::Zilla::Plugin::MetaProvides::Package" : "0", "Dist::Zilla::Plugin::MetaResources" : "0", "Dist::Zilla::Plugin::OurPkgVersion" : "0", "Dist::Zilla::Plugin::PodSyntaxTests" : "0", "Dist::Zilla::Plugin::PodWeaver" : "0", "Dist::Zilla::Plugin::Prereqs" : "0", "Dist::Zilla::Plugin::Prereqs::FromCPANfile" : "0", "Dist::Zilla::Plugin::PruneFiles" : "0", "Dist::Zilla::Plugin::Template::Tiny" : "0", "Dist::Zilla::Plugin::Test::Perl::Critic" : "0", "Dist::Zilla::Plugin::TravisYML" : "0", "Dist::Zilla::PluginBundle::Basic" : "0", "Dist::Zilla::PluginBundle::Git" : "0", "ExtUtils::MakeMaker" : "0", "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "BerkeleyDB" : "0", "BerkeleyDB::Hash" : "0", "Cache::Memcached" : "0", "Config::General" : "0", "DBI" : "0", "Data::Dumper" : "0", "Geo::IP" : "0", "Getopt::Long" : "0", "HTTP::Request::Common" : "0", "IO::Handle" : "0", "IO::Socket::INET" : "0", "IO::Socket::UNIX" : "0", "JSON" : "0", "LWP::UserAgent" : "0", "Mail::RBL" : "0", "Mail::SPF" : "0", "Moose" : "0", "Moose::Role" : "0", "Moose::Util::TypeConstraints" : "0", "MooseX::Getopt" : "0", "MooseX::Role::Parameterized" : "0", "MooseX::Singleton" : "0", "Net::DNS::Resolver" : "0", "Net::LDAP" : "0", "Net::LDAP::Util" : "0", "Net::SMTP::Verify" : "0", "Net::Server::PreFork" : "0", "NetAddr::IP" : "0", "Redis" : "0", "Storable" : "0", "Tie::IxHash" : "0", "Time::HiRes" : "0", "Time::Piece" : "0", "Time::Seconds" : "0", "namespace::autoclean" : "0", "perl" : "v5.8.5", "strict" : "0" } }, "test" : { "requires" : { "DBD::SQLite" : "0", "File::Find" : "0", "File::ReadBackwards" : "0", "File::Temp" : "0", "IO::File" : "0", "String::Random" : "0", "Template" : "0", "Test::BDD::Cucumber::Harness::TestBuilder" : "0", "Test::BDD::Cucumber::Loader" : "0", "Test::Deep" : "0", "Test::Exception" : "0", "Test::Memcached" : "0", "Test::Mock::Net::Server::Mail" : "0", "Test::MockObject" : "0", "Test::More" : "0", "Test::Net::LDAP::Mock" : "0", "Test::Pod" : "0", "Test::RedisDB" : "0" } } }, "provides" : { "Mail::MtPolicyd" : { "file" : "lib/Mail/MtPolicyd.pm", "version" : "2.02" }, "Mail::MtPolicyd::AddressList" : { "file" : "lib/Mail/MtPolicyd/AddressList.pm", "version" : "2.02" }, "Mail::MtPolicyd::Client" : { "file" : "lib/Mail/MtPolicyd/Client.pm", "version" : "2.02" }, "Mail::MtPolicyd::Client::App" : { "file" : "lib/Mail/MtPolicyd/Client/App.pm", "version" : "2.02" }, "Mail::MtPolicyd::Client::Request" : { "file" : "lib/Mail/MtPolicyd/Client/Request.pm", "version" : "2.02" }, "Mail::MtPolicyd::Client::Response" : { "file" : "lib/Mail/MtPolicyd/Client/Response.pm", "version" : "2.02" }, "Mail::MtPolicyd::Connection" : { "file" : "lib/Mail/MtPolicyd/Connection.pm", "version" : "2.02" }, "Mail::MtPolicyd::Connection::Ldap" : { "file" : "lib/Mail/MtPolicyd/Connection/Ldap.pm", "version" : "2.02" }, "Mail::MtPolicyd::Connection::Memcached" : { "file" : "lib/Mail/MtPolicyd/Connection/Memcached.pm", "version" : "2.02" }, "Mail::MtPolicyd::Connection::Redis" : { "file" : "lib/Mail/MtPolicyd/Connection/Redis.pm", "version" : "2.02" }, "Mail::MtPolicyd::Connection::Sql" : { "file" : "lib/Mail/MtPolicyd/Connection/Sql.pm", "version" : "2.02" }, "Mail::MtPolicyd::ConnectionPool" : { "file" : "lib/Mail/MtPolicyd/ConnectionPool.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin" : { "file" : "lib/Mail/MtPolicyd/Plugin.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Accounting" : { "file" : "lib/Mail/MtPolicyd/Plugin/Accounting.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Action" : { "file" : "lib/Mail/MtPolicyd/Plugin/Action.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::AddScoreHeader" : { "file" : "lib/Mail/MtPolicyd/Plugin/AddScoreHeader.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::ClearFields" : { "file" : "lib/Mail/MtPolicyd/Plugin/ClearFields.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Condition" : { "file" : "lib/Mail/MtPolicyd/Plugin/Condition.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::CtIpRep" : { "file" : "lib/Mail/MtPolicyd/Plugin/CtIpRep.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::DBL" : { "file" : "lib/Mail/MtPolicyd/Plugin/DBL.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Eval" : { "file" : "lib/Mail/MtPolicyd/Plugin/Eval.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Fail2Ban" : { "file" : "lib/Mail/MtPolicyd/Plugin/Fail2Ban.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::GeoIPAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/GeoIPAction.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::GeoIPLookup" : { "file" : "lib/Mail/MtPolicyd/Plugin/GeoIPLookup.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Greylist" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Honeypot" : { "file" : "lib/Mail/MtPolicyd/Plugin/Honeypot.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::LdapUserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/LdapUserConfig.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::PostfixMap" : { "file" : "lib/Mail/MtPolicyd/Plugin/PostfixMap.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Proxy" : { "file" : "lib/Mail/MtPolicyd/Plugin/Proxy.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Quota" : { "file" : "lib/Mail/MtPolicyd/Plugin/Quota.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::RBL" : { "file" : "lib/Mail/MtPolicyd/Plugin/RBL.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::RBLAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/RBLAction.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Result" : { "file" : "lib/Mail/MtPolicyd/Plugin/Result.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Role::ConfigurableFields" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/ConfigurableFields.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Role::PluginChain" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/PluginChain.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Role::Scoring" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/Scoring.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Role::SqlUtils" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/SqlUtils.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Role::UserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/UserConfig.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::SMTPVerify" : { "file" : "lib/Mail/MtPolicyd/Plugin/SMTPVerify.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::SPF" : { "file" : "lib/Mail/MtPolicyd/Plugin/SPF.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::SaAwlAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/SaAwlAction.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::SaAwlLookup" : { "file" : "lib/Mail/MtPolicyd/Plugin/SaAwlLookup.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::ScoreAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/ScoreAction.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::SetField" : { "file" : "lib/Mail/MtPolicyd/Plugin/SetField.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::SqlList" : { "file" : "lib/Mail/MtPolicyd/Plugin/SqlList.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::SqlUserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/SqlUserConfig.pm", "version" : "2.02" }, "Mail::MtPolicyd::Plugin::Stress" : { "file" : "lib/Mail/MtPolicyd/Plugin/Stress.pm", "version" : "2.02" }, "Mail::MtPolicyd::PluginChain" : { "file" : "lib/Mail/MtPolicyd/PluginChain.pm", "version" : "2.02" }, "Mail::MtPolicyd::Profiler" : { "file" : "lib/Mail/MtPolicyd/Profiler.pm", "version" : "2.02" }, "Mail::MtPolicyd::Profiler::Timer" : { "file" : "lib/Mail/MtPolicyd/Profiler/Timer.pm", "version" : "2.02" }, "Mail::MtPolicyd::Request" : { "file" : "lib/Mail/MtPolicyd/Request.pm", "version" : "2.02" }, "Mail::MtPolicyd::Result" : { "file" : "lib/Mail/MtPolicyd/Result.pm", "version" : "2.02" }, "Mail::MtPolicyd::Role::Connection" : { "file" : "lib/Mail/MtPolicyd/Role/Connection.pm", "version" : "2.02" }, "Mail::MtPolicyd::SessionCache" : { "file" : "lib/Mail/MtPolicyd/SessionCache.pm", "version" : "2.02" }, "Mail::MtPolicyd::SessionCache::Base" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Base.pm", "version" : "2.02" }, "Mail::MtPolicyd::SessionCache::Memcached" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Memcached.pm", "version" : "2.02" }, "Mail::MtPolicyd::SessionCache::None" : { "file" : "lib/Mail/MtPolicyd/SessionCache/None.pm", "version" : "2.02" }, "Mail::MtPolicyd::SessionCache::Redis" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Redis.pm", "version" : "2.02" }, "Mail::MtPolicyd::VirtualHost" : { "file" : "lib/Mail/MtPolicyd/VirtualHost.pm", "version" : "2.02" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-mail-mtpolicyd@rt.cpan.org", "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Mail-MtPolicyd" }, "homepage" : "https://mtpolicyd.org/", "repository" : { "type" : "git", "url" : "https://github.com/benningm/mtpolicyd", "web" : "https://github.com/benningm/mtpolicyd.git" }, "x_MailingList" : "https://mtpolicyd.org/mailing-list.html" }, "version" : "2.02" } Mail-MtPolicyd-2.02/LICENSE0000644000175000017500000004353312752672654015524 0ustar werewolfwerewolfThis software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. Mail-MtPolicyd-2.02/MANIFEST0000644000175000017500000000720212752672654015641 0ustar werewolfwerewolf# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.020. CHANGES Dockerfile LICENSE MANIFEST META.json META.yml Makefile.PL README bin/mtpolicyd bin/policyd-client cpanfile dist.ini docker-compose.yml etc/docker.conf etc/mtpolicyd.conf etc/mtpolicyd.crontab lib/Mail/MtPolicyd.pm lib/Mail/MtPolicyd/AddressList.pm lib/Mail/MtPolicyd/Client.pm lib/Mail/MtPolicyd/Client/App.pm lib/Mail/MtPolicyd/Client/Request.pm lib/Mail/MtPolicyd/Client/Response.pm lib/Mail/MtPolicyd/Connection.pm lib/Mail/MtPolicyd/Connection/Ldap.pm lib/Mail/MtPolicyd/Connection/Memcached.pm lib/Mail/MtPolicyd/Connection/Redis.pm lib/Mail/MtPolicyd/Connection/Sql.pm lib/Mail/MtPolicyd/ConnectionPool.pm lib/Mail/MtPolicyd/Cookbook.pod lib/Mail/MtPolicyd/Cookbook/BasicPlugin.pod lib/Mail/MtPolicyd/Cookbook/ExtendedPlugin.pod lib/Mail/MtPolicyd/Cookbook/HowtoAccountingQuota.pod lib/Mail/MtPolicyd/Cookbook/Installation.pod lib/Mail/MtPolicyd/Plugin.pm lib/Mail/MtPolicyd/Plugin/Accounting.pm lib/Mail/MtPolicyd/Plugin/Action.pm lib/Mail/MtPolicyd/Plugin/AddScoreHeader.pm lib/Mail/MtPolicyd/Plugin/ClearFields.pm lib/Mail/MtPolicyd/Plugin/Condition.pm lib/Mail/MtPolicyd/Plugin/CtIpRep.pm lib/Mail/MtPolicyd/Plugin/DBL.pm lib/Mail/MtPolicyd/Plugin/Eval.pm lib/Mail/MtPolicyd/Plugin/Fail2Ban.pm lib/Mail/MtPolicyd/Plugin/GeoIPAction.pm lib/Mail/MtPolicyd/Plugin/GeoIPLookup.pm lib/Mail/MtPolicyd/Plugin/Greylist.pm lib/Mail/MtPolicyd/Plugin/Honeypot.pm lib/Mail/MtPolicyd/Plugin/LdapUserConfig.pm lib/Mail/MtPolicyd/Plugin/PostfixMap.pm lib/Mail/MtPolicyd/Plugin/Proxy.pm lib/Mail/MtPolicyd/Plugin/Quota.pm lib/Mail/MtPolicyd/Plugin/RBL.pm lib/Mail/MtPolicyd/Plugin/RBLAction.pm lib/Mail/MtPolicyd/Plugin/Result.pm lib/Mail/MtPolicyd/Plugin/Role/ConfigurableFields.pm lib/Mail/MtPolicyd/Plugin/Role/PluginChain.pm lib/Mail/MtPolicyd/Plugin/Role/Scoring.pm lib/Mail/MtPolicyd/Plugin/Role/SqlUtils.pm lib/Mail/MtPolicyd/Plugin/Role/UserConfig.pm lib/Mail/MtPolicyd/Plugin/SMTPVerify.pm lib/Mail/MtPolicyd/Plugin/SPF.pm lib/Mail/MtPolicyd/Plugin/SaAwlAction.pm lib/Mail/MtPolicyd/Plugin/SaAwlLookup.pm lib/Mail/MtPolicyd/Plugin/ScoreAction.pm lib/Mail/MtPolicyd/Plugin/SetField.pm lib/Mail/MtPolicyd/Plugin/SqlList.pm lib/Mail/MtPolicyd/Plugin/SqlUserConfig.pm lib/Mail/MtPolicyd/Plugin/Stress.pm lib/Mail/MtPolicyd/PluginChain.pm lib/Mail/MtPolicyd/Profiler.pm lib/Mail/MtPolicyd/Profiler/Timer.pm lib/Mail/MtPolicyd/Request.pm lib/Mail/MtPolicyd/Result.pm lib/Mail/MtPolicyd/Role/Connection.pm lib/Mail/MtPolicyd/SessionCache.pm lib/Mail/MtPolicyd/SessionCache/Base.pm lib/Mail/MtPolicyd/SessionCache/Memcached.pm lib/Mail/MtPolicyd/SessionCache/None.pm lib/Mail/MtPolicyd/SessionCache/Redis.pm lib/Mail/MtPolicyd/VirtualHost.pm rpm/mtpolicyd.init-redhat rpm/mtpolicyd.spec t-data/minimal.conf t-data/plugin-postfixmap-postmap t-data/plugin-postfixmap-postmap.db t-data/spamhaus-rbls.conf t-data/vhost-by-policy-context.conf t/addresslist.t t/author-critic.t t/cron.t t/execute-cucumber-tests.t t/plugin-accounting-quota.t t/plugin-clearfields.t t/plugin-condition.t t/plugin-ctiprep.t t/plugin-dbl.t t/plugin-greylist.t t/plugin-ldapuserconfig.t t/plugin-postfixmap.t t/plugin-rbl.t t/plugin-role-configurablefields.t t/plugin-role-sqlutils.t t/plugin-sa-awl-action.t t/plugin-sa-awl-lookup.t t/plugin-smtpverify.t t/plugin-spf.t t/plugin-sqllist.t t/plugin-sqluserconfig.t t/profiler-timer.t t/profiler.t t/release-pod-syntax.t t/request.t t/scoring.t t/server-minimal.feature t/server-spamhaus-rbls.feature t/server-vhost-by-policy-context.feature t/session-cache.t t/step_definitions/00test-net-server_steps.pl t/step_definitions/client_steps.pl t/step_definitions/mtpolicyd_run_steps.pl t/use.t t/virtualhost.t Mail-MtPolicyd-2.02/Dockerfile0000644000175000017500000000105012752672654016475 0ustar werewolfwerewolfFROM perl:5.24.0 MAINTAINER Markus Benning COPY ./cpanfile /mtpolicyd/cpanfile WORKDIR /mtpolicyd RUN cpanm --notest Carton \ && carton install \ && rm -rf ~/.cpanm RUN addgroup --system mtpolicyd \ && adduser --system --home /mtpolicyd --no-create-home \ --disabled-password --ingroup mtpolicyd mtpolicyd COPY . /mtpolicyd COPY ./etc/docker.conf /etc/mtpolicyd/mtpolicyd.conf EXPOSE 12345 CMD [ "carton", "exec", "perl", "-Mlib=./lib", "bin/mtpolicyd", "-f", "-l", "2", "-c", "/etc/mtpolicyd/mtpolicyd.conf" ] Mail-MtPolicyd-2.02/etc/0000755000175000017500000000000012752672654015262 5ustar werewolfwerewolfMail-MtPolicyd-2.02/etc/mtpolicyd.conf0000644000175000017500000001113212752672654020133 0ustar werewolfwerewolf# -*- apache -*- # # Configuration for the mailteam policy daemon user=mtpolicyd group=mtpolicyd #pid_file="/var/run/mtpolicyd/mtpolicyd.pid" #chroot=/var/run/mtpolicyd # 0=>'err', 1=>'warning', 2=>'notice', 3=>'info', 4=>'debug' (default: 2) log_level=2 host=127.0.0.1 port="127.0.0.1:12345" min_servers=4 min_spare_servers=4 max_spare_servers=12 max_servers=50 max_requests=1000 #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 # # module = "Ldap" # host = "localhost" # module = "Memcached" servers = "127.0.0.1:11211" # namespace = "mt-" module = "Sql" dsn = "dbi:SQLite:dbname=/var/lib/mtpolicyd/mtpolicyd.sqlite" module = "Memcached" #memcached = "memcached" # expire session cache entries expire = "300" # wait timeout will be increased each time 50,100,150,... (usec) lock_wait=50 # abort after n retries lock_max_retry=50 # session lock times out after (sec) lock_timeout=10 name="reputation" # we only check for a ticket here # avoid running thru all checks for early retries module = "Greylist" score = -5 mode = "passive" create_ticket = 0 query_autowl = 0 module = "SPF" pass_mode = "passive" pass_score = -10 fail_mode = "reject" # stop #fail_score = 5 # you may want to use some unused recipient addresses as honeypot # make sure they are really unused # # module = "Honeypot" # recipients_re = "^(chung|ogc|wore|aio|duy)@(yourdomain1|yourdomain2)\.de$" # module = "RBL" mode = "accept" # will stop here domain="list.dnswl.org" module = "GeoIPLookup" # apt-get install geoip-database database = "/usr/share/GeoIP/GeoIP.dat" module = "GeoIPAction" result_from = "geoip" country_codes = "DE,AT,CH,FR,IT" mode = passive score = -1 module = "GeoIPAction" result_from = "geoip" country_codes = "RU,UA,CN,IN" mode = passive score = 5 module = "RBL" mode = "passive" domain="zen.spamhaus.org" module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[23]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[4-7]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.1[01]$" score = 3 module = "DBL" domain="dbl.spamhaus.org" helo_name_mode=passive helo_name_score=1 sender_mode=passive sender_score=5 reverse_client_name_mode=passive reverse_client_name_score=2.5 module = "RBL" mode = "passive" domain="dnsbl.sorbs.net" score = 5 module = "RBL" mode = "passive" domain="ix.dnsbl.manitu.net" score = 5 module = "RBL" mode = "passive" domain="bl.spamcop.net" score = 5 module = "RBL" mode = "passive" domain="drone.abuse.ch" score = 3 module = "RBL" mode = "passive" domain="db.wpbl.info" score = 3 module = "RBL" mode = "passive" domain="bb.barracudacentral.org" score = 3 # # block ip address with iptables filter # # module = "ScoreAction" # threshold = 15 # # module = "Fail2Ban" # socket = "/var/run/fail2ban/fail2ban.sock" # jail = "postfix" # # # score >= 15 will be rejected module = "ScoreAction" threshold = 15 action = "reject sender ip %IP% is blocked (score=%SCORE%%SCORE_DETAIL%)" # score >= 5 gets greylisting applied module = "ScoreAction" threshold = 5 module = "Greylist" score = -5 mode = "passive" # activating the autowl will require a SQL database use_autowl = 1 # add an header to everything left module = "AddScoreHeader" spam_score=5 Mail-MtPolicyd-2.02/etc/mtpolicyd.crontab0000644000175000017500000000045512752672654020644 0ustar werewolfwerewolf# crontab for mtpolicyd default tasks 0 1-23 * * * mtpolicyd /usr/bin/mtpolicyd --cron hourly 0 0 2-31 * 1-6 mtpolicyd /usr/bin/mtpolicyd --cron hourly,daily 0 0 2-31 * 0 mtpolicyd /usr/bin/mtpolicyd --cron hourly,daily,weekly 0 0 1 * * mtpolicyd /usr/bin/mtpolicyd --cron hourly,daily,weekly,monthly Mail-MtPolicyd-2.02/etc/docker.conf0000644000175000017500000001111412752672654017376 0ustar werewolfwerewolf# -*- apache -*- # # Configuration for the mailteam policy daemon user=mtpolicyd group=mtpolicyd #pid_file="/var/run/mtpolicyd/mtpolicyd.pid" #chroot=/var/run/mtpolicyd # 0=>'err', 1=>'warning', 2=>'notice', 3=>'info', 4=>'debug' (default: 2) log_level=2 host=127.0.0.1 port="127.0.0.1:12345" min_servers=4 min_spare_servers=4 max_spare_servers=12 max_servers=50 max_requests=1000 #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 # # module = "Ldap" # host = "localhost" # module = "Memcached" servers = "memcached:11211" # namespace = "mt-" module = "Sql" dsn = "dbi:SQLite:dbname=/tmp/mtpolicyd.sqlite" module = "Memcached" #memcached = "memcached" # expire session cache entries expire = "300" # wait timeout will be increased each time 50,100,150,... (usec) lock_wait=50 # abort after n retries lock_max_retry=50 # session lock times out after (sec) lock_timeout=10 name="reputation" # we only check for a ticket here # avoid running thru all checks for early retries module = "Greylist" score = -5 mode = "passive" create_ticket = 0 query_autowl = 0 module = "SPF" pass_mode = "passive" pass_score = -10 fail_mode = "reject" # stop #fail_score = 5 # you may want to use some unused recipient addresses as honeypot # make sure they are really unused # # module = "Honeypot" # recipients_re = "^(chung|ogc|wore|aio|duy)@(yourdomain1|yourdomain2)\.de$" # module = "RBL" mode = "accept" # will stop here domain="list.dnswl.org" module = "GeoIPLookup" # apt-get install geoip-database database = "/usr/share/GeoIP/GeoIP.dat" module = "GeoIPAction" result_from = "geoip" country_codes = "DE,AT,CH,FR,IT" mode = passive score = -1 module = "GeoIPAction" result_from = "geoip" country_codes = "RU,UA,CN,IN" mode = passive score = 5 module = "RBL" mode = "passive" domain="zen.spamhaus.org" module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[23]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[4-7]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.1[01]$" score = 3 module = "DBL" domain="dbl.spamhaus.org" helo_name_mode=passive helo_name_score=1 sender_mode=passive sender_score=5 reverse_client_name_mode=passive reverse_client_name_score=2.5 module = "RBL" mode = "passive" domain="dnsbl.sorbs.net" score = 5 module = "RBL" mode = "passive" domain="ix.dnsbl.manitu.net" score = 5 module = "RBL" mode = "passive" domain="bl.spamcop.net" score = 5 module = "RBL" mode = "passive" domain="drone.abuse.ch" score = 3 module = "RBL" mode = "passive" domain="db.wpbl.info" score = 3 module = "RBL" mode = "passive" domain="bb.barracudacentral.org" score = 3 # # block ip address with iptables filter # # module = "ScoreAction" # threshold = 15 # # module = "Fail2Ban" # socket = "/var/run/fail2ban/fail2ban.sock" # jail = "postfix" # # # score >= 15 will be rejected module = "ScoreAction" threshold = 15 action = "reject sender ip %IP% is blocked (score=%SCORE%%SCORE_DETAIL%)" # score >= 5 gets greylisting applied module = "ScoreAction" threshold = 5 module = "Greylist" score = -5 mode = "passive" # activating the autowl will require a SQL database use_autowl = 1 # add an header to everything left module = "AddScoreHeader" spam_score=5 Mail-MtPolicyd-2.02/t-data/0000755000175000017500000000000012752672654015661 5ustar werewolfwerewolfMail-MtPolicyd-2.02/t-data/spamhaus-rbls.conf0000755000175000017500000000360512752672654021320 0ustar werewolfwerewolf# -*- apache -*- #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 # database connection as perl-DBI DSN (man DBI) db_dsn= db_user= db_password= # memcached connection for session caching memcached_servers="127.0.0.1:[% memcached_port %]" # memcached_namespace=mt- # memcached_expire=300 # wait timeout will be increased each time 50,100,150,... (usec) session_lock_wait=50 # abort after n retries session_lock_max_retry=50 # session lock times out after (sec) session_lock_timeout=10 name="spamhaus" module = "RBL" mode = "passive" domain="zen.spamhaus.org" module = "RBLAction" result_from = "spamhaus-rbl" mode = "reject" re_match = "^127\.0\.0\.[23]$" reject_message="SBL" module = "RBLAction" result_from = "spamhaus-rbl" mode = "reject" re_match = "^127\.0\.0\.[4-7]$" reject_message="XBL" module = "RBLAction" result_from = "spamhaus-rbl" mode = "reject" re_match = "^127\.0\.0\.1[01]$" reject_message="PBL" module = "DBL" domain="dbl.spamhaus.org" helo_name_mode=reject sender_mode=reject reverse_client_name_mode=reject reject_message="DBL %CHECK%" Mail-MtPolicyd-2.02/t-data/vhost-by-policy-context.conf0000755000175000017500000000177012752672654023272 0ustar werewolfwerewolf# -*- apache -*- #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 # database connection as perl-DBI DSN (man DBI) db_dsn= db_user= db_password= # memcached connection for session caching memcached_servers="127.0.0.1:[% memcached_port %]" # memcached_namespace=mt- # memcached_expire=300 # wait timeout will be increased each time 50,100,150,... (usec) session_lock_wait=50 # abort after n retries session_lock_max_retry=50 # session lock times out after (sec) session_lock_timeout=10 # we use policy_context for vhost detection... vhost_by_policy_context=1 name="fred" module = "Action" action = "reject my name is fred" name="horst" module = "Action" action = "reject my name is horst" Mail-MtPolicyd-2.02/t-data/minimal.conf0000755000175000017500000000114512752672654020162 0ustar werewolfwerewolf# -*- apache -*- #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 module = "Memcached" # memcached connection for session caching servers="127.0.0.1:[% memcached_port %]" module = "Memcached" memcached = "memcached" name="minimal" module = "Action" action = "reject test" Mail-MtPolicyd-2.02/t-data/plugin-postfixmap-postmap.db0000750000175000017500000003000012752672654023326 0ustar werewolfwerewolfa  0ý_-,áFU Ñh^  ñéØÕÄÀ«§¡OKfe81OKfe80::250:56ff:fe84OK123.123.123.1231111.111.111.111REJECT111.111.111.1 ¤ ðéÜØÏËƨ¤ 0ý_-,áFUÑh^OKfe80::250:56ff:fe85:56f5OK124OK123.124OK123.123.124DUNNO111.111.111.11Mail-MtPolicyd-2.02/t-data/plugin-postfixmap-postmap0000750000175000017500000000026412752672654022753 0ustar werewolfwerewolf123.123.123.123 OK 123.123.124 OK 123.124 OK 124 OK fe80::250:56ff:fe85:56f5 OK fe80::250:56ff:fe84 OK fe81 OK 111.111.111.111 1 111.111.111.11 DUNNO 111.111.111.1 REJECT Mail-MtPolicyd-2.02/CHANGES0000644000175000017500000003157112752672654015511 0ustar werewolfwerewolf================================================== Changes from 2015-08-11 00:00:00 +0000 to present. ================================================== ----------------------------------------- version 2.02 at 2016-08-10 18:42:45 +0000 ----------------------------------------- Change: e5fac2e10f1bf2653abb6ecc9af05034bd67e4cd Author: Markus Benning Date : 2016-08-10 20:39:23 +0000 Add tests for session caching and fix related bugs This add test cases for memcached and redis based session caching and fixes a few related bugs. fixes #15 #16 #17 #19 Change: 78e42d2bcc4ce829ede501cfc145e0dd637fb66b Author: Markus Benning Date : 2016-08-09 13:16:52 +0000 Fix Kwalitee issues ----------------------------------------- version 2.01 at 2016-08-06 19:52:29 +0000 ----------------------------------------- Change: 01ed4fe6ac040944511cf11e8749ba148c3addc0 Author: Markus Benning Date : 2016-08-06 21:52:29 +0000 Dont include local/ in dist Change: 86f3b7663e7b38b54cbafd6e145add717a76d8bf Author: Markus Benning Date : 2016-08-06 21:36:44 +0000 Add cpanfile.snapshot to .gitignore Change: 7456978e190f05a348bb9212dfca416aa87d481d Author: Markus Benning Date : 2016-08-06 20:35:51 +0000 Revert using cpanfile.snapshot Change: 53ac1ccf5ba3a46b30224722ab73be6e7283ead3 Author: Markus Benning Date : 2016-08-06 20:32:49 +0000 Updated documentation/upgrade notes Change: 850a74f28f841bde2846f34e67799abce79e59dc Author: Markus Benning Date : 2016-08-06 20:04:12 +0000 Add dependecy on Redis Change: 8b38a6ffa961224f48efa84d450a52f6c010f870 Author: Markus Benning Date : 2016-08-06 18:46:37 +0000 Added missing depedency on LDAP mock Change: d5b999117839ac6f3ff741ef597089a85d5e726e Author: Markus Benning Date : 2016-08-06 18:31:26 +0000 Remove test for nonexisting SqlConnection class Change: bb36632db9c116a73d938906a6304d224b3a4c6f Author: Markus Benning Date : 2016-08-06 18:17:38 +0000 Add temporary build files for .dockerignore Change: 290d62f94930c25d63b87b4b51eadce0b4cd0f6b Author: Markus Benning Date : 2016-08-06 18:08:31 +0000 Add cpanfile.snapshot to fix carton deploy Change: 4046ff5d961992a20aa454699b33a8f9ddecb8a2 Author: Markus Benning Date : 2016-08-06 18:06:05 +0000 Fix docker-compose and use carton deployment Change: bfa6bde5ae15335431d325b90eaeb206089aed2e Author: Markus Benning Date : 2016-08-06 17:51:37 +0000 Added docker and docker-compose configuration Change: 7590d99214e528d9a8169591bca61aa6b075df87 Author: Markus Benning Date : 2016-08-06 17:29:46 +0000 Remove debian packaging from CPAN dist Change: 11b13df83cec618d8c80cdedc501a6c788e96873 Author: Markus Benning Date : 2016-08-06 17:27:30 +0000 Remove dependecies from dist.ini Change: 604be923459e392b0279f3ccde434c49a94510d0 Author: Markus Benning Date : 2016-08-06 17:25:50 +0000 Adjust dist to cpanfile dependecies Change: b9fa0982842e7e294998c192764a73085c9a7c7a Author: Markus Benning Date : 2016-08-06 17:14:14 +0000 Added support for redis connection and cache Change: d4e6534b970ca73d9f19226e161e8531cb885eb1 Author: Markus Benning Date : 2016-08-06 17:12:45 +0000 Fix tests and a some bugs This adjusts the tests to the new ConnectionPool and SessionCache infstracture. Change: cbdb082b47d3d6d05dd0b3a08de38d4d5b42e559 Author: Markus Benning Date : 2016-07-10 16:34:11 +0000 plugable session cache and connection pool This adds a generic connection pool mechanism and the possiblitiy of session caches other than memcached. Change: f55e530bed65bc4db5019c2067cf03a4ee2ee92f Author: Markus Benning Date : 2016-07-04 12:31:37 +0000 Add some checks for uninitialized values fixes #12 Change: ddc8472f653be44db0ee51bdc8da4948acdd81e6 Author: Markus Benning Date : 2016-07-04 12:31:00 +0000 create sqlite database in postinst Change: 850641710fe36402ae0e0f5a22a8e35b12669fdd Author: Markus Benning Date : 2016-03-04 15:11:19 +0000 Add softfail and update docs on SPF plugin Two new options for softfail have been added to the SPF plugin: * softfail_mode (default: passive) * softfail_score (default: empty) These could be used to apply a action or score whene the SPF check returns a softfail status. Also the documentation has been updated to clarify that on neutral check result no action will be applied by the plugin. Change: e30ad9c2357323722c7c63d5ade6f0f473102028 Author: Markus Benning Date : 2016-03-02 09:08:35 +0000 Improvements for Condition module This implements a generic method get() in the Request object to retrieve request attributes or session variables. It support the following syntax for retrieving variables: To retrieve request attributes: request: r: If no scope is given it defaults to 'request' To retrieve session variables: session: s: It also changes the Condition plugin to accept this syntax in the "key" configuration parameter. Also an `invert` option has been added to the condition module. Change: aa17f3402d1924bfbdb58b56f5f4c6a3fdf993ad Author: Markus Benning Date : 2015-12-14 16:23:47 +0000 create /var/run/mtpolicyd in debian package ----------------------------------------- version 1.23 at 2015-12-14 15:00:05 +0000 ----------------------------------------- Change: bcecb4f1eb53867f5b602af9dc5071a129ecfb87 Author: Markus Benning Date : 2015-12-14 16:00:05 +0000 adjust rbl/dbl unit tests to changes SpamHaus output Change: 3cd7b711d909b3f9793e54659d9ee9797ca79b0b Author: Markus Benning Date : 2015-12-14 15:49:49 +0000 prune README.pod link Change: 4c3f9c21ff6e725dbbbca52342f1edeb590f209d Author: Markus Benning Date : 2015-12-14 15:33:05 +0000 create data folder in debian package Change: e72f8312d6b7a7a1449beded70c2a943219d2396 Author: Markus Benning Date : 2015-12-14 10:27:12 +0000 change distribution in changelog to jessie Change: 8d4578bcab0658fec72333256e9f02914270eb9e Author: Markus Benning Date : 2015-12-14 10:15:33 +0000 fix debian package dependencies Change: b9a63185a236d958c481ceb48f14cae22e22e2d3 Author: Markus Benning Date : 2015-11-13 10:35:36 +0000 Remove RPM dependency on cron ----------------------------------------- version 1.22 at 2015-11-07 18:11:24 +0000 ----------------------------------------- Change: b8bc2b905f55072fcb9e823ca97a65237d6b6804 Author: Markus Benning Date : 2015-11-07 19:11:24 +0000 fixes to ldap latest LDAP code Change: ef71ff8e2232f3915995e8ccbc2ce5713cff9d99 Author: Markus Benning Date : 2015-10-26 19:56:42 +0000 Added support for LDAP Support for an global LDAP connection has been added to mtpolicyd. The new plugin LdapUserConfig uses this connection to read parameters from a LDAP server. ----------------------------------------- version 1.21 at 2015-09-22 09:04:58 +0000 ----------------------------------------- Change: 0572110c8157f3ad9d5c204f6dfebf8e603b6efa Author: Markus Benning Date : 2015-09-22 11:04:58 +0000 New plugin SMTPVerify The SMTPVerify plugin implements address verification at a remote SMTP server with MAIL FROM and RCPT TO commands. It support the following checks: * check if the remote SMTP server would accept mail for a address. Apply actions or scores if a permanent or temporary error is returned * If the remote server support the SIZE extension the SIZE will be passed to the remote SMTP server. This way it could be checked if the message exceeds the message size limit or the quota limit of the recipient. * Check if the remote SMTP server announces support for STARTTLS * Check if there is a TLSA record for the remote SMTP server * Check if there is OPENPGPKEY for the recipient. Change: 0d87c8d40ee26ef0ed2e0bed369f8beb10d40ad8 Author: Markus Benning Date : 2015-09-05 11:18:02 +0000 use Test::Memcached also in plugin-greylist.t Change: 71b1fae0e7afa31112c7172e2f2183cd2f44d024 Author: Markus Benning Date : 2015-09-04 13:05:17 +0000 another try for travis Change: 93c406f2ed96404ba9f7c900ddc2589712988307 Author: Markus Benning Date : 2015-09-04 12:57:54 +0000 one more for travis... Change: 1b7d9b743ccebc1b0a0e5365c76475cfe3df4c56 Author: Markus Benning Date : 2015-09-04 12:45:29 +0000 try init.d instead of systemctl in travis Change: ffec75868557ddd25b34d40b9b47ab6e3295d0ee Author: Markus Benning Date : 2015-09-04 12:04:56 +0000 try using a local resolver in travis Change: 6e4adc13c9a4ae452a51d6054a1b3ceb0b2b0a82 Author: Markus Benning Date : 2015-09-04 11:40:11 +0000 new feature vhost_by_policy_context New option vhost_by_policy_context will if activated tell mtpolicyd to select the VirtualHost based on the policy_context. For example in postfix main.cf use advanced syntax: check_policy_service { inet:localhost:12345, policy_context=reputation } ... check_policy_service { inet:localhost:12345, policy_context=accounting } In mtpolicyd.conf: port="127.0.0.1:12345" # only 1 port vhost_by_policy_context=1 name=reputation ... plugins ... name=accounting ... plugins ... The policy_context feature will be available in postfix 3.1 and later. Change: ed99a4a0be2508937db23f2a8c4ce90b8de8251d Author: Markus Benning Date : 2015-09-04 10:30:48 +0000 fix RBL plugin testcase spamhaus removed '"' in response? Change: e4913c8f2f2622924e88803427005963c387c512 Author: Markus Benning Date : 2015-09-01 08:05:42 +0000 replace README.md with a link to pod docs Change: b79bb53324ff6bc1e3d0172ee900394ad815e9e0 Author: Markus Benning Date : 2015-09-01 07:57:01 +0000 add DBD::SQLite as a test prereq Change: 90232892201273263be1c1a0784c51f8febf5c5f Author: Markus Benning Date : 2015-09-01 07:45:10 +0000 add cpanm --sudo option in travis Change: 791287bff9ccc1925eb1c21739ec87abddf9eebb Author: Markus Benning Date : 2015-08-31 17:25:11 +0000 update .travis.yml Change: eccde3a2a29180e3ed33343ec0f239204588fef4 Author: Markus Benning Date : 2015-08-31 17:16:02 +0000 use cpanm --notest for prereqs in travis ci Change: 1ae4fdc01a50d652c6ff417dc0c9d0b46bbe68b7 Author: Markus Benning Date : 2015-08-31 17:13:35 +0000 install libdb-dev in travis Change: bb9cf757ed42fc3b9b737284d572c2969a364ed1 Author: Markus Benning Date : 2015-08-31 09:02:14 +0000 added minimum perl version ----------------------------------------- version 1.20 at 2015-08-18 16:13:36 +0000 ----------------------------------------- Change: 8d54631b92ae3b36948701dc3cb84b1fcfcfa35a Author: Markus Benning Date : 2015-08-18 18:13:36 +0000 enable TravisCI Change: 549801562d4392125a70b4a0ab066ea739021518 Author: Markus Benning Date : 2015-08-18 18:08:30 +0000 fix SQL connection handling after child fork Closing the connection after child fork did not cause a reconnect on all DBI versions. Instead do a reconnect by overwriting the previous connection. Change: 757256c033399406d8e5d9803fa4d0843136ec79 Author: Markus Benning Date : 2015-08-18 18:07:45 +0000 improve request logging mtpolicyd now logs the plugin that caused the result. The new log format is: : instance=, type=, t=