2
# Licensed to the Apache Software Foundation (ASF) under one or more
3
# contributor license agreements. See the NOTICE file distributed with
4
# this work for additional information regarding copyright ownership.
5
# The ASF licenses this file to you under the Apache License, Version 2.0
6
# (the "License"); you may not use this file except in compliance with
7
# the License. You may obtain a copy of the License at:
9
# http://www.apache.org/licenses/LICENSE-2.0
11
# Unless required by applicable law or agreed to in writing, software
12
# distributed under the License is distributed on an "AS IS" BASIS,
13
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14
# See the License for the specific language governing permissions and
15
# limitations under the License.
20
Mail::SpamAssassin::Plugin::DomainKeys - perform DomainKeys verification tests
24
loadplugin Mail::SpamAssassin::Plugin::DomainKeys [/path/to/DomainKeys.pm]
27
header DK_SIGNED eval:check_domainkeys_signed()
28
header DK_VERIFIED eval:check_domainkeys_verified()
31
Note that DK policy record is only fetched if DK_VERIFIED is
32
false to save a signing domain from unnecessary DNS queries,
33
as recommended (SHOULD) by draft-delany-domainkeys-base.
34
Rules DK_POLICY_* should preferably not be relied upon when
35
DK_VERIFIED is true, although they will return false in current
36
implementation when a policy record is not fetched, except for
37
DK_POLICY_TESTING, which is true if t=y appears in a public key
38
record OR in a policy record (when available).
39
header DK_POLICY_TESTING eval:check_domainkeys_testing()
40
header DK_POLICY_SIGNSOME eval:check_domainkeys_signsome()
41
header DK_POLICY_SIGNALL eval:check_domainkeys_signall()
43
Whitelisting based on verified signature:
44
header USER_IN_DK_WHITELIST eval:check_for_dk_whitelist_from()
45
header USER_IN_DEF_DK_WL eval:check_for_def_dk_whitelist_from()
49
This is the DomainKeys plugin and it needs lots more documentation.
51
Note that if the C<Mail::SpamAssassin::Plugin::DKIM> plugin is installed with
52
C<Mail::DKIM> version 0.20 or later, that plugin will also perform Domain Key
53
lookups on DomainKey-Signature headers, in which case this plugin is redundant.
56
Here is author's note from module C<Mail::DomainKeys> version 1.0:
58
THIS MODULE IS OFFICIALLY UNSUPPORTED.
60
Please move on to DKIM like a responsible Internet user. I have.
62
I will leave this module here on CPAN for a while, just in case someone
63
has grown to depend on it. It is apparent that DK will not be the way
64
of the future. Thus, it is time to put this module to ground before it
65
causes any further harm.
67
Thanks for your support,
72
package Mail::SpamAssassin::Plugin::DomainKeys;
74
use Mail::SpamAssassin::Plugin;
75
use Mail::SpamAssassin::Logger;
76
use Mail::SpamAssassin::Timeout;
82
# Have to do this so that RPM doesn't find these as required perl modules
83
BEGIN { require Mail::DomainKeys::Message; require Mail::DomainKeys::Policy; }
86
@ISA = qw(Mail::SpamAssassin::Plugin);
88
# constructor: register the eval rule
91
my $mailsaobject = shift;
93
$class = ref($class) || $class;
94
my $self = $class->SUPER::new($mailsaobject);
95
bless ($self, $class);
97
$self->register_eval_rule ("check_domainkeys_signed");
98
$self->register_eval_rule ("check_domainkeys_verified");
99
$self->register_eval_rule ("check_domainkeys_signsome");
100
$self->register_eval_rule ("check_domainkeys_testing");
101
$self->register_eval_rule ("check_domainkeys_signall");
102
$self->register_eval_rule ("check_for_dk_whitelist_from");
103
$self->register_eval_rule ("check_for_def_dk_whitelist_from");
105
$self->set_config($mailsaobject->{conf});
110
###########################################################################
113
my($self, $conf) = @_;
120
=item whitelist_from_dk add@ress.com [signing domain name]
122
Use this to supplement the whitelist_from addresses with a check to make sure
123
the message has been signed by a DomainKeys signature that can be verified
124
against the From: domain's DomainKeys public key.
126
In order to support signing domain names that differ from the address domain
127
name, only one whitelist entry is allowed per line, exactly like
128
C<whitelist_from_rcvd>. Multiple C<whitelist_from_dk> lines are allowed.
129
File-glob style meta characters are allowed for the From: address, just like
130
with C<whitelist_from_rcvd>. The optional signing domain name parameter must
131
match from the right-most side, also like in C<whitelist_from_rcvd>.
133
If no signing domain name parameter is specified the domain of the address
134
parameter specified will be used instead.
136
The From: address is obtained from a signed part of the message (ie. the
137
"From:" header), not from envelope data that is possible to forge.
139
Since this whitelist requires a DomainKeys check to be made, network tests must
144
whitelist_from_dk joe@example.com
145
whitelist_from_dk *@corp.example.com
147
whitelist_from_dk bob@it.example.net example.net
148
whitelist_from_dk *@eng.example.net example.net
150
=item def_whitelist_from_dk add@ress.com [signing domain name]
152
Same as C<whitelist_from_dk>, but used for the default whitelist entries
153
in the SpamAssassin distribution. The whitelist score is lower, because
154
these are often targets for spammer spoofing.
159
setting => 'whitelist_from_dk',
161
my ($self, $key, $value, $line) = @_;
162
unless (defined $value && $value !~ /^$/) {
163
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
165
unless ($value =~ /^(\S+)(?:\s+(\S+))?$/) {
166
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
169
my $signer = (defined $2 ? $2 : $1);
171
unless (defined $2) {
172
$signer =~ s/^.*@(.*)$/$1/;
174
$self->{parser}->add_to_addrlist_rcvd ('whitelist_from_dk',
180
setting => 'def_whitelist_from_dk',
182
my ($self, $key, $value, $line) = @_;
183
unless (defined $value && $value !~ /^$/) {
184
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
186
unless ($value =~ /^(\S+)(?:\s+(\S+))?$/) {
187
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
190
my $signer = (defined $2 ? $2 : $1);
192
unless (defined $2) {
193
$signer =~ s/^.*@(.*)$/$1/;
195
$self->{parser}->add_to_addrlist_rcvd ('def_whitelist_from_dk',
202
=head1 ADMINISTRATOR SETTINGS
206
=item domainkeys_timeout n (default: 5)
208
How many seconds to wait for a DomainKeys query to complete, before
209
scanning continues without the DomainKeys result.
214
setting => 'domainkeys_timeout',
217
type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC
220
$conf->{parser}->register_commands(\@cmds);
224
sub check_domainkeys_signed {
225
my ($self, $scan) = @_;
227
$self->_check_domainkeys($scan) unless $scan->{domainkeys_checked};
229
return $scan->{domainkeys_signed};
232
sub check_domainkeys_verified {
233
my ($self, $scan) = @_;
235
$self->_check_domainkeys($scan) unless $scan->{domainkeys_checked};
237
return $scan->{domainkeys_verified};
240
sub check_domainkeys_signsome {
241
my ($self, $scan) = @_;
243
$self->_check_domainkeys($scan) unless $scan->{domainkeys_checked};
244
return $scan->{domainkeys_signsome};
247
sub check_domainkeys_testing {
248
my ($self, $scan) = @_;
250
$self->_check_domainkeys($scan) unless $scan->{domainkeys_checked};
252
return $scan->{domainkeys_testing};
255
sub check_domainkeys_signall {
256
my ($self, $scan) = @_;
258
$self->_check_domainkeys($scan) unless $scan->{domainkeys_checked};
260
return $scan->{domainkeys_signall};
263
sub check_for_dk_whitelist_from {
264
my ($self, $scan) = @_;
265
$self->_check_dk_whitelist($scan, 0) unless $scan->{dk_whitelist_from_checked};
266
$scan->{dk_whitelist_from};
269
sub check_for_def_dk_whitelist_from {
270
my ($self, $scan) = @_;
271
$self->_check_dk_whitelist($scan, 1) unless $scan->{def_dk_whitelist_from_checked};
272
$scan->{def_dk_whitelist_from};
275
# ---------------------------------------------------------------------------
277
sub _check_domainkeys {
278
my ($self, $scan) = @_;
280
$scan->{domainkeys_checked} = 0;
281
$scan->{domainkeys_signed} = 0;
282
$scan->{domainkeys_verified} = 0;
283
$scan->{domainkeys_signsome} = 0;
284
$scan->{domainkeys_testing} = 0;
285
$scan->{domainkeys_signall} = 0;
287
my $header = $scan->{msg}->get_pristine_header();
288
my $body = $scan->{msg}->get_body();
289
my $dksighdr = $scan->{msg}->get_header("DomainKey-Signature");
290
dbg("dk: signature: $dksighdr") if defined $dksighdr;
292
$self->sanitize_header_for_dk(\$header)
293
if defined $dksighdr && $dksighdr !~ /(?:^|;)[ \t]*h=/; # case sensitive
295
my $message = Mail::DomainKeys::Message->load(HeadString => $header,
296
BodyReference => $body);
299
dbg("dk: cannot load message using Mail::DomainKeys::Message");
303
$scan->{domainkeys_checked} = 1;
305
# does a sender domain header exist?
306
my $domain = $message->senderdomain();
308
dbg("dk: no sender domain");
312
# get the sender address for whitelist checks
313
if (defined $message->sender()) {
314
$scan->{dk_address} = @{$message->sender()}[1];
315
dbg("dk: sender: $scan->{dk_address}");
316
} elsif (defined $message->from()) {
317
$scan->{dk_address} ||= @{$message->from()}[1];
318
dbg("dk: from: $scan->{dk_address}");
320
dbg("dk: could not determine sender: or from: identity");
323
# get the signing domain name for whitelist checks
324
$scan->{dk_signing_domain} = $self->_dkmsg_signing_domain($scan, $message);
325
dbg("dk: signing domain name: ".
326
($scan->{dk_signing_domain} ? $scan->{dk_signing_domain} : "not found"));
328
my $timeout = $scan->{conf}->{domainkeys_timeout};
330
my $timer = Mail::SpamAssassin::Timeout->new({ secs => $timeout });
331
my $err = $timer->run_and_catch(sub {
333
$self->_dk_lookup_trapped($scan, $message, $domain);
337
if ($timer->timed_out()) {
338
dbg("dk: lookup timed out after $timeout seconds");
344
warn("dk: lookup failed: $err\n");
348
my $comment = $self->_dkmsg_hdr($message);
350
$comment =~ s/\s+/ /gs; # no newlines please
352
$scan->{dk_comment} = "DomainKeys status: $comment";
355
# perform DK lookups. This method is trapped within a timeout alarm() scope
356
sub _dk_lookup_trapped {
357
my ($self, $scan, $message, $domain) = @_;
360
if ($message->signed()) {
361
$scan->{domainkeys_signed} = 1;
362
if ($message->verify()) {
363
$scan->{domainkeys_verified} = 1;
366
# testing flag in signature
367
if ($message->testing()) {
368
$scan->{domainkeys_testing} = 1;
371
if (!$scan->{domainkeys_verified}) {
372
# Recipient systems SHOULD not retrieve a policy TXT record
373
# for email that successfully verifies.
374
$policy = Mail::DomainKeys::Policy->fetch(Protocol => 'dns',
376
my($fetched_policy) = $policy ? $policy->as_string : 'NONE';
377
$fetched_policy = '' if !defined $fetched_policy;
378
dbg ("dk: fetched policy for domain $domain: $fetched_policy");
380
return unless $policy;
382
# not signed and domain doesn't sign all
383
if ($policy->signsome()) {
384
$scan->{domainkeys_signsome} = 1;
387
# testing flag in policy
388
if ($policy->testing()) {
389
$scan->{domainkeys_testing} = 1;
392
# does policy require all mail to be signed
393
if ($policy->signall()) {
394
$scan->{domainkeys_signall} = 1;
397
my $comment = $self->_dkmsg_hdr($message);
398
dbg("dk: comment is '$comment'");
401
# get the DK status "header" from the Mail::DomainKeys::Message object
403
my ($self, $message) = @_;
404
# try to use the signature() API if it exists (post-0.80)
405
if ($message->can("signature")) {
407
if (!$message->signed) {
408
$sts = "no signature";
410
$sts = $message->signature->status;
411
$msg = $message->signature->errorstr;
413
dbg("dk: $sts" . (defined $msg ? " ($msg)" : ''));
416
return $message->header->value;
420
# get the DK signing domain name from the Mail::DomainKeys::Message object
421
sub _dkmsg_signing_domain {
422
my ($self, $scan, $message) = @_;
423
# try to use the signature() API if it exists (post-0.80)
424
if ($message->can("signature")) {
425
if (!$message->signed) {
428
return $message->signature->domain;
430
# otherwise parse it ourself
431
if ($scan->{msg}->get_header("DomainKey-Signature") =~
432
/(?: ^|; ) [ \t]* d= [ \t]* ([^;]*?) [ \t]* (?: ;|$ )/x) {
439
sub sanitize_header_for_dk {
440
my ($self, $ref) = @_;
442
dbg("dk: sanitizing header, no \"h\" tag in signature");
443
# remove folding, in a HTML-escape data-preserving style, so we can
444
# strip headers easily
445
$$ref =~ s/!/!ex;/gs;
446
$$ref =~ s/\n([ \t])/!nl;$1/gs;
447
my @hdrs = split(/^/m, $$ref);
449
while (scalar @hdrs > 0) {
450
my $last = pop @hdrs;
451
next if ($last =~ /^\r?$/);
453
# List all the known appended headers that may break a DK signature. Things
456
# 1. only *appended* headers should be listed; prepended additions are fine.
457
# 2. some virus-scanner headers may be better left out, since there are ISPs
458
# who scan for viruses before the message leaves their SMTP relay; this is
461
# TODO: there's probably loads more, and this should be user-configurable
464
# SpamAssassin additions, remove these so that mass-check works
468
|X-MailScanner(?:-SpamCheck)?
469
|X-Pyzor |X-DCC-\S{2,25}-Metrics
472
# post-delivery MUA additions
476
# IMAP or POP additions
478
|(?:X-)?Status |X-Flags |Replied |Forwarded
479
|Lines |Content-Length
482
# MTA delivery control headers
483
|X-MDaemon-Deliver-To
485
# other MUAs: VM and Gnus
486
|X-VM-(?:Bookmark|(?:POP|IMAP)-Retrieved|Labels|Last-Modified
487
|Summary-Format|VHeader|v\d-Data|Message-Order)
492
$last =~ /^([^:]+):/; dbg("dk: ignoring header '$1'");
496
push (@hdrs, $last); last;
499
$$ref = join("", @hdrs);
501
# and return the remaining headers to pristine condition
502
# $$ref =~ s/^\n//gs; $$ref =~ s/\n$//gs;
503
$$ref =~ s/!nl;/\n/gs;
504
$$ref =~ s/!ex;/!/gs;
507
sub _check_dk_whitelist {
508
my ($self, $scan, $default) = @_;
510
return unless $scan->is_dns_available();
512
# trigger a DK check so we can get address/signer info
513
# if verification failed only continue if we want the debug info
514
unless ($self->check_domainkeys_verified($scan)) {
515
unless (would_log("dbg", "dk")) {
520
unless ($scan->{dk_address}) {
521
dbg("dk: ". ($default ? "def_" : "") ."whitelist_from_dk: could not find sender or from address");
524
unless ($scan->{dk_signing_domain}) {
525
dbg("dk: ". ($default ? "def_" : "") ."whitelist_from_dk: could not find signing domain name");
530
$scan->{def_dk_whitelist_from_checked} = 1;
531
$scan->{def_dk_whitelist_from} =
532
$self->_wlcheck_domain($scan,'def_whitelist_from_dk');
534
if (!$scan->{def_dk_whitelist_from}) {
535
$scan->{def_dk_whitelist_from} =
536
$self->_wlcheck_no_domain($scan,'def_whitelist_auth');
539
$scan->{dk_whitelist_from_checked} = 1;
540
$scan->{dk_whitelist_from} =
541
$self->_wlcheck_domain($scan,'whitelist_from_dk');
543
if (!$scan->{dk_whitelist_from}) {
544
$scan->{dk_whitelist_from} =
545
$self->_wlcheck_no_domain($scan,'whitelist_auth');
549
# if the message doesn't pass DK validation, it can't pass a DK whitelist
551
if ($scan->{def_dk_whitelist_from}) {
552
if ($self->check_domainkeys_verified($scan)) {
553
dbg("dk: address: $scan->{dk_address} signing domain name: ".
554
"$scan->{dk_signing_domain} is in user's DEF_WHITELIST_FROM_DK and ".
555
"passed DK verification");
557
dbg("dk: address: $scan->{dk_address} signing domain name: ".
558
"$scan->{dk_signing_domain} is in user's DEF_WHITELIST_FROM_DK but ".
559
"failed DK verification");
560
$scan->{def_dk_whitelist_from} = 0;
563
dbg("dk: address: $scan->{dk_address} signing domain name: ".
564
"$scan->{dk_signing_domain} is not in user's DEF_WHITELIST_FROM_DK");
567
if ($scan->{dk_whitelist_from}) {
568
if ($self->check_domainkeys_verified($scan)) {
569
dbg("dk: address: $scan->{dk_address} signing domain name: ".
570
"$scan->{dk_signing_domain} is in user's WHITELIST_FROM_DK and ".
571
"passed DK verification");
573
dbg("dk: address: $scan->{dk_address} signing domain name: ".
574
"$scan->{dk_signing_domain} is in user's WHITELIST_FROM_DK but ".
575
"failed DK verification");
576
$scan->{dk_whitelist_from} = 0;
579
dbg("dk: address: $scan->{dk_address} signing domain name: ".
580
"$scan->{dk_signing_domain} is not in user's WHITELIST_FROM_DK");
585
sub _wlcheck_domain {
586
my ($self, $scan, $wl) = @_;
588
foreach my $white_addr (keys %{$scan->{conf}->{$wl}}) {
589
my $re = qr/$scan->{conf}->{$wl}->{$white_addr}{re}/i;
590
foreach my $domain (@{$scan->{conf}->{$wl}->{$white_addr}{domain}}) {
591
$self->_wlcheck_one_dom($scan, $wl, $white_addr, $domain, $re) and return 1;
597
sub _wlcheck_one_dom {
598
my ($self, $scan, $wl, $white_addr, $domain, $re) = @_;
600
if ($scan->{dk_address} =~ $re) {
601
if ($scan->{dk_signing_domain} =~ /(?:^|\.)\Q${domain}\E$/i) {
602
dbg("dk: address: $scan->{dk_address} matches $wl $re $domain");
610
# use a traditional whitelist_from-style addrlist, and infer the
611
# domain from each address on the fly. Note: don't pre-parse and
612
# store the domains; that's inefficient memory-wise and only saves 1 m//
613
sub _wlcheck_no_domain {
614
my ($self, $scan, $wl) = @_;
616
foreach my $white_addr (keys %{$scan->{conf}->{$wl}}) {
617
my $domain = ($white_addr =~ /\@(.*?)$/) ? $1 : $white_addr;
618
my $re = $scan->{conf}->{$wl}->{$white_addr};
619
$self->_wlcheck_one_dom($scan, $wl, $white_addr, $domain, $re) and return 1;
added
removed
lib/Mail/SpamAssassin/Plugin/DomainKeys.pm
