fix

lib/Net/OpenSSH/More.pm

@@ -108,6 +108,7 @@ my %defaults = (
 );
 
 my %cache;
+our $disable_destructor = 0;
 
 ###################
 # PRIVATE METHODS #
@@ -120,6 +121,18 @@ my $die_no_trace = sub {
     die "[$summary] ${full_msg}${carp}";
 };
 
+my $check_local_perms = sub {
+    my ( $path, $expected_mode, $is_dir ) = @_;
+    my @stat = stat($path);
+    $die_no_trace->(qq{"$path" must be a directory that exists}) unless !$is_dir ^ -d _;
+    $die_no_trace->(qq{"$path" must be a file that exists})      unless $is_dir ^ -f _;
+    $die_no_trace->(qq{"$path" could not be read})               unless -r _;
+
+    my $actual_mode = $stat[2];
+    $die_no_trace->(qq{Permissions on "$path" are not correct: got=$actual_mode, expected=$expected_mode}) unless $expected_mode eq $actual_mode;
+    return 1;
+};
+
 my $resolve_login_method = sub {
     my ( $opts ) = @_;
 
@@ -131,21 +144,40 @@ my $resolve_login_method = sub {
     ( $opts->{'key_path'} ) = map { "${fallback_path}_$_" } ( first { -s "${fallback_path}_$_" } qw{dsa rsa ecdsa} );
 
     $die_no_trace->('No key_path or password specified and no active SSH agent; cannot connect') if !$opts->{'key_path'};
-    $check_local_perms->( $self->{'key_path'}, 0600 ) if $opts->{'key_path'};
+    $check_local_perms->( $opts->{'key_path'}, 0600 ) if $opts->{'key_path'};
 
     return $opts->{'key_path'};
 };
 
-my $check_local_perms = sub {
-    my ( $path, $expected_mode, $is_dir ) = @_;
-    my @stat = stat($path);
-    $die_no_trace->(qq{"$path" must be a directory that exists}) unless !$is_dir ^ -d _;
-    $die_no_trace->(qq{"$path" must be a file that exists})      unless $is_dir ^ -f _;
-    $die_no_trace->(qq{"$path" could not be read})               unless -r _;
+my $get_dns_record_from_hostname = sub {
+    my ( $hostname, $record_type ) = @_;
+    $record_type ||= 'A';
 
-    my $actual_mode = $stat[2];
-    $die_no_trace->(qq{Permissions on "$path" are not correct: got=$actual_mode, expected=$expected_mode}) unless $expected_mode eq $actual_mode;
-    return 1;
+    my $reply = Net::DNS::Resolver->new()->search( $hostname, $record_type );
+	return unless $reply;
+	return { map { $_->type() => $_->address() } grep { $_->type eq $record_type } ( $reply->answer() ) };
+};
+
+# Knock on the server till it responds, or doesn't. Try both ipv4 and ipv6.
+my $ping = sub {
+    my ( $opts ) = @_;
+
+	my $timeout = 30;
+	my $host_info = first { $get_dns_record_from_hostname->( $opts->{'host'}, $_ ) } qw{A AAAA};
+	my ( $r_type ) = keys( %$host_info );
+	my %family_map = ( 'A' => 'INET', 'AAAA' => 'INET6' );
+	my $start = time;
+	while ( ( time - $start ) <= $timeout ) {
+		return 1 if "IO::Socket::$family_map{$r_type}"->new(
+			'PeerAddr' => $host_info->{$r_type},
+			'PeerPort' => $opts->{'port'},
+			'Proto'    => 'tcp',
+			'Timeout'  => $timeout,
+		);
+		diag( { '_opts' => $opts }, "[DEBUG] Waiting for response on $host_info->{$r_type}:$opts->{'port'} ($r_type)..." ) if $opts->{'debug'};
+		select undef, undef, undef, 0.5;    # there's no need to try more than 2 times per second
+	}
+    return 0;
 };
 
 my $init_ssh = sub {
@@ -153,7 +185,7 @@ my $init_ssh = sub {
 
 	# Always clear the cache if possible when we get here.
 	if( $opts->{'_cache_index'} ) {
-		local $disable_destructor = 1;
+        local $disable_destructor = 1;
 		undef $cache{$opts->{'_cache_index'}};
 	}
 
@@ -169,6 +201,7 @@ my $init_ssh = sub {
 	# Leave no trace!
 	$opts->{'_tmp_obj'} = File::Temp->newdir() if !$opts->{'_tmp_obj'};
     my $tmp_dir = $opts->{'_tmp_obj'}->dirname();
+    my $temp_fh;
 
     # Use an existing connection if possible, otherwise make one
     if ( $ENV{$opts->{'_host_sock_key'}} && -e $ENV{$opts->{'_host_sock_key'}} ) {
@@ -177,10 +210,10 @@ my $init_ssh = sub {
     }
     else {
 		if( !$opts->{'debug'} ) {
-			open( my $temp_fh, ">", "$tmp_dir/STDERR" ) or $die_no_trace->("Can't open $tmp_dir/STDERR for writing: $!");
+			open( $temp_fh, ">", "$tmp_dir/STDERR" ) or $die_no_trace->("Can't open $tmp_dir/STDERR for writing: $!");
 			$opts->{'master_stderr_fh'} = $temp_fh;
 		}
-        $opts->{'ctl_dir'}     = $temp_dir;
+        $opts->{'ctl_dir'}     = $tmp_dir;
         $opts->{'strict_mode'} = 0;
 
         $opts->{'master_opts'} = [
@@ -218,8 +251,8 @@ my $init_ssh = sub {
         }
 
 		# Now, per the POD of Net::OpenSSH, new will NEVER DIE, so just trust it.
-        $self = $class->SUPER::new( $host, %opts );
-		my $error = $ssh->error;
+        $self = $class->SUPER::new( delete $opts->{'host'}, %$opts );
+		my $error = $self->error;
         next unless ref $self eq 'Net::OpenSSH::More' && !$error;
 
         if ( -s $temp_fh ) {
@@ -260,43 +293,12 @@ my $init_ssh = sub {
     return $self;
 };
 
-# Knock on the server till it responds, or doesn't. Try both ipv4 and ipv6.
-$ping = sub {
-    my ( $opts ) = @_;
-
-	my $timeout = 30;
-	my $host_info = first { $get_dns_record_from_hostname->( $opts->{'host'}, $_ ) } qw{A AAAA};
-	my ( $r_type ) = keys( %$host_info );
-	my %family_map = ( 'A' => 'INET', 'AAAA' => 'INET6' );
-	my $start = time;
-	while ( ( time - $start ) <= $timeout ) {
-		return 1 if "IO::Socket::$family_map{$r_type}"->new(
-			'PeerAddr' => $host_info->{$r_type},
-			'PeerPort' => $opts->{'port'},
-			'Proto'    => 'tcp',
-			'Timeout'  => $timeout,
-		);
-		diag( { '_opts' => $opts }, "[DEBUG] Waiting for response on $host_info->{$r_type}:$port ($family)..." ) if $opts->{'debug'};
-		select undef, undef, undef, 0.5;    # there's no need to try more than 2 times per second
-	}
-    return 0;
-};
-
-$get_dns_record_from_hostname = sub {
-    my ( $hostname, $record_type ) = @_;
-    my $record_type ||= 'A';
-
-    my $reply = Net::DNS::Resolver->new()->search( $hostname, $record_type );
-	return unless $reply;
-	return { map { $_->type() => $_->address() } grep { $_->type eq $record_type } ( $reply->answer() ) };
-};
-
 my $connection_check = sub {
     my ( $self ) = @_;
 	local $@;
     eval { $self = $init_ssh->($self->{'_opts'}) unless $self->check_master; };
     return $@ ? 0 : 1;
-}
+};
 
 # Try calling the function.
 # If it fails, then call _connection_check to reconnect if needed.
@@ -307,7 +309,7 @@ my $connection_check = sub {
 #
 # If the control socket has gone away, call
 # _connection_check ahead of time to reconnect it.
-$call_ssh_reinit_if_check_fails = sub {
+my $call_ssh_reinit_if_check_fails = sub {
     my ( $self, $func, @args ) = @_;
 
     $self->_connection_check() if !-S $self->{'_ctl_path'};
@@ -330,9 +332,17 @@ my $post_connect = sub {
     return;
 };
 
+my $trim = sub {
+    my ( $string ) = @_;
+    return '' unless length $string;
+    $string =~ s/^\s+//;
+    $string =~ s/\s+$//;
+    return $string;
+};
+
 my $send = sub {
     my ( $self, $line_reader, @cmd ) = @_;
-    my ( $pty, $err, $pid ) = $call_ssh_reinit_if_check_fails( $self, 'open3pty', @cmd );
+    my ( $pty, $err, $pid ) = $call_ssh_reinit_if_check_fails->( $self, 'open3pty', @cmd );
     $die_no_trace->("Net::OpenSSH::open3pty failed: $err") if( !defined $pid || $self->error() );
 
     $self->{'_out'} = "";
@@ -357,10 +367,50 @@ my $send = sub {
     $self->{'_pid'} = $pid;
     waitpid( $pid, 0 );
     return $? >> 8;
-}
+};
 
-# XXX TODO ALLOW ARRAY YOU BAG BITER
 my $TERMINATOR = "\r\r";
+my $send_persistent_cmd = sub {
+    my ( $self, $cmd, $uuid ) = @_;
+
+    $uuid //= Data::UUID->new()->create_str();
+
+    #Use command on bash to ignore stuff like aliases so that we have a minimum level of PEBKAC errors due to aliasing cp to cp -i, etc.
+    $self->{'expect'}->print("UUID='$uuid'; echo \"BEGIN \$UUID\"; command $cmd ; echo \"___\$?___\"; echo; echo \"EOF \$UUID\" $TERMINATOR");
+
+    #Rather than take the approach of Cpanel::Expect::cmd_then_poll, it seemed more straightforward to echo unique strings before and after the command.
+    #This made getting the return code somewhat more complicated, as you can see below.  That said, Cpanel::Expect appears to not concern itself with such things.
+
+    $self->{'expect'}->expect( 30,                        '-re', qr/BEGIN $uuid/m );
+    $self->{'expect'}->expect( $self->{'expect_timeout'}, '-re', qr/EOF $uuid/m );     #If nothing is printed in 2mins, give up
+
+    #Get the actual output, remove terminal grunk
+    my $message = $trim->( $self->{'expect'}->before() );
+    $message =~ s/[\r\n]{1,2}$//;                                                      #Remove 'secret newline' control chars
+    $message =~ s/\x{d}//g;                                                            #More control chars
+    $message = Term::ANSIColor::colorstrip($message);                                  #Strip colors
+
+    #Find the exit code
+    my ($code) = $message =~ m/___(\d*)___$/;
+    unless ( defined $code ) {
+
+        #Tell the user if they've made a boo-boo
+        my $possible_err = $trim->( $self->{'expect'}->before() );
+        $possible_err =~ s/\s//g;
+        $die_no_trace->("Runaway multi-line string detected.  Please adjust the command passed.") if $possible_err =~ m/\>/;
+
+        $die_no_trace->("Could not determine exit code!
+            It timed out (went 30s without printing anything).
+            Run command outside of the persistent terminal please.
+            (pass use_persistent_shell => 0 as opt to cmd)"
+        );
+    }
+    $message =~ s/___(\d*)___$//g;
+
+    return ( $message, $code );
+};
+
+# XXX TODO ALLOW ARRAY YOU BAG BITER
 my $do_persistent_command = sub {
     my ( $self, $cmd, $no_stderr ) = @_;
 
@@ -392,69 +442,21 @@ my $do_persistent_command = sub {
     #execute the command
     my $uuid = Data::UUID->new()->create_str();
     $cmd .= " 2> /tmp/stderr_$uuid.out" unless $no_stderr;
-    my ( $oot, $code ) = $send_persistent_cmd( $self, $cmd, $uuid );
+    my ( $oot, $code ) = $send_persistent_cmd->( $self, $cmd, $uuid );
     $self->{'_out'} = $oot;
 
     unless ($no_stderr) {
 
         #Grab stderr
-        ( $self->{'_err'} ) = $send_persistent_cmd( $self, "cat /tmp/stderr_$uuid.out" );
+        ( $self->{'_err'} ) = $send_persistent_cmd->( $self, "cat /tmp/stderr_$uuid.out" );
 
         #Clean up
-        $send_persistent_cmd( $self, "rm -f /tmp/stderr_$uuid.out" );
+        $send_persistent_cmd->( $self, "rm -f /tmp/stderr_$uuid.out" );
     }
 
     return int($code);
 };
 
-my $send_persistent_cmd = sub {
-    my ( $self, $cmd, $uuid ) = @_;
-
-    $uuid //= Data::UUID->new()->create_str();
-
-    #Use command on bash to ignore stuff like aliases so that we have a minimum level of PEBKAC errors due to aliasing cp to cp -i, etc.
-    $self->{'expect'}->print("UUID='$uuid'; echo \"BEGIN \$UUID\"; command $cmd ; echo \"___\$?___\"; echo; echo \"EOF \$UUID\" $TERMINATOR");
-
-    #Rather than take the approach of Cpanel::Expect::cmd_then_poll, it seemed more straightforward to echo unique strings before and after the command.
-    #This made getting the return code somewhat more complicated, as you can see below.  That said, Cpanel::Expect appears to not concern itself with such things.
-
-    $self->{'expect'}->expect( 30,                        '-re', qr/BEGIN $uuid/m );
-    $self->{'expect'}->expect( $self->{'expect_timeout'}, '-re', qr/EOF $uuid/m );     #If nothing is printed in 2mins, give up
-
-    #Get the actual output, remove terminal grunk
-    my $message = $trim->( $self->{'expect'}->before() );
-    $message =~ s/[\r\n]{1,2}$//;                                                      #Remove 'secret newline' control chars
-    $message =~ s/\x{d}//g;                                                            #More control chars
-    $message = Term::ANSIColor::colorstrip($message);                                  #Strip colors
-
-    #Find the exit code
-    my ($code) = $message =~ m/___(\d*)___$/;
-    unless ( defined $code ) {
-
-        #Tell the user if they've made a boo-boo
-        my $possible_err = $trim->( $self->{'expect'}->before() );
-        $possible_err =~ s/\s//g;
-        $die_no_trace->("Runaway multi-line string detected.  Please adjust the command passed.") if $possible_err =~ m/\>/;
-
-        $die_no_trace->("Could not determine exit code!
-            It timed out (went 30s without printing anything).
-            Run command outside of the persistent terminal please.
-            (pass use_persistent_shell => 0 as opt to cmd)"
-        );
-    }
-    $message =~ s/___(\d*)___$//g;
-
-    return ( $message, $code );
-};
-
-my $trim = sub {
-    my ( $string ) = @_;
-    return '' unless length $string;
-    $string =~ s/^\s+//;
-    $string =~ s/\s+$//;
-    return $string;
-}
-
 #######################
 # END PRIVATE METHODS #
 #######################
@@ -472,8 +474,8 @@ sub new {
     $opts{'_login_method'} = $resolve_login_method->(\%opts);
 
     # check permissions on base files if we got here
-    $check_local_perms->( "$home/.ssh",        0700, 1 ) if -e "$home/.ssh";
-    $check_local_perms->( "$home/.ssh/config", 0600 )    if -e "$home/.ssh/config";
+    $check_local_perms->( "$opts{'home'}/.ssh",        0700, 1 ) if -e "$opts{'home'}/.ssh";
+    $check_local_perms->( "$opts{'home'}/.ssh/config", 0600 )    if -e "$opts{'home'}/.ssh/config";
 
     # Make the connection
     my $self = $cache{$opts{'_cache_index'}} = $init_ssh->( $class, \%opts );
@@ -500,8 +502,8 @@ the parent's destructor kicks in:
 
 =cut
 
-my $disable_destructor = 0;
 sub DESTROY {
+    my ($self) = @_;
     return if $$ != $self->{'ppid'} || $disable_destructor;
 	$ENV{SSH_AUTH_SOCK} = $self->{'_opts'}{'_restore_auth_sock'} if $self->{'_opts'}{'_restore_auth_sock'};
     $self->{'persistent_shell'}->close() if $self->{'persistent_shell'};
@@ -571,9 +573,9 @@ sub cmd {
 	my @cmd = @_;
 
     $die_no_trace->( 'No command specified', 'PEBCAK' ) if !@cmd;
-    $diag("[DEBUG][$self->{'_opts'}{'host'}] EXEC " . join( " ", @cmd ) ) if $self->{'_opts'}{'debug'};
+    $self->diag("[DEBUG][$self->{'_opts'}{'host'}] EXEC " . join( " ", @cmd ) ) if $self->{'_opts'}{'debug'};
 
-    my $ret = $no_persist ? $send->( $self, undef, @cmd ) : $self->_do_persistent_command( \@cmd, $opts->{'no_stderr'} );
+    my $ret = $opts->{'no_persist'} ? $send->( $self, undef, @cmd ) : $self->_do_persistent_command( \@cmd, $opts->{'no_stderr'} );
     chomp( my $out = $self->read );
     my $err = $self->error;
 
@@ -593,6 +595,8 @@ cPanel, L.L.C. - in particularly the QA department (which the authors once were
 Many of the ideas for this module originated out of lessons learned from our time
 writing a ssh based remote teststuite for testing cPanel & WHM.
 
+Chris Eades - For the original module this evolved from at cPanel over the years.
+
 bdraco (Nick Koston) - For optimization ideas and the general process needed for expect & persistent shell.
 
 J.D. Lightsey - For the somewhat crazy but nonetheless very useful eval_full subroutine used