Net::DNS::Keyset - DNSSEC Keyset object class

    Net::DNS::Keyset - DNSSEC Keyset object class

    $keyset=Net::DNS::Keyset->new("keyset-example.tld");

    $keyset=Net::DNS::Keyset->new(\@keyrr,$privatekeypath);

    $keyset=Net::DNS::Keyset->new(\@keyrr,\@sigrr);

    $res = Net::DNS::Resolver->new;
    $res->dnssec(1);

    $packet = $res->query ("example.com", "DNSKEY", "IN");

    $keyset=Net::DNS::Keyset->new($packet)

    die "Corrupted selfsignature " if ! $keyset->verify;

    @keyrr=$keyset->keys;

    @keyrr=$keyset->sigs;

    die $Net::DNS::Keyset::keyset_err if $keyset->verify;

    - Verifies if all signatures present verify the keyset.
    - Verifies if there are DNSKEYs with the SEP flag set there is
      at least one RRSIG made using that key
    - Verifies that if there are no DNSKEYS with the SEP flag set there is
      at lease one RRSIG made with one of the keys from the keyset.

    $keyset->print;

    $keysetstring=$keyset->string;

    print $keyset->string;
    is similar to
    $keyset->print;

    @ds=$keyset->extract_ds;
    foreach $ds (@ds) {
        $ds->print;
    }

    die $Net::DNS::Keyset::keyset_err if ! $keyset->writekeyset($prefix, $path);

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


package Net::DNS::Keyset;
use Cwd;

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

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

( $VERSION ) = '$Revision: 728 $ ' =~ /\$Revision:\s+([^\s]+)/;

my $debug=0;



sub new {
	my $retval;
	$keyset_err="No Error";
	if (@_ == 2 && ! ref $_[1] ) {
		$retval = new_from_file(@_);
	}
	elsif (@_ == 3 
	       && (ref($_[2]) eq "ARRAY")  &&
	       ref($_[2]->[0]) eq "Net::DNS::RR::RRSIG" &&
	      (ref($_[1]) eq "ARRAY")  &&
	       ref($_[1]->[0]) eq "Net::DNS::RR::DNSKEY" ) {
	    $retval = new_from_keys_sigs(@_);
	}elsif (@_ >= 2 && (ref($_[1]) eq "ARRAY")  &&
	       ref($_[1]->[0]) eq "Net::DNS::RR::DNSKEY" ) {
	    $retval = new_from_keys(@_);
	}elsif ( @_ == 2 &&  ref($_[1]) eq "Net::DNS::Packet"  ){
	    $retval = new_from_packet(@_);
	}else{
	     $keyset_err="Could not parse argument";
	     return(0);
	 }	
	return $retval;
}

