view release on metacpan or  search on metacpan

lib/Mail/MtPolicyd/Plugin/PostfixMap.pm  view on Meta::CPAN

package Mail::MtPolicyd::Plugin::PostfixMap;

use Moose;
use namespace::autoclean;

our $VERSION = '2.05'; # 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 );