331 lines
8.9 KiB
Perl
331 lines
8.9 KiB
Perl
#!perl -w
|
|
|
|
=head1 NAME
|
|
|
|
dkim: validate DomainKeys and (DKIM) Domain Keys Indentified Messages
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
Validate the DKIM and Domainkeys signatures of a message, and enforce DKIM
|
|
sending policies.
|
|
|
|
=head1 CONFIGURATION
|
|
|
|
=head2 reject [ 0 | 1 ]
|
|
|
|
dkim reject 1
|
|
|
|
Reject is a boolean that toggles message rejection on or off. Messages failing
|
|
validation are rejected by default.
|
|
|
|
Default: 1
|
|
|
|
=head2 reject_type
|
|
|
|
dkim reject_type [ temp | perm ]
|
|
|
|
Default: perm
|
|
|
|
=head1 SEE ALSO
|
|
|
|
http://www.dkim.org/
|
|
|
|
http://tools.ietf.org/html/rfc6376 - DKIM Signatures
|
|
|
|
http://tools.ietf.org/html/rfc5863 - DKIM Development, Deployment, & Operations
|
|
|
|
http://tools.ietf.org/html/rfc5617 - DKIM ADSP (Author Domain Signing Practices)
|
|
|
|
http://tools.ietf.org/html/rfc5585 - DKIM Service Overview
|
|
|
|
http://tools.ietf.org/html/rfc5016 - DKIM Signing Practices Protocol
|
|
|
|
http://tools.ietf.org/html/rfc4871 - DKIM Signatures
|
|
|
|
http://tools.ietf.org/html/rfc4870 - DomainKeys
|
|
|
|
=head1 AUTHORS
|
|
|
|
2012 - Matt Simerson - initial plugin
|
|
|
|
=head1 ACKNOWLEDGEMENTS
|
|
|
|
David Summers - http://www.nntp.perl.org/group/perl.qpsmtpd/2010/08/msg9417.html
|
|
|
|
Matthew Harrell - http://alecto.bittwiddlers.com/files/qpsmtpd/dkimcheck
|
|
|
|
I first attempted to fix the dkimcheck plugin, but soon scrapped that effort and wrote this one.
|
|
|
|
The nine 'if' brackets with 19 conditionals, and my inability to easily determine which of the 15 possible permutations (5 signature validation results x 3 possible policy results) were covered.
|
|
|
|
The use of $dkim->fetch_author_policy, which is deprecated by Mail::DKIM.
|
|
|
|
The paradim of a single policy, when DKIM supports 0 or many. Although I may yet implement the 'local' policy idea, so long as I'm confident it will never result in a false positive.
|
|
|
|
The OBF programming style, which is nigh impossible to test.
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Qpsmtpd::Constants;
|
|
|
|
# use Mail::DKIM::Verifier; # eval'ed in register()
|
|
use Socket qw(:DEFAULT :crlf);
|
|
|
|
sub init {
|
|
my ($self, $qp) = (shift, shift);
|
|
|
|
$self->{_args} = { @_ };
|
|
|
|
$self->{_args}{reject} = 1 if ! defined $self->{_args}{reject};
|
|
$self->{_args}{reject_type} ||= 'perm';
|
|
}
|
|
|
|
sub register {
|
|
my $self = shift;
|
|
|
|
eval "use Mail::DKIM::Verifier";
|
|
if ( $@ ) {
|
|
warn "skip, plugin disabled, could not load Mail::DKIM::Verifier\n";
|
|
$self->log(LOGERROR, "skip, plugin disabled, is Mail::DKIM installed?");
|
|
return;
|
|
};
|
|
|
|
$self->register_hook('data_post', 'data_post_handler');
|
|
};
|
|
|
|
sub data_post_handler {
|
|
my ($self, $transaction) = @_;
|
|
|
|
return DECLINED if $self->is_immune();
|
|
|
|
my $dkim = Mail::DKIM::Verifier->new() or do {
|
|
$self->log(LOGERROR, "error, could not instantiate a new Mail::DKIM::Verifier");
|
|
return DECLINED;
|
|
};
|
|
|
|
my $result = $self->get_dkim_result( $dkim, $transaction );
|
|
my $mess = $self->get_details( $dkim );
|
|
|
|
foreach my $r ( qw/ pass fail invalid temperror none / ) {
|
|
my $handler = 'handle_sig_' . $r;
|
|
if ( $result eq $r && $self->can( $handler ) ) {
|
|
#$self->log(LOGINFO, "dispatching $result to $handler");
|
|
return $self->$handler( $dkim, $mess );
|
|
};
|
|
};
|
|
|
|
$self->log( LOGERROR, "unknown result: $result, $mess" );
|
|
return DECLINED;
|
|
}
|
|
|
|
sub get_details {
|
|
my ($self, $dkim ) = @_;
|
|
|
|
my @data;
|
|
my $string;
|
|
push @data, "domain: " . $dkim->signature->domain if $dkim->signature;
|
|
push @data, "selector: " . $dkim->signature->selector if $dkim->signature;
|
|
push @data, "result: " . $dkim->result_detail if $dkim->result_detail;
|
|
|
|
foreach my $policy ( $dkim->policies ) {
|
|
next if ! $policy;
|
|
push @data, "policy: " . $policy->as_string;
|
|
push @data, "name: " . $policy->name;
|
|
push @data, "policy_location: " . $policy->location if $policy->location;
|
|
|
|
my $policy_result;
|
|
$policy_result = $policy->apply($dkim);
|
|
$policy_result or next;
|
|
push @data, "policy_result: " . $policy_result if $policy_result;
|
|
};
|
|
|
|
return join(', ', @data);
|
|
};
|
|
|
|
sub handle_sig_fail {
|
|
my ( $self, $dkim, $mess ) = @_;
|
|
|
|
return $self->get_reject( "DKIM signature invalid: " . $dkim->result_detail, $mess );
|
|
};
|
|
|
|
sub handle_sig_temperror {
|
|
my ( $self, $dkim, $mess ) = @_;
|
|
|
|
$self->log(LOGINFO, "error, $mess" );
|
|
return ( DENYSOFT, "Please try again later - $dkim->result_detail" );
|
|
};
|
|
|
|
sub handle_sig_invalid {
|
|
my ( $self, $dkim, $mess ) = @_;
|
|
|
|
my ( $prs, $policies) = $self->get_policy_results( $dkim );
|
|
|
|
if ( ! $self->qp->connection->relay_client() ) {
|
|
foreach my $policy ( @$policies ) {
|
|
if ( $policy->signall && ! $policy->is_implied_default_policy ) {
|
|
$self->log(LOGINFO, $mess );
|
|
return $self->get_reject(
|
|
"invalid DKIM signature with sign-all policy",
|
|
"invalid signature, sign-all policy"
|
|
);
|
|
}
|
|
};
|
|
};
|
|
|
|
$self->log(LOGINFO, $mess );
|
|
|
|
if ( $prs->{accept} ) {
|
|
$self->add_header( $mess );
|
|
$self->log( LOGERROR, "error, invalid signature but accept policy!?" );
|
|
return DECLINED;
|
|
}
|
|
elsif ( $prs->{neutral} ) {
|
|
$self->add_header( $mess );
|
|
$self->log( LOGERROR, "error, invalid signature but neutral policy?!" );
|
|
return DECLINED;
|
|
}
|
|
elsif ( $prs->{reject} ) {
|
|
return $self->get_reject(
|
|
"invalid DKIM signature: " . $dkim->result_detail,
|
|
"fail, invalid signature, reject policy"
|
|
);
|
|
}
|
|
|
|
# this should never happen
|
|
$self->log( LOGINFO, "error, invalid signature, unhandled" );
|
|
$self->add_header( $mess );
|
|
return DECLINED;
|
|
};
|
|
|
|
sub handle_sig_pass {
|
|
my ( $self, $dkim, $mess ) = @_;
|
|
|
|
my ($prs) = $self->get_policy_results( $dkim );
|
|
|
|
if ( $prs->{accept} ) {
|
|
$self->add_header( $mess );
|
|
$self->log(LOGINFO, "pass, valid signature, accept policy");
|
|
return DECLINED;
|
|
}
|
|
elsif ( $prs->{neutral} ) {
|
|
$self->add_header( $mess );
|
|
$self->log(LOGINFO, "pass, valid signature, neutral policy");
|
|
$self->log(LOGINFO, $mess );
|
|
return DECLINED;
|
|
}
|
|
elsif ( $prs->{reject} ) {
|
|
$self->log(LOGINFO, $mess );
|
|
return $self->get_reject(
|
|
"DKIM signature valid but fails policy, $mess",
|
|
"fail, valid sig, reject policy"
|
|
);
|
|
};
|
|
|
|
# this should never happen
|
|
$self->add_header( $mess );
|
|
$self->log(LOGERROR, "pass, valid sig, no policy results" );
|
|
$self->log(LOGINFO, $mess );
|
|
return DECLINED;
|
|
};
|
|
|
|
sub handle_sig_none {
|
|
my ( $self, $dkim, $mess ) = @_;
|
|
|
|
my ( $prs, $policies) = $self->get_policy_results( $dkim );
|
|
|
|
if ( ! $self->qp->connection->relay_client() ) {
|
|
foreach my $policy ( @$policies ) {
|
|
if ( $policy->signall && ! $policy->is_implied_default_policy ) {
|
|
$self->log(LOGINFO, $mess );
|
|
return $self->get_reject(
|
|
"no DKIM signature with sign-all policy",
|
|
"no signature, sign-all policy"
|
|
);
|
|
}
|
|
};
|
|
};
|
|
|
|
|
|
if ( $prs->{accept} ) {
|
|
$self->log( LOGINFO, "pass, no signature, accept policy" );
|
|
return DECLINED;
|
|
}
|
|
elsif ( $prs->{neutral} ) {
|
|
$self->log( LOGINFO, "pass, no signature, neutral policy" );
|
|
return DECLINED;
|
|
}
|
|
elsif ( $prs->{reject} ) {
|
|
$self->log(LOGINFO, $mess );
|
|
$self->get_reject(
|
|
"no DKIM signature, policy says reject: " . $dkim->result_detail,
|
|
"no signature, reject policy"
|
|
);
|
|
};
|
|
|
|
# should never happen
|
|
$self->log( LOGINFO, "error, no signature, no policy" );
|
|
$self->log(LOGINFO, $mess );
|
|
return DECLINED;
|
|
};
|
|
|
|
sub get_dkim_result {
|
|
my $self = shift;
|
|
my ($dkim, $transaction) = @_;
|
|
|
|
foreach ( split ( /\n/s, $transaction->header->as_string ) ) {
|
|
$_ =~ s/\r?$//s;
|
|
eval { $dkim->PRINT ( $_ . CRLF ); };
|
|
$self->log(LOGERROR, $@ ) if $@;
|
|
}
|
|
|
|
$transaction->body_resetpos;
|
|
while (my $line = $transaction->body_getline) {
|
|
chomp $line;
|
|
s/\015$//;
|
|
eval { $dkim->PRINT($line . CRLF ); };
|
|
$self->log(LOGERROR, $@ ) if $@;
|
|
};
|
|
|
|
$dkim->CLOSE;
|
|
|
|
return $dkim->result;
|
|
};
|
|
|
|
sub get_policies {
|
|
my ($self, $dkim) = @_;
|
|
|
|
my @policies;
|
|
eval { @policies = $dkim->policies };
|
|
$self->log(LOGERROR, $@ ) if $@;
|
|
return @policies;
|
|
};
|
|
|
|
sub get_policy_results {
|
|
my ( $self, $dkim ) = @_;
|
|
|
|
my %prs;
|
|
my @policies = $self->get_policies( $dkim );
|
|
|
|
foreach my $policy ( @policies ) {
|
|
my $policy_result;
|
|
eval { $policy_result = $policy->apply($dkim); }; # accept, reject, neutral
|
|
if ( $@ ) {
|
|
$self->log(LOGERROR, $@ );
|
|
};
|
|
$prs{$policy_result}++ if $policy_result;
|
|
};
|
|
|
|
return \%prs, \@policies;
|
|
};
|
|
|
|
sub add_header {
|
|
my $self = shift;
|
|
my $header = shift or return;
|
|
|
|
$self->qp->transaction->header->add( 'X-DKIM-Authentication', $header, 0 );
|
|
}
|
|
|