view release on metacpan or  search on metacpan

lib/Mail/DKIM/Iterator.pm  view on Meta::CPAN

	push @nh,($_) x $oh{$_} for keys %oh;
	$sig->{h} = join(':',@nh);
    }
    $sig = parse_signature($sig,$error,1) or return;


    my %sig = %$sig;
    $sig{t} = time() if !$sig{t} && exists $sig{t};
    $sig{x} = ($sig{t} || time()) + $1
	if $sig{x} && $sig{x} =~m{^\+(\d+)$};
    $sig{'a:key'} eq 'rsa' or do {
	$$error = "unsupported algorithm ".$sig{'a:key'};
	return;
    };
    delete $sig{b};
    $sig{i} = _encodeQP($sig{':i'}) if $sig{':i'};
    $sig{z} = _encodeQP($sig{':z'}) if $sig{':z'};
    $sig{bh} = _encode64($sig{'bh:computed'} || $sig{'bh:bin'});
    $sig{h} = join(':',@{$sig{'h:list'}});

    my @v;
    for (qw(v a c d q s t x h l i z bh)) {
	my $v = delete $sig{$_} // next;
	push @v, "$_=$v"
    }
    for(sort keys %sig) {
	m{:} and next;
	my $v = _encodeQP(delete $sig{$_} // next);
	push @v, "$_=$v"
    }

    my @lines = shift(@v);
    for(@v,"b=") {
	$lines[-1] .= ';';
	my $append = " $_";
	my $x80 = (@lines == 1 ? 64 : 80) - length($lines[-1]);
	if (length($append)<=$x80) {
	    $lines[-1] .= $append;
	} elsif (length($append)<=80) {
	    push @lines,$append;
	} else {
	    while (1) {
		if ( $x80>10) {
		    $lines[-1] .= substr($append,0,$x80,'');
		    $append eq '' and last;
		}
		push @lines,' ';
		$x80 = 80;
	    }
	}
    }

    my $dkh = 'DKIM-Signature: '.join("\r\n",@lines);
    $sig->{'a:key'} eq 'rsa' or do {
	$$error = "unsupported signature algorithm $sig->{'a:key'}";
	return;
    };
    my $hash = _compute_hdrhash($hdr,
	$sig{'h:list'},$sig->{'a:hash'},$sig->{'c:hdr'},$dkh);

    my $priv = ref($key) ? $key : Crypt::OpenSSL::RSA->new_private_key($key);
    $priv or do {
	$$error = "using private key failed";
	return;
    };
    $priv->use_no_padding;

    my $data = _encode64($priv->decrypt(
	_emsa_pkcs1_v15($sig->{'a:hash'},$hash,$priv->size)));

    my $x80 = 80 - ($dkh =~m{\n([^\n]+)\z} && length($1));
    while ($data ne '') {
	$dkh .= substr($data,0,$x80,'') if $x80>10;
	$dkh .= "\r\n " if $data ne '';
	$x80 = 80;
    }
    $dkh .= "\r\n";
    return $dkh;
}

# Verify a DKIM signature (hash from parse_signature) using a DKIM key (hash
# from parse_dkimkey). Output is (error_code,error_string) or simply
# (DKIM_PASS) in case of no error or () if no final result can be computed yet.
sub _verify_sig {
    my ($sig,$param) = @_;

    # check pre-computed hash over body if body done
    if (defined $sig->{'bh:computed'}
	and $sig->{'bh:computed'} ne $sig->{'bh:bin'}) {
	return (DKIM_FAIL, 'body hash mismatch');
    }
    return if ! $param;

    return (DKIM_PERMERROR,"none or invalid dkim record") if ! %$param;
    return (DKIM_TEMPERROR,$param->{tempfail}) if $param->{tempfail};
    return (DKIM_PERMERROR,$param->{permfail}) if $param->{permfail};

    my $FAIL = $param->{t}{y} ? DKIM_NEUTRAL : DKIM_FAIL;
    return ($FAIL,"key revoked") if ! $param->{p};

    return ($FAIL,"hash algorithm not allowed")
	if ! $param->{h}{$sig->{'a:hash'}};

    return ($FAIL,"identity does not match domain") if $param->{t}{s}
	&& $sig->{'i:domain'} && $sig->{'i:domain'} ne $sig->{d};

    return ($FAIL,"identity does not match granularity")
	if $param->{g} && $sig->{i} !~ $param->{g};

    # needs bh:computed to continue
    return if ! defined $sig->{'bh:computed'};

    if (!eval {
	my $rsa = Crypt::OpenSSL::RSA->new_public_key(do {
	    local $_ = $param->{p};
	    s{\s+}{}g;
	    s{(.{1,64})}{$1\n}g;
	    "-----BEGIN PUBLIC KEY-----\n$_-----END PUBLIC KEY-----\n";
	}) or die [DKIM_PERMERROR,"using public key failed"];
	$rsa->use_no_padding;
	my $bencrypt = eval { $rsa->encrypt($sig->{'b:bin'}) }