Net::DNS::RR::DS - DNS DS resource record

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

    1 = MD5 RSA
    2 = DH
    3 = DSA
    4 = Elliptic curve

    print "digest" = ", $dsrr->digest, "\n";

    $digestbin =  $dsrr->digestbin;

    print "keytag" ." = ". $dsrr->keytag . "\n";

   print "digest type" . " = " . $dsrr->digtype ."\n";

   print $dsrr->babble;

package Net::DNS::RR::DS;

# $Id: DS.pm 728 2008-10-12 09:02:24Z olaf $


use strict;
use vars qw(@ISA $VERSION $_Babble);

use Net::DNS;
use Carp;

use Digest::SHA  qw(sha1 sha1_hex sha256 sha256_hex );

BEGIN {

    $_Babble=0;    
    $_Babble=1 unless (eval "require Digest::BubbleBabble; import Digest::BubbleBabble qw(bubblebabble)") ;

}





$VERSION = do { my @r=(q$Revision: 728 $=~/\d+/g); sprintf "%d."."%03d"x$#r,@r };
my $debug=0;

@ISA = qw(Net::DNS::RR);

sub new {
    my ($class, $self, $data, $offset) = @_;
    if ($self->{"rdlength"} > 0) {
	
	my $offsettoalg=$offset+2;
	my $offsettodigtype=$offset+3;
	my $offsettodigest=$offset+4;
	my $digestlength;


	$self->{"keytag"}=unpack("n",substr($$data,$offset,2));
	$self->{"algorithm"}=unpack("C",substr($$data,$offsettoalg,1));
	$self->{"digtype"}=unpack("C",substr($$data,$offsettodigtype,1));
	if ($self->{"digtype"}==1){
	    $digestlength=20; # SHA1 digest 20 bytes long
	}elsif($self->{"digtype"}==2){
	    $digestlength=32; # SHA256 digest 32 bytes long
	}else{
	    $digestlength=0;
	}
	
	$self->{"digestbin"}= substr($$data,$offsettodigest,
				     $digestlength); 


	$self->{"digest"}= unpack("H*",$self->{"digestbin"});
	
	
    }
    return bless $self, $class;
}





sub new_from_string {
	my ($class, $self, $string) = @_;
	if ($string) {
		$string =~ tr/()//d;
		$string =~ s/;.*$//mg;
		$string =~ s/\n//g;
		my ($keytag,  $algorithm, $digtype, $digest) = 
		    $string =~ /^\s*(\S+)\s+(\S+)\s+(\S+)\s+((\S+\s*)+)/;
		# We allow spaces in the digest.
		$digest=~s/\s//g;
		$self->{"keytag"}=$keytag;
		$self->{"algorithm"}=Net::DNS::SEC->algorithm($algorithm)|| 
		    return undef;		
		$self->{"digtype"}=Net::DNS::SEC->digtype($digtype) || 
		    return undef;
		$self->{"digest"}=$digest;
		$self->{"digestbin"}=pack("H*",$digest);
	    }
	return bless $self, $class;
}



sub rdatastr {
	my $self = shift;
	my $rdatastr;
	if (exists $self->{"keytag"}) {
	    $rdatastr  = $self->{keytag};
	    $rdatastr .= "  "  . "$self->{algorithm}";
	    $rdatastr .= "  "  . "$self->{digtype}";
	    $rdatastr .= "  "  . "$self->{digest}";
	    $rdatastr .= " ; ".$self->babble if $_Babble;   
	    }
	else {
	    $rdatastr = "; no data";
	}

	return $rdatastr;
}

sub rr_rdata {
    my $self = shift;
    my $rdata;
    if (exists $self->{"digest"}) {
      $rdata= pack("n",$self->{"keytag"}) ;
      $rdata.= pack("C",  $self->{"algorithm"}) ;
      $rdata.= pack("C",  $self->{"digtype"}) ;
      $rdata.= $self->digestbin;
    }
    return $rdata;
}

sub verify {
    my ($self, $key) = @_;
    my $tstds=create Net::DNS::RR::DS($key,(
					  digtype => $self->digtype,
				      )
	);
    if ($tstds->digestbin eq $self->digestbin){
	return 1;
    }else{
	return 0;
    }
}




sub babble {
    my $self=shift;
    if ($_Babble){
        return bubblebabble(Digest=>$self->digestbin);
    }else{
	return("");
    }
}


sub digestbin {
    my ($self,$new_val)=@_;

    if (defined $new_val) {
	$self->{"digestbin"} = $new_val;
	$self->{"digest"} = unpack("H*",$new_val);
	return  $self->{"digestbin"};
    }
    

    $self->{"digestbin"}=pack("H*",$self->{"digest"}) unless(  $self->{"digestbin"} ); 
    return $self->{"digestbin"};


}

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

    my $self;

    # Default SHA1...
    $self->{"digtype"}=1;
   
    if ($args{"digtype"}){
	$self->{"digtype"}=2 if Net::DNS::SEC->digtype($args{"digtype"})==2;
    }
    
    $self->{"name"}=$keyrr->name;  # Label is per definition the same as 
                                   # keylabll
    $self->{"type"}="DS";
    $self->{"class"}="IN";
    
    if ($args{ttl}){
	print "\nSetting TTL to ".  $args{"ttl"} if $debug;
	$self->{"ttl"}= $args{"ttl"};
    }else{
	$self->{"ttl"}= $keyrr->ttl;
    }


    # The key must not be a NULL key.
    if (($keyrr->{"flags"} & hex("0xc000") ) == hex("0xc000") ){
	croak "\nCreating a DS record for a NULL key is illegal";
    }
    

    # Bit 0 must not be set.
    if (($keyrr->{"flags"}) & hex("0x8000")) {
	croak "\nCreating a DS record for a key with flag bit 0 set ".
	    "to 0 is illegal";
    }
    
    # Bit 6 must be set to 0 bit 7 must be set to 1
    if ( ($keyrr->{"flags"} & hex("0x300")) != hex("0x100")){
	croak "\nCreating a DS record for a key with flags 6 and 7 not set ".
	    "0  and 1 respectively is illegal";
    }
    

    if ($keyrr->{"protocol"}  != 3 ){
	croak "\nCreating a DS record for a non DNSSEC (protocol=3) ".
	    "key is illegal";
    }

    $self->{"keytag"}=$keyrr->keytag;
    $self->{"algorithm"}=$keyrr->algorithm;

    my $data = $keyrr->_name2wire ($keyrr->name) . $keyrr->_canonicalRdata;

    if ($self->{"digtype"}==1){
	$self->{"digestbin"}=  sha1($data);
	$self->{"digest"}= uc(sha1_hex($data));
    }elsif($self->{"digtype"}==2){
	$self->{"digestbin"}=  sha256($data);
	$self->{"digest"}= uc(sha256_hex($data));
    }else{
	return undef;
    }

    return bless $self, $class;


}

1;