File Coverage

blib/lib/Net/DNS/RR/NSEC.pm

Criterion	Covered	Total	%
statement	129	129	100.0
branch	18	18	100.0
condition	9	9	100.0
subroutine	23	23	100.0
pod	8	10	100.0
total	187	189	100.0

package Net::DNS::RR::NSEC;

use strict;
use warnings;
our $VERSION = (qw$Id: NSEC.pm 1896 2023-01-30 12:59:25Z willem $)[2];

use base qw(Net::DNS::RR);


=head1 NAME

Net::DNS::RR::NSEC - DNS NSEC resource record

=cut

use integer;

use Net::DNS::DomainName;
use Net::DNS::Parameters qw(:type);


sub _decode_rdata {			## decode rdata from wire-format octet string
	my ( $self, $data, $offset ) = @_;

	my $limit = $offset + $self->{rdlength};
	( $self->{nxtdname}, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
	$self->{typebm} = substr $$data, $offset, $limit - $offset;
	return;
}


sub _encode_rdata {			## encode rdata as wire-format octet string
	my $self = shift;

	my $nxtdname = $self->{nxtdname};
	return join '', $nxtdname->encode(), $self->{typebm};
}


sub _format_rdata {			## format rdata portion of RR string.
	my $self = shift;

	my $nxtdname = $self->{nxtdname};
	return ( $nxtdname->string(), $self->typelist );
}


sub _parse_rdata {			## populate RR from rdata in argument list
	my ( $self, @argument ) = @_;

	$self->nxtdname( shift @argument );
	$self->typelist(@argument);
	return;
}


sub _defaults {				## specify RR attribute default values
	my $self = shift;

	$self->_parse_rdata('.');
	return;
}


sub nxtdname {
	my ( $self, @value ) = @_;
	for (@value) { $self->{nxtdname} = Net::DNS::DomainName->new($_) }
	return $self->{nxtdname} ? $self->{nxtdname}->name : undef;
}


sub typelist {
	my ( $self, @argument ) = @_;

	if ( scalar(@argument) || !defined(wantarray) ) {
		$self->{typebm} = &_type2bm(@argument);
		return;
	}

	my @type = &_bm2type( $self->{typebm} );
	return wantarray ? (@type) : "@type";
}


sub typemap {
	my ( $self, $type ) = @_;

	my $number = typebyname($type);
	my $window = $number >> 8;
	my $bitnum = $number & 255;

	my $typebm = $self->{typebm} || return;
	my @bitmap;
	my $index = 0;
	while ( $index < length $typebm ) {
		my ( $block, $size ) = unpack "\@$index C2", $typebm;
		$bitmap[$block] = unpack "\@$index xxa$size", $typebm;
		$index += $size + 2;
	}

	my @bit = split //, unpack 'B*', ( $bitmap[$window] || return );
	return $bit[$bitnum];
}


sub match {
	my ( $self, $qname ) = @_;
	my $name = Net::DNS::DomainName->new($qname)->canonical;
	return $name eq $self->{owner}->canonical;
}


sub covers {
	my ( $self, $qname ) = @_;
	my $name = join chr(0), reverse Net::DNS::DomainName->new($qname)->_wire;
	my $this = join chr(0), reverse $self->{owner}->_wire;
	my $next = join chr(0), reverse $self->{nxtdname}->_wire;
	foreach ( $name, $this, $next ) {tr /\101-\132/\141-\172/}

	return ( $name cmp $this ) + ( "$next\001" cmp $name ) == 2 unless $next gt $this;
	return ( $name cmp $this ) + ( $next cmp $name ) == 2;
}


sub encloser {
	my ( $self, $qname ) = @_;
	my @label = Net::DNS::Domain->new($qname)->label;

	my @owner = $self->{owner}->label;
	my $depth = scalar(@owner);
	my $next;
	while ( scalar(@label) > $depth ) {
		$next = shift @label;
	}

	return unless defined $next;

	my $nextcloser = join( '.', $next, @label );
	return if lc($nextcloser) ne lc( join '.', $next, @owner );

	$self->{nextcloser} = $nextcloser;
	$self->{wildcard}   = join( '.', '*', @label );
	return $self->owner;
}


sub nextcloser { return shift->{nextcloser}; }

sub wildcard { return shift->{wildcard}; }


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

sub _type2bm {
	my @typelist = @_;
	my @typearray;
	foreach my $typename ( map { split() } @typelist ) {
		my $number = typebyname($typename);
		my $window = $number >> 8;
		my $bitnum = $number & 255;
		my $octet  = $bitnum >> 3;
		my $bit	   = $bitnum & 7;
		$typearray[$window][$octet] |= 0x80 >> $bit;
	}

	my $bitmap = '';
	my $window = 0;
	foreach (@typearray) {
		if ( my $pane = $typearray[$window] ) {
			my @content = map { $_ || 0 } @$pane;
			$bitmap .= pack 'CC C*', $window, scalar(@content), @content;
		}
		$window++;
	}

	return $bitmap;
}


sub _bm2type {
	my @empty;
	my $bitmap = shift || return @empty;

	my $index = 0;
	my $limit = length $bitmap;
	my @typelist;

	while ( $index < $limit ) {
		my ( $block, $size ) = unpack "\@$index C2", $bitmap;
		my $typenum = $block << 8;
		foreach my $octet ( unpack "\@$index xxC$size", $bitmap ) {
			my $i = $typenum += 8;
			my @name;
			while ($octet) {
				--$i;
				unshift @name, typebyval($i) if $octet & 1;
				$octet = $octet >> 1;
			}
			push @typelist, @name;
		}
		$index += $size + 2;
	}

	return @typelist;
}


sub typebm {				## historical
	my ( $self, @typebm ) = @_;				# uncoverable pod
	for (@typebm) { $self->{typebm} = $_ }
	$self->_deprecate('prefer $rr->typelist() or $rr->typemap()');
	return $self->{typebm};
}

sub covered {				## historical
	my ( $self, @argument ) = @_;				# uncoverable pod
	return $self->covers(@argument);
}

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


1;
__END__