/
domainkeys
173 lines (123 loc) · 4.43 KB
/
domainkeys
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
#!perl -w
=head1 NAME
domainkeys: validate a DomainKeys signature on an incoming mail
=head1 SYNOPSIS
domainkeys [reject 1]
Performs a DomainKeys validation on the message.
=head1 DEPRECATION
You should probably NOT be using this plugin. DomainKeys has been deprecated in favor of DKIM. That being said, it's March 2013 and I'm still seeing ham arrive with DomainKeys signatures.
=head1 CONFIGURATION
=head2 reject
reject 1
Reject is a boolean that toggles message rejection on or off. Messages failing
DomainKeys validation are rejected by default.
=head2 reject_type
reject_type [ temp | perm ]
The default rejection type is permanent.
=head2 warn_only
A deprecated option that disables message rejection. See reject instead.
=head1 COPYRIGHT
Copyright (C) 2005-2006 John Peacock.
Portions Copyright (C) 2004 Anthony D. Urso. All rights reserved. This
program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 AUTHORS
Matt Simerson - 2013 - save results to Authentication-Results header
instead of DomainKey-Status
Matt Simerson - 2012 - refactored, added tests, safe loading
John Peacock - 2005-2006
Anthony D. Urso. - 2004
=cut
use strict;
use warnings;
use Qpsmtpd::Constants;
sub init {
my ($self, $qp, %args) = @_;
foreach my $key (%args) {
$self->{$key} = $args{$key};
}
$self->{reject} = 1 if !defined $self->{reject}; # default reject
$self->{reject_type} = 'perm' if !defined $self->{reject_type};
if ($args{'warn_only'}) {
$self->log(LOGNOTICE, "warn_only is deprecated. Use reject instead");
$self->{'reject'} = 0;
}
}
sub register {
my $self = shift;
for my $m (qw/ Mail::DomainKeys::Message Mail::DomainKeys::Policy /) {
eval "use $m";
if ($@) {
warn "skip: plugin disabled, could not load $m\n";
$self->log(LOGERROR, "skip: plugin disabled, is $m installed?");
return;
}
}
$self->register_hook('data_post_headers', 'data_post_handler');
}
sub data_post_handler {
my ($self, $transaction) = @_;
return DECLINED if $self->is_immune();
if (!$transaction->header->get('DomainKey-Signature')) {
$self->log(LOGINFO, "skip, unsigned");
return DECLINED;
}
my $body = $self->assemble_body($transaction);
my $message =
load Mail::DomainKeys::Message(
HeadString => $transaction->header->as_string,
BodyReference => $body)
or do {
$self->log(LOGWARN, "skip, unable to load message"), return DECLINED;
};
# no sender domain means no verification
if (!$message->senderdomain) {
$self->log(LOGINFO, "skip, failed to parse sender domain"),
return DECLINED;
}
my $status = $self->get_message_status($message);
if (defined $status) {
#$transaction->header->add("DomainKey-Status", $status, 0);
$self->store_auth_results('domainkey=' . $status);
$self->log(LOGINFO, "pass, $status");
return DECLINED;
}
$self->log(LOGERROR, "fail, signature invalid");
return DECLINED if !$self->{reject};
my $deny = $self->{reject_type} eq 'temp' ? DENYSOFT : DENY;
return $deny, "DomainKeys signature validation failed";
}
sub get_message_status {
my ($self, $message) = @_;
if ($message->testing) {
return "testing"; # key testing, don't do anything else
}
if ($message->signed && $message->verify) {
return $message->signature->status; # verified: add good header
}
# not signed or not verified
my $policy =
fetch Mail::DomainKeys::Policy(Protocol => 'dns',
Domain => $message->senderdomain);
if (!$policy) {
return $message->signed ? "non-participant" : "no signature";
}
if ($policy->testing) {
return "testing"; # Don't do anything else
}
if ($policy->signall) {
return undef; # policy requires all mail to be signed
}
# $policy->signsome
return "no signature"; # not signed and domain doesn't sign all
}
sub assemble_body {
my ($self, $transaction) = @_;
$transaction->body_resetpos;
$transaction->body_getline; # \r\n seperator is NOT part of the body
my @body;
while (my $line = $transaction->body_getline) {
push @body, $line;
}
return \@body;
}