package Net::DNS::SEC::ECCGOST;

#
# $Id: ECCGOST.pm 1306 2015-01-29 09:13:36Z willem $
#
use vars qw($VERSION);
$VERSION = (qw$LastChangedRevision: 1306 $)[1];


=head1 NAME

Net::DNS::SEC::ECCGOST - DNSSEC ECC-GOST digital signature algorithm


=head1 SYNOPSIS

    require Net::DNS::SEC::ECCGOST;

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

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


=head1 DESCRIPTION

Implementation of GOST R 34.10-2001 elliptic curve digital signature
generation and verification procedures.

=head2 sign

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

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

=head2 verify

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

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

=cut


use strict;
use integer;
use warnings;
use Carp;
use Crypt::OpenSSL::Bignum;
use Crypt::OpenSSL::EC;
use Crypt::OpenSSL::ECDSA;
use Digest::GOST;
use Digest::GOST::CryptoPro;
use MIME::Base64;


my %ECcurve;
my %GOST = ( 12 => ['Digest::GOST::CryptoPro'] );


sub ECcurve {
	my ( $class, $algorithm ) = @_;
	my $group = $ECcurve{$algorithm}->dup();		# precalculated curve
}


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

	my $algorithm = $private->algorithm;
	my $group     = $ECcurve{$algorithm}->dup();		# precalculated curve

	my $ctx = Crypt::OpenSSL::Bignum::CTX->new();
	my $key = decode_base64( $private->PrivateKey );
	my $d	= Crypt::OpenSSL::Bignum->new_from_bin($key);
	my $P	= $group->get0_generator();

	my ( $object, @param ) = @{$GOST{$algorithm}};		# step 1  (nomenclature per RFC5832)
	croak 'private key not GOST' unless $object;
	my $hash = $object->new(@param);
	$hash->add($sigdata);
	my $H = reverse $hash->digest;

	my $q = Crypt::OpenSSL::Bignum->zero;			# step 2
	$group->get_order( $q, $ctx );
	my $alpha = Crypt::OpenSSL::Bignum->new_from_bin($H);
	my $e = $alpha->mod( $q, $ctx );       # Note: alpha can exceed but is never longer than q
	$e = Crypt::OpenSSL::Bignum->one if $e->is_zero;

	my $zeta;
	{							# step 3
		$hash->add($key);
		$hash->add( time() ^ ( $$ + ( $$ << 15 ) ) );
		$hash->add( $hash->digest );
		my $m = Crypt::OpenSSL::Bignum->new_from_bin( $hash->digest );
		my $k = $m->mod( $q, $ctx );
		redo if $k->is_zero;

		my $x = Crypt::OpenSSL::Bignum->zero;		# step 4
		my $y = Crypt::OpenSSL::Bignum->zero;
		my $C = Crypt::OpenSSL::EC::EC_POINT::new($group);
		Crypt::OpenSSL::EC::EC_POINT::mul( $group, $C, $q, $P, $k, $ctx );
		Crypt::OpenSSL::EC::EC_POINT::get_affine_coordinates_GFp( $group, $C, $x, $y, $ctx );
		my $r = $x->mod( $q, $ctx );
		redo if $r->is_zero;

		my $v = $r->mul( $d, $ctx );			# step 5
		my $w = $k->mul( $e, $ctx );
		my $s = $v->add($w)->mod( $q, $ctx );
		redo if $s->is_zero;

		my $size = length $H;				# step 6
		$zeta = pack "a$size a$size", reverse( $s->to_bin ), reverse( $r->to_bin );
	}

	return $zeta;
}


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

	# Implementation (ab)using Crypt::OpenSSL::ECDSA

	my $algorithm = $keyrr->algorithm;
	my $group     = $ECcurve{$algorithm}->dup();		# precalculated curve

	my $zeta = $sigbin;					# step 1  (nomenclature per RFC5832)
	my $size = length($zeta) >> 1;
	my ( $s, $r ) = unpack( "a$size a*", $zeta );

	my ( $object, @param ) = @{$GOST{$algorithm}};		# step 2
	croak 'public key not GOST' unless $object;
	my $hash = $object->new(@param);
	$hash->add($sigdata);
	my $H = reverse $hash->digest;

	my $ctx = Crypt::OpenSSL::Bignum::CTX->new();		# step 3
	my $q	= Crypt::OpenSSL::Bignum->zero;
	$group->get_order( $q, $ctx );
	my $alpha = Crypt::OpenSSL::Bignum->new_from_bin($H);
	my $e = $alpha->mod( $q, $ctx );       # Note: alpha can exceed but is never longer than q
	$e = Crypt::OpenSSL::Bignum->one if $e->is_zero;

	my $keybin = reverse $keyrr->keybin;			# public key
	my $keylen = length($keybin) >> 1;
	my ( $y, $x ) = map Crypt::OpenSSL::Bignum->new_from_bin($_), unpack "a$keylen a*", $keybin;
	my $Q = Crypt::OpenSSL::EC::EC_POINT::new($group);
	Crypt::OpenSSL::EC::EC_POINT::set_affine_coordinates_GFp( $group, $Q, $x, $y, $ctx );

	my $eckey = Crypt::OpenSSL::EC::EC_KEY::new();
	$eckey->set_group($group)  || die;
	$eckey->set_public_key($Q) || die;

	# algebraic transformation of ECC-GOST into equivalent ECDSA problem
	my $dsasig = Crypt::OpenSSL::ECDSA::ECDSA_SIG->new();
	$dsasig->set_r($r);
	$dsasig->set_s( $q->sub($e)->to_bin );

	my $m = $q->sub( Crypt::OpenSSL::Bignum->new_from_bin($s) )->mod( $q, $ctx );
	Crypt::OpenSSL::ECDSA::ECDSA_do_verify( $m->to_bin, $dsasig, $eckey );
}


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

BEGIN {
	my %GOST_R_34_10_2001_CryptoPro_A = (			# RFC4357
		a => 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFD94',    # -3 mod p
		b => '00A6',					# 166
		p => 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFD97',
		q => 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF6C611070995AD10045841B09B761B893',
		x => '01',
		y => '8D91E471E0989CDA27DF505A453F2B7635294F2DDF23E3B122ACC99C9E9F1E14'
		);


	my $_curve = sub {
		my %param = @_;

		my $p = Crypt::OpenSSL::Bignum->new_from_hex( $param{p} );
		my $a = Crypt::OpenSSL::Bignum->new_from_hex( $param{a} );
		my $b = Crypt::OpenSSL::Bignum->new_from_hex( $param{b} );
		my $x = Crypt::OpenSSL::Bignum->new_from_hex( $param{x} );
		my $y = Crypt::OpenSSL::Bignum->new_from_hex( $param{y} );
		my $n = Crypt::OpenSSL::Bignum->new_from_hex( $param{q} );
		my $h = Crypt::OpenSSL::Bignum->one;

		my $ctx	   = Crypt::OpenSSL::Bignum::CTX->new();
		my $method = Crypt::OpenSSL::EC::EC_GFp_mont_method();
		my $group  = Crypt::OpenSSL::EC::EC_GROUP::new($method);
		$group->set_curve_GFp( $p, $a, $b, $ctx );	# y^2 = x^3 + a*x + b  mod p

		my $G = Crypt::OpenSSL::EC::EC_POINT::new($group);
		Crypt::OpenSSL::EC::EC_POINT::set_affine_coordinates_GFp( $group, $G, $x, $y, $ctx );
		$group->set_generator( $G, $n, $h );
		die 'bad curve' unless Crypt::OpenSSL::EC::EC_GROUP::check( $group, $ctx );
		return $group;
	};

	$ECcurve{12} = &$_curve(%GOST_R_34_10_2001_CryptoPro_A);
}


1;

__END__

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

=head1 ACKNOWLEDGMENT

Mike McCauley created the Crypt::OpenSSL::ECDSA perl extension module
specifically for this development.


=head1 COPYRIGHT

Copyright (c)2014 Dick Franks.

All rights reserved.

This program is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.


=head1 SEE ALSO

L<Net::DNS>, L<Net::DNS::SEC>,
L<Crypt::OpenSSL::EC>, L<Crypt::OpenSSL::ECDSA>,
L<Digest::GOST>,
RFC4357, RFC5832, RFC5933

=cut

