package Net::DNS::RR::NSEC3;
#
# $Id: NSEC3.pm 1130 2013-11-21 15:50:43Z willem $
use strict;
require Exporter;
use vars qw(
@ISA
$VERSION
@EXPORT_OK
%digestbyname
%digestbyval
);
use Carp;
use bytes;
use MIME::Base64;
use MIME::Base32;
use Digest::SHA qw(sha1 sha1_hex sha256 sha256_hex );
use Net::DNS qw( name2labels );
use Net::DNS::SEC;
use Net::DNS::Packet;
use Net::DNS::RR::NSEC;
#http://www.iana.org/assignments/dnssec-nsec3-parameters
%digestbyname = (
"SHA1" => 1,
);
@EXPORT_OK= qw (
name2hash
);
# Inherit a couple of methods from NSEC.
@ISA = qw(Exporter Net::DNS::SEC Net::DNS::RR Net::DNS::RR::NSEC);
$VERSION = do { my @r=(q$Revision: 510 $=~/\d+/g); sprintf "%d."."%03d"x$#r,@r };
sub new {
my ($class, $self, $data, $offset) = @_;
if ($self->{'rdlength'} > 0) {
# section 3.1 of NSEC3 specs
# 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3
# 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
# | Hash Alg. | Flags Field | Iterations |
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
# | Salt Length | Salt /
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
# | Hash Length | Next Hashed Ownername /
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
# / Type Bit Maps /
# +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
my $offsettoits=$offset+2;
my $offsettoflags=$offset+1;
my $offsettosaltlength=$offset+4;
my $offsettosalt=$offset+5;
$self->{'hashalgo'}=unpack("C",substr($$data,$offset,1));
$self->{'flags'}=unpack("C",substr($$data,$offsettoflags,1));
$self->{'iterations'}=unpack("n",substr($$data,$offsettoits,3));
$self->{'saltlength'}=unpack("C",substr($$data,$offsettosaltlength,1));
$self->{'saltbin'}=substr($$data,$offsettosalt,$self->{'saltlength'});
$self->{'salt'}= unpack("H*",$self->{'saltbin'});
my $offsettohashlength= $offsettosalt+$self->{'saltlength'};
$self->{'hashlength'}=unpack("C",substr($$data,$offsettohashlength,1));
$self->{'hnxtnamebin'}=substr($$data,$offsettohashlength+1,$self->{'hashlength'});
$self->{'hnxtname'}=MIME::Base32::encode $self->{'hnxtnamebin'};
my $offsettotypebm=$offsettohashlength+1+$self->{'hashlength'};
my $typebm =substr($$data,$offsettotypebm, $self->{'rdlength'}-$offsettotypebm +$offset );
$self->{'typebm'}=$typebm;
$self->{'typelist'} = join " "
, Net::DNS::RR::NSEC::_typebm2typearray($typebm);
}
bless $self, $class;
return $self;
}
sub new_from_string {
my ($class, $self, $string) = @_;
if ($string) {
$string =~ tr/()//d;
$string =~ s/;.*$//mg;
$string =~ s/\n//mg;
my ($hashalgo,$flags,$iterations,$salt,$hnxtname,$nxtstr)=
$string =~ /^\s*(\d+)\s+(\d+)\s+(\d+)\s+(\S+)\s+(\S+)\s?(.*)/;
my @nxttypes = split ' ' , $nxtstr; # everything after last match...
bless $self, $class;
# This assumes that the digest type allocations follow the assignments as used for DS...
#overwrite the digestby name table used by Net::DNS::SEC digtype
$self->{'hashalgo'}=$self->digtype($hashalgo) ||
return undef;
$self->{'flags'}=$flags;
$self->{'iterations'}=$iterations;
if ($salt eq '-') {$salt=''};
$self->{'salt'}=$salt;
$self->{'saltbin'}=pack("H*",$salt);
$self->{'saltlength'}=length $self->{saltbin};
$self->{'hnxtname'}= Net::DNS::stripdot($hnxtname);
$self->{'hnxtnamebin'}=MIME::Base32::decode uc $hnxtname;
$self->{'typelist'}= join " " , sort @nxttypes ;
$self->{'typebm'}=Net::DNS::RR::NSEC::_typearray2typebm(@nxttypes);
}
return $self;
}
sub rdatastr
{
my $self = shift;
my $rdatastr;
if (exists $self->{hashalgo})
{
$rdatastr .= $self->{hashalgo} ." ";
$rdatastr .= $self->{flags}." ";
$rdatastr .= $self->{iterations}. " ";
$rdatastr .= $self->salt()." ";
$rdatastr .= "(\n\t\t\t";
$rdatastr .= $self->{hnxtname} . "\n";
$rdatastr .= "\t\t\t$self->{typelist} )";
}
else
{
$rdatastr = "; no data"
}
$rdatastr
}
sub rr_rdata {
my ($self, $packet, $offset) = @_;
my $rdata = "" ;
if (exists $self->{'hnxtname'}) {
$rdata = pack("C",$self->{'hashalgo'});
$rdata .= pack("C", $self->{'flags'} );
$rdata .= pack("n", $self->{'iterations'} );
unless( exists $self->{'saltbin'}) {
if ($self->{'salt'} eq "-"){
$self->{'saltbin'}="";
}else{
$self->{'saltbin'}=pack("H*",$self->{'salt'})
}
}
$rdata.= pack("C",length($self->{'saltbin'}));
$rdata .= $self->{'saltbin'};
$self->{'hnxtnamebin'}=MIME::Base32::decode(uc $self->{'hnxtname'}) unless
exists $self->{'hnxtnamebin'} ;
$rdata.= pack("C",length($self->{'hnxtnamebin'}));
$rdata .= $self->{'hnxtnamebin'};
$rdata .= $self->typebm();
}
return $rdata;
}
sub _normalize_dnames {
my $self=shift;
$self->_normalize_ownername();
$self->{'hnxtname'}= Net::DNS::stripdot($self->{'hnxtname'}) if defined $self->{'hnxtname'};
$self->{'hnxtnamebin'}=MIME::Base32::decode(uc $self->{'hnxtname'});
}
sub salt {
my ($self,$salt)=@_;
if (defined $salt){
if ($salt eq "-"){
$self->{'salt'} = "" ;
}else{
$self->{'salt'} = $salt ;
unless ($salt =~ /^[0-9a-f]*$/i ) {
# print "input ($salt) not hex" ;
return undef;
}
$self->{'saltbin'} = pack("H*",$salt);
}
}
return "-" if ($self->{'salt'} eq "");
return $self->{'salt'};
}
sub name2hash {
my $hashalg=shift;
my $inname= lc shift;
my $iterations=shift;
my $saltbin=shift;
my $hashfunc;
if ($hashalg==1){
$hashfunc = sub {my $x=shift ; return sha1($x)};
}elsif($hashalg==2){
$hashfunc = sub {my $x=shift ; return sha256($x)};
}else{
return;
}
my $wirename=Net::DNS::RR->_name2wire($inname);
my $i=0;
for (0..$iterations)
{
$wirename=&$hashfunc($wirename.$saltbin);
}
return lc MIME::Base32::encode $wirename;
}
sub ownername {
my $self=shift;
if (defined $self->{'ownername'}){
return $self->{'ownername'};
}else{
return $self->{'ownername'} = (name2labels($self->name))[0] ;
}
}
sub _zonelabels {
# Extracts the labels that make up the zone from the owner name of the
# record, simply by stripping the first label.
# returns an array of labels in wire format.
my $self=shift;
unless (defined $self->{'zonelabels'}){
my @labels= (name2labels($self->name)) ;
shift @labels;
$self->{'zonelabels'} = \@labels ;
}
return @{$self->{'zonelabels'}};
}
sub _zone {
# Returns the result from the zonelabels method in presentation
# format (without trailing dot
my $self=shift;
my $name;
foreach my $label ($self->zonelabels){
$name .= wire2presentation($label) . ".";
}
chop($name);
return $name;
}
sub optout {
my ($self,$newval )= @_;
if (defined ($newval)) {
if ($newval){
$self->{'flags'} |= hex("0x01");
}else{
$self->{'flags'} &= ~hex("0x01");
}
}
return $self->{'flags'} & hex("0x01");
}
sub covered {
my $self=shift;
my $domainname=shift;
# first test if the domain name is in the NSEC zone.
my @domainlabels=name2labels($domainname);
my @zonelabels= $self->_zonelabels();
while (my $zlabel = pop @zonelabels ){
my $dlabel= pop @domainlabels;
return 0 unless ($dlabel eq $zlabel)
}
my $hashedname= Net::DNS::RR::NSEC3::name2hash(
$self->hashalgo,
$domainname,
$self->iterations,
$self->saltbin,
);
if ( (lc $self->ownername() cmp lc $self->hnxtname() )== 1 ) {
# last name in the zone.
return 1 if ( ( lc $hashedname cmp lc $self->hnxtname() ) == 1 );
return 1 if ( ( lc $hashedname cmp lc $self->ownername() ) == -1 );
}
elsif ( (lc $self->ownername() cmp lc $self->hnxtname() )== 0 ) {
# One entry in the zone.
return 1;
}else{
return 1 if ( (lc $self->ownername() cmp lc $hashedname) == -1 )
&&
( ( lc $hashedname cmp lc $self->hnxtname() ) == -1 );
}
return 0;
}
sub match {
my $self=shift;
my $domainname=shift;
my $ownername=$self->ownername();
my $hashedname= Net::DNS::RR::NSEC3::name2hash(
$self->hashalgo,
$domainname,
$self->iterations,
$self->saltbin
);
return $ownername eq $hashedname;
}
sub digtype {
my $self=shift;
$self->{'digestbyname'}= \%digestbyname;
$self->_digtype(@_);
}
1;
=head1 NAME
Net::DNS::RR::NSEC3 - DNS NSEC3 resource record
=head1 SYNOPSIS
C<use Net::DNS::RR;>
=head1 DESCRIPTION
Class for DNS Address (NSEC3) resource records.
The NSEC3 Resource Record (RR) provides authenticated denial of
existence for DNS Resource Record Sets. The NSEC3 RR lists RR types
present at the NSEC3 RR's original ownername. It includes the next
hashed ownername in the hash order of the zone. The complete set of
NSEC3 RRs in a zone indicates which RRsets exist for the original
ownername of the RRset and form a chain of hashed ownernames in the
zone.
=head1 METHODS
=head2 ownername
Returns the hashed value of the original owner name as contained in the first
label of the ownername of the record.
The owner name for the NSEC3 RR is the base32 encoding of the hashed
owner name prepended as a single label to the name of the zone.
In other words the name(name) method returns the result of the
ownername() method prepended to the name of the containing zone.
=head2 optout
Reads and sets the opt-out attribute.
=head2 flags
Reads and sets the flag field.
=head2 hashalgo
Reads and sets the hashalgo (hash algorithm) attribute.
=head2 hnxtname
Reads and sets the hnxtname (hashed next ownername) attribute.
=head2 typelist (inhereted from NSEC)
print "typelist" = ", $rr->typelist, "\n";
Returns a string with the list of qtypes for which data exists for
this particular label.
=head2 typebm (inhereted from NSEC)
print "typebm" = " unpack("B*", $rr->typebm), "\n";
Same as the typelist but now in a representation bitmap as in
specified in the RFC. This is not the kind of method you will need
on daily basis.
=head2 covered, matched
print "covered" if $rr->covered{'example.foo'}
covered returns a nonzero value when the the domain name provided as argument
is covered as defined in the NSEC3 specification:
To cover: An NSEC3 RR is said to "cover" a name if the hash of the
name or "next closer" name falls between the owner name and the
next hashed owner name of the NSEC3. In other words, if it proves
the nonexistence of the name, either directly or by proving the
nonexistence of an ancestor of the name.
Similarly ismatched returns a nonzero value when the domainname in the argument
matches as defined in the NSEC3 specification:
To match: An NSEC3 RR is said to "match" a name if the owner name
of the NSEC3 RR is the same as the hashed owner name of that
name.
=head1 Functions
=head2 name2hash
Takes the hash identifyer (numeric), a fullyqualfied domain name, the
number of iterations and a binary salt to compute the hash value used
in the NSEC3 calculations.
$hashalg=Net::DNS::SEC->digtype("SHA1");
$salt=pack("H*","aabbccdd");
$iterations=12;
$name="*.x.w.example";
$hashedname= Net::DNS::RR::NSEC3::name2hash($hashalg,$name,$iterations,$salt);
print $hashedname;
results in:
92pqneegtaue7pjatc3l3qnk738c6v5m
Normally the salt and itterations would be fetched from an NSEC3PARAM record.
=head1 COPYRIGHT
Copyright (c) 2007, 2008 NLnet Labs. Author Olaf M. Kolkman <olaf@net-dns.org>
All Rights Reserved
Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted,
provided that the above copyright notice appear in all copies and that
both that copyright notice and this permission notice appear in
supporting documentation, and that the name of the author not be
used in advertising or publicity pertaining to distribution of the
software without specific, written prior permission.
THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO EVENT SHALL
AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
Based on, and contains, code by Copyright (c) 1997 Michael Fuhr.
Acknowledgements to Roy Arends who made a test version for this class
and whose code I've looked at before writing this module.
=head1 SEE ALSO
L<http://www.net-dns.org/>
L<http://www.iana.org/assignments/dnssec-nsec3-parameters>
L<Net::DNS::RR::NSEC3PARAM>,
L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
RFC4033, RFC4034, RFC4035, RFC5155
=cut