blob: 1cea9cbe65bcefe42b7280af1bddb276f1c88337 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
#!/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';
debug "Checking DMARC policy for $domain";
my $dmarc;
eval {
$dmarc = Mail::DMARC::PurePerl->new(
header_from => $domain,
);
};
if ($@) {
chomp($@);
debug "Error: $@";
info "Skipping invalid domain: $domain";
}
elsif ($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:
|
