123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797 |
- package Net::OpenSSH::More;
- use strict;
- use warnings;
- use parent 'Net::OpenSSH';
- use Data::UUID ();
- use Expect ();
- use File::HomeDir ();
- use File::Temp ();
- use Fcntl ();
- use IO::Pty ();
- use IO::Socket::INET ();
- use IO::Socket::INET6 ();
- use IO::Stty ();
- use List::Util qw{first};
- use Net::DNS::Resolver ();
- use Net::IP ();
- use Time::HiRes ();
- use Term::ANSIColor ();
- =head1 NAME
- Net::OpenSSH::More
- =head1 DESCRIPTION
- Submodule of Net::OpenSSH that contains many methods that were
- otherwise left "as an exercise to the reader" in the parent module.
- Highlights:
- * Persistent terminal via expect for very fast execution, less forking.
- * Usage of File::Temp and auto-cleanup to prevent lingering ctl_path cruft.
- * Ability to manipulate incoming text while streaming the output of commands.
- * Run perl subroutine refs you write locally but execute remotely.
- * Many shortcut methods for common system administration tasks
- * Registration method for commands to run upon DESTROY/before disconnect.
- * Automatic reconnection ability upon connection loss
- * Easy SFTP accessor for file uploads/downloads.
- =head1 SYNOPSIS
- use Net::OpenSSH::More;
- my $ssh = Net::OpenSSH::More->new(
- 'host' => 'some.host.test',
- 'port' => 69420,
- 'user' => 'azurediamond',
- 'password' => 'hunter2',
- );
- ...
- =head1 SEE ALSO
- Net::OpenSSH
- Net::OpenSSH::More::Linux
- =cut
- my %defaults = (
- 'user' => $ENV{'USER'} || getpwuid($>),
- 'port' => 22,
- 'use_persistent_shell' => 0,
- 'output_prefix' => '',
- 'home' => File::HomeDir->my_home,
- 'retry_interval' => 6,
- 'retry_max' => 10,
- );
- our %cache;
- our $disable_destructor = 0;
- ###################
- # PRIVATE METHODS #
- ###################
- my $die_no_trace = sub {
- my ( $full_msg, $summary ) = @_;
- $summary ||= 'FATAL';
- my $carp = $INC{'Carp/Always.pm'} ? '' : ' - Use Carp::Always for full trace.';
- die "[$summary] ${full_msg}${carp}";
- };
- my $check_local_perms = sub {
- my ( $path, $expected_mode, $is_dir ) = @_;
- $is_dir //= 0;
- 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] & 07777;
- $die_no_trace->(sprintf(qq{Permissions on "$path" are not correct: got=0%o, expected=0%o}, $actual_mode, $expected_mode)) unless $expected_mode eq $actual_mode;
- return 1;
- };
- my $resolve_login_method = sub {
- my ( $opts ) = @_;
- my $chosen = first { $opts->{$_} } qw{key_path password};
- $chosen //= '';
- undef $chosen if $chosen eq 'key_path' && !$check_local_perms->( $opts->{'key_path'}, 0600 );
- return $chosen if $chosen;
- return 'SSH_AUTH_SOCK' if $ENV{'SSH_AUTH_SOCK'};
- my $fallback_path = "$opts->{'home'}/.ssh/id";
- ( $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->( $opts->{'key_path'}, 0600 ) if $opts->{'key_path'};
- return $opts->{'key_path'};
- };
- my $get_dns_record_from_hostname = sub {
- my ( $hostname, $record_type ) = @_;
- $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() ) };
- };
- # 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, $ip, $r_type );
- if( my $ip_obj = Net::IP->new($opts->{'host'}) ) {
- $r_type = $ip_obj->ip_is_ipv4 ? 'A' : 'AAAA';
- $ip = $opts->{'host'};
- }
- else {
- my $host_info = first { $get_dns_record_from_hostname->( $opts->{'host'}, $_ ) } qw{A AAAA};
- ( $r_type ) = keys( %$host_info );
- if(!$host_info->{$r_type}) {
- require Data::Dumper;
- die "Can't determine IP type. " . Data::Dumper::Dumper($host_info);
- }
- $ip = $host_info->{$r_type};
- }
- 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' => $ip,
- 'PeerPort' => $opts->{'port'},
- 'Proto' => 'tcp',
- 'Timeout' => $timeout,
- );
- diag( { '_opts' => $opts }, "[DEBUG] Waiting for response on $ip:$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 {
- my ( $class, $opts ) = @_;
- # Always clear the cache if possible when we get here.
- if( $opts->{'_cache_index'} ) {
- local $disable_destructor = 1;
- undef $cache{$opts->{'_cache_index'}};
- }
- # Try not to have disallowed ENV chars. For now just transliterate . into _
- # XXX TODO This will be bad with some usernames/domains.
- # Maybe need to run host through punycode decoder, etc.?
- if( !$opts->{'_host_sock_key'} ) {
- $opts->{'_host_sock_key'} = "NET_OPENSSH_MASTER_$opts->{'host'}_$opts->{'user'}";
- $opts->{'_host_sock_key'} =~ tr/./_/;
- }
- # Make temp dir go out of scope with this object for ctl paths, etc.
- # Leave no trace!
- $opts->{'_tmp_obj'} = File::Temp->newdir() if !$opts->{'_tmp_obj'};
- my $tmp_dir = $opts->{'_tmp_obj'}->dirname();
- diag( { '_opts' => $opts }, "Temp dir: $tmp_dir" ) if $opts->{'debug'};
- my $temp_fh;
- # Use an existing connection if possible, otherwise make one
- if ( $ENV{$opts->{'_host_sock_key'}} && -e $ENV{$opts->{'_host_sock_key'}} ) {
- $opts->{'external_master'} = 1;
- $opts->{'ctl_path'} = $ENV{$opts->{'_host_sock_key'}};
- }
- else {
- if( !$opts->{'debug'} ) {
- 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'} = $tmp_dir;
- $opts->{'strict_mode'} = 0;
- $opts->{'master_opts'} = [
- '-o' => 'StrictHostKeyChecking=no',
- '-o' => 'GSSAPIAuthentication=no',
- '-o' => 'UserKnownHostsFile=/dev/null',
- '-o' => 'ConnectTimeout=180',
- '-o' => 'TCPKeepAlive=no',
- ];
- push @{ $opts->{'master_opts'} }, '-v' if $opts->{'debug'};
- if ( $opts->{'key_path'} ) {
- push @{ $opts->{'master_opts'} }, '-o', 'IdentityAgent=none';
- }
- # Attempt to use the SSH agent if possible. This won't hurt if you use -k or -P.
- # Even if your sock doesn't work to get you in, you may want it to do something on the remote host.
- # Of course, you may want to disable this with no_agent if your system is stupidly configured
- # with lockout after 3 tries and you have 4 keys in agent.
- # Anyways, don't just kill the sock for your bash session, restore it in DESTROY
- $opts->{'_restore_auth_sock'} = delete $ENV{SSH_AUTH_SOCK} if $opts->{'no_agent'};
- $opts->{'forward_agent'} = 1 if $ENV{'SSH_AUTH_SOCK'};
- }
- my $status = 0;
- my $self;
- foreach my $attempt ( 1 .. $opts->{'retry_max'} ) {
- local $@;
- my $up = $ping->($opts);
- if ( !$up ) {
- $die_no_trace->("$opts->{'host'} is down!") if $opts->{die_on_drop};
- diag( { '_opts' => $opts }, "Waiting for host to bring up sshd, attempt $attempt..." );
- next;
- }
- # Now, per the POD of Net::OpenSSH, new will NEVER DIE, so just trust it.
- my @base_module_opts = qw{host user port password passphrase key_path gateway proxy_command batch_mode ctl_dir ctl_path ssh_cmd scp_cmd rsync_cmd remote_shell timeout kill_ssh_on_timeout strict_mode async connect master_opts default_ssh_opts forward_agent forward_X11 default_stdin_fh default_stdout_fh default_stderr_fh default_stdin_file default_stdout_file default_stderr_file master_stdout_fh master_sdterr_fh master_stdout_discard master_stderr_discard expand_vars vars external_master default_encoding default_stream_encoding default_argument_encoding password_prompt login_handler master_setpgrp master_pty_force};
- $self = $class->SUPER::new( map{ $_ => $opts->{$_} } grep { $opts->{$_} } @base_module_opts );
- my $error = $self->error;
- next unless ref $self eq 'Net::OpenSSH::More' && !$error;
- if ( $temp_fh && -s $temp_fh ) {
- seek( $temp_fh, 0, Fcntl::SEEK_SET );
- local $/;
- $error .= " " . readline($temp_fh);
- }
- if($error) {
- $die_no_trace->("Bad password passed, will not retry SSH connection: $error.") if ( $error =~ m{bad password} && $opts->{'password'} );
- $die_no_trace->("Bad key, will not retry SSH connection: $error.") if ( $error =~ m{master process exited unexpectedly} && $opts->{'key_path'} );
- $die_no_trace->("Bad credentials, will not retry SSH connection: $error.") if ( $error =~ m{Permission denied} );
- }
- if ( defined $self->error && $self->error ne "0" && $attempt == 1 ) {
- $self->diag( "SSH Connection could not be established to " . $self->{'host'} . " with the error:", $error, 'Will Retry 10 times.' );
- }
- if ( $status = $self->check_master() ) {
- $self->diag("Successfully established connection to " . $self->{'host'} . " on attempt #$attempt.") if $attempt gt 1;
- last;
- }
- sleep $opts->{'retry_interval'};
- }
- $die_no_trace->("Failed to establish SSH connection after $opts->{'retry_max'} attempts. Stopping here.") if ( !$status );
- # Setup connection caching if needed
- if ( !$opts->{'no_cache'} && !$opts->{'_host_sock_key'} ) {
- $self->{'master_pid'} = $self->disown_master();
- $ENV{$opts->{'_host_sock_key'}} = $self->get_ctl_path();
- }
- #Allow the user to unlink the host sock if we need to pop the cache for some reason
- $self->{'host_sock'} = $ENV{$opts->{'_host_sock_key'}};
- return $self;
- };
- my $connection_check = sub {
- my ( $self ) = @_;
- return 1 if $self->check_master;
- local $@;
- local $disable_destructor = 1;
- eval { $self = $init_ssh->( __PACKAGE__, $self->{'_opts'}) };
- return $@ ? 0 : 1;
- };
- # Try calling the function.
- # If it fails, then call $connection_check to reconnect if needed.
- #
- # The goal is to avoid calling $connection_check
- # unless something goes wrong since it adds about
- # 450ms to each ssh command.
- #
- # If the control socket has gone away, call
- # $connection_check ahead of time to reconnect it.
- my $call_ssh_reinit_if_check_fails = sub {
- my ( $self, $func, @args ) = @_;
- $connection_check->($self) if !-S $self->{'_ctl_path'};
- local $@;
- my @ret = eval { $self->$func(@args) };
- my $ssh_error = $@ || $self->error;
- warn "[WARN] $ssh_error" if $ssh_error;
- return @ret if !$ssh_error;
- $connection_check->($self);
- return ($self->$func(@args));
- };
- my $post_connect = sub {
- my ( $self, $opts ) = @_;
- $self->{'persistent_shell'}->close() if $self->{'persistent_shell'};
- undef $self->{'persistent_shell'};
- 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, @command ) = @_;
- $self->diag("[DEBUG][$self->{'_opts'}{'host'}] EXEC " . join( " ", @command ) ) if $self->{'_opts'}{'debug'};
- my ( $pty, $err, $pid ) = $call_ssh_reinit_if_check_fails->( $self, 'open3pty', @command );
- $die_no_trace->("Net::OpenSSH::open3pty failed: $err") if( !defined $pid || $self->error() );
- $self->{'_out'} = "";
- $line_reader = sub {
- my ( $self, $out, $stash_param ) = @_;
- $out =~ s/[\r\n]{1,2}$//;
- $self->{$stash_param} .= "$out\n";
- return;
- } if ref $line_reader ne 'CODE';
- # TODO make this async so you can stream STDERR as well
- # That said, most only care about error if command fails, so...
- my $out;
- $line_reader->( $self, $out, '_out' ) while $out = $pty->getline;
- $pty->close;
- # only populate error if there's an error #
- $self->{'_err'} = '';
- $line_reader->( $self, $out, '_err' ) while $out = $err->getline;
- $err->close;
- waitpid( $pid, 0 );
- return $? >> 8;
- };
- my $TERMINATOR = "\r\n";
- my $send_persistent_cmd = sub {
- my ( $self, $command, $uuid ) = @_;
- $uuid //= Data::UUID->new()->create_str();
- $command = join( ' ', @$command );
- my $actual_cmd = "UUID='$uuid'; echo \"BEGIN \$UUID\"; $command; echo \"___\$?___\"; echo; echo \"EOF \$UUID\"";
- $self->diag("[DEBUG][$self->{'_opts'}{'host'}] EXEC $actual_cmd" ) if $self->{'_opts'}{'debug'};
- #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("${actual_cmd}${TERMINATOR}");
- # Rather than take the approach of cPanel, which commands then polls async,
- # it is 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, it also makes you not have to worry about doing things asynchronously.
- $self->{'expect'}->expect( $self->{'_opts'}{'expect_timeout'}, '-re', qr/BEGIN $uuid/m );
- $self->{'expect'}->expect( $self->{'_opts'}{'expect_timeout'}, '-re', qr/EOF $uuid/m ); # If nothing is printed in timeout, 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 $self->{'_opts'}{'expect_timeout'}s without printing anything).
- Run command outside of the persistent terminal please."
- );
- }
- $message =~ s/___(\d*)___$//g;
- return ( $message, $code );
- };
- my $do_persistent_command = sub {
- my ( $self, $command, $no_stderr ) = @_;
- if ( !$self->{'persistent_shell'} ) {
- my ( $pty, $pid ) = $call_ssh_reinit_if_check_fails->( $self, 'open2pty', $self->{'_remote_shell'} );
- die "Got no pty back from open2pty: " . $self->error if !$pty;
- # You might think that the below settings are important.
- # In most cases, they are not.
- $pty->set_raw();
- $pty->stty( 'raw', 'icrnl', '-echo' );
- $pty->slave->stty( 'raw', 'icrnl', '-echo' );
- #Hook in expect
- $self->diag("[DEBUG][$self->{'_opts'}{'host'}] INIT expect on for PTY with pid $pid") if $self->{'_opts'}{'debug'};
- $self->{'expect'} = Expect->init($pty);
- $self->{'expect'}->restart_timeout_upon_receive(1); #Logabandon by default
- # XXX WARNING bashisms. That said, I'm not sure how to better do this yet portably.
- my $expect_env_cmd = "export PS1=''; export TERM='dumb'; unset HISTFILE; export FOE='configured'; stty raw icrnl -echo; unalias -a; echo \"EOF=\$FOE\"";
- $self->diag("[DEBUG][$self->{'_opts'}{'host'}] EXEC $expect_env_cmd") if $self->{'_opts'}{'debug'};
- $self->{'expect'}->print("${expect_env_cmd}${TERMINATOR}");
- $self->{'expect'}->expect( $self->{'_opts'}{'expect_timeout'}, '-re', qr/EOF=configured/ );
- $self->{'expect'}->clear_accum();
- #cache
- $self->{'persistent_shell'} = $pty;
- $self->{'persistent_pid'} = $pid;
- }
- #execute the command
- my $uuid = Data::UUID->new()->create_str();
- push @$command, '2>', "/tmp/stderr_$uuid.out" unless $no_stderr;
- my ( $oot, $code ) = $send_persistent_cmd->( $self, $command, $uuid );
- $self->{'_out'} = $oot;
- unless ($no_stderr) {
- #Grab stderr
- ( $self->{'_err'} ) = $send_persistent_cmd->( $self, [ '/usr/bin/cat', "/tmp/stderr_$uuid.out" ] );
- #Clean up
- $send_persistent_cmd->( $self, [ '/usr/bin/rm', '-f', "/tmp/stderr_$uuid.out" ] );
- }
- return int($code);
- };
- #######################
- # END PRIVATE METHODS #
- #######################
- =head1 METHODS
- =head2 new
- Instantiate the object, establish the connection. Note here that I'm not allowing
- a connection string like the parent module, and instead exploding these out into
- opts to pass to the constructor. This is because we want to index certain things
- under the hood by user, etc. and I *do not* want to use a regexp to pick out
- your username, host, port, etc. when this problem is solved much more easily
- by forcing that separation on the caller's end.
- ACCEPTS:
- * %opts - <HASH> A hash of key value pairs corresponding to the what you would normally pass in to Net::OpenSSH,
- along with the following keys:
- * use_persistent_shell - Whether or not to setup Expect to watch a persistent TTY. Less stable, but faster.
- * expect_timeout - When the above is active, how long should we wait before your program prints something
- before bailing out?
- * no_agent - Pass in a truthy value to disable the SSH agent. By default the agent is enabled.
- * die_on_drop - If, for some reason, the connection drops, just die instead of attempting reconnection.
- * output_prefix - If given, is what we will tack onto the beginning of any output via diag method.
- useful for streaming output to say, a TAP consumer (test) via passing in '# ' as prefix.
- * debug - Pass in a truthy value to enable certain diag statements I've added in the module and pass -v to ssh.
- * home - STRING corresponding to an absolute path to something that "looks like" a homedir. Defaults to the user's homedir.
- useful in cases where you say, want to load SSH keys from a different path without changing assumptions about where
- keys exist in a homedir on your average OpenSSH using system.
- * no_cache - Pass in a truthy value to disable caching the connection and object, indexed by host string.
- useful if for some reason you need many separate connections to test something. Make sure your MAX_SESSIONS is set sanely
- in sshd_config if you use this extensively.
- * retry_interval - In the case that sshd is not up on the remote host, how long to wait while before reattempting connection.
- defaults to 6s. We retry $RETRY_MAX times, so this means waiting a little over a minute for SSH to come up by default.
- If your situation requires longer intervals, pass in something longer.
- * retry_max - Number of times to retry when a connection fails. Defaults to 10.
- RETURNS a Net::OpenSSH::More object.
- =head3 A note on Authentication order
- We attempt to authenticate using the following details, and in this order:
- 1) Use supplied key_path.
- 2) Use supplied password.
- 3) Use existing SSH agent (SSH_AUTH_SOCK environment variable)
- 4) Use keys that may exist in $HOME/.ssh - id_rsa, id_dsa and id_ecdsa (in that order).
- If all methods therein fail, we will die, as nothing will likely work at that point.
- It is important to be aware of this if your remove host has something like fail2ban or cPHulkd
- enabled which monitors and blocks access based on failed login attempts. If this is you,
- ensure that you have not configured things in a way as to accidentally lock yourself out
- of the remote host just because you fatfingered a connection detail in the constructor.
- =cut
- sub new {
- my ( $class, %opts ) = @_;
- $opts{'host'} = '127.0.0.1' if !$opts{'host'} || $opts{'host'} eq 'localhost';
- $opts{'remote_shell'} ||= 'bash'; # prevent stupid defaults
- $opts{'expect_timeout'} //= 30; # If your program goes over 30s without printing...
- # Set defaults, check if we can return early
- %opts = ( %defaults, %opts );
- $opts{'_cache_index'} = "$opts{'user'}_$opts{'host'}_$opts{'port'}";
- return $cache{$opts{'_cache_index'}} unless $opts{'no_cache'} || !$cache{$opts{'_cache_index'}};
- # Figure out how we're gonna login
- $opts{'_login_method'} = $resolve_login_method->(\%opts);
- # check permissions on base files if we got here
- $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 = $init_ssh->( $class, \%opts );
- $cache{$opts{'_cache_index'}} = $self unless $opts{'no_cache'};
- # Stash opts for later
- $self->{'_opts'} = \%opts;
- # Establish persistent shell, etc.
- $post_connect->( $self, \%opts );
- return $self;
- };
- =head2 use_persistent_shell
- Pass "defined but falsy/truthy" to this to enable using the persistent shell or deactivate its' use.
- Returns either the value you just set or the value it last had (if arg is not defined).
- =cut
- sub use_persistent_shell {
- my ($self, $use_shell) = @_;
- return $self->{'_opts'}{'use_persistent_shell'} if !defined($use_shell);
- return $self->{'_opts'}{'use_persistent_shell'} = $use_shell;
- }
- =head2 DESTROY
- Noted in POD only because of some behavior differences between the
- parent module and this. The following actions are taken *before*
- the parent's destructor kicks in:
- * Return early if you aren't the PID which created the object.
- =cut
- sub DESTROY {
- my ($self) = @_;
- return if !$self->{'_perl_pid'} || $$ != $self->{'_perl_pid'} || $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'};
- return $self->SUPER::DESTROY();
- }
- =head2 diag
- Print a diagnostic message to STDOUT.
- Optionally prefixed by what you passed in as $opts{'output_prefix'} in the constructor.
- I use this in several places when $opts{'debug'} is passed to the constructor.
- ACCEPTS LIST of messages.
- RETURNS undef.
- =cut
- sub diag {
- my ( $self, @msgs ) = @_;
- print STDOUT "$self->{'_opts'}{'output_prefix'}$_\n" for @msgs;
- return;
- }
- =head2 cmd
- Execute specified command via SSH. If first arg is HASHREF, then it uses that as options.
- Command is specifed as a LIST, as that's the easiest way to ensure escaping is done correctly.
- $opts HASHREF:
- C<no_persist> - Boolean - Whether or not to use persistent shell if that is enabled.
- C<no_stderr> - Boolean - Whether or not to discard STDERR.
- C<command> - LIST of components combined together to make a shell command.
- Returns LIST STDOUT, STDERR, and exit code from executed command.
- my ($out,$err,$ret) = $ssh->cmd(qw{ip addr show});
- If use_persistent_shell was truthy in the constructor,
- then commands are executed in a persistent Expect session to cut down on forks,
- and in general be more efficient.
- However, some things can hang this up.
- Unterminated Heredoc & strings, for instance.
- Also, long running commands that emit no output will time out.
- Also, be careful with changing directory;
- this can cause unexpected side-effects in your code.
- Changing shell with chsh will also be ignored;
- the persistent shell is what you started with no matter what.
- In those cases, use_persistent_shell should be called to disable that before calling this.
- Also note that persistent mode basically *requires* you to use bash.
- I am not yet aware of how to make this better yet.
- If the 'debug' opt to the constructor is set, every command executed hereby will be printed.
- If no_stderr is passed, stderr will not be gathered (it takes writing/reading to a file, which is additional time cost).
- BUGS:
- In no_persist mode, stderr and stdout are merged, making the $err parameter returned less than useful.
- =cut
- sub cmd {
- my ( $self ) = shift;
- my $opts = ref $_[0] eq 'HASH' ? shift : {};
- my @command = @_;
- $die_no_trace->( 'No command specified', 'PEBCAK' ) if !@command;
- my $ret;
- if( $self->{'_opts'}{'use_persistent_shell'} ) {
- $ret = $do_persistent_command->( $self, \@command, $opts->{'no_stderr'} )
- }
- else {
- $ret = $send->( $self, undef, @command );
- }
- chomp( my $out = $self->{'_out'} );
- my $err = $self->error || '';
- $self->{'last_exit_code'} = $ret;
- return ( $out, $err, $ret );
- }
- =head2 cmd_exit_code
- Same thing as cmd but only returns the exit code.
- =cut
- sub cmd_exit_code {
- my ($self,@args) = @_;
- return ($self->cmd(@args))[2];
- }
- sub sftp {
- my ($self) = @_;
- unless ( defined $self->{'_sftp'} ) {
- $self->{'_sftp'} = $self->SUPER::sftp();
- die 'Unable to establish SFTP connection to remote host: ' . $self->error() unless defined $self->{'_sftp'};
- }
- return $self->{'_sftp'};
- }
- =head3 B<write (FILE,CONTENT,[MOD],[OWN])>
- Write a file.
- C<FILE> - Absolute path to file.
- C<CONTENT> - Content to write to file.
- C<MOD> - File mode.
- C<OWN> - File owner. Defaults to the user you connected as.
- C<GRP> - File group. Defaults to OWN.
- Returns true if all actions are successful, otherwise confess the error.
- $ssh->write($filename,$content,'600','root');
- =cut
- sub write {
- my ( $self, $file, $content, $mode, $owner, $group ) = @_;
- die '[PARAMETER] No file specified' if !defined $file;
- die '[PARAMETER] File content not specified' if !defined $content;
- my %opts;
- $opts{'perm'} = $mode if $mode;
- my $ret = $self->sftp()->put_content( $content, $file, %opts );
- warn "[WARN] Write failed: " . $self->sftp()->error() if !$ret;
- if ( defined $owner || defined $group ) {
- $owner //= $self->{'_opts'}{'user'};
- $group //= $owner;
- $ret = $self->sftp()->chown( $file, $owner, $group );
- warn "[WARN] Couldn't chown $file" if $ret;
- }
- return $ret;
- }
- =head3 B<eval_full( options )>
- Run Perl code on the remote system and return the results.
- interpreter defaults to /usr/bin/perl.
- B<Input>
- Input options are supplied as a hash with the following keys:
- code - A coderef or string to execute on the remote system.
- args - An optional arrayref of arguments to the code.
- exe - Path to perl executable. Optional.
- B<Output>
- The output from eval_full() is based on the return value of the input
- coderef. Return context is preserved for the coderef.
- All error states will generate exceptions.
- B<Caveats>
- A coderef supplied to this function will be serialized by B::Deparse
- and recreated on the remote server. This method of moving the code does
- not support closing over variables, and any needed modules must
- be loaded inside the coderef with C<require>.
- B<Example>
- my $greeting_message = $ssh->eval_full( code => sub { return "Hello $_[0]";}, args => [$name] );
- =cut
- sub eval_full {
- my ( $self, %options ) = @_;
- my $code = $options{code};
- my $args = $options{args} // [];
- my $exe = $options{exe} || '/usr/bin/perl';
- require Storable;
- local $Storable::Deparse = 1;
- my ( $in_fh, $out_fh, undef, $pid ) = $call_ssh_reinit_if_check_fails->(
- $self,
- 'open_ex',
- { stdin_pipe => 1, stdout_pipe => 1, stderr_to_stdout => 1 },
- q{export PERLCODE='use Storable;$Storable::Eval=1;my $input;while ($input .= <STDIN>) { if ($input =~ /\d+START_STORABLE(.*)STOP_STORABLE\d+/) { my @result = eval { my $in_hr = Storable::thaw(pack("H*", $1)); if ( ref $in_hr->{code} ) { return $in_hr->{wantarray} ? $in_hr->{code}->(@{$in_hr->{args}}) : scalar $in_hr->{code}->(@{$in_hr->{args}});} return $in_hr->{wantarray} ? eval $in_hr->{code} : scalar eval $in_hr->{code};}; print $$ . "START_STORABLE" . unpack("H*", Storable::freeze( { data => \@result, error => "$@" })) . "STOP_STORABLE" . $$ . "\n";exit;}}'; } . $exe . q{ -e "$PERLCODE";}
- );
- die "Failed to connect: $!" unless ($pid);
- print $in_fh $$ . "START_STORABLE" . unpack( "H*", Storable::freeze( { code => $code, args => $args, wantarray => wantarray() } ) ) . "STOP_STORABLE" . $$ . "\n";
- close $in_fh;
- my $output = '';
- while ( $out_fh->sysread( $output, 4096, length($output) ) > 0 ) {
- 1;
- }
- close $out_fh;
- waitpid( $pid, 0 );
- my $result = { error => "Unable to deserialize output from remote_eval: $output" };
- if ( $output =~ /\d+START_STORABLE(.*)STOP_STORABLE\d+/ ) {
- $result = Storable::thaw( pack( "H*", $1 ) );
- }
- die $result->{error} if ( $result->{error} );
- return wantarray ? @{ $result->{data} } : $result->{data}[0];
- }
- =head1 AUTHORS
- Thomas Andrew "Andy" Baugh <andy@troglodyne.net>
- George S. Baugh <george@troglodyne.net>
- =head1 SPECIAL THANKS
- cPanel, L.L.C. - in particularly the QA department (which the authors once were in).
- 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
- to execute subroutine references from the orchestrating server on the remote host's perl.
- Brian M. Carlson - For the highly useful sftp shortcut methods that utilize Net::SFTP::Foreign.
- Rikus Goodell - For shell escaping expertise
- =head1 IN MEMORY OF
- Paul Trost
- Dan Stewart
- =cut
- 1;
|