File Coverage

blib/lib/Net/DNS/SEC/DSA.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	6	6	100.0
condition			n/a
subroutine	12	12	100.0
pod	2	2	100.0
total	74	74	100.0

package Net::DNS::SEC::DSA;

use strict;
use warnings;

our $VERSION = (qw$Id: DSA.pm 1863 2022-03-14 14:59:21Z willem $)[2];


=head1 NAME

Net::DNS::SEC::DSA - DNSSEC DSA digital signature algorithm


=head1 SYNOPSIS

    require Net::DNS::SEC::DSA;

    $signature = Net::DNS::SEC::DSA->sign( $sigdata, $private );

    $validated = Net::DNS::SEC::DSA->verify( $sigdata, $keyrr, $sigbin );


=head1 DESCRIPTION

Implementation of DSA digital signature
generation and verification procedures.

=head2 sign

    $signature = Net::DNS::SEC::DSA->sign( $sigdata, $private );

Generates the wire-format signature from the sigdata octet string
and the appropriate private key object.

=head2 verify

    $validated = Net::DNS::SEC::DSA->verify( $sigdata, $keyrr, $sigbin );

Verifies the signature over the sigdata octet string using the specified
public key resource record.

=cut

use integer;
use MIME::Base64;

use constant Digest_SHA1    => Net::DNS::SEC::libcrypto->can('EVP_sha1');
use constant DSA_configured => Digest_SHA1 && Net::DNS::SEC::libcrypto->can('EVP_PKEY_new_DSA');

BEGIN { die 'DSA disabled or application has no "use Net::DNS::SEC"' unless DSA_configured }


my %parameters = (
	3 => scalar eval { Net::DNS::SEC::libcrypto::EVP_sha1() },
	6 => scalar eval { Net::DNS::SEC::libcrypto::EVP_sha1() },
	);

sub _index { return keys %parameters }


sub sign {
	my ( $class, $sigdata, $private ) = @_;

	my $evpmd = $parameters{$private->algorithm};
	die 'private key not DSA' unless $evpmd;

	my ( $p, $q, $g, $x, $y ) =
			map { decode_base64( $private->$_ ) } qw(prime subprime base private_value public_value);
	my $t = ( length($g) - 64 ) / 8;

	my $evpkey = Net::DNS::SEC::libcrypto::EVP_PKEY_new_DSA( $p, $q, $g, $y, $x );

	my $asn1 = Net::DNS::SEC::libcrypto::EVP_sign( $sigdata, $evpkey, $evpmd );
	return _ASN1decode( $asn1, $t );
}


sub verify {
	my ( $class, $sigdata, $keyrr, $sigbin ) = @_;

	my $evpmd = $parameters{$keyrr->algorithm};
	die 'public key not DSA' unless $evpmd;

	return unless $sigbin;

	my $key = $keyrr->keybin;				# public key
	my $len = 64 + 8 * unpack( 'C', $key );			# RFC2536, section 2
	my ( $q, $p, $g, $y ) = unpack "x a20 a$len a$len a$len", $key;

	my $evpkey = Net::DNS::SEC::libcrypto::EVP_PKEY_new_DSA( $p, $q, $g, $y, '' );

	my $asn1 = _ASN1encode($sigbin);
	return Net::DNS::SEC::libcrypto::EVP_verify( $sigdata, $asn1, $evpkey, $evpmd );
}


########################################

sub _ASN1encode {
	my @part = unpack 'x a20 a20', shift;			# discard "t"
	my $length;
	foreach (@part) {
		s/^[\000]+//;
		s/^$/\000/;
		s/^(?=[\200-\377])/\000/;
		$_ = pack 'C2 a*', 2, length, $_;
		$length += length;
	}
	return pack 'C2 a* a*', 0x30, $length, @part;
}

sub _ASN1decode {
	my ( $asn1, $t ) = @_;
	my $n	 = unpack 'x3 C',	   $asn1;
	my $m	 = unpack "x5 x$n C",	   $asn1;
	my @part = unpack "x4 a$n x2 a$m", $asn1;
	return pack 'C a* a*', $t, map { substr( pack( 'x20 a*', $_ ), -20 ) } @part;
}


1;

__END__