./mimedefang-filter-select

# -*- Perl -*-
#
# $Id: mimedefang-filter-select,v 1.5 2005/05/23 21:55:32 johnpc Exp $
# 
# mimedefang filter selector
# loads settings from mimedefang-filter.conf,
# and dispatches various mimedefang filter_* calls to all mentioned
# modules.

use strict;
use lib "/usr/local/etc/mimedefang";
use warnings;
use Module::Load;
use Mimedefang qw(filterchain_reset filterchain_tookaction);
use MailFilter::Settings qw(:config);

### routines to call in modules
### grouped per interface style

### routines that do not return anything:
my @routines_noret = qw(
    filter_begin
    filter_initialize
    filter_cleanup
    filter_tick
);
### routines that return a $code indicating the action
my @routines_code = qw(
    filter_relay
    filter_sender
    filter_recipient
);
### routines that indicate an action by calling action_* functions
my @routines_action = qw(
    filter
    filter_multipart
    filter_end
);
### XXX TODO: unsupported filter callbacks are:
### filter_unknown_cmd
### filter_map

### regex that matched all valid returns from @routines_code
my $valid_filter_code = qr{^
        (?:REJECT
            |CONTINUE
            |TEMPFAIL
            |DISCARD
            |ACCEPT_AND_NO_MORE_FILTERING
            )$
        }x;

### all routines
my @routines = (@routines_noret, @routines_code, @routines_action);

# hash per filter_* routine, contains arrayref of [coderef, name] to call, eg:
# $call{"filter_begin"} = [
#    [ \&MailFilter::Virusscan::filter_begin,
#       "MailFilter::Virusscan::filter_begin" ],
#    [ \&MailFilter::Blacklists::filter_begin,
#       "MailFilter::Blacklists::filter_begin" ],
# ];
my %call;

### 
for my $module ( @FilterModules ) {
    load $module;
    for my $r ( @routines ) {
        my $name = $module . "::" . $r;
        if ( exists &$name ) {
            push @{ $call{$r} }, [ \&$name, $name ];
        }
    }
}

### call all filters, for those that do not return anything
### these filter calls also do not take arguments, and do not return
### anything special.
for my $fun ( @routines_noret ) {
    no strict 'refs';
    *$fun = sub {
        for my $c ( @{ $call{$fun} } ) {
            warn "Calling " . $c->[1] . "()\n" if $modules_debug;
            $c->[0]->();
        }
    } if $call{$fun};
}

### call filters while they return 'CONTINUE'
for my $fun ( @routines_code ) {
    no strict 'refs';
    *$fun = sub {
        my($code, $msg, $smtp_code, $smtp_dsn, $delay);

        $code = 'CONTINUE';
        for my $c ( @{ $call{$fun} } ) {
            warn "Calling " . $c->[1] . "(" . join(",", @_) . ")\n"
                if $modules_debug;
            ($code, $msg, $smtp_code, $smtp_dsn, $delay) = $c->[0]->(@_);
            ### verify the routine returned a valid return value.
            if ( !defined $code ) {
                warn "Warning: " . $c->[1] . " did not return a return code\n";
                $code = 'CONTINUE';
            }
            elsif ( $code =~ /^-?\d+$/ ) {
                warn "Warning: " . $c->[1] .
                    " returned a deprecated numeric return code: $code\n";
                $code = 'CONTINUE' if $code > 0;
            }
            elsif ( $code !~ /$valid_filter_code/ ) {
                warn "Warning: " . $c->[1] .
                    " returned an invalid return code: $code\n";
                ### treat this like a compile-time failure, so tempfail.
                ### mimedefang default would be to reject
                $code = 'TEMPFAIL';
            }
            last if $code ne 'CONTINUE';
        }
        return ($code, $msg, $smtp_code, $smtp_dsn, $delay);
    } if $call{$fun};
}

### call filters while they do not take any action_*
for my $fun ( @routines_action ) {
    no strict 'refs';
    *$fun = sub {
        filterchain_reset();
        for my $c ( @{ $call{$fun} } ) {
            warn "Calling " . $c->[1] . "(" . join(",", @_) . ")\n"
                if $modules_debug;
            $c->[0]->(@_);
            last if filterchain_tookaction();
        }
    } if $call{$fun};
}

1;