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   83 use strict;
  11         15  
  11         405  
5 11     11   165 use warnings;
  11         13  
  11         598  
6 11     11   48 use Net::SSH::AuthorizedKey::Base;
  11         15  
  11         242  
7 11     11   58 use base qw(Net::SSH::AuthorizedKey::Base);
  11         11  
  11         914  
8 11     11   85 use Log::Log4perl qw(:easy);
  11         58  
  11         68  
9              
10             # No additional options, only global ones
11             our %VALID_OPTIONS = ();
12              
13             our $KEYTYPE_REGEX = qr/rsa|dsa|ssh-rsa|ssh-dss|ssh-ed25519|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 35     35 0 60 my($class, %options) = @_;
26              
27 35         165 return $class->SUPER::new( %options, type => "ssh-2" );
28             }
29              
30             ###########################################
31             sub as_string {
32             ###########################################
33 47     47 0 65 my($self) = @_;
34              
35 47         128 my $string = $self->options_as_string();
36 47 100       100 $string .= " " if length $string;
37              
38 47         110 $string .= "$self->{encryption} $self->{key}";
39 47 100       114 $string .= " $self->{email}" if length $self->{email};
40              
41 47         133 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 92     92 0 101 my($class, $line) = @_;
84              
85 92 100       825 if($line !~ s/^($KEYTYPE_REGEX)\s*//) {
86 57         105 DEBUG "No SSH2 keytype found";
87 57         377 return undef;
88             }
89              
90 35         74 my $encryption = $1;
91 35         99 DEBUG "Parsed encryption $encryption";
92              
93 35 50       270 if($line !~ s/^(\S+)\s*//) {
94 0         0 DEBUG "No SSH2 key found";
95 0         0 return undef;
96             }
97              
98 35         51 my $key = $1;
99 35         94 DEBUG "Parsed key $key";
100              
101 35         139 my $email = $line;
102              
103 35         81 my $obj = __PACKAGE__->new();
104 35         1081 $obj->encryption( $encryption );
105 35         868 $obj->key( $key );
106 35         834 $obj->email( $email );
107 35         874 $obj->comment( $email );
108              
109 35         125 return $obj;
110             }
111              
112             ###########################################
113             sub sanity_check {
114             ###########################################
115 2     2 0 4 my($self) = @_;
116              
117 2         6 for my $field (@REQUIRED_FIELDS) {
118 2 50       63 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         7 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__