dkim_verify.pl

#!/usr/bin/perl
use strict;
use Data::Dumper;
use Email::Simple;
use Term::ANSIColor qw(:constants);
use MIME::Base64;
use Digest::SHA1  qw(sha1 sha1_hex sha1_base64);
use Digest::SHA qw(sha256_hex sha256);
use Socket qw(:crlf);
use Getopt::Long;

#
# Generate a private key if you want to sign, and not just verify
#
# openssl genrsa -out ${selector}.private $bits
#
# Generate a public key
#
# openssl rsa -in ${selector}.private -pubout -out ${selector}.public -outform PEM

# 3.4.4.  The "relaxed" Body Canonicalization Algorithm
# 
#    The "relaxed" body canonicalization algorithm:
# 
#    o  Ignores all whitespace at the end of lines.  Implementations MUST
#       NOT remove the CRLF at the end of the line.
# 
#    o  Reduces all sequences of WSP within a line to a single SP
#       character.
# 
#    o  Ignores all empty lines at the end of the message body.  "Empty
#       line" is defined in Section 3.4.3.
# 
#       INFORMATIVE NOTE: It should be noted that the relaxed body
#       canonicalization algorithm may enable certain types of extremely
#       crude "ASCII Art" attacks where a message may be conveyed by
#       adjusting the spacing between words.  If this is a concern, the
#       "simple" body canonicalization algorithm should be used instead.
sub relax_body( $ ){
	my ($body) = @_;

	# Get rid of all \r
	$body =~ s/[\r]//g;

	my @lines = split ( /\n/, $body );

	my @relaxed;
	my @relaxed2;
	# Go in reverse order, to remove empty lines at the end
	# of the message
	for my $line ( reverse @lines ){
		$line =~ s/[\r\n]//g;

		# Get rid of trailing whitespace
		$line =~ s/(.*\S)\s+$/$1/;

		# reduce all sequence of WSP within a line to a single SP
		$line =~ s/[\s]+/ /g;

		push( @relaxed, $line );
	}

	# We need to get rid of the empty lines at the end
	# of the message
	my $x = 0;
	LINE: for( @relaxed ){
		print BOLD, BLUE, "relaxed line:[", RESET,
		      BOLD, YELLOW, $_, RESET,
		      BOLD, BLUE, "]\n";
		if( /^\s*$/ ){
			next LINE unless $x > 0;
		}
		$x = 1;
		push( @relaxed2, $_ );
	}

	return( join( $CRLF, reverse @relaxed2 ) );
}

# rfc4871, Section 3.7
#
# The signer/verifier MUST compute two hashes, one over the body of the
# message and one over the selected header fields of the message.
# 
# Signers MUST compute them in the order shown.  Verifiers MAY compute
# them in any order convenient to the verifier, provided that the
# result is semantically identical to the semantics that would be the
# case had they been computed in this order.
# 
# In hash step 1, the signer/verifier MUST hash the message body,
# canonicalized using the body canonicalization algorithm specified in
# the "c=" tag and then truncated to the length specified in the "l="
# tag.  That hash value is then converted to base64 form and inserted
# into (signers) or compared to (verifiers) the "bh=" tag of the DKIM-
# Signature header field.
# 
# In hash step 2, the signer/verifier MUST pass the following to the
# hash algorithm in the indicated order.
# 
# 1.  The header fields specified by the "h=" tag, in the order
#     specified in that tag, and canonicalized using the header
#     canonicalization algorithm specified in the "c=" tag.  Each
#     header field MUST be terminated with a single CRLF.
# 
# 2.  The DKIM-Signature header field that exists (verifying) or will
#     be inserted (signing) in the message, with the value of the "b="
#     tag deleted (i.e., treated as the empty string), canonicalized
#     using the header canonicalization algorithm specified in the "c="
#     tag, and without a trailing CRLF.
# 
# All tags and their values in the DKIM-Signature header field are
# included in the cryptographic hash with the sole exception of the
# value portion of the "b=" (signature) tag, which MUST be treated as
# the null string.  All tags MUST be included even if they might not be
# understood by the verifier.  The header field MUST be presented to
# the hash algorithm after the body of the message rather than with the
# rest of the header fields and MUST be canonicalized as specified in
# the "c=" (canonicalization) tag.  The DKIM-Signature header field
# MUST NOT be included in its own h= tag, although other DKIM-Signature
# header fields MAY be signed (see Section 4).
# 
# When calculating the hash on messages that will be transmitted using
# base64 or quoted-printable encoding, signers MUST compute the hash
# after the encoding.  Likewise, the verifier MUST incorporate the
# values into the hash before decoding the base64 or quoted-printable
# text.  However, the hash MUST be computed before transport level
# encodings such as SMTP "dot-stuffing" (the modification of lines
# beginning with a "." to avoid confusion with the SMTP end-of-message
# marker, as specified in [RFC2821]).
sub body_hash( $$ ){
	my ($body,$algo) = @_;

	my $relaxed_body = relax_body( $body ) . $CRLF;

	open FD, ">/tmp/foo.body.relaxed"
		or die("Cannot write to /tmp/foo.body.relaxed\n" );
	print FD $relaxed_body;
	close FD;

	# ignore the l= for now
	if( $algo eq 'sha256' ){
		my $encoded = encode_base64(sha256( $relaxed_body ));
		$encoded =~ s/[\r\n]//g;
		return $encoded;
	} elsif ( $algo eq 'sha1' ){
		my $encoded = encode_base64(sha1( $relaxed_body ));
		$encoded =~ s/[\r\n]//g;
		return $encoded;
	} else {
		die( "Unsuported digest algorithm: $algo\n" );
	}
}

