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


line stmt bran cond sub pod time code
1             package Net::DNS::RR::IPSECKEY;
2              
3 2     2   15 use strict;
  2         6  
  2         70  
4 2     2   11 use warnings;
  2         4  
  2         159  
5             our $VERSION = (qw$Id: IPSECKEY.pm 1909 2023-03-23 11:36:16Z willem $)[2];
6              
7 2     2   16 use base qw(Net::DNS::RR);
  2         6  
  2         208  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::IPSECKEY - DNS IPSECKEY resource record
13              
14             =cut
15              
16 2     2   16 use integer;
  2         5  
  2         15  
17              
18 2     2   88 use Carp;
  2         3  
  2         174  
19              
20 2     2   16 use Net::DNS::DomainName;
  2         7  
  2         51  
21 2     2   503 use Net::DNS::RR::A;
  2         5  
  2         56  
22 2     2   535 use Net::DNS::RR::AAAA;
  2         6  
  2         91  
23              
24 2     2   16 use constant BASE64 => defined eval { require MIME::Base64 };
  2         3  
  2         9  
  2         2828  
25              
26             my %wireformat = (
27             0 => 'C3 a0 a*',
28             1 => 'C3 a4 a*',
29             2 => 'C3 a16 a*',
30             3 => 'C3 a* a*',
31             );
32              
33              
34             sub _decode_rdata { ## decode rdata from wire-format octet string
35 30     30   53 my ( $self, $data, $offset ) = @_;
36              
37 30         58 my $limit = $offset + $self->{rdlength};
38              
39 30         81 @{$self}{qw(precedence gatetype algorithm)} = unpack "\@$offset C3", $$data;
  30         104  
40 30         52 $offset += 3;
41              
42 30         45 my $gatetype = $self->{gatetype};
43 30 100       137 if ( not $gatetype ) {
    100          
    100          
    100          
44 7         16 $self->{gateway} = undef; # no gateway
45              
46             } elsif ( $gatetype == 1 ) {
47 7         32 $self->{gateway} = unpack "\@$offset a4", $$data;
48 7         16 $offset += 4;
49              
50             } elsif ( $gatetype == 2 ) {
51 7         33 $self->{gateway} = unpack "\@$offset a16", $$data;
52 7         22 $offset += 16;
53              
54             } elsif ( $gatetype == 3 ) {
55 8         20 my $name;
56 8         21 ( $name, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
57 8         42 $self->{gateway} = $name->encode;
58              
59             } else {
60 1         32 die "unknown gateway type ($gatetype)";
61             }
62              
63 29         121 $self->keybin( substr $$data, $offset, $limit - $offset );
64 29         69 return;
65             }
66              
67              
68             sub _encode_rdata { ## encode rdata as wire-format octet string
69 9     9   16 my $self = shift;
70              
71 9         17 my $gatetype = $self->gatetype;
72 9         16 my $gateway = $self->{gateway};
73 9         17 my $precedence = $self->precedence;
74 9         17 my $algorithm = $self->algorithm;
75 9         15 my $keybin = $self->keybin;
76              
77 9         42 return pack $wireformat{$gatetype}, $precedence, $gatetype, $algorithm, $gateway, $keybin;
78             }
79              
80              
81             sub _format_rdata { ## format rdata portion of RR string.
82 23     23   35 my $self = shift;
83              
84 23         31 return $self->SUPER::_format_rdata() unless BASE64;
85 23         41 my @rdata = map { $self->$_ } qw(precedence gatetype algorithm);
  69         134  
86 23         58 my @base64 = split /\s+/, MIME::Base64::encode( $self->keybin );
87 23         65 push @rdata, ( $self->gateway, @base64 );
88 23         85 return @rdata;
89             }
90              
91              
92             sub _parse_rdata { ## populate RR from rdata in argument list
93 7     7   20 my ( $self, @argument ) = @_;
94              
95 7         12 foreach (qw(precedence gatetype algorithm gateway)) { $self->$_( shift @argument ) }
  28         62  
96 7         20 $self->key(@argument);
97 7         16 return;
98             }
99              
100              
101             sub precedence {
102 42     42 1 84 my ( $self, @value ) = @_;
103 42         76 for (@value) { $self->{precedence} = 0 + $_ }
  8         25  
104 42   100     137 return $self->{precedence} || 0;
105             }
106              
107              
108             sub gatetype {
109 71   100 71 1 1058 return shift->{gatetype} || 0;
110             }
111              
112              
113             sub algorithm {
114 42     42 1 880 my ( $self, @value ) = @_;
115 42         67 for (@value) { $self->{algorithm} = 0 + $_ }
  8         32  
116 42   100     129 return $self->{algorithm} || 0;
117             }
118              
119              
120             sub gateway {
121 42     42 1 2631 my ( $self, @value ) = @_;
122              
123 42         79 for (@value) {
124 13 100       63 /^\.*$/ && do {
125 2         4 $self->{gatetype} = 0;
126 2         4 $self->{gateway} = ''; # no gateway
127 2         4 last;
128             };
129 11 100       29 /:.*:/ && do {
130 2         4 $self->{gatetype} = 2;
131 2         9 $self->{gateway} = Net::DNS::RR::AAAA::address( {}, $_ );
132 2         7 last;
133             };
134 9 100       36 /\.\d+$/ && do {
135 2         5 $self->{gatetype} = 1;
136 2         7 $self->{gateway} = Net::DNS::RR::A::address( {}, $_ );
137 2         15 last;
138             };
139 7 100       23 /\..+/ && do {
140 6         13 $self->{gatetype} = 3;
141 6         20 $self->{gateway} = Net::DNS::DomainName->new($_)->encode;
142 6         13 last;
143             };
144 1         137 croak 'unrecognised gateway type';
145             }
146              
147 41 100       83 if ( defined wantarray ) {
148 29         65 my $gateway = $self->{gateway};
149 29         48 for ( $self->gatetype ) {
150 29 100       103 /^1$/ && return Net::DNS::RR::A::address( {address => $gateway} );
151 23 100       62 /^2$/ && return Net::DNS::RR::AAAA::address( {address => $gateway} );
152 17 100       63 /^3$/ && return Net::DNS::DomainName->decode( \$gateway )->name;
153             }
154 7 100       30 return wantarray ? '.' : undef;
155             }
156 12         29 return;
157             }
158              
159              
160             sub key {
161 12     12 1 822 my ( $self, @value ) = @_;
162 12 100       32 return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @value;
163 8         37 return $self->keybin( MIME::Base64::decode( join "", @value ) );
164             }
165              
166              
167             sub keybin {
168 75     75 1 691 my ( $self, @value ) = @_;
169 75         181 for (@value) { $self->{keybin} = $_ }
  37         92  
170 75   100     336 return $self->{keybin} || "";
171             }
172              
173              
174 2     2 1 534 sub pubkey { return &key; }
175              
176              
177             my $function = sub { ## sort RRs in numerically ascending order.
178             return $Net::DNS::a->{'preference'} <=> $Net::DNS::b->{'preference'};
179             };
180              
181             __PACKAGE__->set_rrsort_func( 'preference', $function );
182              
183             __PACKAGE__->set_rrsort_func( 'default_sort', $function );
184              
185              
186             1;
187             __END__