File Coverage

blib/lib/Net/SSH/Perl/Util/Hosts.pm
Criterion Covered Total %
statement 27 153 17.6
branch 0 82 0.0
condition 0 30 0.0
subroutine 9 13 69.2
pod n/a
total 36 278 12.9


line stmt bran cond sub pod time code
1             package Net::SSH::Perl::Util::Hosts;
2 5     5   43 use strict;
  5         10  
  5         146  
3 5     5   25 use warnings;
  5         11  
  5         131  
4              
5 5     5   26 use Net::SSH::Perl::Constants qw( :hosts );
  5         9  
  5         27  
6 5     5   2384 use Crypt::Misc qw( encode_b64 decode_b64 );
  5         31348  
  5         392  
7 5     5   2285 use Crypt::Mac::HMAC qw( hmac );
  5         5766  
  5         267  
8 5     5   2973 use Socket;
  5         18764  
  5         2245  
9              
10 5     5   45 use Carp qw( croak );
  5         22  
  5         237  
11              
12 5     5   36 use constant SALT_LEN => 20;
  5         8  
  5         5004  
13              
14             sub _check_host_in_hostfile {
15 0     0     my($host, $port, $hostfile, $key) = @_;
16 0           my $key_class = ref($key);
17              
18 0 0 0       if (defined $port && $port != 22) {
19 0           $host = "[$host]:$port";
20             }
21              
22             # ssh returns HOST_NEW if the host file can't be opened
23 0 0         open my $fh, '<', $hostfile or return HOST_NEW;
24 0           local($_, $/);
25 0           $/ = "\n";
26 0           my $status = HOST_NEW;
27 0           HOST: while (<$fh>) {
28 0           chomp;
29 0           my ($hosts, $keyblob) = split /\s+/, $_, 2;
30 0 0         next unless $keyblob;
31 0           my $fkey;
32             ## Trap errors for any potentially unsupported key types
33 0           eval {
34 0           $fkey = $key_class->extract_public($keyblob);
35             };
36 0 0         next if $@;
37              
38 0           my $checkhost = $host;
39              
40             ## Check for hashed entries
41 0 0         if (index($hosts, '|') == 0) {
42 0 0         if ($hosts !~ /^\|1\|(.+?)\|/) {
43 0           warn qq{Cannot parse line $. of $hostfile\n};
44 0           next;
45             }
46 0           my $salt = $1;
47              
48 0           my $rawsalt = decode_b64($salt);
49 0           my $hash = encode_b64(hmac('SHA1',$rawsalt,$host));
50 0           $checkhost = "|1|$salt|$hash";
51             }
52              
53 0           for my $h (split /,/, $hosts) {
54 0 0 0       if ($h eq $checkhost && $key->ssh_name eq $fkey->ssh_name) {
55 0 0         $status = $key->equal($fkey) ? HOST_OK : HOST_CHANGED;
56             last HOST
57 0           }
58             }
59             }
60 0           close $fh;
61 0           $status;
62             }
63              
64             sub _all_keys_for_host {
65 0     0     my($host, $port, $hostfile) = @_;
66 0           my $ip;
67 0 0         if ($host =~ /[a-zA-Z]+/) {
68 0           $ip = inet_ntoa(inet_aton($host));
69             }
70 0 0 0       if (defined $port && $port != 22) {
71 0           $host = "[$host]:$port";
72 0           $ip = "[$ip]:$port";
73             }
74              
75 0 0         open my $fh, '<', $hostfile or return 0;
76 0           local($_, $/);
77 0           $/ = "\n";
78 0           my @keys;
79 0           while (<$fh>) {
80 0           chomp;
81 0           my ($hosts, $keyblob) = split /\s+/, $_, 2;
82 0           my @hosts_to_check = ($host);
83 0 0         push @hosts_to_check, $ip if $ip;
84              
85 0           foreach my $checkhost (@hosts_to_check) {
86             ## Check for hashed entries
87 0 0         if (index($hosts, '|') == 0) {
88 0 0         if ($hosts !~ /^\|1\|(.+?)\|/) {
89 0           warn qq{Cannot parse line $. of $hostfile\n};
90             next
91 0           }
92 0           my $salt = $1;
93              
94 0           my $rawsalt = decode_b64($salt);
95 0           my $hash = encode_b64(hmac('SHA1',$rawsalt,$host));
96 0           $checkhost = "|1|$salt|$hash";
97             }
98 0           for my $h (split /,/, $hosts) {
99 0 0         if ($h eq $checkhost) {
100 0           my $fkey;
101 0           eval { $fkey = Net::SSH::Perl::Key->extract_public($keyblob) };
  0            
102 0 0         push @keys, $fkey if $fkey;
103             }
104             }
105             }
106             }
107 0           close $fh;
108 0 0         return wantarray ? @keys : \@keys
109             }
110              
111             sub _add_host_to_hostfile {
112 0     0     my($host, $port, $hostfile, $key, $hash_flag) = @_;
113 0 0         unless (-e $hostfile) {
114 0           require File::Basename;
115 0           my $dir = File::Basename::dirname($hostfile);
116 0 0         unless (-d $dir) {
117 0           require File::Path;
118 0 0         File::Path::mkpath([ $dir ])
119             or die "Can't create directory $dir: $!";
120             }
121             }
122              
123 0           my $ip;
124 0 0         if ($host =~ /[a-zA-Z]+/) {
125 0           $ip = inet_ntoa(inet_aton($host));
126 0 0 0       $ip = "[$ip]:$port" if $ip && defined $port && $port != 22;
      0        
127             }
128 0 0 0       $host = "[$host]:$port" if defined $port && $port != 22;
129              
130 0           my $data;
131 0 0         open my $fh, '>>', $hostfile or croak "Can't write to $hostfile: $!";
132 0 0         if ($hash_flag) {
133 5     5   61 use Crypt::PRNG qw( random_bytes );
  5         11  
  5         3973  
134 0           my @entries = ($host);
135 0 0         push @entries, $ip if $ip;
136 0           foreach my $entry (@entries) {
137 0           my $rawsalt = random_bytes(SALT_LEN);
138 0           my $salt = encode_b64($rawsalt);
139 0           my $hash = encode_b64(hmac('SHA1', $rawsalt, $entry));
140 0           $data .= join(' ', "|1|$salt|$hash", $key->dump_public, "\n");
141             }
142             }
143             else {
144 0 0         $host = "$host,$ip" if $ip;
145 0           $data = join(' ', $host, $key->dump_public, "\n");
146             }
147 0           print $fh $data;
148 0 0         close $fh or croak "Can't close $hostfile: $!";
149             }
150              
151             sub _remove_host_from_hostfile {
152 0     0     my($host, $port, $hostfile, $key) = @_;
153 0 0         return unless -e $hostfile;
154              
155 0           my $ip;
156 0 0         if ($host =~ /[a-zA-Z]+/) {
157 0           $ip = inet_ntoa(inet_aton($host));
158 0 0 0       $ip = "[$ip]:$port" if $ip && defined $port && $port != 22;
      0        
159             }
160 0 0 0       $host = "[$host]:$port" if defined $port && $port != 22;
161              
162 0 0         open my $fh, '<', $hostfile or croak "Can't open $hostfile: $!";
163 0 0         open my $fhw, '>', "$hostfile.new" or croak "Can't open $hostfile.new for writing: $!";
164              
165 0           LINE: while (<$fh>) {
166 0           chomp;
167 0           my ($hosts, $keyblob) = split /\s+/, $_, 2;
168 0           my $fkey;
169             ## Trap errors for any potentially unsupported key types
170 0           eval {
171 0           $fkey = Net::SSH::Perl::Key->extract_public($keyblob);
172             };
173             # keep it if we don't know what it is
174 0 0         if ($@) {
175 0           print $fhw $_,"\n";
176 0           next LINE;
177             }
178              
179 0           my @hosts_to_check = ($host);
180 0 0         push @hosts_to_check, $ip if $ip;
181              
182 0           foreach my $checkhost (@hosts_to_check) {
183             ## Check for hashed entries
184 0 0         if (index($hosts, '|') == 0) {
185 0 0         if ($hosts !~ /^\|1\|(.+?)\|/) {
186 0           warn qq{Cannot parse line $. of $hostfile\n};
187 0           next;
188             }
189 0           my $salt = $1;
190              
191 0           my $rawsalt = decode_b64($salt);
192 0           my $hash = encode_b64(hmac('SHA1',$rawsalt,$checkhost));
193 0           $checkhost = "|1|$salt|$hash";
194             }
195              
196 0           for my $h (split /,/, $hosts) {
197 0 0 0       if ($h eq $checkhost && $key->equal($fkey)) {
198 0           next LINE;
199             }
200             }
201             }
202 0           print $fhw $_,"\n";
203             }
204 0 0         close $fhw or croak "Can't close $hostfile.new: $!";
205 0 0         close $fh or croak "Can't close $hostfile: $!";
206 0           rename "$hostfile.new", $hostfile;
207             }
208              
209             1;