# Relax the header per RFC4871 3.4.2 Canonicalization algorithm
sub relaxheader( $$ ){
	my ($headername,$headerval) = @_;
	
	# Convert all header field names to lowercase
	$headername = lc $headername;
	
	# unfold all header field continuation lines
	$headerval =~ s/[\r\n]/ /g;

	# convert all sequences of one or more WSP characters to a sing SP character
	$headerval =~ s/(\s+)/ /g;

	# Delete all WSP characters at the end of each unfolded header field value.
	if( $headerval =~ /^(.*\S)\s*/ ){
		$headerval = $1;
	}

	return ( join( ":", ( $headername,$headerval )) );
}

sub pause(){
	print BOLD,BLUE,"Press ENTER to continue..\n",RESET;
	getc STDIN;
	return;
}

###
### MAIN SECTION
###
my $step2working = 0;
my %quitafter;
my $qa;
my $verbose = '';
my $pausestep = 0;
GetOptions (
	'verbose+' => \$verbose,
	"quitafter=s" => \$qa,
	"pause" => \$pausestep,
);

###
### Read in the email
###
print BOLD, BLUE, "Loading email..\n", RESET;

my $emailtext = do { local $/; <>; }
	or do {
		print BOLD,RED, $!,"\n",RESET;
		exit(1);
	};

my $email = Email::Simple->new($emailtext)
	or do {
		print BOLD,RED,"Could not parse email message\n",RESET;
		exit(1);
	};

# Now we have an email, we need to get the DKIM-Signature: header,
# and get some of the info within it.

print BOLD, BLUE, "Extracting DKIM-Signature header..\n", RESET;
my $dkim_header = $email->header("DKIM-Signature")
	or die("Email does not contain DKIM-Signature header\n");

print BOLD, YELLOW, "DKIM-Signature: [$dkim_header]\n", RESET;

pause() if $pausestep;

# Split it up by semicolon

my @a_fields = split /;\s?/, $dkim_header;
my %fields;

for( @a_fields ){
	if( /([a-z]+)=(.*)/ ){
		$fields{$1} = $2;
	}
}

# Let's show what that datastructure looks like
print BOLD, BLUE, "DKIM Header Fields: ", RESET;
print BOLD, YELLOW, Dumper( \%fields ),"\n", RESET;

pause()	if $pausestep;

# Great, now we need to see what kind of massaging the headers
# have taken.  We only to "relaxed" in this script.

if( $fields{c} ne 'relaxed/relaxed' ){
	print BOLD, RED, "Cannot parse non 'relaxed/relaxed' canonicalization..\n", RESET;
	exit(1);
}

# STEP 1: Body relaxation and checksum!
print BOLD,BLUE,"We must now relax the body, and compute the body hash..\n",RESET;
print BOLD,BLUE,"We will print the relaxed body in reverse order, since per spec, we must leave out any trailing blank lines.\n",RESET;

my $algorithm = $1 if( $fields{a} =~ /rsa-(\S+)/ );
my $body_checksum = body_hash( $email->body, $algorithm );
print BOLD, BLUE, "Body hash: [", RESET,
      BOLD, YELLOW, $body_checksum, RESET,
      BOLD, BLUE, "]\n", RESET;

pause() if $pausestep;

print BOLD,BLUE,"We have computed the bodyhash, and must check it against the hash value in the DKIM signature..\n",RESET;

