File Coverage

blib/lib/Net/SSH/AuthorizedKey/SSH2.pm
Criterion Covered Total %
statement 43 68 63.2
branch 8 18 44.4
condition n/a
subroutine 9 11 81.8
pod 0 6 0.0
total 60 103 58.2


line stmt bran cond sub pod time code
1             ###########################################
2             package Net::SSH::AuthorizedKey::SSH2;
3             ###########################################
4 11     11   103 use strict;
  11         20  
  11         385  
5 11     11   52 use warnings;
  11         20  
  11         353  
6 11     11   54 use Net::SSH::AuthorizedKey::Base;
  11         16  
  11         278  
7 11     11   50 use base qw(Net::SSH::AuthorizedKey::Base);
  11         36  
  11         894  
8 11     11   96 use Log::Log4perl qw(:easy);
  11         49  
  11         67  
9              
10             # No additional options, only global ones
11             our %VALID_OPTIONS = ();
12              
13             our $KEYTYPE_REGEX = qr/rsa|dsa|ssh-rsa|ssh-dss|ecdsa-\S+/;
14              
15             our @REQUIRED_FIELDS = qw(
16             encryption
17             );
18              
19             __PACKAGE__->make_accessor( $_ ) for
20             (@REQUIRED_FIELDS);
21              
22             ###########################################
23             sub new {
24             ###########################################
25 34     34 0 65 my($class, %options) = @_;
26              
27 34         166 return $class->SUPER::new( %options, type => "ssh-2" );
28             }
29              
30             ###########################################
31             sub as_string {
32             ###########################################
33 46     46 0 81 my($self) = @_;
34              
35 46         142 my $string = $self->options_as_string();
36 46 100       151 $string .= " " if length $string;
37              
38 46         125 $string .= "$self->{encryption} $self->{key}";
39 46 100       207 $string .= " $self->{email}" if length $self->{email};
40              
41 46         168 return $string;
42             }
43              
44             ###########################################
45             sub parse_multi_line {
46             ###########################################
47 0     0 0 0 my($self, $string) = @_;
48              
49 0         0 my @fields = ();
50              
51 0         0 while($string =~ s/^(.*):\s+(.*)//gm) {
52 0         0 my($field, $value) = ($1, $2);
53             # remove quotes
54 0         0 $value =~ s/^"(.*)"$/$1/;
55 0         0 push @fields, $field, $value;
56 0         0 my $lcfield = lc $field;
57              
58 0 0       0 if( $self->accessor_exists( $lcfield ) ) {
59 0         0 $self->$lcfield( $value );
60             } else {
61 0         0 WARN "Ignoring unknown field '$field'";
62             }
63             }
64              
65             # Rest is the key, split across several lines
66 0         0 $string =~ s/\n//g;
67 0         0 $self->key( $string );
68 0         0 $self->type( "ssh-2" );
69              
70             # Comment: "rsa-key-20090703"
71 0 0       0 if($self->comment() =~ /\b(.*?)-key/) {
    0          
72 0         0 $self->encryption( "ssh-" . $1 );
73             } elsif( ! $self->{strict} ) {
74 0         0 WARN "Unknown encryption [", $self->comment(),
75             "] fixed to ssh-rsa";
76 0         0 $self->encryption( "ssh-rsa" );
77             }
78             }
79              
80             ###########################################
81             sub key_read {
82             ############################################
83 91     91 0 139 my($class, $line) = @_;
84              
85 91 100       852 if($line !~ s/^($KEYTYPE_REGEX)\s*//) {
86 57         123 DEBUG "No SSH2 keytype found";
87 57         414 return undef;
88             }
89              
90 34         85 my $encryption = $1;
91 34         106 DEBUG "Parsed encryption $encryption";
92              
93 34 50       322 if($line !~ s/^(\S+)\s*//) {
94 0         0 DEBUG "No SSH2 key found";
95 0         0 return undef;
96             }
97              
98 34         64 my $key = $1;
99 34         109 DEBUG "Parsed key $key";
100              
101 34         186 my $email = $line;
102              
103 34         87 my $obj = __PACKAGE__->new();
104 34         1137 $obj->encryption( $encryption );
105 34         995 $obj->key( $key );
106 34         988 $obj->email( $email );
107 34         1015 $obj->comment( $email );
108              
109 34         148 return $obj;
110             }
111              
112             ###########################################
113             sub sanity_check {
114             ###########################################
115 2     2 0 6 my($self) = @_;
116              
117 2         5 for my $field (@REQUIRED_FIELDS) {
118 2 50       76 if(! length $self->$field()) {
119 0         0 WARN "ssh-2 sanity check failed '$field' requirement";
120 0         0 return undef;
121             }
122             }
123              
124 2         12 return 1;
125             }
126              
127             ###########################################
128             sub option_type {
129             ###########################################
130 0     0 0   my($self, $option) = @_;
131              
132 0 0         if(exists $VALID_OPTIONS{ $option }) {
133 0           return $VALID_OPTIONS{ $option };
134             }
135              
136 0           return undef;
137             }
138              
139             1;
140              
141             __END__