#!/usr/bin/perl -I../lib
use strict;
use warnings;
use Test::More tests => 104;
use Mail::DKIM::Verifier;
my $homedir = (-d "t") ? "t" : ".";
my $dkim = Mail::DKIM::Verifier->new();
ok($dkim, "new() works");
$dkim = Mail::DKIM::Verifier->new_object();
ok($dkim, "new_object() works");
my $sample_email = read_file("$homedir/test5.txt");
ok($sample_email, "able to read sample email");
ok($sample_email =~ /\015\012/, "sample has proper line endings");
$dkim->PRINT($sample_email);
$dkim->CLOSE;
my $result = $dkim->result;
ok($result, "result() works");
SKIP:
{
skip "older-prestandard DKIM signatures", 5;
test_email("good_ietf00_1.txt", "pass");
test_email("good_ietf00_2.txt", "pass");
test_email("good_ietf00_3.txt", "pass");
test_email("good_ietf00_4.txt", "pass");
test_email("good_ietf00_5.txt", "pass");
}
test_email("mine_ietf01_1.txt", "pass");
test_email("mine_ietf01_2.txt", "pass");
test_email("mine_ietf01_3.txt", "pass");
test_email("mine_ietf01_4.txt", "pass");
test_email("mine_ietf05_1.txt", "pass");
test_email("good_ietf01_1.txt", "pass");
test_email("good_ietf01_2.txt", "pass");
test_email("good_rfc4871_3.txt", "pass"); # tests extra tags in signature
test_email("good_rfc4871_4.txt", "pass"); # case-differing domain name
test_email("good_1878523.txt", "pass"); # test issue #1878523
test_email("multiple_1.txt", "pass");
test_email("multiple_2.txt", "pass");
my @sigs = $dkim->signatures;
ok($sigs[0]->result eq "invalid", "first signature is 'invalid'");
ok($sigs[1]->result eq "pass", "second signature is 'pass'");
ok($sigs[2]->result eq "fail", "third signature is 'fail'");
test_email("good_qp_1.txt", "pass"); # tests i= quoted-printable value
test_email("good_qp_2.txt", "pass"); # tests i= quoted-printable value
test_email("good_qp_3.txt", "pass"); # tests i= quoted-printable value
test_email("bad_ietf01_1.txt", "fail");
ok($dkim->result_detail =~ /body/, "determined body had been altered");
test_email("bad_ietf01_2.txt", "fail");
ok($dkim->result_detail =~ /message/, "determined message had been altered");
test_email("bad_ietf01_3.txt", "fail");
ok($dkim->result_detail =~ /RSA/, "determined RSA failure");
test_email("bad_1.txt", "fail"); #openssl error
print "# " . $dkim->result_detail . "\n";
SKIP:
{
skip "did not recognize OpenSSL error", 1
unless ($dkim->result_detail =~ /OpenSSL/i);
like($dkim->result_detail,
qr/OpenSSL/i,
"determined OpenSSL error");
}
test_email("bad_1878954.txt", "fail"); # shouldn't die
# test older DomainKeys messages, from Gmail and Yahoo!
test_email("good_dk_gmail.txt", "pass");
test_email("good_dk_yahoo.txt", "pass");
test_email("good_dk_1.txt", "pass");
test_email("good_dk_2.txt", "pass");
test_email("good_dk_3.txt", "pass"); # key with g= tag (ident in From header)
test_email("good_dk_4.txt", "pass"); # key with g= tag (ident in Sender head)
test_email("good_dk_5.txt", "pass"); # key with empty g=
test_email("good_dk_6.txt", "pass"); # no h= tag
test_email("good_dk_7.txt", "pass"); # case-differing domain names
test_email("dk_headers_1.txt", "pass");
test_email("dk_headers_2.txt", "pass");
test_email("bad_dk_1.txt", "invalid"); # sig. domain != From header (no Sender)
test_email("bad_dk_2.txt", "invalid"); # added Sender header, no h= tag
SKIP:
{
skip "missing q= tag on DomainKey signature accepted", 1;
test_email("bad_dk_3.txt", "invalid"); # no q= tag
}
test_email("bad_dk_4.txt", "invalid"); # empty q= tag
test_email("bad_dk_5.txt", "invalid"); # unrecognized q= tag
test_email("dk_multiple_1.txt", "pass");
my @dksigs = $dkim->signatures;
ok(@dksigs == 2, "found two signatures");
ok($dksigs[0]->result eq "pass", "first signature is 'pass'");
ok($dksigs[1]->result eq "pass", "second signature is 'pass'");
# test empty/missing body - simple canonicalization
test_email("no_body_1.txt", "pass");
test_email("no_body_2.txt", "pass");
test_email("no_body_3.txt", "pass");
#
# test various problems with the signature itself
#
test_email("ignore_1.txt", "invalid"); # unsupported v= tag (v=5)
test_email("ignore_2.txt", "invalid"); # unsupported a= tag (a=rsa-md5)
test_email("ignore_3.txt", "invalid"); # unsupported a= tag (a=dsa-sha1)
test_email("ignore_4.txt", "invalid"); # unsupported c= tag (c=future)
test_email("ignore_5.txt", "invalid"); # unsupported q= tag (q=http)
test_email("ignore_6.txt", "invalid"); # unsupported q= tag (q=dns/special)
test_email("ignore_7.txt", "invalid"); # expired signature
test_email("ignore_8.txt", "invalid"); # bad i= value
#
# test variants on the public key
#
test_email("goodkey_1.txt", "pass"); # public key with s=email
test_email("goodkey_2.txt", "pass"); # public key with extra tags, h=, s=, etc.
test_email("goodkey_3.txt", "pass"); # public key with g=jl*g
test_email("goodkey_4.txt", "pass"); # public key with implied g
#
# test problems with the public key
#
test_email("badkey_1.txt", "invalid"); # public key NXDOMAIN
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_2.txt", "invalid"); # public key REVOKED
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_3.txt", "invalid"); # public key unsupported v= tag
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_4.txt", "invalid"); # public key syntax error
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_5.txt", "invalid"); # public key unsupported k= tag
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_6.txt", "invalid"); # public key unsupported s= tag
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_7.txt", "invalid"); # public key unsupported h= tag
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_8.txt", "invalid"); # public key unmatched g= tag
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_9.txt", "invalid"); # public key empty g= tag
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_10.txt", "invalid"); # public key requires i == d
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_11.txt", "invalid"); # public key unmatched h= tag
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_12.txt", "invalid"); # public key g= != i= by case
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_13.txt", "invalid"); # public key g= matches From but not i=
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
test_email("badkey_14.txt", "invalid"); # dns error (timeout)
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
ok($dkim->result_detail =~ /dns.*timed? ?out/i, "type of dns failure");
test_email("badkey_15.txt", "invalid"); # dns error (SERVFAIL)
ok($dkim->result_detail =~ /public key/, "detail mentions public key");
ok($dkim->result_detail =~ /dns.*SERVFAIL/i, "type of dns failure");
sub read_file
{
my $srcfile = shift;
open my $fh, "<", $srcfile
or die "Error: can't open $srcfile: $!\n";
binmode $fh;
local $/;
my $content = <$fh>;
close $fh;
return $content;
}
sub test_email
{
my ($file, $expected_result) = @_;
print "# verifying message '$file'\n";
$dkim = Mail::DKIM::Verifier->new();
my $path = "$homedir/corpus/$file";
my $email = read_file($path);
$dkim->PRINT($email);
$dkim->CLOSE;
my $result = $dkim->result;
print "# result: " . $dkim->result_detail . "\n";
ok($result eq $expected_result, "'$file' should '$expected_result'");
}
# override the DNS implementation, so that these tests do not
# rely on DNS servers I have no control over
my $CACHE;
sub Mail::DKIM::DNS::fake_query
{
my ($domain, $type) = @_;
die "can't lookup $type record" if $type ne "TXT";
unless ($CACHE)
{
open my $fh, "<", "$homedir/FAKE_DNS.dat"
or die "Error: cannot read $homedir/FAKE_DNS.dat: $!\n";
$CACHE = {};
while (<$fh>)
{
chomp;
next if /^\s*[#;]/ || /^\s*$/;
my ($k, $v) = split /\s+/, $_, 2;
$CACHE->{$k} = ($v =~ /^~~(.*)~~$/) ? "$1" :
$v eq "NXDOMAIN" ? [] :
[ bless \$v, "FakeDNS::Record" ];
}
close $fh;
}
if (not exists $CACHE->{$domain})
{
warn "did not cache that DNS entry: $domain\n";
print STDERR ">>>\n";
print STDERR join("", (Mail::DKIM::DNS::orig_query($domain, $type))[0]->char_str_list) . "\n";
print STDERR "<<<\n";
die;
}
if (ref $CACHE->{$domain})
{
return @{$CACHE->{$domain}};
}
else
{
die "DNS error: $CACHE->{$domain}\n";
}
}
BEGIN {
unless ($ENV{use_real_dns})
{
*Mail::DKIM::DNS::orig_query = *Mail::DKIM::DNS::query;
*Mail::DKIM::DNS::query = *Mail::DKIM::DNS::fake_query;
}
}
package FakeDNS::Record;
sub type
{
return "TXT";
}
sub char_str_list
{
return ${$_[0]};
}