File Coverage

blib/lib/Net/SSH/Perl/SSH1.pm
Criterion Covered Total %
statement 82 304 26.9
branch 9 96 9.3
condition 0 8 0.0
subroutine 24 43 55.8
pod 8 13 61.5
total 123 464 26.5


line stmt bran cond sub pod time code
1             package Net::SSH::Perl::SSH1;
2 1     1   7 use strict;
  1         1  
  1         30  
3 1     1   8 use warnings;
  1         1  
  1         24  
4              
5 1     1   5 use Net::SSH::Perl::Packet;
  1         2  
  1         21  
6 1     1   14 use Net::SSH::Perl::Buffer;
  1         10  
  1         29  
7 1     1   5 use Net::SSH::Perl::Config;
  1         1  
  1         21  
8 1     1   5 use Net::SSH::Perl::Constants qw( :protocol :msg :hosts );
  1         1  
  1         23  
9 1     1   6 use Net::SSH::Perl::Cipher;
  1         2  
  1         32  
10 1     1   486 use Net::SSH::Perl::Auth;
  1         3  
  1         31  
11 1     1   466 use Net::SSH::Perl::Comp;
  1         6  
  1         33  
12 1     1   472 use Net::SSH::Perl::Key::RSA1;
  1         3  
  1         29  
13 1     1   6 use Net::SSH::Perl::Util qw( :hosts _compute_session_id _rsa_public_encrypt );
  1         4  
  1         5  
14              
15 1     1   6 use Net::SSH::Perl;
  1         2  
  1         24  
16 1     1   5 use base qw( Net::SSH::Perl );
  1         1  
  1         100  
17              
18 1     1   6 use Math::GMP;
  1         2  
  1         4  
19 1     1   23 use Carp qw( croak );
  1         1  
  1         63  
20 1     1   8 use File::Spec::Functions qw( catfile );
  1         2  
  1         46  
21 1     1   632 use File::HomeDir ();
  1         5981  
  1         26  
22              
23 1     1   7 use vars qw( $VERSION $CONFIG $HOSTNAME );
  1         1  
  1         3203  
