File Coverage

blib/lib/Net/DNS/SEC/Private.pm
Criterion Covered Total %
statement 61 61 100.0
branch 14 14 100.0
condition n/a
subroutine 14 14 100.0
pod 1 1 100.0
total 90 90 100.0


line stmt bran cond sub pod time code
1             package Net::DNS::SEC::Private;
2              
3 12     12   58963 use strict;
  12         45  
  12         488  
4 12     12   90 use warnings;
  12         57  
  12         746  
5              
6             our $VERSION = (qw$Id: Private.pm 1853 2021-10-11 10:40:59Z willem $)[2];
7              
8              
9             =head1 NAME
10              
11             Net::DNS::SEC::Private - DNSSEC Private key object
12              
13              
14             =head1 SYNOPSIS
15              
16             use Net::DNS::SEC::Private;
17              
18             $private = Net::DNS::SEC::Private->new( $keypath );
19              
20             $private = Net::DNS::SEC::Private->new(
21             'algorithm' => '13',
22             'keytag' => '26512',
23             'privatekey' => 'h/mc+iq9VDUbNAjQgi8S8JzlEX29IALchwJmNM3QYKk=',
24             'signame' => 'example.com.'
25             );
26              
27              
28             =head1 DESCRIPTION
29              
30             Class representing private keys as read from a keyfile generated by BIND
31             dnssec-keygen. The class is written to be used only in the context of the
32             Net::DNS::RR::RRSIG create method. This class is not designed to interact
33             with any other system.
34              
35             =cut
36              
37              
38 12     12   104 use integer;
  12         34  
  12         66  
39 12     12   342 use Carp;
  12         32  
  12         1277  
40 12     12   95 use File::Spec;
  12         215  
  12         415  
41 12     12   77 use IO::File;
  12         27  
  12         3997  
42              
43 12     12   101 use constant SYMLINK => defined(&CORE::readlink); # Except Win32, VMS, RISC OS
  12         26  
  12         8249  
44              
45              
46 21 100   21 1 64505 sub new { return scalar(@_) > 2 ? &_new_params : &_new_keyfile }
47              
48             sub _new_keyfile {
49 19     19   63 my ( $class, $file ) = @_;
50              
51 19         262 my ($keypath) = SYMLINK ? grep( {$_} readlink($file), $file ) : $file;
  38         140  
52 19         661 my ( $vol, $dir, $name ) = File::Spec->splitpath($keypath);
53              
54             # Format something like: 'Kbla.foo.+001+12345.private' as created by BIND dnssec-keygen.
55 19 100       410 croak "$file does not appear to be a BIND private key"
56             unless $name =~ /^K([^+]+)\+(\d+)\+(\d+)\.private$/;
57 18         120 my @identifier = ( signame => $1, algorithm => 0 + $2, keytag => 0 + $3 );
58              
59 18 100       3775 my $handle = IO::File->new( $file, '<' ) or croak qq("$file": $!);
60              
61 17         1622 my @content;
62 17         35 local $_;
63 17         2427 while (<$handle>) {
64 163         255 chomp;
65 163 100       374 next if /^$/;
66 162 100       309 next if /^\s*[;]/;
67 160         310 s/\(.+\)//;
68 160         420 my ( $name, $value ) = split;
69 160         687 push @content, $name, $value;
70             }
71              
72 17         149 return $class->_new_params( @content, @identifier );
73             }
74              
75              
76             sub _new_params {
77 19     19   203 my ( $class, %parameter ) = @_;
78 19         50 my $hashref = {};
79              
80 19         132 while ( my ( $name, $value ) = each %parameter ) {
81 213         357 $name =~ tr/A-Za-z0-9\000-\377/a-za-z0-9/d;
82 213         678 $hashref->{$name} = $value;
83             }
84              
85 19     156   99 my $self = bless sub { $hashref->{shift()} }, $class;
  156         2116  
86 19 100       104 croak 'no algorithm specified' unless $self->algorithm;
87 18 100       89 croak 'no signame specified' unless $self->signame;
88 17         389 return $self;
89             }
90              
91              
92             our $AUTOLOAD;
93              
94             sub AUTOLOAD { ## Default method
95 57     57   2592 my ($self) = @_;
96              
97 57         397 my ($attribute) = $AUTOLOAD =~ m/::([^:]*)$/;
98 57         259 $attribute =~ tr/A-Za-z0-9\000-\377/a-za-z0-9/d;
99              
100             # Build a method in the class
101 12     12   101 no strict 'refs'; ## no critic ProhibitNoStrict
  12         36  
  12         1308  
102 57     156   207 *{$AUTOLOAD} = sub { &{shift()}($attribute) };
  57         249  
  156         690  
  156         385  
103              
104             # and jump to it
105 57         98 goto &{$AUTOLOAD};
  57         208  
106             }
107              
108              
109             1;
110             __END__