summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorFlorian Schlichting <fsfs@debian.org>2015-08-18 18:15:16 +0200
committerFlorian Schlichting <fsfs@debian.org>2015-08-18 18:15:16 +0200
commitf205c147abe36c1a3043cf68d9ff1bcfd6fcc534 (patch)
tree2d3e9acc46223fe9ad7672ba24155879a0394c36 /lib
parenta5b394ff4bfd1c0f10f5dab078424e9f57a81a83 (diff)
Imported Upstream version 0.64
Diffstat (limited to 'lib')
-rw-r--r--lib/Net/OpenSSH.pm913
-rw-r--r--lib/Net/OpenSSH/ConnectionCache.pm11
-rw-r--r--lib/Net/OpenSSH/Constants.pm21
-rw-r--r--lib/Net/OpenSSH/ShellQuoter.pm3
-rw-r--r--lib/Net/OpenSSH/ShellQuoter/POSIX.pm2
5 files changed, 616 insertions, 334 deletions
diff --git a/lib/Net/OpenSSH.pm b/lib/Net/OpenSSH.pm
index 9fc72cb..c354c96 100644
--- a/lib/Net/OpenSSH.pm
+++ b/lib/Net/OpenSSH.pm
@@ -1,6 +1,6 @@
package Net::OpenSSH;
-our $VERSION = '0.62';
+our $VERSION = '0.64';
use strict;
use warnings;
@@ -16,7 +16,7 @@ use File::Spec;
use Cwd ();
use Scalar::Util ();
use Errno ();
-use Net::OpenSSH::Constants qw(:error);
+use Net::OpenSSH::Constants qw(:error :_state);
use Net::OpenSSH::ModuleLoader;
use Net::OpenSSH::ShellQuoter;
@@ -260,6 +260,7 @@ sub new {
my $timeout = delete $opts{timeout};
my $kill_ssh_on_timeout = delete $opts{kill_ssh_on_timeout};
my $strict_mode = _first_defined delete $opts{strict_mode}, 1;
+ my $connect = _first_defined delete $opts{connect}, 1;
my $async = delete $opts{async};
my $remote_shell = _first_defined delete $opts{remote_shell}, 'POSIX';
my $expand_vars = delete $opts{expand_vars};
@@ -393,6 +394,7 @@ sub new {
_default_argument_encoding => $default_argument_encoding,
_expand_vars => $expand_vars,
_vars => $vars,
+ _master_state => _STATE_START,
};
bless $self, $class;
@@ -408,8 +410,7 @@ sub new {
if defined $default_stdin_file;
if ($self->error == OSSH_SLAVE_PIPE_FAILED) {
- $self->_set_error(OSSH_MASTER_FAILED,
- "Unable to create default slave stream: " . $self->error);
+ $self->_master_fail($async, "Unable to create default slave stream", $self->{_error});
return $self;
}
@@ -424,18 +425,16 @@ sub new {
unless (defined $ctl_dir) {
unless (defined $self->{_home}) {
- $self->_set_error(OSSH_MASTER_FAILED, "unable to determine home directory for uid $>");
+ $self->_master_fail($async, "unable to determine home directory for uid $>");
return $self;
}
$ctl_dir = File::Spec->catdir($self->{_home}, ".libnet-openssh-perl");
}
- my $old_umask = umask 077;
- mkdir $ctl_dir;
- umask $old_umask;
+ mkdir $ctl_dir, 0700;
unless (-d $ctl_dir) {
- $self->_set_error(OSSH_MASTER_FAILED, "unable to create ctl_dir $ctl_dir");
+ $self->_master_fail($async, "unable to create ctl_dir $ctl_dir");
return $self;
}
@@ -446,8 +445,7 @@ sub new {
last unless -e $ctl_path
}
if (-e $ctl_path) {
- $self->_set_error(OSSH_MASTER_FAILED,
- "unable to find unused name for ctl_path inside ctl_dir $ctl_dir");
+ $self->_master_fail($async, "unable to find unused name for ctl_path inside ctl_dir $ctl_dir");
return $self;
}
}
@@ -455,18 +453,14 @@ sub new {
$debug and $debug & 2 and _debug "ctl_path: $ctl_path, ctl_dir: $ctl_dir";
if ($strict_mode and !$self->_is_secure_path($ctl_dir)) {
- $self->_set_error(OSSH_MASTER_FAILED, "ctl_dir $ctl_dir is not secure");
+ $self->_master_fail($async, "ctl_dir $ctl_dir is not secure");
return $self;
}
$self->{_ctl_path} = $ctl_path;
- if ($external_master) {
- $self->_wait_for_master($async, 1);
- }
- else {
- $self->_connect($async);
- }
+ $self->_master_wait($async) if $connect;
+
$self;
}
@@ -635,33 +629,88 @@ sub _make_tunnel_call {
sub master_exited {
my $self = shift;
- my $pid = delete $self->{_pid};
- delete $self->{_wfm_state};
- $self->_set_error(OSSH_MASTER_FAILED, "master ssh connection broken");
- undef;
+ $self->_master_gone(1)
}
-sub _kill_master {
+sub _master_gone {
my $self = shift;
- my $pid = delete $self->{_pid};
- $debug and $debug & 32 and _debug '_kill_master: ', $pid;
- if ($pid and $self->{_perl_pid} == $$ and $self->{_thread_generation} == $thread_generation) {
- local $SIG{CHLD} = sub {};
- for my $sig (0, 0, 'TERM', 'TERM', 'TERM', 'KILL', 'KILL') {
- if ($sig) {
- $debug and $debug & 32 and _debug "killing master with signal $sig";
- kill $sig, $pid
- or return;
- }
- for (0..5) {
- my $r = waitpid($pid, WNOHANG);
- $debug and $debug & 32 and _debug "waitpid(master: $pid) => pid: $r, rc: $!";
- return if ($r == $pid or $! == Errno::ECHILD);
- select(undef, undef, undef, 0.2);
- }
+ my $async = shift;
+ delete $self->{_pid};
+ $self->_master_fail($async, (@_ ? @_ : "master process exited unexpectedly"));
+}
+
+my @kill_signal = qw(0 0 TERM TERM TERM KILL);
+
+sub _master_kill {
+ my ($self, $async) = @_;
+
+ if (my $pid = $self->_my_master_pid) {
+ $debug and $debug & 32 and _debug '_master_kill: ', $pid;
+
+ my $now = time;
+ my $start = $self->{_master_kill_start} ||= $now;
+ $self->{_master_kill_last} ||= $now;
+ $self->{_master_kill_count} ||= 0;
+
+ local $SIG{CHLD} = sub {} unless $async;
+ while (1) {
+ if ($self->{_master_kill_last} < $now) {
+ $self->{_master_kill_last} = $now;
+ my $sig = $kill_signal[$self->{_master_kill_count}++];
+ $sig = 'KILL' unless defined $sig;
+ $debug and $debug & 32 and _debug "killing master $$ with signal $sig";
+ kill $sig, $pid;
+ }
+ my $r = waitpid($pid, WNOHANG);
+ $debug and $debug & 32 and _debug "waitpid(master: $pid) => pid: $r, rc: $!";
+ last if $r == $pid or $! == Errno::ECHILD();
+ if ($self->{_master_kill_count} > 20) {
+ # FIXME: remove the hard-coded 20 retries?
+ $debug and $debug & 32 and _debug "unable to kill SSH master process, giving up";
+ last;
+ }
+ return if $async;
+ select(undef, undef, undef, 0.2);
+ $now = time;
}
- warn "unable to kill SSH master connection (pid: $pid)";
}
+ else {
+ $debug and $debug & 32 and _debug("not killing master SSH (", $pid, ") started from " .
+ "process $self->{_perl_pid}/$self->{_thread_generation}" .
+ ", current $$/$thread_generation");
+ }
+ $self->_master_gone($async);
+}
+
+sub disconnect {
+ my ($self, $async) = @_;
+ @_ <= 2 or croak 'Usage: $self->disconnect([$async])';
+ $self->_disconnect($async, 1);
+}
+
+sub _my_master_pid {
+ my $self = shift;
+ unless ($self->{_external_master}) {
+ my $pid = $self->{_pid};
+ return $pid if
+ $pid and $self->{_perl_pid} == $$ and $self->{_thread_generation} == $thread_generation;
+ }
+ ()
+}
+
+sub _disconnect {
+ my ($self, $async, $send_ctl) = @_;
+ return if $self->{_master_state} == _STATE_GONE;
+
+ if (!$async and
+ $self->{_master_state} == _STATE_RUNNING and
+ ($send_ctl or $self->_my_master_pid)) {
+ # we have successfully created the master connection so we
+ # can send control commands:
+ $debug and $debug & 32 and _debug("sending exit control to master");
+ $self->_master_ctl('exit');
+ }
+ $self->_master_fail($async, 'aborted')
}
sub _check_is_system_fh {
@@ -692,7 +741,91 @@ sub _master_redirect {
}
}
-sub _connect {
+sub _waitpid {
+ my ($self, $pid, $timeout) = @_;
+ $? = 0;
+ if ($pid) {
+ $timeout = $self->{_timeout} unless defined $timeout;
+
+ my $time_limit;
+ if (defined $timeout and $self->{_kill_ssh_on_timeout}) {
+ $timeout = 0 if $self->error == OSSH_SLAVE_TIMEOUT;
+ $time_limit = time + $timeout;
+ }
+ local $SIG{CHLD} = sub {};
+ while (1) {
+ my $r;
+ if (defined $time_limit) {
+ while (1) {
+ # TODO: we assume that all OSs return 0 when the
+ # process is still running, that may be wrong!
+ $r = waitpid($pid, WNOHANG) and last;
+ my $remaining = $time_limit - time;
+ if ($remaining <= 0) {
+ $debug and $debug & 16 and _debug "killing SSH slave, pid: $pid";
+ kill TERM => $pid;
+ $self->_or_set_error(OSSH_SLAVE_TIMEOUT, "ssh slave failed", "timed out");
+ }
+ # There is a race condition here. We try to
+ # minimize it keeping the waitpid and the select
+ # together and limiting the sleep time to 1s:
+ my $sleep = ($remaining < 0.1 ? 0.1 : 1);
+ $debug and $debug & 16 and
+ _debug "waiting for slave, timeout: $timeout, remaining: $remaining, sleep: $sleep";
+ $r = waitpid($pid, WNOHANG) and last;
+ select(undef, undef, undef, $sleep);
+ }
+ }
+ else {
+ $r = waitpid($pid, 0);
+ }
+ $debug and $debug & 16 and _debug "_waitpid($pid) => pid: $r, rc: $?, err: $!";
+ if ($r == $pid) {
+ if ($?) {
+ my $signal = ($? & 255);
+ my $errstr = "child exited with code " . ($? >> 8);
+ $errstr .= ", signal $signal" if $signal;
+ $self->_or_set_error(OSSH_SLAVE_CMD_FAILED, $errstr);
+ return undef;
+ }
+ return 1;
+ }
+ if ($r > 0) {
+ warn "internal error: spurious process $r exited";
+ next;
+ }
+ next if $! == Errno::EINTR();
+ if ($! == Errno::ECHILD) {
+ $self->_or_set_error(OSSH_SLAVE_FAILED, "child process $pid does not exist", $!);
+ return undef
+ }
+ warn "Internal error: unexpected error (".($!+0).": $!) from waitpid($pid) = $r. Report it, please!";
+
+ # wait a bit before trying again
+ select(undef, undef, undef, 0.1);
+ }
+ }
+ else {
+ $self->_or_set_error(OSSH_SLAVE_FAILED, "spawning of new process failed");
+ return undef;
+ }
+}
+
+sub check_master {
+ my $self = shift;
+ @_ and croak 'Usage: $ssh->check_master()';
+ $self->_master_check(0);
+}
+
+sub wait_for_master {
+ my ($self, $async) = @_;
+ @_ <= 2 or croak 'Usage: $ssh->wait_for_master([$async])';
+ $self->{_error} = 0
+ unless $self->{_error} == OSSH_MASTER_FAILED;
+ $self->_master_wait($async);
+}
+
+sub _master_start {
my ($self, $async) = @_;
$self->_set_error;
@@ -733,18 +866,15 @@ sub _connect {
unless ($gateway = Net::OpenSSH::Gateway->find_gateway(errors => $errors,
host => $self->{_host}, port => $self->{_port},
%$gateway_args)) {
- $self->_set_error(OSSH_MASTER_FAILED, 'Unable to build gateway object', join(', ', @$errors));
- return undef;
+ return $self->_master_fail($async, 'Unable to build gateway object', join(', ', @$errors));
}
}
else {
$gateway = $gateway_args
}
$self->{_gateway} = $gateway;
- unless ($gateway->before_ssh_connect) {
- $self->_set_error(OSSH_MASTER_FAILED, 'Gateway setup failed', join(', ', $gateway->errors));
- return;
- }
+ $gateway->before_ssh_connect or
+ return $self->_master_fail($async, 'Gateway setup failed', join(', ', $gateway->errors));
$proxy_command = $gateway->proxy_command;
}
@@ -765,10 +895,8 @@ sub _connect {
local $SIG{CHLD};
my $pid = fork;
unless ($pid) {
- unless (defined $pid) {
- $self->_set_error(OSSH_MASTER_FAILED, "unable to fork ssh master: $!");
- return undef;
- }
+ defined $pid
+ or return $self->_master_fail($async, "unable to fork ssh master: $!");
if ($debug and $debug & 512) {
require Net::OpenSSH::OSTracer;
@@ -790,135 +918,100 @@ sub _connect {
POSIX::_exit(255);
}
$self->{_pid} = $pid;
- my $r = $self->_wait_for_master($async, 1);
- $mpty->close_slave if $mpty;
- $r;
+ 1;
}
-sub _waitpid {
- my ($self, $pid, $timeout) = @_;
- $? = 0;
- if ($pid) {
- $timeout = $self->{_timeout} unless defined $timeout;
-
- my $time_limit;
- if (defined $timeout and $self->{_kill_ssh_on_timeout}) {
- $timeout = 0 if $self->error == OSSH_SLAVE_TIMEOUT;
- $time_limit = time + $timeout;
+sub _master_check {
+ my ($self, $async) = @_;
+ my $out = $self->_master_ctl('check');
+ my $error = $self->{_error};
+ unless ($error) {
+ my $pid = $self->{_pid};
+ if ($out =~ /pid=(\d+)/) {
+ return 1 if !$pid or $1 == $pid;
+ $error = "bad ssh master at $self->{_ctl_path} socket owned by pid $1 (pid $pid expected)";
+ }
+ else {
+ $error = ($out =~ /illegal option/i
+ ? 'OpenSSH 4.1 or later required'
+ : 'unknown error');
}
- local $SIG{CHLD} = sub {};
- while (1) {
- my $r;
- if (defined $time_limit) {
- while (1) {
- # TODO: we assume that all OSs return 0 when the
- # process is still running, that may not be true!
- $r = waitpid($pid, WNOHANG) and last;
- my $remaining = $time_limit - time;
- if ($remaining <= 0) {
- $debug and $debug & 16 and _debug "killing SSH slave, pid: $pid";
- kill TERM => $pid;
- $self->_or_set_error(OSSH_SLAVE_TIMEOUT, "ssh slave failed", "timed out");
- }
- # There is a race condition here. We try to
- # minimize it keeping the waitpid and the select
- # together and limiting the sleep time to 1s:
- my $sleep = ($remaining < 0.1 ? 0.1 : 1);
- $debug and $debug & 16 and
- _debug "waiting for slave, timeout: $timeout, remaining: $remaining, sleep: $sleep";
- $r = waitpid($pid, WNOHANG) and last;
- select(undef, undef, undef, $sleep);
- }
- }
- else {
- $r = waitpid($pid, 0);
- }
- $debug and $debug & 16 and _debug "_waitpid($pid) => pid: $r, rc: $!";
- if ($r == $pid) {
- if ($?) {
- my $signal = ($? & 255);
- my $errstr = "child exited with code " . ($? >> 8);
- $errstr .= ", signal $signal" if $signal;
- $self->_or_set_error(OSSH_SLAVE_CMD_FAILED, $errstr);
- return undef;
- }
- return 1;
- }
- if ($r > 0) {
- warn "internal error: spurious process $r exited";
- next;
- }
- next if $! == Errno::EINTR();
- if ($! == Errno::ECHILD) {
- $self->_or_set_error(OSSH_SLAVE_FAILED, "child process $pid does not exist", $!);
- return undef
- }
- warn "Internal error: unexpected error (".($!+0).": $!) from waitpid($pid) = $r. Report it, please!";
-
- # wait a bit before trying again
- select(undef, undef, undef, 0.1);
- }
- }
- else {
- $self->_or_set_error(OSSH_SLAVE_FAILED, "spawning of new process failed");
- return undef;
}
+ $self->_master_fail($async, $error);
}
-sub wait_for_master {
+sub _master_fail {
my $self = shift;
- @_ <= 1 or croak 'Usage: $ssh->wait_for_master([$async])';
- return undef if $self->{_error} == OSSH_MASTER_FAILED;
- $self->{_error} = 0;
- return $self->_wait_for_master($_[0]) if $self->{_wfm_state};
-
- unless (-S $self->{_ctl_path}) {
- $self->_set_error(OSSH_MASTER_FAILED, "master ssh connection broken");
- return undef;
+ my $async = shift;
+ if ($self->{_error} != OSSH_MASTER_FAILED) {
+ $self->_set_error(OSSH_MASTER_FAILED, @_);
}
- 1;
+ $self->_master_jump_state($self->{_pid} ? _STATE_KILLING : _STATE_GONE, $async);
}
-sub check_master {
- my $self = shift;
- @_ and croak 'Usage: $ssh->check_master()';
- $self->{_error} = 0;
- $self->_wait_for_master;
+sub _master_jump_state {
+ my ($self, $state, $async) = @_;
+ $debug and $debug & 4 and _debug "master state jumping from $self->{_master_state} to $state";
+ if ($state == $self->{_master_state} and
+ $state != _STATE_KILLING and
+ $state != _STATE_GONE) {
+ croak "internal error: state jump to itself ($state)!";
+ }
+ $self->{_master_state} = $state;
+ return $self->_master_wait($async);
}
-sub _wait_for_master {
- my ($self, $async, $reset) = @_;
+sub _master_wait {
+ my ($self, $async) = @_;
- my $state = delete $self->{_wfm_state} || 'waiting_for_mux_socket';
- my $bout = \ ($self->{_wfm_bout});
+ my $pid = $self->_my_master_pid;
+ if ($pid) {
+ if (waitpid($pid, WNOHANG) == $pid or $! == Errno::ECHILD) {
+ $debug and $debug & 4 and _debug "master $pid exited, rc:", $?,", err: ",$!;
+ return $self->_master_gone($async);
+ }
+ }
- my $mpty = $self->{_mpty};
- my $passwd = $deobfuscate->($self->{_passwd});
- my $login_handler = $self->{_login_handler};
- my $pid = $self->{_pid};
- # an undefined pid indicates we are reusing a master connection
+ if ($self->{_master_state} == _STATE_RUNNING) {
+ return 1 if -S $self->{_ctl_path};
+ return $self->_master_fail($async, "master SSH connection broken");
+ }
- if ($reset) {
- $$bout = '';
- $state = ( (defined $passwd and $pid) ? 'waiting_for_passwd_prompt' :
- (defined $login_handler) ? 'waiting_for_login_handler' :
- 'waiting_for_mux_socket' );
+ if ($self->{_master_state} == _STATE_KILLING) {
+ $debug and $debug & 4 and _debug "killing master";
+ return $self->_master_kill($async);
}
- my $ctl_path = $self->{_ctl_path};
- my $dt = ($async ? 0 : 0.1);
- my $timeout = $self->{_timeout};
- my $start_time = time;
+ if ($self->{_master_state} == _STATE_START) {
+ if ($self->{_external_master}) {
+ return ($self->_master_jump_state(_STATE_RUNNING, $async) and
+ $self->_master_check($async))
+ }
- my $fnopty;
- my $rv = '';
- if ($state eq 'waiting_for_passwd_prompt') {
- $fnopty = fileno $mpty;
- vec($rv, $fnopty, 1) = 1
+ $self->_master_start($async) or return;
+ if (defined $self->{_passwd} or $self->{_login_handler}) {
+ $self->{_wfm_bout} = '';
+ return $self->_master_jump_state(_STATE_LOGIN, $async);
+ }
+ return $self->_master_jump_state(_STATE_AWAITING_MUX, $async);
}
+ if ($self->{_master_state} == _STATE_GONE or
+ $self->{_master_state} == _STATE_STOPPED) {
+ return 0;
+ }
+
+ # At this point we are either in state AWAITIN_MUX or LOGIN
+
+ local $self->{_error_prefix} = [@{$self->{_error_prefix}},
+ "unable to establish master SSH connection"];
+
+ $pid or return $self->_master_gone($async,
+ "perl process was forked or threaded before SSH connection had been established");
+
my $old_tcpgrp;
- if ($pid and $self->{_master_setpgrp} and not $async and not $self->{_batch_mode}) {
+ if ($self->{_master_setpgrp} and not $async and
+ not $self->{_batch_mode} and not $self->{_external_master}) {
$old_tcpgrp = POSIX::tcgetpgrp(0);
if ($old_tcpgrp > 0) {
# let the master process ask for passwords at the TTY
@@ -929,175 +1022,133 @@ sub _wait_for_master {
}
}
+ my $mpty = $self->{_mpty};
+ my $fnopty;
+ my $rv = '';
+ if ($self->{_master_state} == _STATE_LOGIN) {
+ $fnopty = fileno $mpty;
+ vec($rv, $fnopty, 1) = 1
+ }
+
+ my $timeout = $self->{_timeout};
+ my $dt = ($async ? 0 : 0.1);
+ my $start_time = time;
+ my $error;
+
# Loop until the mux socket appears or something goes wrong:
- local $self->{_error_prefix} = [@{$self->{_error_prefix}},
- "unable to establish master SSH connection"];
while (1) {
- last if (defined $timeout and (time - $start_time) > $timeout);
-
- if (-e $ctl_path) {
- $debug and $debug & 4 and _debug "file object found at $ctl_path";
- unless (-S $ctl_path) {
- $self->_set_error(OSSH_MASTER_FAILED,
- "bad ssh master at $ctl_path, object is not a socket");
- goto kill_master_and_fail;
- }
- my $check = $self->_master_ctl('check');
- if (defined $check) {
- my $error;
- if ($check =~ /pid=(\d+)/) {
- if (!$pid or $1 == $pid) {
- if ($self->{_master_setpgrp} and $old_tcpgrp) {
- if ($debug and $debug & 4) {
- my $pgrp = getpgrp($pid);
- my $tcpgrp = POSIX::tcgetpgrp(0);
- $debug and _debug "ssh pid: $pid, pgrp: $pgrp \$\$: $$, tcpgrp: $tcpgrp old_tcppgrp: $old_tcpgrp";
- }
- local $SIG{TTOU} = 'IGNORE';
- POSIX::tcsetpgrp(0, $old_tcpgrp);
- }
- return 1;
- }
- $error = "bad ssh master at $ctl_path, socket owned by pid $1 (pid $pid expected)";
- }
- elsif ($check =~ /illegal option/i) {
- $error = "OpenSSH 4.1 or later required";
- }
- else {
- $error = "Unknown error";
- }
- $self->_or_set_error(OSSH_MASTER_FAILED, $error);
- }
- goto kill_master_and_fail;
+ if (-e $self->{_ctl_path}) {
+ $debug and $debug & 4 and _debug "file object found at $self->{_ctl_path}";
+ last;
}
- $debug and $debug & 4 and _debug "file object not yet found at $ctl_path, state: $state";
+ $debug and $debug & 4 and _debug "file object not yet found at $self->{_ctl_path}, state:", $self->{_master_state};
- if ($self->{_perl_pid} != $$ or $self->{_thread_generation} != $thread_generation) {
- $self->_set_error(OSSH_MASTER_FAILED,
- "process was forked or threaded before SSH connection had been established");
- # just return, the thread creating the mess should clean it all up!
- return undef;
+ if (defined $timeout and (time - $start_time) > $timeout) {
+ $error = "login timeout";
+ last;
}
- if (!$pid) {
- # when using an external master the mux socket must be
- # there from the first time
- $self->_set_error(OSSH_MASTER_FAILED,
- "socket does not exist");
- goto fail;
- }
- elsif (waitpid($pid, WNOHANG) == $pid or $! == Errno::ECHILD) {
- my $error = "master process exited unexpectedly";
- $error = "bad pass" . ($self->{_passphrase} ? 'phrase' : 'word') . " or $error"
+ if (waitpid($pid, WNOHANG) == $pid or $! == Errno::ECHILD) {
+ $error = "master process exited unexpectedly";
+ $error = "bad pass" . ($self->{_passphrase} ? 'phrase' : 'word') . " or $error"
if defined $self->{_passwd};
- $self->_set_error(OSSH_MASTER_FAILED, $error);
- goto fail; # master has already died
+ delete $self->{_pid};
+ last;
}
- if ($state eq 'waiting_for_login_handler') {
+ if ($self->{_login_handler} and $self->{_master_state} == _STATE_LOGIN) {
local ($@, $SIG{__DIE__});
- if (eval { $login_handler->($self, $mpty, $bout) }) {
- $state = 'waiting_for_mux_socket';
+ if (eval { $self->{_login_handler}->($self, $mpty, \$self->{_wfm_bout}) }) {
+ $self->{_master_state} = _STATE_AWAITING_MUX;
next;
}
if ($@) {
- $self->_set_error(OSSH_MASTER_FAILED,
- "custom login handler failed: $@");
- goto kill_master_and_fail;
+ $error = "custom login handler failed: $@";
+ last;
}
+ # fallback
}
else {
+ # we keep reading from mpty even after leaving state
+ # STATE_LOGIN in order to search for additional password
+ # prompts.
my $rv1 = $rv;
my $n = select($rv1, undef, undef, $dt);
if ($n > 0) {
- vec($rv1, $fnopty, 1)
- or die "internal error";
- my $read = sysread($mpty, $$bout, 4096, length $$bout);
+ vec($rv1, $fnopty, 1) or die "internal error";
+ my $read = sysread($mpty, $self->{_wfm_bout}, 4096, length $self->{_wfm_bout});
if ($read) {
my $passwd_prompt = _first_defined $self->{_passwd_prompt}, qr/[:?]/;
$passwd_prompt = quotemeta $passwd_prompt unless ref $passwd_prompt;
- if ($state eq 'waiting_for_passwd_prompt') {
- if ($$bout =~ /The authenticity of host.*can't be established/si) {
- $self->_set_error(OSSH_MASTER_FAILED,
- "the authenticity of the target host can't be established, the remote host "
- . "public key is probably not present on the '~/.ssh/known_hosts' file");
- goto kill_master_and_fail;
+ if ($self->{_master_state} == _STATE_LOGIN) {
+ if ($self->{_wfm_bout} =~ /The authenticity of host.*can't be established/si) {
+ $error = "the authenticity of the target host can't be established, the remote host " .
+ "public key is probably not present on the '~/.ssh/known_hosts' file";
+ last;
}
- if ($$bout =~ /^(.*$passwd_prompt)/s) {
+ if ($self->{_wfm_bout} =~ /^(.*$passwd_prompt)/s) {
$debug and $debug & 4 and _debug "passwd/passphrase requested ($1)";
- print $mpty "$passwd\n";
- $$bout = ''; # reset
- $state = 'waiting_for_mux_socket';
+ print $mpty $deobfuscate->($self->{_passwd}) . "\n";
+ $self->{_wfm_bout} = ''; # reset
+ $self->{_master_state} = _STATE_AWAITING_MUX;
}
}
- elsif (length($passwd_prompt) and $$bout =~ /^(.*$passwd_prompt)\s*$/s) {
+ elsif (length($passwd_prompt) and $self->{_wfm_bout} =~ /^(.*$passwd_prompt)\s*$/s) {
$debug and $debug & 4 and _debug "passwd/passphrase requested again ($1)";
- $self->_set_error(OSSH_MASTER_FAILED, "password authentication failed");
- goto kill_master_and_fail;
+ $error = "password authentication failed";
+ last;
}
- next;
+ next; # skip delay
}
}
}
- if ($async) {
- $self->{_wfm_state} = $state;
- return 0;
- }
- else {
- select(undef, undef, undef, $dt);
- }
+ return if $async;
+ select(undef, undef, undef, $dt);
}
- $self->_set_error(OSSH_MASTER_FAILED, "login timeout");
- kill_master_and_fail:
- $self->_kill_master;
-
- fail:
- if ($pid and $self->{_master_setpgrp} and $old_tcpgrp) {
- if ($debug and $debug & 4) {
- my $pgrp = getpgrp($pid);
- my $tcpgrp = POSIX::tcgetpgrp(0);
- $debug and _debug "ssh pid: $pid, pgrp: $pgrp \$\$: $$, tcpgrp: $tcpgrp old_tcppgrp: $old_tcpgrp";
- }
+ if (defined $old_tcpgrp) {
+ $debug and $debug & 4 and
+ _debug("ssh pid: $pid, pgrp: ", getpgrp($pid),
+ ", \$\$: ", $$,
+ ", tcpgrp: ", POSIX::tcgetpgrp(0),
+ ", old_tcppgrp: ", $old_tcpgrp);
local $SIG{TTOU} = 'IGNORE';
POSIX::tcsetpgrp(0, $old_tcpgrp);
}
- return undef;
+
+ if ($error) {
+ return $self->_master_fail($async, $error);
+ }
+
+ $self->_master_jump_state(_STATE_RUNNING, $async)
+ and $self->_master_check($async);
}
sub _master_ctl {
- my ($self, $cmd) = @_;
+ my $self = shift;
+ my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
+ my $cmd = shift;
+
local $self->{_error_prefix} = [@{$self->{_error_prefix}},
"control command failed"];
- $self->capture({ encoding => 'bytes', # don't let the encoding
- # stuff go in the way
+ $self->capture({ %opts,
+ encoding => 'bytes', # don't let the encoding
+ # stuff get in the way
stdin_discard => 1, tty => 0,
stderr_to_stdout => 1, ssh_opts => [-O => $cmd]});
}
sub stop {
- # FIXME: this method currently fails because of a bug in ssh.
my ($self, $timeout) = @_;
my $pid = $self->{_pid};
- $self->_master_ctl('stop');
- if (not $self->error and
- $pid and
- $self->{_perl_pid} == $$ and
- $self->{_thread_generation} == $thread_generation) {
-
- local $self->{_kill_ssh_on_timeout};
- if ($self->_waitpid($pid, $timeout)) {
- delete $self->{_pid};
- $self->_set_error(OSSH_MASTER_FAILED, "master ssh connection stopped");
- return 1;
- }
- else {
- return $self->_kill_master;
- }
+ local $self->{_kill_ssh_on_timeout} = 1;
+ $self->_master_ctl({timeout => $timeout}, 'stop');
+ unless ($self->{_error}) {
+ $self->_set_error(OSSH_MASTER_FAILED, "master stopped");
+ $self->_master_jump_state(_STATE_STOPPED, 1);
}
- undef;
}
sub _make_pipe {
@@ -1116,7 +1167,7 @@ sub _make_pipe {
sub _remote_quoter {
my ($self, $remote_shell) = @_;
- if (ref $self and not defined $remote_shell) {
+ if (ref $self and (!defined $remote_shell or $remote_shell eq $self->{_remote_shell})) {
return $self->{remote_quoter} ||= Net::OpenSSH::ShellQuoter->quoter($self->{_remote_shell});
}
Net::OpenSSH::ShellQuoter->quoter($remote_shell);
@@ -2122,11 +2173,11 @@ my %rsync_opt_with_arg = map { $_ => 1 } qw(chmod suffix backup-dir rsync-path m
skip-compress filter exclude exclude-from include include-from
out-format log-file log-file-format bwlimit protocol iconv checksum-seed);
-my %rsync_opt_forbiden = map { $_ => 1 } qw(rsh address port sockopts blocking-io password-file write-batch
+my %rsync_opt_forbidden = map { $_ => 1 } qw(rsh address port sockopts blocking-io password-file write-batch
only-write-batch read-batch ipv4 ipv6 version help daemon config detach
files-from from0 blocking-io protect-args list-only);
-$rsync_opt_forbiden{"no-$_"} = 1 for (keys %rsync_opt_with_arg, keys %rsync_opt_forbiden);
+$rsync_opt_forbidden{"no-$_"} = 1 for (keys %rsync_opt_with_arg, keys %rsync_opt_forbidden);
my %rsync_error = (1, 'syntax or usage error',
2, 'protocol incompatibility',
@@ -2182,7 +2233,7 @@ sub _rsync {
else {
my $opt1 = $opt;
$opt1 =~ tr/_/-/;
- $rsync_opt_forbiden{$opt1} and croak "forbiden rsync option '$opt' used";
+ $rsync_opt_forbidden{$opt1} and croak "forbidden rsync option '$opt' used";
if ($rsync_opt_with_arg{$opt1}) {
push @opts, "--$opt1=$_" for _array_or_scalar_to_list($value)
}
@@ -2291,22 +2342,19 @@ sub sshfs_export {
$self->spawn(\%opts, $self->{_sshfs_cmd}, "$hostname:$from", $to, @sshfs_opts);
}
+sub any {
+ my $self = shift;
+ _load_module('Net::SSH::Any');
+ Net::SSH::Any->new($self->{_host}, user => $self->{_user}, port => $self->{_port},
+ backend => 'Net_OpenSSH',
+ backend_opts => { Net_OpenSSH => { instance => $self } });
+}
+
sub DESTROY {
my $self = shift;
- my $pid = $self->{_pid};
- local ($@, $SIG{__DIE__});
- $debug and $debug & 2 and _debug("DESTROY($self, pid: ", $pid, ")");
- if ($pid and $self->{_perl_pid} == $$ and $self->{_thread_generation} == $thread_generation) {
- $debug and $debug & 32 and _debug("killing master");
- local ($?, $!);
- unless ($self->{_wfm_state}) {
- # we have successfully created the master connection so we
- # can send control commands:
- $debug and $debug & 32 and _debug("sending exit control to master");
- $self->_master_ctl('exit');
- }
- $self->_kill_master;
- }
+ $debug and $debug & 2 and _debug("DESTROY($self, pid: ", $self->{_pid}, ")");
+ local ($SIG{__DIE__}, $@, $?, $!);
+ $self->_disconnect;
}
1;
@@ -2365,7 +2413,7 @@ OpenSSH binary client (C<ssh>).
This package is implemented around the multiplexing feature found in
later versions of OpenSSH. That feature allows one to run several
-commands over a single SSH connection (IIRC, OpenSSH 4.1 is the first
+sessions over a single SSH connection (OpenSSH 4.1 was the first
one to provide all the required functionality).
When a new Net::OpenSSH object is created, the OpenSSH C<ssh> client
@@ -2391,7 +2439,7 @@ in some ways.
L<Net::SSH2|Net::SSH2> is much better than Net::SSH::Perl, but not
completely stable yet. It can be very difficult to install on some
-specific operative systems and its API is also limited, in the same
+specific operating systems and its API is also limited, in the same
way as L<Net::SSH::Perl|Net::SSH::Perl>.
Using L<Net::SSH::Expect|Net::SSH::Expect>, in general, is a bad
@@ -2617,6 +2665,10 @@ in parallel:
$ssh{$host}->system('ls /');
}
+=item connect => 0
+
+Do not launch the master SSH process yet.
+
=item master_opts => [...]
Additional options to pass to the C<ssh> command when establishing the
@@ -2958,8 +3010,8 @@ See L</"Shell quoting"> below.
=item remote_shell => $shell
-Sets the remote shell. Allows to change the argument quoting mechanism
-in a per-command fashion.
+Sets the remote shell. Allows one to change the argument quoting
+mechanism in a per-command fashion.
This may be useful when interacting with a Windows machine where
argument parsing may be done at the command level in custom ways.
@@ -3013,7 +3065,7 @@ Set encodings. See L</Data encoding>.
Usage example:
# similar to IPC::Open2 open2 function:
- my ($in_pipe, $out_pipe, undef, $pid) =
+ my ($in_pipe, $out_pipe, undef, $pid) =
$ssh->open_ex( { stdin_pipe => 1,
stdout_pipe => 1 },
@cmd )
@@ -3353,11 +3405,11 @@ Calls C<scp> with the C<-v> flag.
=item recursive => 1
-Copy files and directories recursively.
+Copies files and directories recursively.
=item glob => 1
-Allow expansion of shell metacharacters in the sources list so that
+Enables expansion of shell metacharacters in the sources list so that
wildcards can be used to select files.
=item glob_flags => $flags
@@ -3512,6 +3564,10 @@ established. False is returned if the connection process fails or if
it has not yet completed (then, the L</error> method can be used to
distinguish between both cases).
+From version 0.64 upwards, undef is returned when the master is still
+in an unstable state (login, killing, etc.) and 0 when it is in a
+stable state (running, stopped or gone).
+
=item $ssh->check_master
This method runs several checks to ensure that the master connection
@@ -3621,6 +3677,15 @@ See also the L<sshfs(1)> man page and the C<sshfs> and FUSE web sites
at L<http://fuse.sourceforge.net/sshfs.html> and
L<http://fuse.sourceforge.net/> respectively.
+=item $any = $ssh->any(%opts)
+
+Wraps the current object inside a Net::SSH::Any one.
+
+Example:
+
+ my $any = $ssh->any;
+ my $content = $any->scp_get_content("my-file.txt");
+
=back
=head2 Shell quoting
@@ -3958,7 +4023,7 @@ This example is adapted from L<Net::Telnet> documentation:
=head2 mod_perl and mod_perl2
L<mod_perl> and L<mod_perl2> tie STDIN and STDOUT to objects that are
-not backed up by real file descriptors at the operative system
+not backed up by real file descriptors at the operating system
level. Net::OpenSSH will fail if any of these handles is used
explicitly or implicitly when calling some remote command.
@@ -4051,7 +4116,7 @@ use. For instance:
ssh_cmd => "/opt/OpenSSH/5.8/bin/ssh")
Some hardware vendors (e.g. Sun, err... Oracle) include custom
-versions of OpenSSH bundled with the operative system. In principle,
+versions of OpenSSH bundled with the operating system. In principle,
Net::OpenSSH should work with these SSH clients as long as they are
derived from some version of OpenSSH recent enough. Anyway, my advise
is to use the real OpenSSH software if you can!
@@ -4216,6 +4281,118 @@ Note that the meaning of the flags and the information generated is
only intended for debugging of the module and may change without
notice between releases.
+If you are using password authentication, enabling debugging for
+L<IO::Tty> may also show interesting information:
+
+ IO::Tty::DEBUG = 1;
+
+=head1 SECURITY
+
+B<Q>: Is this module secure?
+
+B<A>: Well, it tries to be!
+
+From a security standpoint the aim of this module is to be as secure
+as OpenSSH, your operating system, your shell and in general your
+environment allow it to be.
+
+It does not take any shortcut just to make your life easier if that
+means lowering the security level (for instance, disabling
+C<StrictHostKeyChecking> by default).
+
+In code supporting features that are not just proxied to OpenSSH,
+the module tries to keep the same standards of security as OpenSSH
+(for instance, checking directory and file permissions when placing
+the multiplexing socket).
+
+On the other hand, and keeping with OpenSSH philosophy, the module
+lets you disable most (all?) of those security measures. But just
+because it lets you do it it doesn't mean it is a good idea to do
+so!!!
+
+If you are a novice programmer or SSH user, and googling you have just
+found some flag that you don't understand but that seems to magically
+solve your connection problems... well, believe me, it is probably a
+bad idea to use it. Ask somebody how really knows first!
+
+Just to make thinks clear, if your code contains any of the keywords
+from the (non-exclusive) list below and you don't know why, you are
+probably wrecking the security of the SSH protocol:
+
+ strict_mode
+ StrictHostKeyChecking
+ UserKnownHostsFile
+
+Other considerations related to security you may like to know are as
+follows:
+
+=over 4
+
+=item Taint mode
+
+The module supports working in taint mode.
+
+If you are in an exposed environment, you should probably enable it
+for your script in order to catch any unchecked command for being
+executed in the remote side.
+
+=item Web environments
+
+It is a bad idea to establish SSH connections from your webserver
+because if it becomes compromised in any way, the attacker would be
+able to use the credentials from your script to connect to the remote
+host and do anything he wishes there.
+
+=item Command quoting
+
+The module can quote commands and arguments for you in a flexible
+and powerful way.
+
+This is a feature you should use as it reduces the possibility of some
+attacker being able to inject and run arbitrary commands on the remote
+machine (and even for scripts that are not exposed it is always
+advisable to enable argument quoting).
+
+Having said that, take into consideration that argument-quoting is
+just a hack to emulate the invoke-without-a-shell feature of Perl
+builtins such as C<system> and alike. There may be bugs(*) on the
+quoting code, your particular shell may have different quoting rules
+with unhandled corner cases or whatever. If your script is exposed to
+the outside, you should check your inputs and restrict what you accept
+as valid.
+
+[* even if this is one of the parts of the module more intensively
+tested!]
+
+=item Shellshock
+
+(see L<Shellshock|http://en.wikipedia.org/wiki/Shellshock_%28software_bug%29>)
+
+When executing local commands, the module always avoids calling the
+shell so in this way it is not affected by Shellshock.
+
+Unfortunately, some commands (C<scp>, C<rsync> and C<ssh> when the
+C<ProxyCommand> option is used) invoke other commands under the hood
+using the user shell. That opens the door to local Shellshock
+exploitation.
+
+On the remote side invocation of the shell is unavoidable due to the
+protocol design.
+
+By default, SSH does not forward environment variables but some Linux
+distributions explicitly change the default OpenSSH configuration to
+enable forwarding and acceptance of some specific ones (for instance
+C<LANG> and C<LC_*> on Debian and derivatives, Fedora does alike) and
+this also opens the door to Shellshock exploitation.
+
+Note that the shell used to invoke commands is not C</bin/sh> but the
+user shell as configured in C</etc/passwd>, PAM or whatever
+authentication subsystem is used by the local or remote operating
+system. Debian users, don't think you are not affected because
+your C</bin/sh> points to C<dash>!
+
+=back
+
=head1 FAQ
Frequent questions about the module:
@@ -4254,17 +4431,20 @@ command mode. It unconditionally attaches the restricted shell to any
incoming SSH connection and waits for the user to enter commands
through the redirected stdin stream.
-The only way to work-around this limitation is to make your script talk
-to the restricted shell (1-open a new SSH session, 2-wait for the
+The only way to work-around this limitation is to make your script
+talk to the restricted shell (1-open a new SSH session, 2-wait for the
shell prompt, 3-send a command, 4-read the output until you get to the
shell prompt again, repeat from 3). The best tool for this task is
-probably L<Expect>, used alone, as wrapped by L<Net::SSH::Expect> or
-combined with Net::OpenSSH (see L</Expect>).
+probably L<Expect>, used alone or combined with Net::OpenSSH (see
+L</Expect>).
There are some devices that support command mode but that only accept
one command per connection. In that cases, using L<Expect> is also
probably the best option.
+Nowadays, there is a new player, L<Net::CLI::Interaction> that may be
+more suitable than Expect.
+
=item Connection fails
B<Q>: I am unable to make the module connect to the remote host...
@@ -4358,10 +4538,10 @@ does not list the contents of C</home/foo/bin>.
What am I doing wrong?
B<A>: Net::OpenSSH (and, for that matter, all the SSH modules
-available from CPAN but L<Net::SSH::Expect>) runs every command in a
+available from CPAN but L<Net::SSH::Expect>) run every command in a
new session so most shell builtins that are run for its side effects
become useless (e.g. C<cd>, C<export>, C<ulimit>, C<umask>, etc.,
-usually, you can list them running help from the shell).
+usually, you can list them running C<help> from the shell).
A work around is to combine several commands in one, for instance:
@@ -4496,6 +4676,13 @@ execution of Perl code in remote machines through SSH.
L<SSH::RPC|SSH::RPC> implements an RPC mechanism on top of SSH using
Net::OpenSSH to handle the connections.
+L<Net::CLI::Interact> allows one to interact with remote shells
+and other services. It is specially suited for interaction with
+network equipment. The passphrase approach it uses is very clever. You
+may also like to check the L<other
+modules|https://metacpan.org/author/OLIVER> from its author, Oliver
+Gorwits.
+
=head1 BUGS AND SUPPORT
=head2 Experimental features
@@ -4526,11 +4713,6 @@ Perl L<perlfunc/fcntl> can be used to unset the non-blocking flag:
my $flags = fcntl(STDOUT, F_GETFL, 0);
fcntl(STDOUT, F_SETFL, $flags & ~O_NONBLOCK);
-=head2 Git repository
-
-The source code of this module is hosted at GitHub:
-L<http://github.com/salva/p5-Net-OpenSSH>.
-
=head2 Reporting bugs and asking for help
To report bugs send an email to the address that appear below or use
@@ -4558,33 +4740,106 @@ upon: L<http://www.openssh.org/donations.html>.
=head1 TODO
-- *** add tests for C<scp_*>, C<rsync_*> and C<sftp> methods
+- Tests for C<scp_*>, C<rsync_*> and C<sftp> methods
+
+- Make L</pipe_in> and L</pipe_out> methods L</open_ex> based
+
+- C<auto_discard_streams> feature for mod_perl2 and similar environments
+
+- Refactor open_ex support for multiple commands, maybe just keeping
+ tunnel, ssh and raw
+
+Send your feature requests, ideas or any feedback, please!
-- *** add support for more target operating systems (quoting, OpenVMS,
- Windows & others)
+=head1 CONTRIBUTING CODE
-- better timeout handling in system and capture methods
+The source code of this module is hosted at GitHub:
+L<http://github.com/salva/p5-Net-OpenSSH>.
-- make L</pipe_in> and L</pipe_out> methods L</open_ex> based
+Code contributions to the module are welcome but you should obey the
+following rules:
-- add C<scp_cat> and similar methods
+=over 4
-- async disconnect
+=item Only Perl 5.8.4 required
-- currently wait_for_master does not honor timeout
+Yes, that's pretty old, but Net::OpenSSH is intended to be also used
+by system administrators that some times have to struggle with old
+systems. The reason to pick 5.8.4 is that is has been the default perl
+on Solaris for a long time.
-- auto_discard_streams feature for mod_perl2 and similar environments
+=item Avoid the "All the world's a Linux PC" syndrome
-- add proper shell quoting for Windows (see
- L<http://blogs.msdn.com/b/twistylittlepassagesallalike/archive/2011/04/23/everyone-quotes-arguments-the-wrong-way.aspx>).
+The module should work on any (barely) sane Unix or Linux operating
+system. Specially, it should not be assumed that the over-featured GNU
+utilities and toolchain are available.
-- refactor open_ex support for multiple commands, maybe just keeping tunnel, ssh and raw
+=item Dependencies are optional
-Send your feature requests, ideas or any feedback, please!
+In order to make the module very easy to install, no mandatory
+dependencies on other CPAN modules are allowed.
+
+Optional modules, that are loaded only on demand, are acceptable when
+they are used for adding new functionality (as it is done, for
+instance, with L<IO::Pty>).
+
+Glue code for integration with 3rd party modules is also allowed (as
+it is done with L<Expect>).
+
+Usage of language extension modules and alike is not acceptable.
+
+=item Tests should be lax
+
+We don't want false negatives when testing. In case of doubt tests
+should succeed.
+
+Also, in case of tests invoking some external program, it should be
+checked that the external program is available and that it works as
+expected or otherwise skip the tests.
+
+=item Backward compatibility
+
+Nowadays Net::OpenSSH is quite stable and there are lots of scripts
+out there using it that we don't want to break, so, keeping the API
+backward compatible is a top priority.
+
+Probably only security issues could now justify a backward
+incompatible change.
+
+=item Follow my coding style
+
+Look at the rest of the code.
+
+I let Emacs do the formatting for me using cperl-mode PerlStyle.
+
+=item Talk to me
+
+Before making a large change or implementing a new feature get in
+touch with me.
+
+I may have my own ideas about how things should be done. It is better
+it you know them before hand or otherwise, you risk getting your patch
+rejected.
+
+=back
+
+Well, actually you should know that I am quite good at rejecting
+patches but it is not my fault!
+
+Most of the patches I get are broken in some way, don't follow the
+main module principles or just the author didn't get the full picture
+and solved its issue in a short-sighted way.
+
+In any case, you should not be discouraged to contribute. Even if your
+patch is not applied directly, seeing how it solves your requirements
+or, in the case of bugs, the underlying problem analysis may be very
+useful and help me do it... my way.
+
+I always welcome documentation corrections and improvements.
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2008-2014 by Salvador FandiE<ntilde>o
+Copyright (C) 2008-2015 by Salvador FandiE<ntilde>o
(sfandino@yahoo.com)
This library is free software; you can redistribute it and/or modify
diff --git a/lib/Net/OpenSSH/ConnectionCache.pm b/lib/Net/OpenSSH/ConnectionCache.pm
index cf2ae29..d182114 100644
--- a/lib/Net/OpenSSH/ConnectionCache.pm
+++ b/lib/Net/OpenSSH/ConnectionCache.pm
@@ -7,7 +7,7 @@ use Data::Dumper;
use Scalar::Util qw(weaken);
our $MAX_SIZE = 20;
-my %cache;
+our %cache;
sub _factory {
my $class = shift;
@@ -45,6 +45,8 @@ sub _factory {
$Net::OpenSSH::FACTORY = \&_factory;
+sub clean_cache { %cache = () }
+
END { %cache = () }
1;
@@ -74,9 +76,14 @@ C<$Net::OpenSSH::ConnectionCache::MAX_SIZE> controls the cache
size. Once as many connections are allocated, the module will try to
free any of them before allocating a new one.
+The function C<clean_cache> makes the module forget (and close) all
+the cached connections:
+
+ Net::OpenSSH::ConnectionCache::clean_cache();
+
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2011 by Salvador FandiE<ntilde>o
+Copyright (C) 2011, 2014 by Salvador FandiE<ntilde>o
(sfandino@yahoo.com)
This library is free software; you can redistribute it and/or modify
diff --git a/lib/Net/OpenSSH/Constants.pm b/lib/Net/OpenSSH/Constants.pm
index 42fa6de..f1ef3cc 100644
--- a/lib/Net/OpenSSH/Constants.pm
+++ b/lib/Net/OpenSSH/Constants.pm
@@ -5,10 +5,11 @@ our $VERSION = '0.51_07';
use strict;
use warnings;
use Carp;
+use Scalar::Util ();
require Exporter;
our @ISA = qw(Exporter);
-our %EXPORT_TAGS = (error => []);
+our %EXPORT_TAGS = (error => [], _state => []);
my %error = ( OSSH_MASTER_FAILED => 1,
OSSH_SLAVE_FAILED => 2,
@@ -26,6 +27,22 @@ for my $key (keys %error) {
push @{$EXPORT_TAGS{error}}, $key
}
+my @states = qw(_STATE_START
+ _STATE_LOGIN
+ _STATE_AWAITING_MUX
+ _STATE_RUNNING
+ _STATE_KILLING
+ _STATE_GONE
+ _STATE_STOPPED);
+
+my $last_value;
+for my $state (@states) {
+ no strict 'refs';
+ my $value = Scalar::Util::dualvar(++$last_value, $state);
+ *{$state} = sub () { $value };
+ push @{$EXPORT_TAGS{_state}}, $state
+}
+
our @EXPORT_OK = map { @{$EXPORT_TAGS{$_}} } keys %EXPORT_TAGS;
$EXPORT_TAGS{all} = [@EXPORT_OK];
@@ -55,7 +72,7 @@ This module exports the following constants:
OSSH_SLAVE_TIMEOUT - slave process timeout
OSSH_SLAVE_CMD_FAILED - child process exited with a non zero status
OSSH_SLAVE_SFTP_FAILED - creation of SFTP client failed
- OSS_ENCODING_ERROR - some error related to the encoding/decoding of strings happened
+ OSSH_ENCODING_ERROR - some error related to the encoding/decoding of strings happened
=back
diff --git a/lib/Net/OpenSSH/ShellQuoter.pm b/lib/Net/OpenSSH/ShellQuoter.pm
index e9939d6..ece197a 100644
--- a/lib/Net/OpenSSH/ShellQuoter.pm
+++ b/lib/Net/OpenSSH/ShellQuoter.pm
@@ -13,7 +13,10 @@ my %alias = (bash => 'POSIX',
dash => 'POSIX',
pdksh => 'POSIX',
mksh => 'POSIX',
+ lksh => 'POSIX',
zsh => 'POSIX',
+ fizsh => 'POSIX',
+ posh => 'POSIX',
tcsh => 'csh');
sub quoter {
diff --git a/lib/Net/OpenSSH/ShellQuoter/POSIX.pm b/lib/Net/OpenSSH/ShellQuoter/POSIX.pm
index 21f6125..5de7c68 100644
--- a/lib/Net/OpenSSH/ShellQuoter/POSIX.pm
+++ b/lib/Net/OpenSSH/ShellQuoter/POSIX.pm
@@ -7,7 +7,7 @@ use Carp;
sub new { __PACKAGE__ }
my $noquote_class = '.\\w/\\-@,:';
-my $glob_class = '*?\\[\\],{}:!^~';
+my $glob_class = '*?\\[\\],\\{\\}:!^~';
sub quote {
shift;