File Coverage

blib/lib/Net/SSH/AuthorizedKeysFile.pm
Criterion Covered Total %
statement 111 145 76.5
branch 30 52 57.6
condition 1 3 33.3
subroutine 17 21 80.9
pod 10 14 71.4
total 169 235 71.9


line stmt bran cond sub pod time code
1             ###########################################
2             package Net::SSH::AuthorizedKeysFile;
3             ###########################################
4 7     7   582622 use strict;
  7         17  
  7         276  
5 7     7   38 use warnings;
  7         13  
  7         300  
6 7     7   3896 use Log::Log4perl qw(:easy);
  7         204409  
  7         66  
7 7     7   13915 use Text::ParseWords;
  7         17520  
  7         488  
8 7     7   4092 use Net::SSH::AuthorizedKey;
  7         25  
  7         224  
9 7     7   51 use Net::SSH::AuthorizedKey::SSH1;
  7         12  
  7         142  
10 7     7   36 use Net::SSH::AuthorizedKey::SSH2;
  7         12  
  7         11334  
11              
12             our $VERSION = "0.16";
13              
14             ###########################################
15             sub new {
16             ###########################################
17 22     22 1 6870 my($class, @options) = @_;
18              
19 22         200 my $self = {
20             default_file => "$ENV{HOME}/.ssh/authorized_keys",
21             strict => 0,
22             abort_on_error => 0,
23             append => 0,
24             ridiculous_line_len => 100_000,
25             @options,
26             };
27              
28 22         81 bless $self, $class;
29              
30             # We allow keys to be set in the constructor
31 22 50       118 my $keys = $self->{keys} if exists $self->{keys};
32              
33 22         80 $self->reset();
34              
35 22 50       59 $self->{keys} = $keys if defined $keys;
36              
37 22         66 return $self;
38             }
39              
40             ###########################################
41             sub sanity_check {
42             ###########################################
43 3     3 1 3651 my($self, $file) = @_;
44              
45 3 100       16 $self->{file} = $file if defined $file;
46 3 50       11 $self->{file} = $self->{default_file} if !defined $self->{file};
47              
48 3         9 my $result = undef;
49              
50 3         5 my $fh;
51              
52 3 50       195 if(! open $fh, "<$self->{file}") {
53 0         0 ERROR "Cannot open file $self->{file}";
54 0         0 return undef;
55             }
56              
57 3         961 while(
58             defined(my $rc =
59             sysread($fh, my $chunk, $self->{ridiculous_line_len}))) {
60 4 100       18 if($rc < $self->{ridiculous_line_len}) {
61 2         4 $result = 1;
62 2         6 last;
63             }
64              
65 2 100       224 if(index( $chunk, "\n" ) >= 0) {
66             # contains a newline, looks good
67 1         12 next;
68             }
69              
70             # we've got a line that's between ridiculous_line_len and
71             # 2*ridiculous_line_len characters long. Pull the plug.
72 1         13 $self->error("File $self->{file} contains insanely long lines " .
73             "(> $self->{ridiculous_line_len} chars");
74 1         3 last;
75             }
76              
77             DONE:
78 3         44 close $fh;
79              
80 3 100       11 if(!$result) {
81 1         6 ERROR "Sanity check of file $self->{file} failed";
82             }
83 3         37 return $result;
84             }
85              
86             ###########################################
87             sub keys {
88             ###########################################
89 15     15 1 65 my($self) = @_;
90              
91 15         20 return @{$self->{keys}};
  15         83  
92             }
93              
94             ###########################################
95             sub reset {
96             ###########################################
97 43     43 0 72 my($self) = @_;
98              
99 43         90 $self->{keys} = [];
100 43         144 $self->{content} = "";
101 43         92 $self->{error} = undef;
102             }
103              
104             ###########################################
105             sub content {
106             ###########################################
107 0     0 1 0 my($self, $new_content) = @_;
108              
109 0 0       0 if( defined $new_content ) {
110 0         0 $self->reset();
111 0         0 $self->{content} = $new_content;
112             }
113              
114 0         0 return $self->{content};
115             }
116              
117             ###########################################
118             sub line_parse {
119             ###########################################
120 54     54 0 86 my($self, $line, $line_number) = @_;
121              
122 54         97 chomp $line;
123              
124 54         182 DEBUG "Parsing line [$line]";
125              
126 54         459 $self->error( "" );
127              
128 54         247 my $pk = Net::SSH::AuthorizedKey->parse( $line );
129              
130 54 100       124 if( !$pk ) {
131 12         17 my $msg = "[$line] rejected by all parsers";
132 12         35 WARN $msg;
133 12         71 $self->error($msg);
134 12         20 return undef;
135             }
136              
137 42 50 33     133 if(! $self->{strict} or $pk->sanity_check()) {
138 42         76 return $pk;
139             }
140              
141 0         0 WARN "Key [$line] failed sanity check";
142              
143 0 0       0 if($self->{strict}) {
144 0         0 $self->error( $pk->error() );
145 0         0 return undef;
146             }
147              
148             # Key is corrupted, but ok in non-strict mode
149 0         0 return $pk;
150             }
151              
152             ###########################################
153             sub parse {
154             ###########################################
155 21     21 0 85 my($self) = @_;
156              
157 21         46 $self->{keys} = [];
158 21         48 $self->{error} = "";
159              
160 21         33 my $line_number = 0;
161              
162 21         104 for my $line (split /\n/, $self->{content}) {
163 62         74 $line_number++;
164              
165 62         138 $line =~ s/^\s+//; # Remove leading blanks
166 62         199 $line =~ s/\s+$//; # Remove trailing blanks
167 62 100       155 next if $line =~ /^$/; # Ignore empty lines
168 59 100       122 next if $line =~ /^#/; # Ignore comment lines
169              
170 54         141 my $key = $self->line_parse($line, $line_number);
171              
172 54 100       100 if( defined $key ) {
173 42         40 push @{$self->{keys}}, $key;
  42         119  
174             } else {
175 12 100       36 if($self->{abort_on_error}) {
176 2         6 $self->error("Line $line_number: " . $self->error());
177 2         7 return undef;
178             }
179             }
180             }
181              
182 19         66 return 1;
183             }
184              
185             ###########################################
186             sub read {
187             ###########################################
188 21     21 1 198 my($self, $file) = @_;
189              
190 21         45 $self->reset();
191              
192 21 50       48 $self->{file} = $file if defined $file;
193 21 50       57 $self->{file} = $self->{default_file} if !defined $self->{file};
194 21         35 $self->{content} = "";
195              
196 21         110 DEBUG "Reading in $self->{file}";
197              
198 21 50       1332 open FILE, "<$self->{file}" or LOGDIE "Cannot open $self->{file}";
199              
200 21         468 while() {
201 62         290 $self->{content} .= $_;
202             }
203              
204 21         775 close FILE;
205              
206 21         75 return $self->parse();
207             }
208              
209             ###########################################
210             sub as_string {
211             ###########################################
212 5     5 1 13 my($self) = @_;
213              
214 5         12 my $string = "";
215              
216 5         9 for my $key ( @{ $self->{keys} } ) {
  5         20  
217 14         51 $string .= $key->as_string . "\n";
218             }
219              
220 5         60 return $string;
221             }
222              
223             ###########################################
224             sub save {
225             ###########################################
226 4     4 1 17 my($self, $file) = @_;
227              
228 4 50       14 if(!defined $file) {
229 4         13 $file = $self->{file};
230             }
231              
232 4 50       487 if(! open FILE, ">$file") {
233 0         0 $self->error("Cannot open $file ($!)");
234 0         0 WARN $self->error();
235 0         0 return undef;
236             }
237              
238 4         20 print FILE $self->as_string();
239 4         352 close FILE;
240             }
241              
242             ###########################################
243             sub append {
244             ###########################################
245 0     0 0 0 my($self, $key) = @_;
246              
247 0         0 $self->{append} = 1;
248             }
249              
250             ###########################################
251             sub error {
252             ###########################################
253 73     73 1 1000 my($self, $text) = @_;
254              
255 73 100       184 if(defined $text) {
256 69         103 $self->{error} = $text;
257 69         281 ERROR "$text";
258             }
259              
260 73         465 return $self->{error};
261             }
262              
263             ###########################################
264             sub ssh_dir {
265             ###########################################
266 0     0 1   my($self, $user) = @_;
267              
268 0 0         if(!defined $user) {
269 0           my $uid = $>;
270 0           $user = getpwuid($uid);
271 0 0         if(!defined $user) {
272 0           ERROR "getpwuid of $uid failed ($!)";
273 0           return undef;
274             }
275             }
276              
277 0           my @pwent = getpwnam($user);
278              
279 0 0         if(! defined $pwent[0]) {
280 0           ERROR "getpwnam of $user failed ($!)";
281 0           return undef;
282             }
283              
284 0           my $home = $pwent[7];
285              
286 0           return File::Spec->catfile($home, ".ssh");
287             }
288              
289             ###########################################
290             sub path_locate {
291             ###########################################
292 0     0 1   my($self, $user) = @_;
293              
294 0           my $ssh_dir = $self->ssh_dir($user);
295              
296 0 0         return undef if !defined $ssh_dir;
297              
298 0           return File::Spec->catfile($ssh_dir, "authorized_keys");
299             }
300              
301             1;
302              
303             __END__