File Coverage

blib/lib/Mail/Simple/DKIM/Signer.pm

Criterion	Covered	Total	%
statement	15	79	18.9
branch	0	12	0.0
condition	0	14	0.0
subroutine	5	10	50.0
pod	0	5	0.0
total	20	120	16.6

package Mail::Simple::DKIM::Signer;

use strict;
use warnings;
use Digest::SHA qw/sha1/;
use MIME::Base64;
use Crypt::OpenSSL::RSA;
our $VERSION = '0.01';


sub new {

    my $class = shift;
    my $options = shift;
    my $self = {};

    my $private_key = $options->{key};
    $self->{headers} = $options->{headers};

    my $rsa_priv = new_private_key Crypt::OpenSSL::RSA($private_key);

    $self->{rsa} = $rsa_priv;

    $self->{BodyCanonicalization} = 'simplebody';
    $self->{HeadersCanonicalization} = 'simpleheader';


    $self->{d} = $options->{domain};

    $self->{s} = $options->{selector} || 'dkim';

    $self->{c} = $options->{c} || 'simple/simple';

    $self->{l} = $options->{l} || '0';

    ###get each methods
    my @methods = split(/\//, $self->{c});

    $self->{HeadersC} = $methods[0] || 'simple';
    $self->{BodyC} = $methods[1] || 'simple';

    $self->{a} = $options->{a} || 'rsa-sha1';
    $self->{q} = $options->{q} || 'dns/txt';

    $self->{i} = $options->{i};

    return bless($self, $class);
}



sub sign {

    my ($self,$headers,$body) =@_;

    ####convert body with simple Canonicalization
    #$body = $self->SimpleBodyCanonicalization($body);

    $body = $self->SimpleBodyCanonicalization($body);

    ##get body length
    my $body_length = length($body);

    ####generate body ahsh key (bh)
    my $bh = pack("H*", $body);
    $bh = encode_base64(sha1($body));

    ###remove unwanted spaces from body hash
    $bh =~ tr/\015\012 \t//d  if defined $bh;


    ####start genrating signature of headers

    ##first run Canonicalization
    $headers = SimpleHeaderCanonicalization($headers);

    ##add headers to array
    my @headers = split(/\r\n/, $headers);
    my @str;
    my @headers_to_be_signed;

    ##loop throug headers
    foreach my $header (@headers){

        ###remove embty leading and ending lines
        $header = $self->trim($header);

        ##exlude headers with x- and dkim- part
        push @headers_to_be_signed,$header if $header !~/^X-|^Dkim-/i;
        #push @to_be_signed,$header;

        ##get name part of headers
        $header =~ m/(.*?): (.*?)/;
        push @str,$1 if $1 !~/^X-|^Dkim-/i;

    }

    ###join header values we want to sign this will go to the h= tag
    my $str = join(":",@str);

    ##getting i= tag
    my $i_part = '';
    my $l_part = '';

    if ($self->{i}){
        $i_part = " i=".$self->{i}.";";
    }

    if ($self->{l}){
        $l_part = " l=$body_length;";
    }

    ###create dkim string
    my $dkim="v=1; a=$self->{a}; q=$self->{q};$l_part s=$self->{s};\r\n".
    "\tc=$self->{c};\r\n".
    "\th=$str;\r\n".
    "\td=$self->{d};$i_part\r\n".
    "\tbh=$bh;\r\n".
    "\tb=";


    ##push dkim string to the headers_to_be_signed array
    push (@headers_to_be_signed,"DKIM-Signature: ".$dkim);

    ##get headers to be signed as string
    my $headers_to_be_signed = join("\r\n",@headers_to_be_signed);


    ##generate signature
    my $signature = $self->{rsa}->sign($headers_to_be_signed);


    ##encode segnature
    my $b = encode_base64($signature);

    ##remove unwanted new lines
    $b =~ tr/\015\012 \t//d  if defined $b;

    ###add signature to the dkim string
    $dkim = $dkim.$b;

    #return $dkim;
    return {
        string => "DKIM-Signature: ".$dkim,
        value => $dkim,
        key => "DKIM-Signature"
    };


}




sub SimpleBodyCanonicalization {

    my ($self,$body) = @_;

    ##convert \r\n to \n just in case if this came from windows
    $body =~s /\r\n/\n/g;

    $body =~s /\n/\r\n/g;

    #$body = length($body);
    my $bodylength = length($body);

    ###remove embty lines from the end of the message body

    while (substr($body,$bodylength-4,4) =~ m/\r\n\r\n/){
        $body = substr($body,0,length($body)-2);
    }

    return $body;

}



sub SimpleHeaderCanonicalization {

    my $header =shift;

    ##convert \r\n to \n just in case if this came from windows
    $header =~s /\r\n/\n/g;
    $header =~s /\n/\r\n/g;

    ###nothing else to do with headers as this is what simple header Canonicalization
    ##documents say

    return $header;

}



sub trim($) {

    my ($self,$string) = @_;

    $string =~ s/^\s+//;
    $string =~ s/\s+$//;

    return $string;
}



1;
__END__