24             $VERSION = $Net::SSH::Perl::VERSION;
25              
26             sub version_string {
27 1     1 0 2 my $class = shift;
28 1         8 sprintf "Net::SSH::Perl Version %s, protocol version %s.%s.",
29             $class->VERSION, PROTOCOL_MAJOR_1, PROTOCOL_MINOR_1;
30             }
31              
32             sub _proto_init {
33 1     1   2 my $ssh = shift;
34 1         5 my $home = File::HomeDir->my_home;
35 1         35 my $config = $ssh->{config};
36              
37 1 50       4 unless ($config->get('user_known_hosts')) {
38 1 50       4 defined $home or croak "Cannot determine home directory, please set the environment variable HOME";
39 1         7 $config->set('user_known_hosts', catfile($home, '.ssh', 'known_hosts'));
40             }
41 1 50       7 unless ($config->get('global_known_hosts')) {
42             my $glob_known_hosts = $^O eq 'MSWin32'
43 1 50       4 ? catfile( $ENV{WINDIR}, 'ssh_known_hosts' )
44             : '/etc/ssh_known_hosts';
45 1         3 $config->set('global_known_hosts', $glob_known_hosts );
46             }
47 1 50       2 unless (my $if = $config->get('identity_files')) {
48 1 50       3 defined $home or croak "Cannot determine home directory, please set the environment variable HOME";
49 1         5 $config->set('identity_files', [ catfile($home, '.ssh', 'identity') ]);
50             }
51              
52 1         3 for my $a (qw( password rhosts rhosts_rsa rsa ch_res )) {
53 5 50       11 $config->set("auth_$a", 1)
54             unless defined $config->get("auth_$a");
55             }
56             }
57              
58             sub _disconnect {
59 1     1   2 my $ssh = shift;
60 1         3 my $packet = $ssh->packet_start(SSH_MSG_DISCONNECT);
61 1 50       21 $packet->put_str("@_") if @_;
62 1         4 $packet->send;
63 1         11 $ssh->{session} = {};
64 1         3 for my $key (qw( _cmd_stdout _cmd_stderr _cmd_exit )) {
65 3         10 $ssh->{$key} = "";
66             }
67             }
68              
69             sub register_handler {
70 0     0 1 0 my($ssh, $type, $sub, @extra) = @_;
71             ## XXX hack
72 0 0       0 if ($type eq 'stdout') {
    0          
73 0         0 $type = SSH_SMSG_STDOUT_DATA;
74             } elsif ($type eq 'stderr') {
75 0         0 $type = SSH_SMSG_STDERR_DATA;
76             }
77 0         0 $ssh->{client_handlers}{$type} = { code => $sub, extra => \@extra };
78             }
79 0     0 0 0 sub handler_for { $_[0]->{client_handlers}{$_[1]} }
80              
81             sub _login {
82 0     0   0 my $ssh = shift;
83 0         0 my $user = $ssh->{config}->get('user');
84 0 0       0 croak "No user defined" unless $user;
85              
86 0         0 $ssh->debug("Waiting for server public key.");
87 0         0 my $packet = Net::SSH::Perl::Packet->read_expect($ssh, SSH_SMSG_PUBLIC_KEY);
88              
89 0         0 my $check_bytes = $packet->bytes(0, 8, "");
90              
91 0         0 my %keys;
92 0         0 for my $which (qw( public host )) {
93 0         0 $keys{$which} = Net::SSH::Perl::Key::RSA1->new;
94 0         0 $keys{$which}{rsa}{bits} = $packet->get_int32;
95 0         0 $keys{$which}{rsa}{e} = $packet->get_mp_int;
96 0         0 $keys{$which}{rsa}{n} = $packet->get_mp_int;
97             }
98              
99 0         0 my $protocol_flags = $packet->get_int32;
100 0         0 my $supported_ciphers = $packet->get_int32;
101 0         0 my $supported_auth = $packet->get_int32;
102              
103 0         0 $ssh->debug("Received server public key ($keys{public}{rsa}{bits} " .
104             "bits) and host key ($keys{host}{rsa}{bits} bits).");
105              
106             my $session_id =
107 0         0 _compute_session_id($check_bytes, $keys{host}, $keys{public});
108 0         0 $ssh->{session}{id} = $session_id;
109              
110 0         0 $ssh->check_host_key($keys{host});
111              
112 0         0 my $session_key = join '', map chr rand(255), 1..32;
113 0         0 my $skey = Math::GMP->new(0);
114 0         0 for my $i (0..31) {
115 0         0 $skey *= 2**8;
116 0 0       0 $skey += $i < 16 ?
117             vec($session_key, $i, 8) ^ vec($session_id, $i, 8) :
118             vec($session_key, $i, 8);
119             }
120              
121 0 0       0 if ($keys{public}{rsa}{n} < $keys{host}{rsa}{n}) {
122 0         0 $skey = _rsa_public_encrypt($skey, $keys{public});
123 0         0 $skey = _rsa_public_encrypt($skey, $keys{host});
124             }
125             else {
126 0         0 $skey = _rsa_public_encrypt($skey, $keys{host});
127 0         0 $skey = _rsa_public_encrypt($skey, $keys{public});
128             }
129              
130 0         0 my($cipher, $cipher_name);
131 0 0       0 if ($cipher_name = $ssh->{config}->get('cipher')) {
132 0         0 $cipher = Net::SSH::Perl::Cipher::id($cipher_name);
133             }
134             else {
135 0         0 my $cid;
136 0 0 0     0 if (($cid = Net::SSH::Perl::Cipher::id('IDEA')) &&
    0 0        
137             Net::SSH::Perl::Cipher::supported($cid, $supported_ciphers)) {
138 0         0 $cipher_name = 'IDEA';
139 0         0 $cipher = $cid;
140             }
141             elsif (($cid = Net::SSH::Perl::Cipher::id('DES3')) &&
142             Net::SSH::Perl::Cipher::supported($cid, $supported_ciphers)) {
143 0         0 $cipher_name = 'DES3';
144 0         0 $cipher = $cid;
145             }
146             }
147              
148 0 0       0 unless (Net::SSH::Perl::Cipher::supported($cipher, $supported_ciphers)) {
149 0         0 croak "Selected cipher type $cipher_name not supported by server.";
150             }
151 0         0 $ssh->debug(sprintf "Encryption type: %s", $cipher_name);
152              
153 0         0 $packet = $ssh->packet_start(SSH_CMSG_SESSION_KEY);
154 0         0 $packet->put_int8($cipher);
155 0         0 $packet->put_chars($check_bytes);
156 0         0 $packet->put_mp_int($skey);
157 0         0 $packet->put_int32(0); ## No protocol flags.
158 0         0 $packet->send;
159 0         0 $ssh->debug("Sent encrypted session key.");
160              
161 0         0 $ssh->set_cipher($cipher_name, $session_key);
162 0         0 $ssh->{session}{key} = $session_key;
163              
164 0         0 Net::SSH::Perl::Packet->read_expect($ssh, SSH_SMSG_SUCCESS);
165 0         0 $ssh->debug("Received encryption confirmation.");
166              
167 0         0 $packet = $ssh->packet_start(SSH_CMSG_USER);
168 0         0 $packet->put_str($user);
169 0         0 $packet->send;
170              
171 0         0 $packet = Net::SSH::Perl::Packet->read($ssh);
172 0 0       0 return 1 if $packet->type == SSH_SMSG_SUCCESS;
173              
174 0 0       0 if ($packet->type != SSH_SMSG_FAILURE) {
175 0         0 $ssh->fatal_disconnect(sprintf
176             "Protocol error: got %d in response to SSH_CMSG_USER", $packet->type);
177             }
178              
179 0         0 my $auth_order = Net::SSH::Perl::Auth::auth_order();
180 0         0 for my $auth_id (@$auth_order) {
181 0 0       0 next unless Net::SSH::Perl::Auth::supported($auth_id, $supported_auth);
182 0         0 my $auth = Net::SSH::Perl::Auth->new(Net::SSH::Perl::Auth::name($auth_id), $ssh);
183 0         0 my $valid = $auth->authenticate;
184 0 0       0 return 1 if $valid;
185             }
186             }
187              
188             sub compression {
189 10     10 1 16 my $ssh = shift;
190 10 50       21 if (@_) {
191 0         0 my $level = shift;
192 0         0 $ssh->debug("Enabling compression at level $level.");
193 0         0 $ssh->{session}{compression} = Net::SSH::Perl::Comp->new('Zlib', $level);
194             }
195 10         28 $ssh->{session}{compression};
196             }
197              
198             sub _setup_connection {
199 0     0   0 my $ssh = shift;
200              
201 0 0       0 $ssh->_connect unless $ssh->sock;
202 0 0       0 $ssh->_login or
203             $ssh->fatal_disconnect("Permission denied");
204              
205 0 0       0 if ($ssh->{config}->get('compression')) {
206 0         0 eval { require Compress::Zlib; };
  0         0  
207 0 0       0 if ($@) {
208 0         0 $ssh->debug("Compression is disabled because Compress::Zlib can't be loaded.");
209             }
210             else {
211 0   0     0 my $level = $ssh->{config}->get('compression_level') || 6;
212 0         0 $ssh->debug("Requesting compression at level $level.");
213 0         0 my $packet = $ssh->packet_start(SSH_CMSG_REQUEST_COMPRESSION);
214 0         0 $packet->put_int32($level);
215 0         0 $packet->send;
216              
217 0         0 $packet = Net::SSH::Perl::Packet->read($ssh);
218 0 0       0 if ($packet->type == SSH_SMSG_SUCCESS) {
219 0         0 $ssh->compression($level);
220             }
221             else {
222 0         0 $ssh->debug("Warning: Remote host refused compression.");
223             }
224             }
225             }
226              
227 0 0       0 if ($ssh->{config}->get('use_pty')) {
228 0         0 $ssh->debug("Requesting pty.");
229 0         0 my($packet);
230 0         0 $packet = $ssh->packet_start(SSH_CMSG_REQUEST_PTY);
231 0         0 my($term) = $ENV{TERM} =~ /(\S+)/;
232 0         0 $packet->put_str($term);
233 0         0 my $foundsize = 0;
234 0 0       0 if (eval "require Term::ReadKey") {
235 0         0 my @sz = Term::ReadKey::GetTerminalSize($ssh->sock);
236 0 0       0 if (defined $sz[0]) {
237 0         0 $foundsize = 1;
238 0         0 $packet->put_int32($sz[0]); # width
239 0         0 $packet->put_int32($sz[1]); # height
240 0         0 $packet->put_int32($sz[2]); # xpix
241 0         0 $packet->put_int32($sz[3]); # ypix
242             }
243             }
244 0 0       0 if (!$foundsize) {
245 0         0 $packet->put_int32(0) for 1..4;
246             }
247 0         0 $packet->put_int8(0);
248 0         0 $packet->send;
249              
250 0         0 $packet = Net::SSH::Perl::Packet->read($ssh);
251 0 0       0 unless ($packet->type == SSH_SMSG_SUCCESS) {
252 0         0 $ssh->debug("Warning: couldn't allocate a pseudo tty.");
253             }
254             }
255             }
256              
257             sub cmd {
258 0     0 1 0 my $ssh = shift;
259 0         0 my $cmd = shift;
260 0         0 my $stdin = shift;
261              
262 0         0 $ssh->_setup_connection;
263              
264 0         0 my($packet);
265              
266 0         0 $ssh->debug("Sending command: $cmd");
267 0         0 $packet = $ssh->packet_start(SSH_CMSG_EXEC_CMD);
268 0         0 $packet->put_str($cmd);
269 0         0 $packet->send;
270              
271 0 0       0 if (defined $stdin) {
272 0         0 my $chunk_size = 32000;
273 0         0 while ($stdin) {
274 0         0 my $chunk = substr($stdin, 0, $chunk_size, '');
275 0         0 $packet = $ssh->packet_start(SSH_CMSG_STDIN_DATA);
276 0         0 $packet->put_str($chunk);
277 0         0 $packet->send;
278             }
279              
280 0         0 $packet = $ssh->packet_start(SSH_CMSG_EOF);
281 0         0 $packet->send;
282             }
283              
284 0 0       0 unless ($ssh->handler_for(SSH_SMSG_STDOUT_DATA)) {
285             $ssh->register_handler(SSH_SMSG_STDOUT_DATA,
286 0     0   0 sub { $ssh->{_cmd_stdout} .= $_[1]->get_str });
  0         0  
287             }
288 0 0       0 unless ($ssh->handler_for(SSH_SMSG_STDERR_DATA)) {
289             $ssh->register_handler(SSH_SMSG_STDERR_DATA,
290 0     0   0 sub { $ssh->{_cmd_stderr} .= $_[1]->get_str });
  0         0  
291             }
292 0 0       0 unless ($ssh->handler_for(SSH_SMSG_EXITSTATUS)) {
293             $ssh->register_handler(SSH_SMSG_EXITSTATUS,
294 0     0   0 sub { $ssh->{_cmd_exit} = $_[1]->get_int32 });
  0         0  
295             }
296              
297 0         0 $ssh->debug("Entering interactive session.");
298 0 0       0 $ssh->_start_interactive(defined $stdin ? 1 : 0);
299             my($stdout, $stderr, $exit) =
300 0         0 map $ssh->{"_cmd_$_"}, qw( stdout stderr exit );
301              
302 0         0 $ssh->_disconnect;
303 0         0 ($stdout, $stderr, $exit);
304             }
305              
306             sub shell {
307 0     0 1 0 my $ssh = shift;
308              
309             $ssh->{config}->set('use_pty', 1)
310 0 0       0 unless defined $ssh->{config}->get('use_pty');
311 0         0 $ssh->_setup_connection;
312              
313 0         0 $ssh->debug("Requesting shell.");
314 0         0 my $packet = $ssh->packet_start(SSH_CMSG_EXEC_SHELL);
315 0         0 $packet->send;
316              
317             $ssh->register_handler(SSH_SMSG_STDOUT_DATA,
318 0     0   0 sub { syswrite STDOUT, $_[1]->get_str });
  0         0  
319             $ssh->register_handler(SSH_SMSG_STDERR_DATA,
320 0     0   0 sub { syswrite STDERR, $_[1]->get_str });
  0         0  
321 0     0   0 $ssh->register_handler(SSH_SMSG_EXITSTATUS, sub {});
322              
323 0         0 $ssh->debug("Entering interactive session.");
324 0         0 $ssh->_start_interactive(0);
325              
326 0         0 $ssh->_disconnect;
327             }
328              
329             sub open2 {
330 0     0 0 0 my $ssh = shift;
331 0         0 my($cmd) = @_;
332              
333 0         0 require Net::SSH::Perl::Handle::SSH1;
334              
335 0 0       0 unless ($cmd) {
336             $ssh->{config}->set('use_pty', 1)
337 0 0       0 unless defined $ssh->{config}->get('use_pty');
338             }
339 0         0 $ssh->_setup_connection;
340              
341 0 0       0 if ($cmd) {
342 0         0 $ssh->debug("Sending command: $cmd");
343 0         0 my $packet = $ssh->packet_start(SSH_CMSG_EXEC_CMD);
344 0         0 $packet->put_str($cmd);
345 0         0 $packet->send;
346             }
347             else {
348 0         0 $ssh->debug("Requesting shell.");
349 0         0 my $packet = $ssh->packet_start(SSH_CMSG_EXEC_SHELL);
350 0         0 $packet->send;
351             }
352              
353 0         0 my $read = Symbol::gensym;
354 0         0 my $write = Symbol::gensym;
355 0         0 tie *$read, 'Net::SSH::Perl::Handle::SSH1', 'r', $ssh;
356 0         0 tie *$write, 'Net::SSH::Perl::Handle::SSH1', 'w', $ssh;
357              
358 0         0 $ssh->debug("Entering interactive session.");
359 0         0 return ($read, $write);
360             }
361              
362 0     0 0 0 sub break_client_loop { $_[0]->{_cl_quit_pending} = 1 }
363 0     0   0 sub _quit_pending { $_[0]->{_cl_quit_pending} }
364              
365             sub _start_interactive {
366 0     0   0 my $ssh = shift;
367 0         0 my($sent_stdin) = @_;
368              
369 0         0 my $s = IO::Select->new;
370 0         0 $s->add($ssh->{session}{sock});
371 0 0       0 $s->add(\*STDIN) unless $sent_stdin;
372              
373             CLOOP:
374 0         0 $ssh->{_cl_quit_pending} = 0;
375 0         0 while (!$ssh->_quit_pending) {
376 0         0 my @ready = $s->can_read;
377 0         0 for my $a (@ready) {
378 0 0       0 if ($a == $ssh->{session}{sock}) {
    0          
379 0         0 my $buf;
380 0         0 my $len = sysread $a, $buf, 8192;
381 0 0       0 $ssh->break_client_loop unless $len;
382 0         0 ($buf) = $buf =~ /(.*)/s; ## Untaint data. Anything allowed.
383 0         0 $ssh->incoming_data->append($buf);
384             }
385             elsif ($a == \*STDIN) {
386 0         0 my $buf;
387 0         0 sysread STDIN, $buf, 8192;
388 0         0 ($buf) = $buf =~ /(.*)/s; ## Untaint data. Anything allowed.
389 0         0 my $packet = $ssh->packet_start(SSH_CMSG_STDIN_DATA);
390 0         0 $packet->put_str($buf);
391 0         0 $packet->send;
392             }
393             }
394              
395 0         0 while (my $packet = Net::SSH::Perl::Packet->read_poll($ssh)) {
396 0 0       0 if (my $r = $ssh->handler_for($packet->type)) {
397 0         0 $r->{code}->($ssh, $packet, @{ $r->{extra} });
  0         0  
398             }
399             else {
400 0         0 $ssh->debug(sprintf
401             "Warning: ignoring packet of type %d", $packet->type);
402             }
403              
404 0 0       0 if ($packet->type == SSH_SMSG_EXITSTATUS) {
405 0         0 my $packet = $ssh->packet_start(SSH_CMSG_EXIT_CONFIRMATION);
406 0         0 $packet->send;
407 0         0 $ssh->break_client_loop;
408             }
409             }
410              
411 0 0       0 last if $ssh->_quit_pending;
412             }
413             }
414              
415             sub send_data {
416 0     0 0 0 my $ssh = shift;
417 0         0 my($data) = @_;
418 0         0 my $packet = $ssh->packet_start(SSH_CMSG_STDIN_DATA);
419 0         0 $packet->put_str($data);
420 0         0 $packet->send;
421             }
422              
423             sub set_cipher {
424 0     0 1 0 my $ssh = shift;
425 0         0 my $ciph = shift;
426 0         0 $ssh->{session}{receive} = Net::SSH::Perl::Cipher->new($ciph, @_);
427 0         0 $ssh->{session}{send} = Net::SSH::Perl::Cipher->new($ciph, @_);
428             }
429              
430 5     5 1 10 sub send_cipher { $_[0]->{session}{send} }
431 5     5 1 17 sub receive_cipher { $_[0]->{session}{receive} }
432 0     0 1   sub session_key { $_[0]->{session}{key} }
433              
434             1;
435             __END__