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   57027 use strict;
  12         42  
  12         417  
4 12     12   85 use warnings;
  12         34  
  12         763  
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   91 use integer;
  12         39  
  12         63  
39 12     12   280 use Carp;
  12         42  
  12         1263  
40 12     12   96 use File::Spec;
  12         184  
  12         440  
41 12     12   94 use IO::File;
  12         25  
  12         3707  
42              
43 12     12   88 use constant SYMLINK => defined(&CORE::readlink); # Except Win32, VMS, RISC OS
  12         27  
  12         8043  
44              
45              
46 21 100   21 1 61211 sub new { return scalar(@_) > 2 ? &_new_params : &_new_keyfile }
47              
48             sub _new_keyfile {
49 19     19   53 my ( $class, $file ) = @_;
50              
51 19         242 my ($keypath) = SYMLINK ? grep( {$_} readlink($file), $file ) : $file;
  38         123  
52 19         578 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       408 croak "$file does not appear to be a BIND private key"
56             unless $name =~ /^K([^+]+)\+(\d+)\+(\d+)\.private$/;
57 18         3919 my @identifier = ( signame => $1, algorithm => 0 + $2, keytag => 0 + $3 );
58              
59 18 100       98 my $handle = IO::File->new( $file, '<' ) or croak qq("$file": $!);
60              
61 17         1536 my @content;
62 17         31 local $_;
63 17         328 while (<$handle>) {
64 163         250 chomp;
65 163 100       350 next if /^$/;
66 162 100       307 next if /^\s*[;]/;
67 160         304 s/\(.+\)//;
68 160         422 my ( $name, $value ) = split;
69 160         656 push @content, $name, $value;
70             }
71              
72 17         134 return $class->_new_params( @content, @identifier );
73             }
74              
75              
76             sub _new_params {
77 19     19   177 my ( $class, %parameter ) = @_;
78 19         46 my $hashref = {};
79              
80 19         112 while ( my ( $name, $value ) = each %parameter ) {
81 213         360 $name =~ tr/A-Za-z0-9\000-\377/a-za-z0-9/d;
82 213         662 $hashref->{$name} = $value;
83             }
84              
85 19     156   85 my $self = bless sub { $hashref->{shift()} }, $class;
  156         1995  
86 19 100       97 croak 'no algorithm specified' unless $self->algorithm;
87 18 100       94 croak 'no signame specified' unless $self->signame;
88 17         357 return $self;
89             }
90              
91              
92             our $AUTOLOAD;
93              
94             sub AUTOLOAD { ## Default method
95 57     57   2526 my ($self) = @_;
96              
97 57         396 my ($attribute) = $AUTOLOAD =~ m/::([^:]*)$/;
98 57         204 $attribute =~ tr/A-Za-z0-9\000-\377/a-za-z0-9/d;
99              
100             # Build a method in the class
101 12     12   95 no strict 'refs'; ## no critic ProhibitNoStrict
  12         24  
  12         1252  
102 57     156   196 *{$AUTOLOAD} = sub { &{shift()}($attribute) };
  57         206  
  156         632  
  156         382  
103              
104             # and jump to it
105 57         96 goto &{$AUTOLOAD};
  57         193  
106             }
107              
108              
109             1;
110             __END__