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