1# $Id: SSH2.pm,v 1.47 2009/01/26 01:50:38 turnstep Exp $
2
3package Net::SSH::Perl::SSH2;
4use strict;
5use warnings;
6
7use Net::SSH::Perl::Kex;
8use Net::SSH::Perl::ChannelMgr;
9use Net::SSH::Perl::Packet;
10use Net::SSH::Perl::Buffer;
11use Net::SSH::Perl::Constants qw( :protocol :msg2 :hosts
12                                  CHAN_INPUT_CLOSED CHAN_INPUT_WAIT_DRAIN
13                                  KEX_DEFAULT_PK_ALG );
14use Net::SSH::Perl::Cipher;
15use Net::SSH::Perl::AuthMgr;
16use Net::SSH::Perl::Comp;
17use Net::SSH::Perl::Util qw( :hosts :win32 _read_yes_or_no );
18
19use base qw( Net::SSH::Perl );
20
21use Carp qw( croak );
22use File::Spec::Functions qw( catfile );
23use File::HomeDir ();
24
25use Errno;
26
27use vars qw( $VERSION $CONFIG $HOSTNAME );
28$VERSION = $Net::SSH::Perl::VERSION;
29
30sub select_class { 'IO::Select' }
31
32sub _dup {
33    my($fh, $mode) = @_;
34
35    if ( $^O eq 'MSWin32' ) {
36        #
37        # On Windows platform select() is working only for sockets.
38        #
39        my ( $r, $w ) = _socketpair()
40            or die "Could not create socketpair: $!\n";
41
42        # TODO: full support (e.g. stdin)
43
44        return ( $mode eq '>' ) ? $w : $r;
45    }
46
47    my $dup = Symbol::gensym;
48    my $str = "${mode}&$fh";
49    open ($dup, $str) or die "Could not dupe: $!\n"; ## no critic
50    $dup;
51}
52
53sub version_string {
54    my $class = shift;
55    sprintf "Net::SSH::Perl Version %s, protocol version %s.%s.",
56        $class->VERSION, PROTOCOL_MAJOR_2, PROTOCOL_MINOR_2;
57}
58
59sub _proto_init {
60    my $ssh = shift;
61    my $home = File::HomeDir->my_home;
62    my $config = $ssh->{config};
63
64    unless ($config->get('user_known_hosts')) {
65        defined $home or croak "Cannot determine home directory, please set the environment variable HOME";
66        $config->set('user_known_hosts', catfile($home, '.ssh', 'known_hosts2'));
67    }
68    unless ($config->get('global_known_hosts')) {
69        my $glob_known_hosts = $^O eq 'MSWin32'
70          ? catfile( $ENV{WINDIR}, 'ssh_known_hosts2' )
71          : '/etc/ssh_known_hosts2';
72        $config->set('global_known_hosts', $glob_known_hosts);
73    }
74    unless (my $if = $config->get('identity_files')) {
75        defined $home or croak "Cannot determine home directory, please set the environment variable HOME";
76        $config->set('identity_files', [ catfile($home, '.ssh', 'id_ed25519'),
77            catfile($home, '.ssh', 'id_rsa'), catfile($home, '.ssh', 'id_ecdsa') ]);
78    }
79
80    for my $a (qw( password dsa kbd_interactive )) {
81        $config->set("auth_$a", 1)
82            unless defined $config->get("auth_$a");
83    }
84}
85
86sub kex { $_[0]->{kex} }
87
88sub register_handler {
89    my($ssh, $type, $sub, @extra) = @_;
90    $ssh->{client_handlers}{$type} = { code => $sub, extra => \@extra };
91}
92
93# handle SSH2_MSG_GLOBAL_REQUEST
94sub client_input_global_request {
95    my $ssh = shift;
96    my $pack = shift or return;
97    my $req = $pack->get_str;
98    my $want_reply = ord $pack->get_char;
99    my $success = 0;
100    $ssh->debug("Global Request: $req, want reply: $want_reply");
101    if ($req eq 'hostkeys-00@openssh.com') {
102        if ($ssh->config->get('hostkeys_seen')) {
103            die 'Server already sent hostkeys!';
104        }
105        my $update_host_keys = $ssh->config->get('update_host_keys') || 'no';
106        $success = $ssh->client_input_hostkeys($pack)
107           if $update_host_keys eq 'yes' || $update_host_keys eq 'ask';
108        $ssh->config->set('hostkeys_seen', 1);
109    }
110    if ($want_reply) {
111        my $packet = $ssh->packet_start(
112            $success ? SSH2_MSG_REQUEST_SUCCESS : SSH2_MSG_REQUEST_FAILURE
113        );
114        $packet->send;
115    }
116}
117
118# handle hostkeys-00@openssh.com global request from server
119sub client_input_hostkeys {
120    my $ssh = shift;
121    my $pack = shift;
122    my %keys;
123
124    use Net::SSH::Perl::Key;
125
126    my $fp_hash = $ssh->config->get('fingerprint_hash');
127    while ($pack->offset < $pack->length) {
128        my $blob = $pack->get_str;
129        my $key = Net::SSH::Perl::Key->new_from_blob($blob);
130        unless ($key) {
131            $ssh->debug("Invalid key sent by server");
132            next;
133        }
134
135        my @allowed_key_types = split(',',
136            $ssh->config->get('host_key_algorithms') ||
137            KEX_DEFAULT_PK_ALG);
138        my $key_type = $key->ssh_name;
139        $ssh->debug("Received $key_type key: " . $key->fingerprint($fp_hash));
140        unless (grep { /^$key_type$/ } @allowed_key_types) {
141            unless ($key_type eq 'ssh-rsa' && grep { /^rsa-sha2-/ } @allowed_key_types) {
142                $ssh->debug("$key_type key not permitted by HostkeyAlgorithms");
143                next;
144            }
145        }
146        my $fp = $key->fingerprint($fp_hash);
147        if (exists $keys{$fp}) {
148            $ssh->debug("Received duplicate $key_type key");
149            next;
150        }
151        $keys{$fp} = $key;
152    }
153    unless (%keys) {
154        $ssh->debug('Server sent no usable keys');
155        return 0;
156    }
157
158    my $host = $ssh->{host};
159    my $port = $ssh->{config}->get('port');
160    if (defined $port && $port =~ /\D/) {
161        my @serv = getservbyname(my $serv = $port, 'tcp');
162        $port = $serv[2];
163    }
164    my $u_hostfile = $ssh->{config}->get('user_known_hosts');
165    my %known_keys = map { $_->fingerprint($fp_hash) => $_ }
166       _all_keys_for_host($host, $port, $u_hostfile);
167
168    my $retained = 0;
169    my @new_keys;
170    foreach my $fp (keys %keys) {
171        if ($known_keys{$fp}) {
172            $retained++;
173        } else {
174            push @new_keys, $keys{$fp};
175        }
176    }
177
178    my @deprecated_keys;
179    foreach my $fp (keys %known_keys) {
180        push @deprecated_keys, $known_keys{$fp} unless $keys{$fp};
181    }
182
183    $ssh->debug(scalar(keys(%keys)) . ' keys from server: ' . scalar(@new_keys) .
184        " new, $retained retained. " . scalar(@deprecated_keys) . ' to remove');
185
186    if ((@deprecated_keys || @new_keys) && $ssh->config->get('update_host_keys') eq 'ask') {
187        return 0 unless _read_yes_or_no("Update hostkeys in known hosts? (yes/no)", 'yes');
188    }
189    foreach my $key (@deprecated_keys) {
190        $ssh->debug('Removing deprecated ' . $key->ssh_name . 'key from known hosts');
191        _remove_host_from_hostfile($host, $port, $u_hostfile, $key);
192    }
193
194    if (@new_keys) {
195        my $packet = $ssh->packet_start(SSH2_MSG_GLOBAL_REQUEST);
196        $packet->put_str('hostkeys-prove-00@openssh.com');
197        $packet->put_char(chr(1));
198        foreach my $key (@new_keys) {
199            $packet->put_str($key->as_blob);
200        }
201        $packet->send;
202        $ssh->debug("Sent hostkeys-prove request");
203
204        my $sigbuf = Net::SSH::Perl::Packet->read($ssh);
205        unless ($sigbuf && $sigbuf->type == SSH2_MSG_REQUEST_SUCCESS) {
206            $ssh->debug("hostkeys-prove request failed");
207            return 0;
208        }
209        $ssh->debug("Got hostkeys-prove request success");
210        my @verified_keys;
211        foreach my $key (@new_keys) {
212            my $sig = $sigbuf->get_str;
213            # prepare signed data
214            my $data = Net::SSH::Perl::Buffer->new( MP => 'SSH2' );
215            $data->put_str('hostkeys-prove-00@openssh.com');
216            $data->put_str($ssh->session_id);
217            $data->put_str($key->as_blob);
218            # verify signature
219            unless ($key->verify($sig,$data->bytes)) {
220                $ssh->debug("Server failed to confirm ownership of " .
221                    "private " . $ssh->ssh_name . " host key");
222                next;
223            }
224            $ssh->debug('Learned new hostkey: ' . $key->ssh_name . ' ' .
225                $key->fingerprint($fp_hash));
226            push @verified_keys, $key;
227        }
228        my %verified = map { $_->fingerprint($fp_hash) => 1 } @verified_keys;
229        my $hash_known_hosts = $ssh->config->get('hash_known_hosts');
230        foreach my $key (@verified_keys) {
231            $ssh->debug('Adding ' . $key->ssh_name . ' key to known hosts');
232            _add_host_to_hostfile($host, $port, $u_hostfile, $key, $hash_known_hosts);
233        }
234    }
235    return 1;
236}
237
238sub login {
239    my $ssh = shift;
240    $ssh->SUPER::login(@_);
241    my $suppress_shell = $_[2];
242    $ssh->_login or $ssh->fatal_disconnect("Permission denied");
243
244    $ssh->debug("Login completed, opening dummy shell channel.");
245    my $cmgr = $ssh->channel_mgr;
246    my $channel = $cmgr->new_channel(
247        ctype => 'session', local_window => 0,
248        local_maxpacket => 0, remote_name => 'client-session');
249    $channel->open;
250
251    # check if a global request was sent
252    my $packet = Net::SSH::Perl::Packet->read($ssh);
253    if ($packet && $packet->type == SSH2_MSG_GLOBAL_REQUEST) {
254        my $p = $packet;
255        $packet = Net::SSH::Perl::Packet->read_expect($ssh,
256            SSH2_MSG_CHANNEL_OPEN_CONFIRMATION);
257        $ssh->client_input_global_request($p);
258    } elsif ($packet->type != SSH2_MSG_CHANNEL_OPEN_CONFIRMATION) {
259        die "Unexpected " . $packet->type . " response!";
260    }
261    $cmgr->input_open_confirmation($packet);
262
263    unless ($suppress_shell) {
264        $ssh->debug("Got channel open confirmation, requesting shell.");
265        $channel->request("shell", 0);
266    }
267}
268
269sub _login {
270    my $ssh = shift;
271
272    my $kex = Net::SSH::Perl::Kex->new($ssh);
273    $kex->exchange;
274
275    my $amgr = Net::SSH::Perl::AuthMgr->new($ssh);
276    $amgr->authenticate;
277}
278
279sub _session_channel {
280    my $ssh = shift;
281    my $cmgr = $ssh->channel_mgr;
282
283    my $channel = $cmgr->new_channel(
284        ctype => 'session', local_window => 32*1024,
285        local_maxpacket => 16*1024, remote_name => 'client-session',
286        rfd => _dup('STDIN', '<'), wfd => _dup('STDOUT', '>'),
287        efd => _dup('STDERR', '>'));
288
289    $channel;
290}
291
292sub _make_input_channel_req {
293    my($r_exit) = @_;
294    return sub {
295        my($channel, $packet) = @_;
296        my $rtype = $packet->get_str;
297        my $reply = $packet->get_int8;
298        $channel->{ssh}->debug("input_channel_request: rtype $rtype reply $reply");
299        if ($rtype eq "exit-status") {
300            $$r_exit = $packet->get_int32;
301        }
302        if ($reply) {
303            my $r_packet = $channel->{ssh}->packet_start(SSH2_MSG_CHANNEL_SUCCESS);
304            $r_packet->put_int($channel->{remote_id});
305            $r_packet->send;
306        }
307    };
308}
309
310sub cmd {
311    my $ssh = shift;
312    my($cmd, $stdin) = @_;
313    my $cmgr = $ssh->channel_mgr;
314    my $channel = $ssh->_session_channel;
315    $channel->open;
316
317    $channel->register_handler(SSH2_MSG_CHANNEL_OPEN_CONFIRMATION, sub {
318        my($channel, $packet) = @_;
319
320                ## Experimental pty support:
321                if ($ssh->{config}->get('use_pty')) {
322			$ssh->debug("Requesting pty.");
323
324			my $packet = $channel->request_start('pty-req', 0);
325
326			my($term) = $ENV{TERM} =~ /(\w+)/;
327			$packet->put_str($term);
328			my $foundsize = 0;
329			if (eval "require Term::ReadKey") {
330				my @sz = Term::ReadKey::GetTerminalSize($ssh->sock);
331				if (defined $sz[0]) {
332					$foundsize = 1;
333					$packet->put_int32($sz[1]); # height
334					$packet->put_int32($sz[0]); # width
335					$packet->put_int32($sz[2]); # xpix
336					$packet->put_int32($sz[3]); # ypix
337				}
338			}
339			if (!$foundsize) {
340				$packet->put_int32(0) for 1..4;
341			}
342
343            # Array used to build Pseudo-tty terminal modes; fat commas separate opcodes from values for clarity.
344
345            my $terminal_mode_string;
346            if(!defined($ssh->{config}->get('terminal_mode_string'))) {
347                my @terminal_modes = (
348                   5 => 0,0,0,4,      # VEOF => 0x04 (^d)
349                   0                  # string must end with a 0 opcode
350                );
351                for my $char (@terminal_modes) {
352                    $terminal_mode_string .= chr($char);
353                }
354            }
355            else {
356                $terminal_mode_string = $ssh->{config}->get('terminal_mode_string');
357            }
358            $packet->put_str($terminal_mode_string);
359            $packet->send;
360        }
361
362        my $r_packet = $channel->request_start("exec", 0);
363        $r_packet->put_str($cmd);
364        $r_packet->send;
365
366        if (defined $stdin) {
367            if($ssh->{config}->get('use_pty') && !$ssh->{config}->get('no_append_veof')) {
368                my $append_string = $ssh->{config}->get('stdin_append');
369                if(!defined($append_string)) {
370                    $append_string = chr(4) . chr(4);
371                }
372                $stdin .= $append_string;
373            }
374            $channel->send_data($stdin);
375
376            $channel->drain_outgoing;
377            $channel->{istate} = CHAN_INPUT_WAIT_DRAIN;
378            $channel->send_eof;
379            $channel->{istate} = CHAN_INPUT_CLOSED;
380        }
381    });
382
383    my($exit);
384    $channel->register_handler(SSH2_MSG_CHANNEL_REQUEST,
385        _make_input_channel_req(\$exit));
386
387    my $h = $ssh->{client_handlers};
388    my($stdout, $stderr);
389    if (my $r = $h->{stdout}) {
390        $channel->register_handler("_output_buffer",
391            $r->{code}, @{ $r->{extra} });
392    }
393    else {
394        $channel->register_handler("_output_buffer", sub {
395            $stdout .= $_[1]->bytes;
396        });
397    }
398    if (my $r = $h->{stderr}) {
399        $channel->register_handler("_extended_buffer",
400            $r->{code}, @{ $r->{extra} });
401    }
402    else {
403        $channel->register_handler("_extended_buffer", sub {
404            $stderr .= $_[1]->bytes;
405        });
406    }
407
408    $ssh->debug("Entering interactive session.");
409    $ssh->client_loop;
410
411    ($stdout, $stderr, $exit);
412}
413
414sub shell {
415    my $ssh = shift;
416    my $cmgr = $ssh->channel_mgr;
417    my $channel = $ssh->_session_channel;
418    $channel->open;
419
420    $channel->register_handler(SSH2_MSG_CHANNEL_OPEN_CONFIRMATION, sub {
421        my($channel, $packet) = @_;
422        my $r_packet = $channel->request_start('pty-req', 0);
423        my($term) = $ENV{TERM} =~ /(\S+)/;
424        $r_packet->put_str($term);
425        my $foundsize = 0;
426        if (eval "require Term::ReadKey") {
427            my @sz = Term::ReadKey::GetTerminalSize($ssh->sock);
428            if (defined $sz[0]) {
429                $foundsize = 1;
430                $r_packet->put_int32($sz[0]); # width
431                $r_packet->put_int32($sz[1]); # height
432                $r_packet->put_int32($sz[2]); # xpix
433                $r_packet->put_int32($sz[3]); # ypix
434            }
435        }
436        if (!$foundsize) {
437            $r_packet->put_int32(0) for 1..4;
438        }
439        $r_packet->put_str("");
440        $r_packet->send;
441        $channel->{ssh}->debug("Requesting shell.");
442        $channel->request("shell", 0);
443    });
444
445    my($exit);
446    $channel->register_handler(SSH2_MSG_CHANNEL_REQUEST,
447        _make_input_channel_req(\$exit));
448
449    $channel->register_handler("_output_buffer", sub {
450        syswrite STDOUT, $_[1]->bytes;
451    });
452    $channel->register_handler("_extended_buffer", sub {
453        syswrite STDERR, $_[1]->bytes;
454    });
455
456    $ssh->debug("Entering interactive session.");
457    $ssh->client_loop;
458}
459
460sub open2 {
461    my $ssh = shift;
462    my($cmd) = @_;
463
464    require Net::SSH::Perl::Handle::SSH2;
465
466    my $cmgr = $ssh->channel_mgr;
467    my $channel = $ssh->_session_channel;
468    $channel->open;
469
470    $channel->register_handler(SSH2_MSG_CHANNEL_OPEN_CONFIRMATION, sub {
471        my($channel, $packet) = @_;
472        $channel->{ssh}->debug("Sending command: $cmd");
473        my $r_packet = $channel->request_start("exec", 1);
474        $r_packet->put_str($cmd);
475        $r_packet->send;
476    });
477
478    my $exit;
479    $channel->register_handler(SSH2_MSG_CHANNEL_REQUEST, sub {
480    my($channel, $packet) = @_;
481    my $rtype = $packet->get_str;
482    my $reply = $packet->get_int8;
483    $channel->{ssh}->debug("input_channel_request: rtype $rtype reply $reply");
484    if ($rtype eq "exit-status") {
485        $exit = $packet->get_int32;
486    }
487    if ($reply) {
488        my $r_packet = $channel->{ssh}->packet_start(SSH2_MSG_CHANNEL_SUCCESS);
489        $r_packet->put_int($channel->{remote_id});
490        $r_packet->send;
491    }
492    });
493
494    my $reply = sub {
495        my($channel, $packet) = @_;
496        if ($packet->type == SSH2_MSG_CHANNEL_FAILURE) {
497            $channel->{ssh}->fatal_disconnect("Request for " .
498                "exec failed on channel '" . $packet->get_int32 . "'");
499        }
500        $channel->{ssh}->break_client_loop;
501    };
502
503    $cmgr->register_handler(SSH2_MSG_CHANNEL_FAILURE, $reply);
504    $cmgr->register_handler(SSH2_MSG_CHANNEL_SUCCESS, $reply);
505
506    $ssh->client_loop;
507
508    my $read = Symbol::gensym;
509    my $write = Symbol::gensym;
510    tie *$read, 'Net::SSH::Perl::Handle::SSH2', 'r', $channel, \$exit;
511    tie *$write, 'Net::SSH::Perl::Handle::SSH2', 'w', $channel, \$exit;
512
513    return ($read, $write);
514}
515
516sub break_client_loop { $_[0]->{_cl_quit_pending} = 1 }
517sub restore_client_loop { $_[0]->{_cl_quit_pending} = 0 }
518sub _quit_pending { $_[0]->{_cl_quit_pending} }
519
520sub client_loop {
521    my $ssh = shift;
522    my $cmgr = $ssh->channel_mgr;
523
524    my $h = $cmgr->handlers;
525    my $select_class = $ssh->select_class;
526
527    CLOOP:
528    $ssh->{_cl_quit_pending} = 0;
529    while (!$ssh->_quit_pending) {
530        while (my $packet = Net::SSH::Perl::Packet->read_poll($ssh)) {
531            if (my $code = $h->{ $packet->type }) {
532                $code->($cmgr, $packet);
533            }
534            else {
535                $ssh->debug("Warning: ignore packet type " . $packet->type);
536            }
537        }
538        last if $ssh->_quit_pending;
539
540        $cmgr->process_output_packets;
541
542        my $rb = $select_class->new;
543        my $wb = $select_class->new;
544        $rb->add($ssh->sock);
545        $cmgr->prepare_channels($rb, $wb);
546
547        #last unless $cmgr->any_open_channels;
548        my $oc = grep { defined } @{ $cmgr->{channels} };
549        last unless $oc > 1;
550
551        my($rready, $wready) = $select_class->select($rb, $wb);
552        unless (defined $rready or defined $wready) {
553            next if ( $!{EAGAIN} || $!{EINTR} );
554            die "select: $!";
555        }
556
557        $cmgr->process_input_packets($rready, $wready);
558
559        for my $ab (@$rready) {
560            if ($ab == $ssh->{session}{sock}) {
561                my $buf;
562                my $len = sysread $ab, $buf, 8192;
563				if (! defined $len) {
564					croak "Connection failed: $!\n";
565				}
566                $ssh->break_client_loop if $len == 0;
567                ($buf) = $buf =~ /(.*)/s;  ## Untaint data. Anything allowed.
568                $ssh->incoming_data->append($buf);
569            }
570        }
571    }
572}
573
574sub channel_mgr {
575    my $ssh = shift;
576    unless (defined $ssh->{channel_mgr}) {
577        $ssh->{channel_mgr} = Net::SSH::Perl::ChannelMgr->new($ssh);
578    }
579    $ssh->{channel_mgr};
580}
581
5821;
583__END__
584
585=head1 NAME
586
587Net::SSH::Perl::SSH2 - SSH2 implementation
588
589=head1 SYNOPSIS
590
591    use Net::SSH::Perl;
592    my $ssh = Net::SSH::Perl->new($host, protocol => 2);
593
594=head1 DESCRIPTION
595
596I<Net::SSH::Perl::SSH2> implements the SSH2 protocol. It is a
597subclass of I<Net::SSH::Perl>, and implements the interface
598described in the documentation for that module. In fact, your
599usage of this module should be completely transparent; simply
600specify the proper I<protocol> value (C<2>) when creating your
601I<Net::SSH::Perl> object, and the SSH2 implementation will be
602loaded automatically.
603
604NOTE: Of course, this is still subject to protocol negotiation
605with the server; if the server doesn't support SSH2, there's
606not much the client can do, and you'll get a fatal error if
607you use the above I<protocol> specification (C<2>).
608
609=head2 AUTHOR & COPYRIGHTS
610
611Please see the Net::SSH::Perl manpage for author, copyright,
612and license information.
613
614=cut
615