sub new_from_file {
    my $class=shift;
    my $keysetfile=shift;

    $keyset_err="No Error";
    my $TTL;

    croak "need keysetfile as argumnt" if ! $keysetfile;

    open(KEYSET, $keysetfile)          # get sort's results
	|| croak "Can't open $keysetfile for input: $!";

    my $currentorigin;
    my $buffer="";
    my $previouslabel;
    my @keys;
    my $k=0;
    my @sigs;
    my $s=0;
    my %names;
    
    # We now read the keyset as if it is a (bind) zone file.  # To be
    #able to read the individual RRs into RR-objects we # have to fill
    #in the information that was conveniently left out # of the zone
    #file to make it more readable for us humans.  #


    # This is code I reused. There is a whole chunk of code for dncame
    # completion for RR types other than DNSKEY and RRSIG.  That may be
    # usefull # if you want to reuse the code for writing a zone
    # parser


    while (<KEYSET>){
	s/;.*//;  # Remove comments
	next if /^\s*$/ ;
	if (!$TTL && /^\s*\$TTL\s+(\d+)/){
	    $TTL=$1;
	    print ";; TTL found : ". $TTL ."\n" if $debug;
	    next;
	}
	
	
	
	# replace the @ by the ORIGIN.. as given by the argument.
	s/@/$currentorigin/;
	
	# Set the current originin. This is the one from the $ORINIGIN value from 
	# the zone file. It will be used to complete labels  below.
	if ( /^\s*\$ORIGIN\s+(\S+)\s*$/){
	    $currentorigin=$1;
	    print ";; currentorigin set to : ". $currentorigin ."\n" if $debug;
	    next;
	}
	# Join multilines to one line
	if ( $buffer ne ""){
	    if (s/\)//) {
		$buffer.=$_;
		$_=$buffer;
		$buffer="";
		s/\s+(\s)/$1/g;
	    }else{
		chop;
		$buffer.=$_;
		next;
	    }
	}elsif (s/\(//) {        
	    chop;
	    $buffer.=$_;
	    next;
	}
	s/\s+/ /g; #Single spaces .. eases future matching
	s/ $//;    #strips trailing space, that got introduced by the previous...
	
	# Use the previoous label if no label was qualified (line starts with blanks)
	if (/^(\S+) /){
	    $previouslabel=$1;
	}else{
	    $_ = $previouslabel . $_;
	}
	
	
	# Now we have
	# label  optional TTL  optional ClASS and QTYPE and RDATA
	# If the TTL and CLASS are not there we'll add them. Besides we'll
	# look at the QTYPE and may take some action to RDATA depending on that.
	
	{ #LOCALIZE SOME VARIABLES
	    my $label;
	    my $ttl=$TTL;
	    my $class='IN';  # We only considder IN
	    my $rtype='';
	    my $rdata='';
	    my $prefix='';
	    
	    # It should be easier to do this....
	    
	    s/^(\S+) / /;  # remove the label to put it back fully quallified
	    if ($1){
		
		$label=$1;
		_complete_dname($label,$currentorigin);
		$_ = $label . $_;
		print ";;    read LABEL: " . $label ."\n" if  $debug>2 ;
	    }else{
		croak "Couldnt match label in read method while reading\n". $_ . " \nthis Should not happen\n";
	    }
	    
	    
	    # See if there is a TTL value, if not insert one
	    if (/^\S+. (\d+)/) {
		print ";;    TTL   : " . $1. "\n" if  $debug>2 ;
		$ttl=$1;
	    }else {
		# instert default TTL
		s/^(\S+) (.*)$/$1 $ttl $2/;
	    }		
	    
	    
	    # See if there is the CLASS is defined, if not insert one.
	    if(! /^\S+ \d+ (IN)/){   
		#insert IN
		s/^(\S+ \d+ )(.*)$/$1IN $2/;
	    }
	    
	    
	    
	    # We have everything specified.. We now get the RTYPE AND RDATA...
	    /^\S+ \d+ IN (\S+) (.*)$/;
	    
	    
	    if ($1) {
		print ";;    rtype: " . $1 ."\n" if  $debug>2 ;
		$rtype=$1;
	    }else{
		croak " We expected to match an RTYPE\n". $_ . " \nthis Should not happen\n";
	    }
	    
	    if ($2) {
		$rdata=$2;	       
		print ";;    rdata:-->" . $rdata ."<---\n" if  $debug>3 ;
		
	    }else{
		croak " We expected a match RDATA\n". $_ . " \nthis Should not happen\n";
	    }
	    
	    $prefix=$label." ".$ttl." IN ".$rtype." ";
	    
	    
	} #END LOCALIZATION
	print ";;    " . $_ . "\n" if $debug>2;
	
	# The sting in $_ now contains a one-line RRset. We now turn it into
	# RR object.
	my $rr=Net::DNS::RR->new($_);
	if ($rr->type eq "DNSKEY") {
	    $keys[$k++]=$rr;
	    $names{$rr->name}=1;
	}elsif ($rr->type eq "RRSIG") {
	    $sigs[$s++]=$rr;
	    $names{$rr->name}=1;
	}else{
	    $keyset_err= "WARNING the following RR was found in a keyset and is not expected there\n".   $rr->string;
	    return(0);
	}
    }

    if ((keys %names )!=1){
	$keyset_err = "Different names in the keyset: ". 
	    join ( " ",(keys %names))."\n";
	return 0;
    }

    # @keys_and_sigs contains all keys and sigs from the RRset.
    

    my $ks;
    my $keyset;
    $keyset= {
	keys => [ @keys ],
	sigs => [ @sigs ],
    };
    bless $ks= $keyset, $class;
    return 0 if (! $ks->verify);
    return $ks;
}

