home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Hosts.pm < prev    next >
Encoding:
Perl POD Document  |  2001-05-10  |  1.7 KB  |  60 lines
  1. # $Id: Hosts.pm,v 1.8 2001/05/11 01:05:24 btrott Exp $
  2.  
  3. package Net::SSH::Perl::Util::Hosts;
  4. use strict;
  5.  
  6. use Net::SSH::Perl::Constants qw( :hosts );
  7.  
  8. use Carp qw( croak );
  9.  
  10. sub _check_host_in_hostfile {
  11.     my($host, $hostfile, $key) = @_;
  12.     my $key_class = ref($key);
  13.     local *FH;
  14.     open FH, $hostfile or return HOST_NEW; # ssh returns HOST_NEW if
  15.                                            # the host file can't be opened
  16.     local($_, $/);
  17.     $/ = "\n";
  18.     my($status, $match, $hosts) = (HOST_NEW);
  19.     while (<FH>) {
  20.         chomp;
  21.         my($hosts, $keyblob) = split /\s+/, $_, 2;
  22.         my $fkey;
  23.         ## Trap errors for unsupported key types (eg. if
  24.         ## known_hosts has an entry for an ssh-rsa key, and
  25.         ## we don't have Crypt::RSA installed).
  26.         eval {
  27.             $fkey = $key_class->extract_public($keyblob);
  28.         };
  29.         next if $@;
  30.         for my $h (split /,/, $hosts) {
  31.             if ($h eq $host) {
  32.                 if ($key->equal($fkey)) {
  33.                     close FH;
  34.                     return HOST_OK;
  35.                 }
  36.                 $status = HOST_CHANGED;
  37.             }
  38.         }
  39.     }
  40.     $status;
  41. }
  42.  
  43. sub _add_host_to_hostfile {
  44.     my($host, $hostfile, $key) = @_;
  45.     unless (-e $hostfile) {
  46.         require File::Basename;
  47.         my $dir = File::Basename::dirname($hostfile);
  48.         unless (-d $dir) {
  49.             require File::Path;
  50.             File::Path::mkpath([ $dir ])
  51.                 or die "Can't create directory $dir: $!";
  52.         }
  53.     }
  54.     open FH, ">>" . $hostfile or croak "Can't write to $hostfile: $!";
  55.     print FH join(' ', $host, $key->dump_public), "\n";
  56.     close FH or croak "Can't close $hostfile: $!";
  57. }
  58.  
  59. 1;
  60.