File Coverage

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


line stmt bran cond sub pod time code
1             package Net::DNS::SEC::Private;
2              
3 10     10   119331 use strict;
  10         28  
  10         556  
4 10     10   72 use warnings;
  10         21  
  10         1195  
5              
6             our $VERSION = (qw$Id: Private.pm 2003 2025-01-21 12:06:06Z 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 10     10   83 use integer;
  10         50  
  10         77  
39 10     10   387 use Carp;
  10         21  
  10         1005  
40 10     10   75 use File::Spec;
  10         30  
  10         487  
41 10     10   105 use IO::File;
  10         33  
  10         2915  
42              
43 10     10   103 use constant SYMLINK => defined(&CORE::readlink); # Except Win32, VMS, RISC OS
  10         53  
  10         10315  
44              
45              
46 20 100   20 1 65305 sub new { return scalar(@_) > 2 ? &_new_params : &_new_keyfile }
47              
48             sub _new_keyfile {
49 18     18   62 my ( $class, $file ) = @_;
50              
51 18         450 my ($keypath) = SYMLINK ? grep( {$_} readlink($file), $file ) : $file;
  36         167  
52 18         701 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 18 100       477 croak "$file does not appear to be a BIND private key"
56             unless $name =~ /^K([^+]+)\+(\d+)\+(\d+)\.private$/;
57 17         143 my @identifier = ( signame => $1, algorithm => 0 + $2, keytag => 0 + $3 );
58              
59 17 100       135 my $handle = IO::File->new( $file, '<' ) or croak qq("$file": $!);
60              
61 16         1827 my @content;
62 16         37 local $_;
63 16         453 while (<$handle>) {
64 135         209 chomp;
65 135 100       340 next if /^$/;
66 134 100       309 next if /^\s*[;]/;
67 132         278 s/\(.+\)//;
68 132         381 my ( $name, $value ) = split;
69 132         537 push @content, $name, $value;
70             }
71              
72 16         151 return $class->_new_params( @content, @identifier );
73             }
74              
75              
76             sub _new_params {
77 18     18   204 my ( $class, %parameter ) = @_;
78 18         50 my $hashref = {};
79              
80 18         86 while ( my ( $name, $value ) = each %parameter ) {
81 182         343 $name =~ tr/A-Za-z0-9\000-\377/a-za-z0-9/d;
82 182         645 $hashref->{$name} = $value;
83             }
84              
85 18     167   114 my $self = bless sub { $hashref->{shift()} }, $class;
  167         2195  
86 18 100       115 croak 'no algorithm specified' unless $self->algorithm;
87 17 100       74 croak 'no signame specified' unless $self->signame;
88 16         439 return $self;
89             }
90              
91              
92 10     10   216 sub _index { return my @empty } ## no algorithm index
93              
94             sub AUTOLOAD { ## Dynamic instance methods
95 60     60   5290 my ($self) = @_;
96 60         142 our $AUTOLOAD;
97              
98 60         456 my ($attribute) = $AUTOLOAD =~ m/::([^:]*)$/;
99 60         142 $attribute =~ tr/A-Za-z0-9\000-\377/a-za-z0-9/d;
100              
101             # Build a method in the class
102 10     10   108 no strict 'refs'; ## no critic ProhibitNoStrict
  10         23  
  10         1456  
103 60     177   313 *{$AUTOLOAD} = sub { &{shift()}($attribute) };
  60         309  
  177         728  
  177         616  
104              
105             # and jump to it
106 60         113 goto &{$AUTOLOAD};
  60         242  
107             }
108              
109              
110             1;
111             __END__