sub new_from_keys {
    my $class=shift;
    my $keyrr_ref=shift;
    my $privatekeypath=shift;
    $keyset_err="No Error";

    if (  defined $privatekeypath ){
	$privatekeypath =~ s!\/*\s*$!! ; #strip trailing spaces and slashes
	if (! -d $privatekeypath){
	    $keyset_err= "The file " . $privatekeypath . 
		" could not be found\n";
	    return 0;
	}
    }else{
	$privatekeypath=cwd;
    }
    my $key;
    my $privatekey;
    my @sigrr;
    my @keyrr;
    foreach $key (@{$keyrr_ref}){
	my $privkey= $privatekeypath."/".$key->privatekeyname;
	if (! -r $privkey){
	    $keyset_err= "private key  ".$privkey.
		"could not be found";
	    return 0;
	}
	my $sig=Net::DNS::RR::RRSIG->create($keyrr_ref,$privkey);
	push @sigrr, $sig;
	push @keyrr, $key;

    }

    my $ks;
    my $keyset= {
	keys => [ @keyrr ],
	sigs => [ @sigrr ],
    };
    bless $ks= $keyset, $class;
    return 0 if (! $ks->verify);
    return $ks;
}

sub new_from_keys_sigs{
    my $class=shift;
    my $keyrr_ref=shift;
    my $sigrr_ref=shift;

    my @sigrr;
    my @keyrr;

    
    foreach my  $key (@{$keyrr_ref}){
	push @keyrr, $key;

    }


    foreach my $sig (@{$sigrr_ref}){
	push @sigrr, $sig;

    }


    my $ks;
    my $keyset= {
	keys => [ @keyrr ],
	sigs => [ @sigrr ],
    };
    bless $ks= $keyset, $class;
    return 0 if (! $ks->verify);
    return $ks;

}

sub new_from_packet {
    my $class=shift;    
    my $packet=shift;

    my @sigrr;
    my @keyrr;

    $keyset_err="No Error";

    if (ref ($packet) ne "Net::DNS::Packet"){
	$keyset_err="Input is not a Net::DNS::Packet" ;
	return (0);
    }
	     
    # All the information is in the answer section. 
    # We expect keys and signatures there.
    foreach my $rr  ($packet->answer){
	if ($rr->type eq "RRSIG"){
	    push @sigrr, $rr;
	}
	elsif ($rr->type eq "DNSKEY")
	{
	    push @keyrr, $rr ;
	}else{
	    $keyset_err = "Unexpected RR in the answer section of the packet:\n".
		$rr->string."\n";
	    return (0);

	}
    }


    my $ks;
    my $keyset= {
	keys => [ @keyrr ],
	sigs => [ @sigrr ],
    };
    bless $ks= $keyset, $class;

    return 0 if (! $ks->verify);
    return $ks;


}




    

sub keys {
    my $self=shift;
    return @{$self->{'keys'}};
}

sub sigs {
    my $self=shift;
    return @{$self->{'sigs'}};
}

    
sub verify {
    my $self=shift;
    my $keyid=shift;
    my $key;
    my $sig;
    



    my $one_sep_key_found=0;
    my $one_sep_key_validated=0;
    my $one_key_validated=0;
    my $key_id_found=0;
    my @tags_verified=();

    
  KEY:    foreach $key ($self->keys) {
      $one_sep_key_found=1 if $key->is_sep;
      foreach $sig ($self->sigs) {
	  print "Checking: " . $key->name .":". $key->keytag . 
	      ($key->is_sep?"(SEP)":"") .
	      "---" .
	      $sig->signame .":". $sig->keytag .  "\n" if $debug;
	  
	  if ($key->keytag == $sig->keytag &&
	      $key->name."." eq $sig->signame."." ){
	      print "...\n" if $debug;
		my @keys=$self->keys ;
		if (! $sig->verify( \@keys , $key)){
		    $keyset_err="" if ($keyset_err eq "No Error");
		    $keyset_err .= $sig->vrfyerrstr. " on key ". $key->name.			" ".$key->keytag ." ";

		    # If we did supply an argument we want to fail if
		    # the signature made with that keytag failed.

		    if (defined $keyid && $sig->keytag == $keyid ){
			$keyset_err= "Signature made with $keyid did not validate";
			return 0;
		    }
		    # If we did not supply an argument we want to fail if any 
		    # of the signatures failed
		    return 0 if (! defined $keyid);
		    
		    next KEY;
		}
	      push @tags_verified, $key->keytag;
	      # past verification
		$one_key_validated=1;
		$one_sep_key_validated=1 if $key->is_sep;    
		$key_id_found=1 if (defined $keyid && $key->keytag == $keyid );
		print "verified " .$key->keytag."\n" if $debug;

	    }
      }

  }
    if ($one_sep_key_found && ! $one_sep_key_validated){
	$keyset_err= "One key had the SEP flag set but non of the keys had a signature";
	return 0;
    }elsif(  ! $one_key_validated ){
	$keyset_err= "None of the keys in the keyset had a signature";
	return 0;
    }elsif ( defined($keyid) && ! $key_id_found ){
	$keyset_err= "No signature made with $keyid found";
	return 0;
    }
    @tags_verified = ($keyid) if defined ($keyid);
    return @tags_verified;
}

sub string {
    my $self=shift;
    my $string;
    foreach my $rr ($self->keys,$self->sigs){
	$string .= $rr->string ."\n";
    }
    return $string;
}

sub print {
    my $self=shift;
    print $self->string;
}

  
sub extract_ds {
    my $self=shift;
    $keyset_err="No error";
    my @ds;
   
    return (0) if (! $self->verify);

    foreach my $rr ($self->keys){
	my $ds=Net::DNS::RR::DS->create($rr);
	push @ds, $ds;
    }


    return (@ds);
}

sub writekeyset {
    my $self=shift;
    my $prefix=shift;
    my $keysetpath=shift;
    $keyset_err="No Error";
    my $domainname=$self->{'keys'}->[0]->name;
    if (  defined $keysetpath ){
	$keysetpath =~ s!\/*\s*$!! ; #strip trailing spaces and slashes
	if (! -d $keysetpath){
	    $keyset_err= "Directory " . $keysetpath . 
		" could not be found\n";
	    return 0;
	} 
    }else {
	$keysetpath=cwd;
    }
    
    my $keysetname="$keysetpath/$prefix" . "keyset-$domainname.";
    if (! open(KEYSET,"> $keysetname")   ){
	$keyset_err= " Could not open $keysetname for writing";
	return 0;
    }
    print KEYSET $self->string;
    return (1);
}



sub _complete_dname
{
    my $dname=shift;
    my $origin=shift;
    if ( $dname !~ /\.$/ ){       
	# breaks if a label ends in an escapped \. 
	# Is that allowed?
	$dname .= ".".$origin;
    }
    return $dname;
}





1;
__END__