view release on metacpan or  search on metacpan

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

    $self->scoring_aware( 1 )
        if $self->config->{ scoring_aware };
    
    return;
}


=head2 handle

=cut

sub handle {
    my ( $self, $server, $attrs_ref ) = @_;
    
    # don bother with loopback addresses! EVEN IF ENABLED BY FORCE!
    #return if is_local_host( $attrs_ref->{ client_address } );
    
    #
    # CACHES
    #
    
    my @caches = ();
    
    # is on sender->recipient cache (has been send less then min-interval before ?!
    push @caches, "Greylist-SR-$attrs_ref->{ sender_address }-$attrs_ref->{ recipient_address }";
    push @caches, "Greylist-H-$attrs_ref->{ client_address }";
    push @caches, "Greylist-D-$attrs_ref->{ sender_domain }";
    
    my $pass = 0;
    foreach my $cache( @caches ) {
        my $cached = $self->cache->get( $cache );
        if ( $cached && ( $cached eq 'OK' || $cached - $self->min_interval <= time() ) ) {
            $pass++;
            last;
        }
    }
    
    # update databases
    unless ( $pass ) {
        $pass = $self->update_pass( $attrs_ref );
    }
    
    # pass
    if ( $pass ) {
        $self->go_final_state( $self->pass_code ) if $self->pass_code !~ /^(DUNNO|PREPEND)/;
    }
    else {
        
        # or not..
        $self->go_final_state( 450 => $self->reject_message )
    }
}


=head2 update_pass

Add counters to pass databases

=cut

sub update_pass {
    my ( $self, $attrs_ref ) = @_;
    
    my $pass = 0;
    
    # use host and domain whitelisting only if we don't care for hosting
    #   or the score of the mail looks like hame
    #   remark: in context with SPF beforehand we will not add sender
    #   domains or hosts to the whitelist if the look somewhat bogus
    if ( ! $self->scoring_aware || $self->session_data->spam_score >= 0 ) {
        
        my @update_policy;
        push @update_policy, [ hosts => client_address => 'H' ]
            if $self->has_hosts_policy;
        push @update_policy, [ domains => sender_domain => 'D' ]
            if $self->has_domains_policy;
        
        foreach my $ref( @update_policy ) {
            my ( $policy, $attr, $cache ) = @$ref;
            
            # read existing data .. attr: client_address | sender_domain
            my $data_ref = $self->database->get( greylist => $attr => {
                $attr => $attrs_ref->{ $attr }
            } ) || {
                total         => 0,
                max_unique    => 0,
                max_one       => 0,
                unique_sender => {},
                last_seen     => time()
            };
            
            # convert unique sender to hashref, if given in YAML
            eval {
                $data_ref->{ unique_sender } = YAML::Load( $data_ref->{ unique_sender } )
                    unless ref( $data_ref->{ unique_sender } );
            };
            $data_ref->{ unique_sender } = {} if $@;
            
            # increment total
            $data_ref->{ total }++;
            
            # increment unique sender policy
            unless ( $data_ref->{ unique_sender }->{ $attrs_ref->{ sender_address } }++ ) {
                $data_ref->{ max_unique }++;
            }
            
            # determine MAX "send by one sender"
            ( $data_ref->{ max_one } ) = sort { $b <=> $a } values %{ $data_ref->{ unique_sender } };
            
            # write  back
            $self->logger->debug3( "Write to $attr database: $attrs_ref->{ $attr }" );
            $self->database->set( greylist => $attr => {
                $attr => $attrs_ref->{ $attr }
            }, $data_ref );
            
            # write to cache if positive
            my $policy_meth = "${policy}_policy";
            my $do_cache = (
                $self->$policy_meth->{ unique_sender }
                && $self->$policy_meth->{ unique_sender } <= $data_ref->{ max_unique }
            ) || (