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   20 use strict;
  2         5  
  2         78  
4 2     2   12 use warnings;
  2         4  
  2         149  
5             our $VERSION = (qw$Id: IPSECKEY.pm 1909 2023-03-23 11:36:16Z willem $)[2];
6              
7 2     2   17 use base qw(Net::DNS::RR);
  2         5  
  2         233  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::IPSECKEY - DNS IPSECKEY resource record
13              
14             =cut
15              
16 2     2   17 use integer;
  2         6  
  2         22  
17              
18 2     2   85 use Carp;
  2         5  
  2         223  
19              
20 2     2   20 use Net::DNS::DomainName;
  2         6  
  2         62  
21 2     2   511 use Net::DNS::RR::A;
  2         5  
  2         63  
22 2     2   493 use Net::DNS::RR::AAAA;
  2         5  
  2         96  
23              
24 2     2   19 use constant BASE64 => defined eval { require MIME::Base64 };
  2         7  
  2         4  
  2         2856  
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   60 my ( $self, $data, $offset ) = @_;
36              
37 30         53 my $limit = $offset + $self->{rdlength};
38              
39 30         88 @{$self}{qw(precedence gatetype algorithm)} = unpack "\@$offset C3", $$data;
  30         122  
40 30         54 $offset += 3;
41              
42 30         50 my $gatetype = $self->{gatetype};
43 30 100       117 if ( not $gatetype ) {
    100          
    100          
    100          
44 7         22 $self->{gateway} = undef; # no gateway
45              
46             } elsif ( $gatetype == 1 ) {
47 7         28 $self->{gateway} = unpack "\@$offset a4", $$data;
48 7         20 $offset += 4;
49              
50             } elsif ( $gatetype == 2 ) {
51 7         30 $self->{gateway} = unpack "\@$offset a16", $$data;
52 7         14 $offset += 16;
53              
54             } elsif ( $gatetype == 3 ) {
55 8         17 my $name;
56 8         31 ( $name, $offset ) = Net::DNS::DomainName->decode( $data, $offset );
57 8         55 $self->{gateway} = $name->encode;
58              
59             } else {
60 1         32 die "unknown gateway type ($gatetype)";
61             }
62              
63 29         174 $self->keybin( substr $$data, $offset, $limit - $offset );
64 29         78 return;
65             }
66              
67              
68             sub _encode_rdata { ## encode rdata as wire-format octet string
69 9     9   15 my $self = shift;
70              
71 9         19 my $gatetype = $self->gatetype;
72 9         26 my $gateway = $self->{gateway};
73 9         18 my $precedence = $self->precedence;
74 9         20 my $algorithm = $self->algorithm;
75 9         19 my $keybin = $self->keybin;
76              
77 9         43 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   40 my $self = shift;
83              
84 23         27 return $self->SUPER::_format_rdata() unless BASE64;
85 23         41 my @rdata = map { $self->$_ } qw(precedence gatetype algorithm);
  69         136  
86 23         56 my @base64 = split /\s+/, MIME::Base64::encode( $self->keybin );
87 23         66 push @rdata, ( $self->gateway, @base64 );
88 23         84 return @rdata;
89             }
90              
91              
92             sub _parse_rdata { ## populate RR from rdata in argument list
93 7     7   19 my ( $self, @argument ) = @_;
94              
95 7         14 foreach (qw(precedence gatetype algorithm gateway)) { $self->$_( shift @argument ) }
  28         60  
96 7         30 $self->key(@argument);
97 7         16 return;
98             }
99              
100              
101             sub precedence {
102 42     42 1 76 my ( $self, @value ) = @_;
103 42         70 for (@value) { $self->{precedence} = 0 + $_ }
  8         24  
104 42   100     134 return $self->{precedence} || 0;
105             }
106              
107              
108             sub gatetype {
109 71   100 71 1 1278 return shift->{gatetype} || 0;
110             }
111              
112              
113             sub algorithm {
114 42     42 1 1132 my ( $self, @value ) = @_;
115 42         66 for (@value) { $self->{algorithm} = 0 + $_ }
  8         16  
116 42   100     118 return $self->{algorithm} || 0;
117             }
118              
119              
120             sub gateway {
121 42     42 1 3261 my ( $self, @value ) = @_;
122              
123 42         74 for (@value) {
124 13 100       56 /^\.*$/ && do {
125 2         5 $self->{gatetype} = 0;
126 2         4 $self->{gateway} = ''; # no gateway
127 2         3 last;
128             };
129 11 100       38 /:.*:/ && do {
130 2         5 $self->{gatetype} = 2;
131 2         8 $self->{gateway} = Net::DNS::RR::AAAA::address( {}, $_ );
132 2         7 last;
133             };
134 9 100       34 /\.\d+$/ && do {
135 2         8 $self->{gatetype} = 1;
136 2         6 $self->{gateway} = Net::DNS::RR::A::address( {}, $_ );
137 2         6 last;
138             };
139 7 100       36 /\..+/ && do {
140 6         14 $self->{gatetype} = 3;
141 6         24 $self->{gateway} = Net::DNS::DomainName->new($_)->encode;
142 6         15 last;
143             };
144 1         121 croak 'unrecognised gateway type';
145             }
146              
147 41 100       76 if ( defined wantarray ) {
148 29         50 my $gateway = $self->{gateway};
149 29         45 for ( $self->gatetype ) {
150 29 100       97 /^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       68 /^3$/ && return Net::DNS::DomainName->decode( \$gateway )->name;
153             }
154 7 100       29 return wantarray ? '.' : undef;
155             }
156 12         29 return;
157             }
158              
159              
160             sub key {
161 12     12 1 1089 my ( $self, @value ) = @_;
162 12 100       31 return MIME::Base64::encode( $self->keybin(), "" ) unless scalar @value;
163 8         35 return $self->keybin( MIME::Base64::decode( join "", @value ) );
164             }
165              
166              
167             sub keybin {
168 75     75 1 803 my ( $self, @value ) = @_;
169 75         133 for (@value) { $self->{keybin} = $_ }
  37         85  
170 75   100     332 return $self->{keybin} || "";
171             }
172              
173              
174 2     2 1 653 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__