File Coverage

blib/lib/Net/DNS/RR/HIP.pm
Criterion Covered Total %
statement 85 85 100.0
branch 10 10 100.0
condition 8 8 100.0
subroutine 20 20 100.0
pod 6 9 100.0
total 129 132 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::RR::HIP;
2              
3 1     1   7 use strict;
  1         2  
  1         30  
4 1     1   6 use warnings;
  1         1  
  1         49  
5             our $VERSION = (qw$Id: HIP.pm 1896 2023-01-30 12:59:25Z willem $)[2];
6              
7 1     1   5 use base qw(Net::DNS::RR);
  1         2  
  1         97  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::HIP - DNS HIP resource record
13              
14             =cut
15              
16 1     1   7 use integer;
  1         1  
  1         8  
17              
18 1     1   40 use Carp;
  1         2  
  1         87  
19 1     1   8 use Net::DNS::DomainName;
  1         2  
  1         48  
20 1     1   5 use MIME::Base64;
  1         2  
  1         1161  
21              
22              
23             sub _decode_rdata { ## decode rdata from wire-format octet string
24 2     2   4 my ( $self, $data, $offset ) = @_;
25              
26 2         7 my ( $hitlen, $pklen ) = unpack "\@$offset Cxn", $$data;
27 2         10 @{$self}{qw(algorithm hitbin keybin)} = unpack "\@$offset xCxx a$hitlen a$pklen", $$data;
  2         7  
28              
29 2         4 my $limit = $offset + $self->{rdlength};
30 2         4 $offset += 4 + $hitlen + $pklen;
31 2         3 $self->{servers} = [];
32 2         6 while ( $offset < $limit ) {
33 4         6 my $item;
34 4         9 ( $item, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
35 4         8 push @{$self->{servers}}, $item;
  4         9  
36             }
37 2 100       248 croak('corrupt HIP data') unless $offset == $limit; # more or less FUBAR
38 1         2 return;
39             }
40              
41              
42             sub _encode_rdata { ## encode rdata as wire-format octet string
43 7     7   13 my $self = shift;
44              
45 7         14 my $hit = $self->hitbin;
46 7         15 my $key = $self->keybin;
47 7         16 my $nos = pack 'C2n a* a*', length($hit), $self->algorithm, length($key), $hit, $key;
48 7         11 return join '', $nos, map { $_->encode } @{$self->{servers}};
  12         28  
  7         13  
49             }
50              
51              
52             sub _format_rdata { ## format rdata portion of RR string.
53 3     3   13 my $self = shift;
54              
55 3         16 my $base64 = MIME::Base64::encode( $self->{keybin}, '' );
56 3         4 my @server = map { $_->string } @{$self->{servers}};
  4         13  
  3         15  
57 3         8 my @rdata = ( $self->algorithm, $self->hit, $base64, @server );
58 3         58 return @rdata;
59             }
60              
61              
62             sub _parse_rdata { ## populate RR from rdata in argument list
63 3     3   8 my ( $self, @argument ) = @_;
64              
65 3         7 foreach (qw(algorithm hit key)) { $self->$_( shift @argument ) }
  9         22  
66 3         8 $self->servers(@argument);
67 3         9 return;
68             }
69              
70              
71             sub algorithm {
72 18     18 1 38 my ( $self, @value ) = @_;
73 18         28 for (@value) { $self->{algorithm} = 0 + $_ }
  4         11  
74 18   100     73 return $self->{algorithm} || 0;
75             }
76              
77              
78             sub hit {
79 10     10 1 1163 my ( $self, @value ) = @_;
80 10 100       26 return unpack "H*", $self->hitbin() unless scalar @value;
81 5 100       11 my @hex = map { /^"*([\dA-Fa-f]*)"*$/ || croak("corrupt hex"); $1 } @value;
  5         115  
  4         18  
82 4         24 return $self->hitbin( pack "H*", join "", @hex );
83             }
84              
85              
86             sub hitbin {
87 16     16 1 28 my ( $self, @value ) = @_;
88 16         30 for (@value) { $self->{hitbin} = $_ }
  4         8  
89 16   100     65 return $self->{hitbin} || "";
90             }
91              
92              
93             sub key {
94 8     8 1 805 my ( $self, @value ) = @_;
95 8 100       19 return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @value;
96 4         23 return $self->keybin( MIME::Base64::decode( join "", @value ) );
97             }
98              
99              
100             sub keybin {
101 17     17 1 551 my ( $self, @value ) = @_;
102 17         27 for (@value) { $self->{keybin} = $_ }
  4         8  
103 17   100     65 return $self->{keybin} || "";
104             }
105              
106              
107             sub servers {
108 8     8 1 781 my ( $self, @names ) = @_;
109 8   100     39 my $servers = $self->{servers} ||= [];
110 8         16 for (@names) { push @$servers, Net::DNS::DomainName->new($_) }
  6         20  
111 8 100       25 return defined(wantarray) ? map( { $_->name } @$servers ) : ();
  1         8  
112             }
113              
114             sub rendezvousservers { ## historical
115 2     2 0 296 my @servers = &servers; # uncoverable pod
116 2         4 return \@servers;
117             }
118              
119             sub pkalgorithm { ## historical
120 2     2 0 368 return &algorithm; # uncoverable pod
121             }
122              
123             sub pubkey { ## historical
124 2     2 0 323 return &key; # uncoverable pod
125             }
126              
127              
128             1;
129             __END__