view release on metacpan or  search on metacpan

lib/Mail/Decency/Policy/Honeypot.pm  view on Meta::CPAN

=head2 addresses : HashRef[Bool]

List of addresses used as honeypot targets

=cut

has addresses => ( is => 'rw', isa => 'HashRef[Bool]', predicate => 'has_addresses' );

=head2 domains : HashRef[Bool]

List of (FULL) domains used as honeypot targets

=cut

has domains => ( is => 'rw', isa => 'HashRef', predicate => 'has_domains' );

=head2 reject_message : Str

Reject message, if an IP was already on the honeypot blacklist.

Default: "Your host ip is blacklisted"

=cut

has reject_message => ( is => 'rw', isa => 'Str', default => 'Your host ip is blacklisted.' );

=head2 welcome_message : Str

Reject message, which will be thrown if a new IP is welcomed on the blacklist.

Default: "The honey has been served."

=cut

has welcome_message => ( is => 'rw', isa => 'Str', default => 'The honey has been served.' );

=head2 negative_cache : Bool

If enabled: negative answers (not on blacklist) will be stored, too.

=cut

has negative_cache => ( is => 'rw', isa => 'Bool', default => 1 );

=head2 pass_for_collection : Bool

If enabled: Do not reject honeypot mails, but flag them so that they can be collected via L<Mail::Decency::ContentFilter::HoneyCollector>

=cut

has pass_for_collection => ( is => 'rw', isa => 'Bool', default => 0 );

=head2 schema_definition : HashRef[Bool]

List of addresses used as honeyport targets

=cut

has schema_definition => ( is => 'ro', isa => 'HashRef[HashRef]', default => sub {
    {
        honeypot => {
            addresses => {
                client_address => [ varchar => 39 ],
                created        => 'integer',
                -unique        => [ 'client_address' ],
                -index         => [ 'created' ]
            },
        }
    };
} );


=head1 METHODS


=head2 init

=cut 

sub init {
    my ( $self ) = @_;
    
    die "Require either addresses or domains to run!\n"
        unless $self->config->{ addresses } || $self->config->{ domains };
    
    # init addresses 
    if ( $self->config->{ addresses } ) {
        $self->addresses( { map { ( $_ => 1 ) } @{ $self->config->{ addresses } } } );
    }
    
    # init domains
    if ( $self->config->{ domains } ) {
        $self->domains( {} );
        
        my $count = 1;
        foreach my $ref( @{ $self->config->{ domains } } ) {
            
            # having hashref -> using exceptions
            if ( ref( $ref ) ) {
                die "Missing 'domain' in domain $count\n"
                    unless $ref->{ domain };
                $self->domains->{ $ref->{ domain } } = { map {
                    ( $_ => 1 );
                } @{ $ref->{ exceptions } || [] } };
            }
            
            # being scalar -> full domain
            else {
                $self->domains->{ $ref }++;
            }
            $count++;
        }
    }
    
    # disable negative cache ?
    $self->negative_cache( 0 ) 
        if defined $self->config->{ negative_cache } && ! $self->config->{ negative_cache };
    
    # enable passing for collecting later on ?