File Coverage

blib/lib/Mail/Milter/Authentication/Handler/Sanitize.pm

Criterion	Covered	Total	%
statement	85	95	89.4
branch	22	32	68.7
condition			n/a
subroutine	12	14	85.7
pod	1	10	10.0
total	120	151	79.4

package Mail::Milter::Authentication::Handler::Sanitize;
use strict;
use warnings;
use base 'Mail::Milter::Authentication::Handler';
our $VERSION = '20191206'; # VERSION

use Sys::Syslog qw{:standard :macros};

sub default_config {
    return {
        'hosts_to_remove' => [ 'example.com', 'example.net' ],
        'remove_headers'  => 'yes',
    };
}

sub grafana_rows {
    my ( $self ) = @_;
    my @rows;
    push @rows, $self->get_json( 'Sanitize_metrics' );
    return \@rows;
}

sub register_metrics {
    return {
        'sanitize_remove_total' => 'The number Authentication Results headers removed',
    };
}

sub is_hostname_mine {
    my ( $self, $check_hostname ) = @_;
    my $config = $self->handler_config();

    return 0 if ! defined $check_hostname;

    my $hostname = $self->get_my_hostname();
    my ($check_for) = $hostname =~ /^[^\.]+\.(.*)/;

    if ( exists( $config->{'hosts_to_remove'} ) ) {
        foreach my $remove_hostname ( @{ $config->{'hosts_to_remove'} } ) {
            if (
                substr( lc $check_hostname, ( 0 - length($remove_hostname) ) ) eq
                lc $remove_hostname )
            {
                return 1;
            }
        }
    }

    if (
        substr( lc $check_hostname, ( 0 - length($check_for) ) ) eq
        lc $check_for )
    {
        return 1;
    }
    return 0;
}

sub remove_auth_header {
    my ( $self, $index ) = @_;
    $self->metric_count( 'sanitize_remove_total', {'header'=>'authentication-results'} );
    if ( !exists( $self->{'remove_auth_headers'} ) ) {
        $self->{'remove_auth_headers'} = [];
    }
    push @{ $self->{'remove_auth_headers'} }, $index;
    return;
}

sub get_headers_to_remove {
    my ( $self ) = @_;
    my @headers = qw{ X-Disposition-Quarantine };
    return \@headers;
}

sub envfrom_callback {
    my ( $self, $env_from ) = @_;
    delete $self->{'auth_result_header_index'};
    delete $self->{'remove_auth_headers'};

    my $headers = {};
    foreach my $header ( sort @{ $self->get_headers_to_remove() } ) {
        $headers->{ lc $header } = {
            'index'  => 0,
            'silent' => 1,
        };
    }
    $self->{'header_hash'} = $headers;

    return;
}

sub header_callback {
    my ( $self, $header, $value ) = @_;
    my $config = $self->handler_config();

    return if ( $self->is_trusted_ip_address() );
    return if ( lc $config->{'remove_headers'} eq 'no' );

    # Sanitize Authentication-Results headers
    if ( lc $header eq 'authentication-results' ) {
        if ( !exists $self->{'auth_result_header_index'} ) {
            $self->{'auth_result_header_index'} = 0;
        }
        $self->{'auth_result_header_index'} =
          $self->{'auth_result_header_index'} + 1;
        my ($domain_part) = $value =~ /^([^;]*);/;
        $domain_part =~ s/ +//g;
        if ( $self->is_hostname_mine($domain_part) ) {
            $self->remove_auth_header( $self->{'auth_result_header_index'} );
            if ( lc $config->{'remove_headers'} ne 'silent' ) {
                my $forged_header =
                  '(Received Authentication-Results header removed by '
                  . $self->get_my_hostname()
                  . ')' . "\n"
                  . '    '
                  . $value;
                $self->append_header( 'X-Received-Authentication-Results',
                    $forged_header );
            }
        }
    }

    # Sanitize other headers
    foreach my $remove_header ( sort @{ $self->get_headers_to_remove() } ) {
        next if ( lc $remove_header ne lc $header );
        $self->{'header_hash'}->{ lc $header }->{'index'} = $self->{'header_hash'}->{ lc $header }->{'index'} + 1;
        $self->metric_count( 'sanitize_remove_total', {'header'=> lc $header} );

        if ( ! $self->{'header_hash'}->{ lc $header }->{'silent'} ) {
            my $forged_header =
              '(Received ' . $remove_header . ' header removed by '
              . $self->get_my_hostname()
              . ')' . "\n"
              . '    '
              . $value;
            $self->append_header( 'X-Received-' . $remove_header,
                $forged_header );
        }
    }

    return;
}

sub eom_callback {
    my ($self) = @_;
    my $config = $self->handler_config();
    return if ( lc $config->{'remove_headers'} eq 'no' );

    if ( exists( $self->{'remove_auth_headers'} ) ) {
        foreach my $index ( reverse @{ $self->{'remove_auth_headers'} } ) {
            $self->dbgout( 'RemoveAuthHeader', $index, LOG_DEBUG );
            $self->change_header( 'Authentication-Results', $index, q{} );
        }
    }

    foreach my $remove_header ( sort @{ $self->get_headers_to_remove() } ) {
        my $max_index = $self->{'header_hash'}->{ lc $remove_header }->{'index'};
        if ( $max_index ) {
            for ( my $index = $max_index; $index > 0; $index-- ) {
                $self->dbgout( 'RemoveHeader', "$remove_header $index", LOG_DEBUG );
                $self->change_header( $remove_header, $index, q{} );
            }
        }
    }

    return;
}

sub close_callback {
    my ( $self ) = @_;
    delete $self->{'remove_auth_headers'};
    delete $self->{'auth_result_header_index'};
    delete $self->{'header_hash'};
    return;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Mail::Milter::Authentication::Handler::Sanitize

=head1 VERSION

version 20191206

=head1 DESCRIPTION

Remove unauthorized (forged) Authentication-Results headers from processed email.

=head1 CONFIGURATION

        "Sanitize" : {                                  | Config for the Sanitize Module
                                                        | Remove conflicting Auth-results headers from inbound mail
            "hosts_to_remove" : [                       | Hostnames (including subdomains thereof) for which we
                "example.com",                          | want to remove existing authentication results headers.
                "example.net"
            ],
            "remove_headers" : "yes"                    | Remove headers with conflicting host names (as defined above)
                                                        | "no" : do not remove
                                                        | "yes" : remove and add a header for each one
                                                        | "silent" : remove silently
                                                        | Does not run for trusted IP address connections
        }

=head1 AUTHOR

Marc Bradshaw <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2018 by Marc Bradshaw.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut