Net::DNS::RR::RRSIG - DNS RRSIG resource record

    my $keypath= 
            "/home/olaf/keys/Kbla.foo.+001+60114.private";
    my $sigrr= create Net::DNS::RR::RRSIG(\@datarrset,
					$keypath);
    my $sigrr= create Net::DNS::RR::RRSIG(\@datarrset,
					$keypath,
					%arguments);
    $sigrr->print;







    #Alternatively use Net::DNS::SEC::Private 

    my $private=Net::DNS::SEC::Private-new(
	"/home/olaf/keys/Kbla.foo.+001+60114.private");
    my $sigrr= create Net::DNS::RR::RRSIG(\@datarrset,
					  $private);

    ( ttl => 3600,                        # TTL 
      sigin =>   20010501010101,          # signature inception 
      sigex =>   20010501010101,          # signature expiration
      sigval => 1.5                       # signature validity
      )

    print "typecovered =", $rr->typecovered, "\n"

    print "algorithm =", $rr->algorithm, "\n"

    print "labels =", $rr->labels, "\n"

    print "orgttl =", $rr->orgttl, "\n"

    print "sigexpiration =", $rr->sigexpiration, "\n"

    print "siginception =", $rr->siginception, "\n"

    print "keytag =", $rr->keytag, "\n"

    print "signame =", $rr->signame, "\n"

    print "sig =", $rr->sig, "\n"

    $sigrr->verify($data, $keyrr) || croak $sigrr->vrfyerrstr;
    $sigrr->verify($data, [$keyrr, $keyrr2, $keyrr3]) || 
                  croak $sigrr->vrfyerrstr;

   my $sigrr=$packet->pop("additional");
   print $sigrr->vrfyerrstr unless $sigrr1->verify($update1, $keyrr1);

# perldoc RRSIG.pm for documentation.
# Specs: RFC 2535 section 4
# $Id: RRSIG.pm 814 2009-11-27 09:28:30Z olaf $

package Net::DNS::RR::RRSIG;

use vars qw(@ISA $VERSION @EXPORT );

use Net::DNS;
use Carp;
use bytes;
use Data::Dumper;

use Crypt::OpenSSL::DSA;
use Crypt::OpenSSL::RSA;
use Crypt::OpenSSL::Bignum;
use Net::DNS::SEC::Private;

use File::Basename;
use MIME::Base64;
use Math::BigInt;
use Time::Local;
use Digest::SHA qw (sha1 sha256 sha512);





#
# Most of the cryptovariables should be interpred as unsigned
#
#


require Exporter;

$VERSION = do { my @r=(q$Revision: 814 $=~/\d+/g); sprintf "%d."."%03d"x$#r,@r };
@ISA = qw (
	   Exporter
  	 Net::DNS::RR
  	 Net::DNS::SEC
	   );


@EXPORT = qw (          
	      );




use strict;
my $crypt_open_ssl=1;
my $debug=0;




sub new {
    my ($class, $self, $data, $offset) = @_;

    if ($self->{"rdlength"} > 0) {
	#RFC2535 section 4.1
	my $offsettoalg=$offset+2;
	my $offsettolabels=$offset+3;
	my $offsettoorgttl=$offset+4;
	my $offsettosigexp=$offset+8;
	my $offsettosiginc=$offset+12;
	my $offsettokeytag=$offset+16;
	my $offsettosignm=$offset+18;

	$self->{"typecovered"}= _type2string(unpack("n",substr($$data,$offset,2)));
	$self->{"algorithm"}=unpack("C",substr($$data,$offsettoalg,1));
	$self->{"labels"}=lc(unpack("C",substr($$data,$offsettolabels,1)));
	$self->{"orgttl"}=unpack("N",substr($$data,$offsettoorgttl,4));
	my @expt=gmtime(unpack("N",substr($$data,$offsettosigexp,4)));
	$self->{"sigexpiration"}= sprintf ("%d%02d%02d%02d%02d%02d",
					   $expt[5]+1900 ,$expt[4]+1 , 
					   $expt[3] ,$expt[2] , $expt[1]  , 
					   $expt[0]);
	my @inct=gmtime(unpack("N",substr($$data,$offsettosiginc,4)));
	$self->{"siginception"}=  sprintf ("%d%02d%02d%02d%02d%02d",
					     $inct[5]+1900 ,$inct[4]+1 , 
					     $inct[3] ,$inct[2] , $inct[1]  ,
					     $inct[0]);
	$self->{"keytag"}=unpack("n",substr($$data,$offsettokeytag,2));
	my($signame,$sigoffset) = Net::DNS::Packet::dn_expand
	    ($data, $offsettosignm);
	$self->{"signame"}=lc($signame); 
	my($sigmaterial)=substr($$data,$sigoffset,
				($self->{"rdlength"}-$sigoffset+$offset));
	$self->{"sigbin"}=$sigmaterial;
	$self->{"sig"}= encode_base64($sigmaterial);
	$self->{"vrfyerrstr"}="";
	
    }
    return bless $self, $class;
}




sub new_from_string {
    my ($class, $self, $string) = @_;
    if ($string) {
	$string =~ tr/()//d;
	$string =~ s/;.*$//mg;
	$string =~ s/\n//mg;
	my ($typecovered, $algoritm,
	    $labels, $orgttl, $sigexpiration,
	    $siginception, $keytag,$signame,$sig) = 
		$string =~ 
		    /^\s*(\S+)\s+(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\S+)\s+(.*)/;
	croak (" Invallid RRSIG RR, check your fomat ") if !$keytag;
	$sig =~ s/\s*//g;
	$self->{"typecovered"}= $typecovered;
	$self->{"algorithm"}= Net::DNS::SEC->algorithm($algoritm);
	$self->{"labels"}= lc($labels);
	$self->{"orgttl"}= $orgttl;
	_checktimeformat($sigexpiration);
	_checktimeformat($siginception);
	$self->{"sigexpiration"}=  $sigexpiration;
	$self->{"siginception"}= $siginception;
	$self->{"keytag"}= $keytag;
	$self->{"signame"}= lc(Net::DNS::stripdot($signame));
	$self->{"sig"}= $sig;
	$self->{"sigbin"}= decode_base64($sig);
	$self->{"vrfyerrstr"}="";
    }
    return bless $self, $class;
}


sub rdatastr {
	my $self = shift;
	my $rdatastr;
	if (exists $self->{"typecovered"}) {
	    $rdatastr  = $self->{typecovered};
	    $rdatastr .= "  "  . $self->algorithm;
	    $rdatastr .= "  "  . "$self->{labels}";
	    $rdatastr .= "  "  . "$self->{orgttl}";
	    $rdatastr .= "  "  . "$self->{sigexpiration}";
	    $rdatastr .= " (\n\t\t\t"  . "$self->{siginception}";
	    $rdatastr .= " "  . "$self->{keytag}";
	    $rdatastr .= "  "  . "$self->{signame}.";
	    # do some nice formatting
	    my $sigstring=$self->{sig};
	    $sigstring =~ s/\n//g;
	    $sigstring =~ s/(\S{45})/$1\n\t\t\t/g;
	    $rdatastr .=  "\n\t\t\t".$sigstring;
	    $rdatastr .= " )";
	    }
	else {
	    $rdatastr = "; no data";
	}

	return $rdatastr;
}


sub rr_rdata_without_sigbin {
    my ($self) = shift;
    my $rdata = "";

    if (exists $self->{"typecovered"}) {
	$rdata  = pack("n",_string2type($self->{typecovered}));
	$rdata .= pack("C",$self->algorithm);
	$rdata .= pack("C",$self->{"labels"});
	$rdata .= pack("N",$self->{"orgttl"});

	$self->{"sigexpiration"} =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;
	$rdata .= pack("N",timegm ($6, $5, $4, $3, $2-1, $1-1900));

	$self->{"siginception"} =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/;
	$rdata .= pack("N",timegm ($6, $5, $4, $3, $2-1, $1-1900));
	$rdata .= pack("n",$self->{"keytag"});
	# Since we will need canonical and expanded names while checking 
	# we do not use the packet->dn_comp here but use RFC1035 p10.
	{   my @dname= split /\./,lc($self->{"signame"}.".");  #/ emacs fontlock
	    for (my $i=0;$i<@dname;$i++){
		$rdata .= pack ("C",length $dname[$i] );
		$rdata .= $dname[$i] ;

	    }
	    $rdata .= pack ("C","0");
	}
    }
    return $rdata;

}


sub rr_rdata {
    my ($self, $packet, $offset) = @_;
    my $rdata = "";
    if (exists $self->{"typecovered"}) {
	$rdata=$self->rr_rdata_without_sigbin;
	
	if ($self->{"sig"} ne "NOTYETCALCULATED") {
            $self->{"sigbin"}= decode_base64($self->{"sig"}) unless defined $self->{"sigbin"} ;
	    $rdata .= $self->{"sigbin"};
	}else{
	    die "RRSIGs should not be used for SIG0 type signatures, use Net::DNS::RR::SIG";
	}
    }
    return $rdata;
}

sub create {
    my ($class,  $datarrset, $priv_key, %args) = @_;


    # This method returns a sigrr with the signature over the
    # datatrrset (an array of RRs) made with the private key stored in
    # the $key_file.

    my $self;
    $self->{"sigerrstr"}="---- Unknown Error Condition ------";
    my $Private;


    if (UNIVERSAL::isa($priv_key,"Net::DNS::SEC::Private")){
	$Private=$priv_key;
    }else{
	$Private=Net::DNS::SEC::Private->new($priv_key);
    }

    unless (UNIVERSAL::isa($Private,"Net::DNS::SEC::Private")){
	$self->{"sigerrstr"}= "Create did not manage to parse a private key into a Net::DNS::SEC::Private object ";
	return (0);
	    
    }
    $self->{"algorithm"}=Net::DNS::SEC->algorithm($Private->algorithm);
    $self->{"keytag"}=$Private->keytag;
    $self->{"signame"}=Net::DNS::stripdot($Private->signame);
   

    die "Argument is not a reference to an array, are you trying to create a SIG0 using RRSIG?" if ! ref ($datarrset);


    $self->{"rr_rdata_recursion"}=0;

    # Start with seting up the data in the packet we can get our hands on...


    $self->{"name"}=$datarrset->[0]->name;

    $self->{"type"}="RRSIG";
    $self->{"class"}="IN";


    if (defined ($args{ttl})){
	print "Setting TTL to ".  $args{"ttl"} . "\n" if $debug;
	$self->{"ttl"}= $args{"ttl"};
    }else{
	$self->{"ttl"}= $datarrset->[0]->ttl;
    }

    $self->{"typecovered"}=$datarrset->[0]->type;  #Sanity checks elsewhere



    if (defined ($args{response})){
	$self->{"response"}=$args{"response"};
    }

    if (defined($args{"sigin"})){
	_checktimeformat($args{"sigin"});
	print "\nSetting siginception to " . $args{"sigin"} if $debug;
	$self->{"siginception"} =$args{"sigin"};
    }else{
	my @inct=gmtime(time);
	my $currentdatestring=  sprintf ("%d%02d%02d%02d%02d%02d",
					 $inct[5]+1900 ,$inct[4]+1 , 
					 $inct[3] ,$inct[2] , $inct[1]  ,
					 $inct[0]);	
	$self->{"siginception"} = $currentdatestring ;
    }

    # This will fail if the dateformat is not correct...
    $self->{"siginception"} =~ 
	/(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/ ;
    my $siginc_time=timegm ($6, $5, $4, $3, $2-1, $1-1900);

    if (defined($args{"sigval"})){ #sigexpiration set by siginception + sigval
	my @inct;


	# treat sigval as days
	@inct=gmtime($siginc_time+$args{"sigval"}*24*3600 );  

	$self->{"sigexpiration"}= sprintf ("%d%02d%02d%02d%02d%02d",
					   $inct[5]+1900 ,$inct[4]+1 , 
					   $inct[3] ,$inct[2] , $inct[1]  ,
					   $inct[0]);	
    }elsif ($args{"sigex"}) { #sigexpiration set by the argument
	_checktimeformat($args{"sigex"});

	if ( $self->{"siginception"} > $args{"sigex"} ){
	    croak "Signature can only expire after it has been incepted (".
		$args{"sigex"} . "<" . $self->{"siginception"} .
		    ")";
	}
	print "\nSetting sigexpiration to " . $args{"sigex"} if $debug;
	$self->{"sigexpiration"}=$args{"sigex"} ;

    }else{ 
	my @inct;

	# Take the 30 days default for sigexpiration 	
	@inct=gmtime($siginc_time+30*24*3600 );  

	$self->{"sigexpiration"}= sprintf ("%d%02d%02d%02d%02d%02d",
					   $inct[5]+1900 ,$inct[4]+1 , 
					   $inct[3] ,$inct[2] , $inct[1]  ,
					   $inct[0]);	
    }


    my  $labels=$datarrset->[0]->name;
    $labels =~ s/\.$//;  # remove trailing dot.
    $labels =~ s/^\*\.//;  # remove initial asterisk label
    my @labels= split /\./ , $labels;    # / emacs font-lock-mode	
    $self->{"labels"}= scalar(@labels);


    # All the TTLs need to be the same in the data RRset.
    if ( @{$datarrset}>1 ){
	for (my $i=0; $i<@{$datarrset}; $i++){
	    if ($datarrset->[0]->{"ttl"} != $datarrset->[$i]->{"ttl"}){
		croak "\nNot all TTLs  in the data RRset are equal ";
	    }
	}
    }
    $self->{"orgttl"}=$datarrset->[0]->{"ttl"};

    $self->{"sig"}=  "NOTYETCALCULATED";  # This is what we'll do in a bit...
    $self->{"sigbin"}= decode_base64($self->{"sig"});

    # Bless the whole thing so we can get access to the methods...
    # (Don not ask me why I havent called the new method, There are
    # more ways to do things)

    bless $self, $class;
    
    my $sigdata=$self->_CreateSigData($datarrset);

    my $signature;
    
    #
    # Enjoy the crypto
    if ($self->algorithm == 1 
	|| $self->algorithm == 5
	|| $self->algorithm == 7
	|| $self->algorithm == 8
	|| $self->algorithm == 10) {  #RSA
	if (! ($Private->algorithm == 1 
	       || $Private->algorithm == 5 
	       || $Private->algorithm == 7 
	       || $Private->algorithm == 8 
	       || $Private->algorithm == 10  )) {
	    die "Private key mismatch, not RSAMD5 or RSASHA.";
	    
	}
#	my $rsa_priv = Crypt::OpenSSL::RSA->new_private_key($Private->privatekey);
	my $rsa_priv = $Private->privatekey;
	$self->{"private_key"}=$Private->privatekey;
	eval {
	    $rsa_priv->use_pkcs1_oaep_padding;
	    if ($self->algorithm == 1) {
		$rsa_priv->use_md5_hash;
	    } elsif ($self->algorithm == 8) {
    	$rsa_priv->use_sha256_hash;
	    } elsif ($self->algorithm == 10) {
    	$rsa_priv->use_sha512_hash;
	    } else {
		$rsa_priv->use_sha1_hash;
	    }

	};
	die "RSA private key loading failed:".$@ if $@;
	eval {
	    $signature = $rsa_priv->sign($sigdata);
	};
	die "RSA Signature generation failed ".$@ if $@;

	print "\n SIGNED" if $debug ;
	
    }elsif ($self->algorithm == 3 || $self->algorithm == 6  ){  #DSA
	$self->{"private_key"}=$Private->privatekey;
	my $private_dsa=$Private->privatekey;

	
      	if ($datarrset ne "" ){
	    if (my $sig_obj= $private_dsa->do_sign(sha1($sigdata)))
	    {
		
		print "\n SIGNED" if $debug ;
		# See RFC 2535 for the content of the SIG
		my $T_parameter= (length($private_dsa->get_g)-64)/8;
		$signature=pack("C",$T_parameter);

		my $sig_r_param=$sig_obj->get_r;
		my $sig_s_param=$sig_obj->get_s;
		# both the R and S paramater in the RDATA need to be
		# 20 octets:
		while (length($sig_r_param)<20){
		    $sig_r_param=pack('x').$sig_r_param ; 
		}
		while (length($sig_s_param)<20) {	
		    $sig_s_param=pack('x').$sig_s_param ;
		}
		$signature.=$sig_r_param.$sig_s_param;


	    }else
	    {  
		confess "creation of DSA Signature failed " ;
	    }
	}
	
    }

    if ($datarrset ne "" ){
	# Replace the "sig" by the real signature and return the object.
	$self->{"sigbin"}=$signature;
	$self->{"sig"}= encode_base64($signature);
    }

    return $self;
}


sub verify {
    my ($self, $dataref, $keyrrref ) = @_;

    # Reminder...

    # $dataref may be a reference to an array of RR objects:
    # $dataref->[$i]->method is the call to the method of the $i th
    # object in the array...  @{$dataref} is length of the array when
    # called in numerical context

    # $keyref is eiter a reference to an array of keys or a a key object.

    # if $dataref is not a reference it contains a string with data to be 
    # verified using SIG0
    
    my $sigzero_verify=0;
    my $packet_verify=0;
    my $rrarray_verify=0;

    my $keyrr; # This will be used to store the key to which we want to 
               # verify.
   

    print "Second argument is of class".ref($keyrrref)."\n" if $debug;;
    if (ref($keyrrref) eq "ARRAY"){
	#  We will recurse for each key that matches algorithm and key-id 
	#  we return when there is a succesful verification.
        #  If not we'll continue so that we even survive key-id collission.
	#  The downside of this is that the error string only matches the
	#  last error.
	my @keyarray=@{$keyrrref};
	my $errorstring="";
	my $i=0;
	print "Itterating over " . @keyarray ." keys \n" if $debug;
      KEYRR: foreach my $keyrr (@keyarray) {
	  $i++;
	  unless ($keyrr->algorithm == $self->algorithm){
	      print "key $i: algorithm does not match\n" if $debug;
	      $errorstring.="key $i: algorithm does not match ";
	      next KEYRR;
	  }
	  unless ($keyrr->keytag == $self->keytag){
	      print "key $i: keytag does not match (".$keyrr->keytag." ".$self->keytag.")\n" if $debug;
	      $errorstring.="key $i: keytag does not match ";
	      next KEYRR ;
	      
	  }
	  my $result=$self->verify($dataref,$keyrr);
	  print "key $i:".$self->vrfyerrstr if $debug;
	  $errorstring.="key $i:".$self->vrfyerrstr." ";
	  next KEYRR unless $result;
	  $self->{"vrfyerrstr"}="No Error";
	  return $result;
      }
	$self->{"vrfyerrstr"}=$errorstring;	  
	return (0);
    }elsif(ref($keyrrref) eq 'Net::DNS::RR::DNSKEY' ||
	   ref($keyrrref) eq 'Net::DNS::RR::KEY' # we are liberal...
	){
	# substitute and continue processing after this conditional
	$keyrr=$keyrrref;
	print "Validating using key with keytag:".$keyrr->keytag." \n" if $debug;

    }else{
	# Error condition
	$self->{"vrfyerrstr"} = "You are trying to pass ".ref($keyrrref) ." data for a key";
	return (0);
    }




    print "Verifying data of class:".  ref( $dataref) . "\n" if $debug;
    $sigzero_verify=1 unless (ref($dataref));
    if (! $sigzero_verify ){
	if (ref($dataref) eq "ARRAY"){

	    if (ref($dataref->[0]) and $dataref->[0]->isa('Net::DNS::RR')){
		$rrarray_verify=1;
	    }else{
		die "Trying to verify an array of ".  ref( $dataref->[0]) ."\n";
	    }
	}elsif( (ref($dataref)) and $dataref->isa("Net::DNS::Packet")){
	    $packet_verify=1 if ((ref($dataref)) and $dataref->isa("Net::DNS::Packet"));
	    die "Trying to verify a packet while signature is not of SIG0 type"
		if ($self->{"typecovered"} ne "SIGZERO");
	    
	}else{
	    die "Do not know what kind of data this is" . ref( $dataref) . ")\n";
	}
    }



    $self->{"vrfyerrstr"}="---- Unknown Error Condition ------";
    print "\n ------------------------------- RRSIG DEBUG  -----------------\n"  if $debug;
    print "Reference: ".ref($dataref) if $debug;;
    print "\n  RRSIG:\t", $self->string if $debug;
    if ( $rrarray_verify ){
	for (my $i=0; $i<@{$dataref}; $i++){
	    print "\n DATA:\t", $dataref->[$i]->string if $debug ;
	}
    }
    print "\n  KEY:\t" , $keyrr->string if $debug;
    print "\n ------------------------------------------------------------\n" if $debug;



     
    if (!$sigzero_verify && !$packet_verify && $dataref->[0]->type ne $self->typecovered ) {
	$self->{"vrfyerrstr"} = "\nCannot verify datatype  " . $self->typecovered . 
	    " with a key intended for " . 
		$dataref->[0]->type .
		    " verification\n";
	return 0;
    }


    if ( $rrarray_verify &&  !$dataref->[0]->type eq "RRSIG" ) {
	# if [0] has type RRSIG the whole RRset is type RRSIG. 
	# There are no SIGs over SIG RRsets
	$self->{"vrfyerrstr"} = 
	    "RRSIGs over RRSIGs???\n" .
 	   " What are you trying to do. This is not possible.\n";
	return 0;
    }
    if ( $self->algorithm != $keyrr->algorithm ){
	$self->{"vrfyerrstr"} = 
	    "It is impossible to verify a signature made with algorithm " .
		$self->algorithm . "\nagainst a key made with algorithm " .
		    $keyrr->algorithm . "\n";
	return 0;

    }

    if ( $packet_verify){
	# We keep the intelligence for verification in here....
	# The packet is compressed ... we have to undo the compression.
	# Do this by creating a newpaclet
	my $newpacket;
	bless($newpacket = {},"Net::DNS::Packet");
	%{$newpacket} = %{$dataref};
	bless($newpacket->{"header"} = {},"Net::DNS::Header");
	%{$newpacket->{"header"}} = %{$dataref->{"header"}};
	@{$newpacket->{"additional"}} = @{$dataref->{"additional"}};
	shift(@{$newpacket->{"additional"}});
	$newpacket->{"header"}{"arcount"}--;
	$newpacket->{"compnames"} = {};
	$dataref=$dataref->data;
    }


    # The data that is to be signed
    my $sigdata=$self->_CreateSigData($dataref);
    my $signature=$self->sigbin; 
    my $verified=0;
    if ( $self->algorithm == 1 ){    #Verifying for RSA
	$verified=$self->_verifyRSA($sigdata,$signature,$keyrr,0) || return 0;
    }     
    elsif ( $self->algorithm == 3 ||  $self->algorithm == 6 )  # Verifying for DSA
    {
	 $verified=$self->_verifyDSA($sigdata,$signature,$keyrr) || return 0;
    }
    elsif ( $self->algorithm == 5 ||  $self->algorithm == 7 )  # Verifying for RSASHA1
    {
	$verified=$self->_verifyRSA($sigdata,$signature,$keyrr,1) || return 0;
    }
    elsif ( $self->algorithm == 8 )  # Verifying for RSASHA256
    {
	$verified=$self->_verifyRSA($sigdata,$signature,$keyrr,256) || return 0;
    }
    elsif ( $self->algorithm == 10 )  # Verifying for RSASHA512
    {
	$verified=$self->_verifyRSA($sigdata,$signature,$keyrr,512) || return 0;
    }
    else                                  # Verifying other algorithms
    { 
	$self->{"vrfyerrstr"}= "Algoritm ". $self->algorithm . " has not yet been implemented";
	return 0;
    }	
    
    # This really is a redundant test
    if ($verified) {  
        # time to do some time checking.
	my @inct=gmtime(time);
	my $currentdatestring=  sprintf ("%d%02d%02d%02d%02d%02d",
					     $inct[5]+1900 ,$inct[4]+1 , 
					     $inct[3] ,$inct[2] , $inct[1]  ,
					     $inct[0]);	
	if ($self->{"siginception"} > $currentdatestring ){
	    $self->{"vrfyerrstr"}= "Signature may only be used in the future; after " .
		$self->{"siginception"} ;
	    return 0;
	}elsif($self->{"sigexpiration"} < $currentdatestring ){
	    $self->{"vrfyerrstr"}= "Signature has expired since: " .
		$self->{"sigexpiration"} ;
	    return 0;
	}
	$self->{"vrfyerrstr"}= "No Error";
	return 1;
    }
    
    $self->{"vrfyerrstr"}="Verification method error.";
    return 0;

} #END verify block




# Below are all sorts of helper functions. 
# They should not really be used outside the scope of this class ...
#
# To do:  make these functions invisable outside the class.
#
sub _type2string {
    my $index=shift;
    if( Net::DNS::typesbyval($index)){
	return Net::DNS::typesbyval($index) ;
    }else{
	return "UNKNOWN TYPE";
    }
}

sub _string2type {
    my $index=shift;
        if( Net::DNS::typesbyname(uc($index))){
	return Net::DNS::typesbyname(uc($index)) ;
    }else{
	carp "UNKNOWN TYPE, cannot continue ";
    }
}






sub _verifyDSA {
    my ($self, $sigdata, $signature, $keyrr) = @_; 

    print "\nDSA verification called with key:\n". $keyrr->string . 
	
	" and sig:\n" . $self->string ."\n" if $debug;

    # RSA RFC2536
    #
    # Setup a DSA::Key. 
    #


    
    
    
    my $t_param=ord substr($keyrr->keybin,
			0,
			1);   # This works since T is only one octed .
    
    my $q_param=substr($keyrr->keybin, 
		       1,
		       20);
    my $p_param=substr($keyrr->keybin, 
		       21, 
		       64+$t_param*8 );
    my $g_param=substr($keyrr->keybin, 
		       21+64+$t_param*8,
				    64+$t_param*8);
    


    #rfc3279  section 2.3.2
    # (...)
    # The DSA public key MUST be ASN.1 DER encoded as an INTEGER; this
    # encoding shall be used as the contents (i.e., the value) of the
    # subjectPublicKey component (a BIT STRING) of the
    # SubjectPublicKeyInfo data element.
    # (...)

    
my $pubkey_param=substr($keyrr->keybin, 
			21+2*(64+$t_param*8),
			64+$t_param*8);

my $dsa_pub=Crypt::OpenSSL::DSA->new();
    $dsa_pub->set_q($q_param);
    $dsa_pub->set_g($g_param);
    $dsa_pub->set_p($p_param);
    $dsa_pub->set_pub_key($pubkey_param);



    my $r_field=(substr($self->sigbin,
			1,
			20));
    my $s_field=(substr($self->sigbin,
			21,
			20));
    
    my $DSAsig=Crypt::OpenSSL::DSA::Signature->new();
    $DSAsig->set_r($r_field);
    $DSAsig->set_s($s_field);


    if (my $valid=$dsa_pub->do_verify (sha1( $sigdata) ,
				       $DSAsig
				       )){
	if ($valid==-1){
	    print "Crypt::OpenSSL::DSA Verification failed with error\n" if $debug;
	    $self->{"vrfyerrstr"}="DSA Verification failed with error";
	    return(0);
	}else{
	    print "Crypt::OpenSSL::DSA Verification successful:$valid\n" if $debug;;
	    
	    $self->{"vrfyerrstr"}="DSA Verification successful ";
	    return(1);
	}
    }else{
	print "Crypt::OpenSSL::DSA Verification failed\n " if $debug;;
	$self->{"vrfyerrstr"}="DSA Verification failed ";
	return(0);
    }
    
    $self->{"vrfyerrstr"}="DSA Verification failed: undefined error ";
    
    return 0;	
}


sub _verifyRSA {
    # Implementation using crypt::openssl

    my ($self, $sigdata, $signature, $keyrr, $isSHA) = @_; 

    print "\nRSA verification called with key:\n". $keyrr->string . 
	
	" sig:\n" . $self->string ."\non sigdata:\t".
	    unpack ("H*",$sigdata) . "\n" 
	    if $debug;
    # RSA RFC2535
    # 
    
    my $explength;
    my $exponent;
    my $modulus;
    my $RSAPublicKey;
	
    {   #localise dummy
	my $dummy=1;
	# determine exponent length
	
	#RFC 2537 sect 2
	($dummy, $explength)=unpack("Cn",$keyrr->keybin) 
	    if ! ($explength=unpack("C",$keyrr->keybin));
	print "\n\nEXPLENGTH:",$explength if $debug;
	
	# We are constructing the exponent and modulus as a hex number so 
	# the AUTOLOAD function in Crypt::RSA::Key::Public can deal with it
	# later, there must be better ways to do this,
	if ($dummy) { # skip one octet
	    $exponent=(substr ($keyrr->keybin, 
			       1, 
			       $explength));
	    
	    $modulus=( substr ($keyrr->keybin,
			       1+$explength, 
			       (length $keyrr->keybin) - 1
			       - $explength));
	    
	    
	}else{ # skip two octets
	    $exponent=(substr ($keyrr->keybin, 
			       3,
			       $explength));
	    
	    $modulus=( substr ($keyrr->keybin, 
			       3+$explength, 
			       (length $keyrr->keybin) - 3
			       - $explength));
	}
    }
    

    my $bn_modulus=Crypt::OpenSSL::Bignum->new_from_bin($modulus);
    my $bn_exponent=Crypt::OpenSSL::Bignum->new_from_bin($exponent);

  

    my $rsa_pub = Crypt::OpenSSL::RSA->new_key_from_parameters($bn_modulus,$bn_exponent);


    die "Could not load public key" unless $rsa_pub;
    $rsa_pub->use_pkcs1_oaep_padding;
    if ($isSHA == 1) {
	$rsa_pub->use_sha1_hash;
    } elsif ($isSHA == 256) {
	$rsa_pub->use_sha256_hash;
    } elsif ($isSHA == 512) {
	$rsa_pub->use_sha512_hash;
    } else {
	$rsa_pub->use_md5_hash;
    }
    

    
    my $verified;
    eval {
	$verified=$rsa_pub->verify($sigdata, $signature);
    };

    if ($@){
	 $self->{"vrfyerrstr"}=
	     "Verification of RSA string generated error: ". $@;
	 print "\nRSA library error.\n" if $debug;
	 return 0;
     }
    if ($verified )
    {
	print "\nVERIFIED\n\n" if $debug ;
	$self->{"vrfyerrstr"}="RSA Verification successful";
	return 1;
    }else
    {   $self->{"vrfyerrstr"}="RSA Verification failed";
	# Data is not verified
	print "\nNOT VERIFIED\n" if $debug;
	return 0;
    }
    
    $self->{"vrfyerrstr"}="RSA Verification failed: This code should not be run ";
    0;

}

sub _CreateSigData {
    # this is the data that will be  signed, it will be fed to the
    # verifier. See RFC4034 section 6 on how this string is constructed

    # This method is called by the method that creates as signature
    # and by the method that verifies the signature. It is assumed
    # that the creation method has checked that all the TTL are the same
    # for the dataref and that sig->orgttl has been set to the TTL of
    # the data. This method will set the datarr->ttl to the sig->orgttl for
    # all the RR in the dataref.



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

    my $sigzero= ! ref ($rawdata);
    my $sigdata;
    # construction of message 

    print "_CreatSigData\n" if $debug;
    my $rdatawithoutsig=$self->rr_rdata_without_sigbin;
    print "raw RRsig:\t",  unpack("H*", $rdatawithoutsig) if $debug;
    $sigdata= $rdatawithoutsig;


    if ( ! $sigzero ){
	# Not a SIG0
	if (@{$rawdata}>1) {
	    my @canonicaldataarray;
	    for (my $i=0; $i<@{$rawdata}; $i++){
		if ($debug){
		    print "Setting TTL to from ". $rawdata->[$i]->{"ttl"} . " to " .
			$self->orgttl . "\n" 
			    if ( $rawdata->[$i]->{"ttl"}!=$self->orgttl);
		}
		$rawdata->[$i]->{"ttl"}=$self->orgttl;
		# Some error checking is done to. A RRset is defined by 
		# Same label,class,qtype
		if (lc($rawdata->[$i]->name) ne lc($rawdata->[0]->name)){
		    print "\nError:\n";
		    for  (my $j=0; $j<@{$rawdata}; $j++){
			print "\n";
			$rawdata->[$j]->print;
		    }
		    croak "\nNot all labels in the data RRset above are equal ";
		}
		
		if ($rawdata->[$i]->type ne $rawdata->[0]->type){
		    print "\nError:\n";
		    for  (my $j=0; $j<@{$rawdata}; $j++){
			print "\n";
			$rawdata->[$j]->print;
		    }
		    croak "\nThe  the data RRset consists of different types ";
		}
		
		if ($rawdata->[$i]->class ne $rawdata->[0]->class){
		    print "\nError:\n";
		    for  (my $j=0; $j<@{$rawdata}; $j++){
			print "\n";
			$rawdata->[$j]->print;
		    }
		    croak "\nThe  the data RRset has different classes (What are you trying to do?)  ";
		}
		
		print "\n\nCan Data RR: $i\t", 
		unpack("H*", ($rawdata->[$i]->_canonicaldata)) if $debug;
		
		# To allow for sorting on RDATA we create an array of hashes.
		# We sort on canonicalRdata and use the full RR representation 
		# in rr to build the digest.
		$canonicaldataarray[$i]= 
		{ rrdigest => $rawdata->[$i]->_canonicaldata,
		  canonicalRdata => $rawdata->[$i]->_canonicalRdata,
	      };
	    }
	    
	    # Sort acording to RFC2535 section 8.3
	    # Comparing left justified octet strings: perl sort does just that.
	    # We have to sort on RDATA.. the array contains the whole RRset.
	    #  the sort routine
	    
	    my @sortedcanonicaldataarray= sort        {
		$a->{"canonicalRdata"} cmp $b->{"canonicalRdata"};   
	    }
	    @canonicaldataarray;
	    
	    
	    
	    for (my $i=0; $i<@sortedcanonicaldataarray ; $i++){
		print "\n>>>" . $i 	.
		    ">>> \t" .
			unpack("H*",$sortedcanonicaldataarray[$i]{canonicalRdata}) .
			    "\n>>>\t " .
				unpack("H*",$sortedcanonicaldataarray[$i]{rrdigest}) .
				    "\n" if $debug;
		$sigdata .=  $sortedcanonicaldataarray[$i]{rrdigest};
	    }
	}else{
	    if ($debug) {
		print "\nSetting TTL to from ". $rawdata->[0]->{"ttl"} . " to " .
		    $self->orgttl . "\n" if 
			( $rawdata->[0]->{"ttl"}!=$self->orgttl );
	    }
	    print "\nRDATA:\t\t" .$rawdata->[0]->_canonicalRdata ."\n-----:\t\t" .
	      unpack("H*",$rawdata->[0]->_canonicalRdata) ."\n" if $debug;
	    
	    $rawdata->[0]->{"ttl"}=$self->orgttl;	    
	    $sigdata .= $rawdata->[0]->_canonicaldata;
	    
	}
	
    }else{ #SIG0 case  

	print "\nsig0 proccessing\nrawdata:\t". unpack("H*",$rawdata)."\n"if $debug;
	$sigdata=$sigdata.$rawdata;
    }
    

    print "\n sigdata:\t".   unpack("H*",$sigdata) . "\n" if $debug;

    return $sigdata;
}


sub _checktimeformat {
    # Function to check if the strings entered as time are properly formated.
    # Croaks if the format does not make sense...
    
    
    my $timestring=shift;

    my @timeval=($timestring =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})/);
    if (@timeval != 6) {
	croak "The time " . $timestring . " is not in the expected format (yyyymmddhhmmss)";
    }
    if ($timeval[0]< 1970) {
	croak "The year ". $timeval[0] . " is before the epoch (1970)";
    }
    if ($timeval[1]> 12) {
	croak "What??? There is no month number ". $timeval[1] ;
    }
    # This is a rough check... 
    # Feb 31 will work... 
    if ($timeval[2]> 31) {
	croak "Intresting, a month with ". $timeval[2] . " days" ;
    }

    if ($timeval[3]> 24) {
	croak "Intresting, a day with ". $timeval[3] . " hours" ;
    }

    if ($timeval[4]> 60) {
	croak "Intresting, an hour with ". $timeval[3] . " minutes" ;
    }
    if ($timeval[5]> 60) {
	croak "Intresting, a minute with ". $timeval[3] . " seconds" ;
    }

    
    0;
}


# The previous versions had a typo... *Sigh*
sub siginceptation {
    my $self=shift;
    return $self->siginception(@_);
}



sub _normalize_dnames {
	my $self=shift;
	$self->_normalize_ownername();
	$self->{'signame'}=lc(Net::DNS::stripdot($self->{'signame'})) if defined $self->{'signame'};
}


1;