unless( $body_checksum eq $fields{bh} ){
	print BOLD, YELLOW, "b=$fields{bh}\n", RESET;
	print BOLD, RED, "Checksums do not match!\n", RESET;
	exit(-1);
}

if( $body_checksum eq $fields{bh} ){
	print BOLD, GREEN, "Body hash matches header, continue to step 2\n", RESET;
}

exit(0)
	if $qa eq 'bodyhash';

pause() if $pausestep;

###############################################################################
# Step 2, relax the headers
###############################################################################

unless ( $step2working ) {
	print BOLD,RED,"Header relaxation, and signature verification steps not complete. Exiting now.\n",RESET;
	exit(-1);
}

my @headers = split /:/, $fields{h};
for( @headers ){
	s/[\s]//g;
}

my $hashheaders = '';
my $a_hh = [];

for my $header ( @headers ){
	my $headertext = $email->header( $header );
	my $relaxed = relaxheader( $header, $headertext );
	$hashheaders .= $relaxed;

	print BOLD, BLUE, "Relaxed: [";
	print BOLD, YELLOW, $relaxed, RESET;
	print BOLD, BLUE, "]\n";

	push( @$a_hh, $relaxed );
}

print BOLD, BLUE, "Headers post relaxation: [", RESET;
print BOLD, YELLOW, join( "\n", @$a_hh ) , RESET;
print BOLD, BLUE, "]\n", RESET;

$hashheaders = join( "\r\n", @$a_hh ) . "\r\n";

# Create a digest of this
open FD, ">/tmp/foo"
	or die("Cannot open /tmp/foo to write headers into: $!\n" );
print FD "$hashheaders";
close( FD );

print BOLD, BLUE, "Creating digest: [";
print BOLD, YELLOW, "openssl dgst -sha1 < /tmp/foo";
print BOLD, BLUE, "]\n", RESET;
my $headerhash = `openssl dgst -sha1 < /tmp/foo`;

$headerhash =~ s/[\r\n]//g;
print BOLD, BLUE, "Hash: [", RESET, BOLD, YELLOW, $headerhash, RESET, BOLD, BLUE"]\n", RESET;

##
## VERIFY the signature
##

# Get the public key from dns
my ($selector, $domain) = ( $fields{s}, $fields{d} );

print BOLD, BLUE, "Getting public key from dns: ", RESET,
      BOLD, YELLOW, "dig $selector._domainkey.$domain txt +short\n", RESET;
my $publickey = `dig $selector._domainkey.$domain txt +short`;
$publickey =~ s/[\r\n]//g;

#print "Public key for $selector._domainkey.$domain: [$publickey]\n";
$publickey = $1 if ( $publickey =~ /p=(\S+?)\"/ );

print BOLD, BLUE, "Public key for $selector._domainkey.$domain: [", RESET,
      BOLD, YELLOW, $publickey, RESET,
      BOLD, BLUE, "]\n", RESET;

# Write the public key
print BOLD, BLUE, "Opening up /tmp/foo.pem to store public key, splitting on 64 characters\n", RESET;
open FD, ">/tmp/foo.pem"
	or die("Cannot write to /tmp/foo.pem: $!\n" );

print FD "-----BEGIN PUBLIC KEY-----\n";
my @pemlines = split(/(.{64})/, $publickey);
for( @pemlines ){
	next if $_ eq '';
	s/[\r\n]//g;
	print "Writing [$_]\n";
	print FD "$_\n";
}
print FD "-----END PUBLIC KEY-----\n";
close (FD);

# Write the signature
print BOLD, BLUE, "Creating ", RESET,
      BOLD, YELLOW, "/tmp/foo.sig\n", RESET;
open FD, ">/tmp/foo.sig"
	or die("Cannot write to /tmp/foo.sig: $!\n" );
my $b64 = $fields{b};
$b64 =~ s/[\s]//g;
my $decoded = decode_base64($b64);
print FD $decoded;
close (FD);

#print "openssl rsautl -verify -inkey /tmp/foo.pem -keyform PEM -pubin -in /tmp/foo.sig\n";
#`openssl rsautl -verify -inkey /tmp/foo.pem -keyform PEM -pubin -in /tmp/foo.sig`;

# Get the b=, and base64 decode it.  This is the signature.
my $sig = decode_base64( $fields{b} );

open FD, ">/tmp/foo.sig.sha1";
print FD $sig;
close FD;

`openssl dgst -sha1 -verify /tmp/foo.pem -signature foo.sig.sha1 /tmp/foo 2>&1`;

#unlink( "/tmp/foo" )
#	or die("Cannot unlink /tmp/foo: $!\n" );