File Coverage

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

Criterion	Covered	Total	%
statement	109	109	100.0
branch	28	28	100.0
condition	8	8	100.0
subroutine	20	20	100.0
pod	7	7	100.0
total	172	172	100.0

package Net::DNS::RR::IPSECKEY;

use strict;
use warnings;
our $VERSION = (qw$Id: IPSECKEY.pm 1909 2023-03-23 11:36:16Z willem $)[2];

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


=head1 NAME

Net::DNS::RR::IPSECKEY - DNS IPSECKEY resource record

=cut

use integer;

use Carp;

use Net::DNS::DomainName;
use Net::DNS::RR::A;
use Net::DNS::RR::AAAA;

use constant BASE64 => defined eval { require MIME::Base64 };

my %wireformat = (
	0 => 'C3 a0 a*',
	1 => 'C3 a4 a*',
	2 => 'C3 a16 a*',
	3 => 'C3 a* a*',
	);


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

	my $limit = $offset + $self->{rdlength};

	@{$self}{qw(precedence gatetype algorithm)} = unpack "\@$offset C3", $$data;
	$offset += 3;

	my $gatetype = $self->{gatetype};
	if ( not $gatetype ) {
		$self->{gateway} = undef;			# no gateway

	} elsif ( $gatetype == 1 ) {
		$self->{gateway} = unpack "\@$offset a4", $$data;
		$offset += 4;

	} elsif ( $gatetype == 2 ) {
		$self->{gateway} = unpack "\@$offset a16", $$data;
		$offset += 16;

	} elsif ( $gatetype == 3 ) {
		my $name;
		( $name, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
		$self->{gateway} = $name->encode;

	} else {
		die "unknown gateway type ($gatetype)";
	}

	$self->keybin( substr $$data, $offset, $limit - $offset );
	return;
}


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

	my $gatetype   = $self->gatetype;
	my $gateway    = $self->{gateway};
	my $precedence = $self->precedence;
	my $algorithm  = $self->algorithm;
	my $keybin     = $self->keybin;

	return pack $wireformat{$gatetype}, $precedence, $gatetype, $algorithm, $gateway, $keybin;
}


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

	return $self->SUPER::_format_rdata() unless BASE64;
	my @rdata  = map { $self->$_ } qw(precedence gatetype algorithm);
	my @base64 = split /\s+/, MIME::Base64::encode( $self->keybin );
	push @rdata, ( $self->gateway, @base64 );
	return @rdata;
}


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

	foreach (qw(precedence gatetype algorithm gateway)) { $self->$_( shift @argument ) }
	$self->key(@argument);
	return;
}


sub precedence {
	my ( $self, @value ) = @_;
	for (@value) { $self->{precedence} = 0 + $_ }
	return $self->{precedence} || 0;
}


sub gatetype {
	return shift->{gatetype} || 0;
}


sub algorithm {
	my ( $self, @value ) = @_;
	for (@value) { $self->{algorithm} = 0 + $_ }
	return $self->{algorithm} || 0;
}


sub gateway {
	my ( $self, @value ) = @_;

	for (@value) {
		/^\.*$/ && do {
			$self->{gatetype} = 0;
			$self->{gateway}  = '';			# no gateway
			last;
		};
		/:.*:/ && do {
			$self->{gatetype} = 2;
			$self->{gateway}  = Net::DNS::RR::AAAA::address( {}, $_ );
			last;
		};
		/\.\d+$/ && do {
			$self->{gatetype} = 1;
			$self->{gateway}  = Net::DNS::RR::A::address( {}, $_ );
			last;
		};
		/\..+/ && do {
			$self->{gatetype} = 3;
			$self->{gateway}  = Net::DNS::DomainName->new($_)->encode;
			last;
		};
		croak 'unrecognised gateway type';
	}

	if ( defined wantarray ) {
		my $gateway = $self->{gateway};
		for ( $self->gatetype ) {
			/^1$/ && return Net::DNS::RR::A::address( {address => $gateway} );
			/^2$/ && return Net::DNS::RR::AAAA::address( {address => $gateway} );
			/^3$/ && return Net::DNS::DomainName->decode( \$gateway )->name;
		}
		return wantarray ? '.' : undef;
	}
	return;
}


sub key {
	my ( $self, @value ) = @_;
	return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @value;
	return $self->keybin( MIME::Base64::decode( join "", @value ) );
}


sub keybin {
	my ( $self, @value ) = @_;
	for (@value) { $self->{keybin} = $_ }
	return $self->{keybin} || "";
}


sub pubkey { return &key; }


my $function = sub {			## sort RRs in numerically ascending order.
	return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'};
};

__PACKAGE__->set_rrsort_func( 'preference', $function );

__PACKAGE__->set_rrsort_func( 'default_sort', $function );


1;
__END__