File Coverage

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

Criterion	Covered	Total	%
statement	63	63	100.0
branch	4	4	100.0
path			n/a
condition	8	8	100.0
subroutine	17	17	100.0
pod	7	7	100.0
total	99	99	100.0

package Net::DNS::RR::TLSA;

use strict;
use warnings;
our $VERSION = (qw$Id: TLSA.pm 2003 2025-01-21 12:06:06Z willem $)[2];

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


=head1 NAME

Net::DNS::RR::TLSA - DNS TLSA resource record

=cut

use integer;

use Carp;
use constant BABBLE => defined eval { require Digest::BubbleBabble };


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

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

	@{$self}{qw(usage selector matchingtype)} = unpack "\@$offset C3", $$data;
	$offset += 3;
	$self->{certbin} = substr $$data, $offset, $next - $offset;
	return;
}


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

	return pack 'C3 a*', @{$self}{qw(usage selector matchingtype certbin)};
}


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

	$self->_annotation( $self->babble ) if BABBLE;
	my @cert  = split /(\S{64})/, $self->cert;
	my @rdata = ( $self->usage, $self->selector, $self->matchingtype, @cert );
	return @rdata;
}


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

	for (qw(usage selector matchingtype)) { $self->$_( shift @argument ) }
	$self->cert(@argument);
	return;
}


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


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


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


sub cert {
	my ( $self, @value ) = @_;
	return unpack "H*", $self->certbin() unless scalar @value;
	my @hex = map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @value;
	return $self->certbin( pack "H*", join "", @hex );
}


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


sub certificate { return &cert; }


sub babble {
	return BABBLE ? Digest::BubbleBabble::bubblebabble( Digest => shift->certbin ) : '';
}


1;
__END__