|
@@ -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
|