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