diff options
Diffstat (limited to 'Spline/DMARC.pm')
-rw-r--r-- | Spline/DMARC.pm | 118 |
1 files changed, 118 insertions, 0 deletions
diff --git a/Spline/DMARC.pm b/Spline/DMARC.pm new file mode 100644 index 0000000..4264dd5 --- /dev/null +++ b/Spline/DMARC.pm @@ -0,0 +1,118 @@ +#!/usr/bin/perl +=pod + +=head1 NAME + +Spline::DMARC - Methods to check the DMARC policy of mails. + +=head1 SYNOPSIS + + use Spline::DMARC qw(...); + + $policy = get_dmarc_policy($domain); + $would_reject = check_addresses($from); + +=head1 DESCRIPTION + +=cut + +package Spline::DMARC; + +use strict; +use warnings; + +use Mail::DMARC::PurePerl; +use Email::Address; +use Spline::Log qw(info debug); + +use base 'Exporter'; +our @EXPORT = qw(); +our @EXPORT_OK = qw( + check_addresses + get_dmarc_policy +); + +=head2 get_dmarc_policy + + $policy = get_dmarc_policy($domain); + +Get the DMARC policy for the specified domain. It will only return the +"p" value ('reject', 'none', ...) or the "sp" value (if the policy is +defined on a parent domain). + +If there is no DMARC policy defined, 'none' is returned. + +=cut + +sub get_dmarc_policy($) { + my $domain = shift; + my $effective_p = 'none'; + + my $dmarc = Mail::DMARC::PurePerl->new( + header_from => $domain, + ); + + debug "Checking DMARC policy for $domain"; + if ($dmarc->exists_in_dns()) { + my $policy = $dmarc->discover_policy(); + + if (defined $policy && $policy->is_valid()) { + if ($dmarc->is_subdomain && defined $policy->sp) { + debug 'Found policy on parent domain, using sp: ' . $policy->sp; + $effective_p = $policy->sp; + } + else { + debug 'Found policy: ' . $policy->p; + $effective_p = $policy->p; + } + } + } + else { + debug 'No policy found'; + } + + return $effective_p; +} + +=head2 check_addresses + + $would_reject = check_addresses($from); + +Check if any of the addresses in the specified from header has a DMARC +policy with the value 'reject'. This would cause the messasge to +bounce on all DMARC respecting receivers (like hotmail) after mailman +resends it. + +We do not try to validate the DMARC policy, because it will always +fail after mailman, because the Envelop-From and From header will not +match. + +If there is a policy defined with the value 'reject', this method +returns 1. If there is no policy or a policy with any other value then +'reject', this method returns 0. + +=cut + +sub check_addresses($) { + my $from = shift; + + my @addresses = Email::Address->parse($from); + foreach my $addr (@addresses) { + my $policy = get_dmarc_policy($addr->host); + if ($policy eq 'reject') { + info '"' . $addr->host . '" has reject policy!'; + return 1; + } + } + + return 0; +} + +=head1 AUTHOR + +Alexander Sulfrian <alex@spline.inf.fu-berlin.de> + +=cut + +1; +# vim: set et tabstop=4 tw=70: |