File Coverage

blib/lib/Net/DNS/RR/CERT.pm
Criterion Covered Total %
statement 67 67 100.0
branch 16 16 100.0
condition 6 6 100.0
subroutine 20 20 100.0
pod 6 8 100.0
total 115 117 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::RR::CERT;
2              
3 1     1   7 use strict;
  1         2  
  1         32  
4 1     1   6 use warnings;
  1         2  
  1         60  
5             our $VERSION = (qw$Id: CERT.pm 1896 2023-01-30 12:59:25Z willem $)[2];
6              
7 1     1   6 use base qw(Net::DNS::RR);
  1         2  
  1         133  
8              
9              
10             =head1 NAME
11              
12             Net::DNS::RR::CERT - DNS CERT resource record
13              
14             =cut
15              
16 1     1   7 use integer;
  1         3  
  1         8  
17              
18 1     1   39 use Carp;
  1         2  
  1         74  
19 1     1   5 use MIME::Base64;
  1         2  
  1         1268  
20              
21             my %certtype = (
22             PKIX => 1, # X.509 as per PKIX
23             SPKI => 2, # SPKI certificate
24             PGP => 3, # OpenPGP packet
25             IPKIX => 4, # The URL of an X.509 data object
26             ISPKI => 5, # The URL of an SPKI certificate
27             IPGP => 6, # The fingerprint and URL of an OpenPGP packet
28             ACPKIX => 7, # Attribute Certificate
29             IACPKIX => 8, # The URL of an Attribute Certificate
30             URI => 253, # URI private
31             OID => 254, # OID private
32             );
33              
34              
35             sub _decode_rdata { ## decode rdata from wire-format octet string
36 1     1   2 my ( $self, $data, $offset ) = @_;
37              
38 1         5 @{$self}{qw(certtype keytag algorithm)} = unpack "\@$offset n2 C", $$data;
  1         4  
39 1         4 $self->{certbin} = substr $$data, $offset + 5, $self->{rdlength} - 5;
40 1         3 return;
41             }
42              
43              
44             sub _encode_rdata { ## encode rdata as wire-format octet string
45 5     5   10 my $self = shift;
46              
47 5         10 return pack "n2 C a*", $self->certtype, $self->keytag, $self->algorithm, $self->{certbin};
48             }
49              
50              
51             sub _format_rdata { ## format rdata portion of RR string.
52 2     2   2 my $self = shift;
53              
54 2         5 my @param = ( $self->certtype, $self->keytag, $self->algorithm );
55 2         18 my @rdata = ( @param, split /\s+/, encode_base64( $self->{certbin} ) );
56 2         9 return @rdata;
57             }
58              
59              
60             sub _parse_rdata { ## populate RR from rdata in argument list
61 6     6   15 my ( $self, @argument ) = @_;
62              
63 6         14 foreach (qw(certtype keytag algorithm)) {
64 18         41 $self->$_( shift @argument );
65             }
66 6         20 $self->cert(@argument);
67 6         15 return;
68             }
69              
70              
71             sub certtype {
72 20     20 1 84 my ( $self, @value ) = @_;
73              
74 20 100       69 return $self->{certtype} unless scalar @value;
75              
76 9         18 my $certtype = shift @value;
77 9 100       45 return $self->{certtype} = $certtype unless $certtype =~ /\D/;
78              
79 2         5 my $typenum = $certtype{$certtype};
80 2 100       93 $typenum || croak qq[unknown certtype $certtype];
81 1         5 return $self->{certtype} = $typenum;
82             }
83              
84              
85             sub keytag {
86 18     18 1 559 my ( $self, @value ) = @_;
87 18         35 for (@value) { $self->{keytag} = 0 + $_ }
  7         18  
88 18   100     59 return $self->{keytag} || 0;
89             }
90              
91              
92             sub algorithm {
93 20     20 1 585 my ( $self, $arg ) = @_;
94              
95 20 100       65 return $self->{algorithm} unless defined $arg;
96 11 100       30 return _algbyval( $self->{algorithm} ) if uc($arg) eq 'MNEMONIC';
97 9         16 return $self->{algorithm} = _algbyname($arg);
98             }
99              
100              
101 2     2 1 542 sub certificate { return &certbin; }
102              
103              
104             sub certbin {
105 11     11 1 26 my ( $self, @value ) = @_;
106 11         16 for (@value) { $self->{certbin} = $_ }
  7         20  
107 11   100     49 return $self->{certbin} || "";
108             }
109              
110              
111             sub cert {
112 9     9 1 538 my ( $self, @value ) = @_;
113 9 100       22 return MIME::Base64::encode( $self->certbin(), "" ) unless scalar @value;
114 7         32 return $self->certbin( MIME::Base64::decode( join "", @value ) );
115             }
116              
117              
118 2     2 0 518 sub format { return &certtype; } # uncoverable pod
119              
120 2     2 0 594 sub tag { return &keytag; } # uncoverable pod
121              
122              
123             ########################################
124              
125             {
126             my @algbyname = (
127             'DELETE' => 0, # [RFC4034][RFC4398][RFC8078]
128             'RSAMD5' => 1, # [RFC3110][RFC4034]
129             'DH' => 2, # [RFC2539]
130             'DSA' => 3, # [RFC3755][RFC2536]
131             ## Reserved => 4, # [RFC6725]
132             'RSASHA1' => 5, # [RFC3110][RFC4034]
133             'DSA-NSEC3-SHA1' => 6, # [RFC5155]
134             'RSASHA1-NSEC3-SHA1' => 7, # [RFC5155]
135             'RSASHA256' => 8, # [RFC5702]
136             ## Reserved => 9, # [RFC6725]
137             'RSASHA512' => 10, # [RFC5702]
138             ## Reserved => 11, # [RFC6725]
139             'ECC-GOST' => 12, # [RFC5933]
140             'ECDSAP256SHA256' => 13, # [RFC6605]
141             'ECDSAP384SHA384' => 14, # [RFC6605]
142             'ED25519' => 15, # [RFC8080]
143             'ED448' => 16, # [RFC8080]
144              
145             'INDIRECT' => 252, # [RFC4034]
146             'PRIVATEDNS' => 253, # [RFC4034]
147             'PRIVATEOID' => 254, # [RFC4034]
148             ## Reserved => 255, # [RFC4034]
149             );
150              
151             my %algbyval = reverse @algbyname;
152              
153             foreach (@algbyname) { s/[\W_]//g; } # strip non-alphanumerics
154             my @algrehash = map { /^\d/ ? ($_) x 3 : uc($_) } @algbyname;
155             my %algbyname = @algrehash; # work around broken cperl
156              
157             sub _algbyname {
158 9     9   16 my $arg = shift;
159 9         13 my $key = uc $arg; # synthetic key
160 9         23 $key =~ s/[\W_]//g; # strip non-alphanumerics
161 9         18 my $val = $algbyname{$key};
162 9 100       29 return $val if defined $val;
163 2 100       232 return $key =~ /^\d/ ? $arg : croak qq[unknown algorithm $arg];
164             }
165              
166             sub _algbyval {
167 2     2   4 my $value = shift;
168 2   100     12 return $algbyval{$value} || return $value;
169             }
170             }
171              
172             ########################################
173              
174              
175             1;
176             __END__