1###########################################
2package Net::SSH::AuthorizedKeysFile;
3###########################################
4use strict;
5use warnings;
6use Log::Log4perl qw(:easy);
7use Text::ParseWords;
8use Net::SSH::AuthorizedKey;
9use Net::SSH::AuthorizedKey::SSH1;
10use Net::SSH::AuthorizedKey::SSH2;
11
12our $VERSION = "0.18";
13
14###########################################
15sub new {
16###########################################
17    my($class, @options) = @_;
18
19    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    bless $self, $class;
29
30      # We allow keys to be set in the constructor
31    my $keys = $self->{keys} if exists $self->{keys};
32
33    $self->reset();
34
35    $self->{keys} = $keys if defined $keys;
36
37    return $self;
38}
39
40###########################################
41sub sanity_check {
42###########################################
43    my($self, $file) = @_;
44
45    $self->{file} = $file if defined $file;
46    $self->{file} = $self->{default_file} if !defined $self->{file};
47
48    my $result = undef;
49
50    my $fh;
51
52    if(! open $fh, "<$self->{file}") {
53        ERROR "Cannot open file $self->{file}";
54        return undef;
55    }
56
57    while(
58      defined(my $rc =
59              sysread($fh, my $chunk, $self->{ridiculous_line_len}))) {
60        if($rc < $self->{ridiculous_line_len}) {
61            $result = 1;
62            last;
63        }
64
65        if(index( $chunk, "\n" ) >= 0) {
66              # contains a newline, looks good
67            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        $self->error("File $self->{file} contains insanely long lines " .
73                     "(> $self->{ridiculous_line_len} chars");
74        last;
75    }
76
77DONE:
78    close $fh;
79
80    if(!$result) {
81        ERROR "Sanity check of file $self->{file} failed";
82    }
83    return $result;
84}
85
86###########################################
87sub keys {
88###########################################
89    my($self) = @_;
90
91    return @{$self->{keys}};
92}
93
94###########################################
95sub reset {
96###########################################
97    my($self) = @_;
98
99    $self->{keys}    = [];
100    $self->{content} = "";
101    $self->{error}   = undef;
102}
103
104###########################################
105sub content {
106###########################################
107    my($self, $new_content) = @_;
108
109    if( defined $new_content ) {
110       $self->reset();
111       $self->{content} = $new_content;
112    }
113
114    return $self->{content};
115}
116
117###########################################
118sub line_parse {
119###########################################
120    my($self, $line, $line_number) = @_;
121
122    chomp $line;
123
124    DEBUG "Parsing line [$line]";
125
126    $self->error( "" );
127
128    my $pk = Net::SSH::AuthorizedKey->parse( $line );
129
130    if( !$pk ) {
131        my $msg = "[$line] rejected by all parsers";
132        WARN $msg;
133        $self->error($msg);
134        return undef;
135    }
136
137    if(! $self->{strict} or $pk->sanity_check()) {
138        return $pk;
139    }
140
141    WARN "Key [$line] failed sanity check";
142
143    if($self->{strict}) {
144        $self->error( $pk->error() );
145        return undef;
146    }
147
148      # Key is corrupted, but ok in non-strict mode
149    return $pk;
150}
151
152###########################################
153sub parse {
154###########################################
155    my($self) = @_;
156
157    $self->{keys}  = [];
158    $self->{error} = "";
159
160    my $line_number = 0;
161
162    for my $line (split /\n/, $self->{content}) {
163        $line_number++;
164
165        $line =~ s/^\s+//;     # Remove leading blanks
166        $line =~ s/\s+$//;     # Remove trailing blanks
167        next if $line =~ /^$/; # Ignore empty lines
168        next if $line =~ /^#/; # Ignore comment lines
169
170        my $key = $self->line_parse($line, $line_number);
171
172        if( defined $key ) {
173            push @{$self->{keys}}, $key;
174        } else {
175            if($self->{abort_on_error}) {
176                $self->error("Line $line_number: " . $self->error());
177                return undef;
178            }
179        }
180    }
181
182    return 1;
183}
184
185###########################################
186sub read {
187###########################################
188    my($self, $file) = @_;
189
190    $self->reset();
191
192    $self->{file} = $file if defined $file;
193    $self->{file} = $self->{default_file} if !defined $self->{file};
194    $self->{content} = "";
195
196    DEBUG "Reading in $self->{file}";
197
198    open FILE, "<$self->{file}" or LOGDIE "Cannot open $self->{file}";
199
200    while(<FILE>) {
201        $self->{content} .= $_;
202    }
203
204    close FILE;
205
206   return $self->parse();
207}
208
209###########################################
210sub as_string {
211###########################################
212    my($self) = @_;
213
214    my $string = "";
215
216    for my $key ( @{ $self->{keys} } ) {
217        $string .= $key->as_string . "\n";
218    }
219
220    return $string;
221}
222
223###########################################
224sub save {
225###########################################
226    my($self, $file) = @_;
227
228    if(!defined $file) {
229        $file = $self->{file};
230    }
231
232    if(! open FILE, ">$file") {
233        $self->error("Cannot open $file ($!)");
234        WARN $self->error();
235        return undef;
236    }
237
238    print FILE $self->as_string();
239    close FILE;
240}
241
242###########################################
243sub append {
244###########################################
245    my($self, $key) = @_;
246
247    $self->{append} = 1;
248}
249
250###########################################
251sub error {
252###########################################
253    my($self, $text) = @_;
254
255
256    if(defined $text) {
257        $self->{error} = $text;
258
259        if(length $text) {
260            ERROR "$text";
261        }
262    }
263
264    return $self->{error};
265}
266
267###########################################
268sub ssh_dir {
269###########################################
270    my($self, $user) = @_;
271
272    if(!defined $user) {
273        my $uid = $>;
274        $user = getpwuid($uid);
275        if(!defined $user) {
276            ERROR "getpwuid of $uid failed ($!)";
277            return undef;
278        }
279    }
280
281    my @pwent = getpwnam($user);
282
283    if(! defined $pwent[0]) {
284        ERROR "getpwnam of $user failed ($!)";
285        return undef;
286    }
287
288    my $home = $pwent[7];
289
290    return File::Spec->catfile($home, ".ssh");
291}
292
293###########################################
294sub path_locate {
295###########################################
296    my($self, $user) = @_;
297
298    my $ssh_dir = $self->ssh_dir($user);
299
300    return undef if !defined $ssh_dir;
301
302    return File::Spec->catfile($ssh_dir, "authorized_keys");
303}
304
3051;
306
307__END__
308
309=head1 NAME
310
311Net::SSH::AuthorizedKeysFile - Read and modify ssh's authorized_keys files
312
313=head1 SYNOPSIS
314
315    use Net::SSH::AuthorizedKeysFile;
316
317        # Reads $HOME/.ssh/authorized_keys by default
318    my $akf = Net::SSH::AuthorizedKeysFile->new();
319
320    $akf->read("authorized_keys");
321
322        # Iterate over entries
323    for my $key ($akf->keys()) {
324        print $key->as_string(), "\n";
325    }
326
327        # Modify entries:
328    for my $key ($akf->keys()) {
329        $key->option("from", 'quack@quack.com');
330        $key->keylen(1025);
331    }
332        # Save changes back to $HOME/.ssh/authorized_keys
333    $akf->save() or die "Cannot save";
334
335=head1 DESCRIPTION
336
337Net::SSH::AuthorizedKeysFile reads and modifies C<authorized_keys> files.
338C<authorized_keys> files contain public keys and meta information to
339be used by C<ssh> on the remote host to let users in without
340having to type their password.
341
342=head1 METHODS
343
344=over 4
345
346=item C<new>
347
348Creates a new Net::SSH::AuthorizedKeysFile object and reads in the
349authorized_keys file. The filename
350defaults to C<$HOME/.ssh/authorized_keys> unless
351overridden with
352
353    Net::SSH::AuthorizedKeysFile->new( file => "/path/other_authkeys_file" );
354
355Normally, the C<read> method described below will just silently ignore
356faulty lines and only gobble up keys that either one of the two parsers
357accepts. If you want it to be stricter, set
358
359    Net::SSH::AuthorizedKeysFile->new( file   => "authkeys_file",
360                                       abort_on_error => 1 );
361
362and read will immediately abort after the first faulty line. Also,
363the key parsers are fairly lenient in default mode. Adding
364
365    strict => 1
366
367adds sanity checks before a key is accepted.
368
369=item C<read>
370
371Reads in the file defined by new(). By default, strict mode is off and
372read() will silently ignore faulty lines. If it's on (see new() above),
373read() will immediately abort after the first faulty line. A textual
374description of the last error will be available via error().
375
376=item C<content>
377
378Contains the original file content, read by C<read()> earlier. Can be
379used to set arbitrary content:
380
381    $keysfile->content( "some\nrandom\nlines\n" );
382
383and have C<parse()> operate on a string instead of an actual file
384this way.
385
386=item C<keys>
387
388Returns a list of Net::SSH::AuthorizedKey objects. Methods are described in
389L<Net::SSH::AuthorizedKey>.
390
391=item C<as_string>
392
393String representation of all keys, ultimately the content that gets
394written out when calling the C<save()> method.
395Note that comments from the original file are lost.
396
397=item C<save>
398
399Write changes back to the authorized_keys file using the as_string()
400method described above. Note that comments from the original file are lost.
401Optionally takes a file
402name parameter, so calling C<$akf-E<gt>save("foo.txt")> will save the data
403in the file "foo.txt" instead of the file the data was read from originally.
404Returns 1 if successful, and undef on error. In case of an error, error()
405contains a textual error description.
406
407=item C<sanity_check>
408
409Run a sanity check on the currently selected authorized_keys file. If
410it contains insanely long lines, then parsing with read() (and potential
411crashes because of out-of-memory errors) should be avoided.
412
413=item C<ssh_dir( [$user] )>
414
415Locate the .ssh dir of a given user. If no user name is given, ssh_dir will
416look up the .ssh dir of the effective user. Typically returns something like
417"/home/gonzo/.ssh".
418
419=item C<path_locate( [$user] )>
420
421Locate the authorized_keys file of a given user. Typically returns something
422like "/home/gonzo/.ssh/authorized_keys". See C<ssh_dir()> for how the
423containing directory is located with and without a given user name.
424
425=item C<error>
426
427Description of last error that occurred.
428
429=back
430
431=head1 LEGALESE
432
433Copyright 2005-2009 by Mike Schilli, all rights reserved.
434This program is free software, you can redistribute it and/or
435modify it under the same terms as Perl itself.
436
437=head1 AUTHOR
438
4392005, Mike Schilli <m@perlmeister.com>
440