File Coverage

blib/lib/Net/OpenSSH.pm

Criterion	Covered	Total	%
statement	498	1395	35.7
branch	230	1076	21.3
condition	80	433	18.4
subroutine	46	123	37.4
pod	45	49	91.8
total	899	3076	29.2

package Net::OpenSSH;

our $VERSION = '0.82';

use strict;
use warnings;

our $debug ||= 0;
our $debug_fh ||= \*STDERR;

our $FACTORY;

use Carp qw(carp croak);
use POSIX qw(:sys_wait_h);
use Socket;
use File::Spec;
use Cwd ();
use Scalar::Util ();
use Errno ();
use Net::OpenSSH::Constants qw(:error :_state);
use Net::OpenSSH::ModuleLoader;
use Net::OpenSSH::ShellQuoter;
use Digest::MD5;

my $thread_generation = 0;

sub CLONE { $thread_generation++ };

sub _debug {
    local ($!, $@);
    print {$debug_fh} '# ', (map { defined($_) ? $_ : '' } @_), "\n"
}

sub _debug_dump {
    local ($!, $@);
    require Data::Dumper;
    local $Data::Dumper::Terse = 1;
    local $Data::Dumper::Indent = 0;
    my $head = shift;
    _debug("$head: ", Data::Dumper::Dumper(@_));
}

sub _hexdump {
    no warnings qw(uninitialized);
    my $data = shift;
    while ($data =~ /(.{1,32})/smg) {
        my $line=$1;
        my @c= (( map { sprintf "%02x",$_ } unpack('C*', $line)),
                (("  ") x 32))[0..31];
        $line=~s/(.)/ my $c=$1; unpack("c",$c)>=32 ? $c : '.' /egms;
        print {$debug_fh} "#> ", join(" ", @c, '|', $line), "\n";
    }
}

{
    my %good;

    sub _sub_options {
        my $sub = shift;
        $good{__PACKAGE__ . "::$sub"} = { map { $_ => 1 } @_ };
    }

    sub _croak_bad_options (\%) {
        my $opts = shift;
        if (%$opts) {
	    my $sub = (caller 1)[3];
            my $good = $good{$sub};
            my @keys = grep defined($opts->{$_}), ( $good ? grep !$good->{$_}, keys %$opts : keys %$opts);
            if (@keys) {
                croak "Invalid or bad combination of options ('" . CORE::join("', '", @keys) . "')";
            }
        }
    }
}

sub _croak_scalar_context {
    my ($sub, $wantarray) = (caller 1)[3, 5];
    unless ($wantarray) {
        $sub =~ s/^.*:://;
        croak "method '$sub' called in scalar context";
    }
}

sub _tcroak {
    if (${^TAINT} > 0) {
	push @_, " while running with -T switch";
        goto &croak;
    }
    if (${^TAINT} < 0) {
	push @_, " while running with -t switch";
        goto &carp;
    }
}

sub _catch_tainted_args {
    my $i;
    for (@_) {
        next unless $i++;
        if (Scalar::Util::tainted($_)) {
            my (undef, undef, undef, $subn) = caller 1;
            my $msg = ( $subn =~ /::([a-z]\w*)$/
                        ? "Insecure argument '$_' on '$1' method call"
                        : "Insecure argument '$_' on method call" );
            _tcroak($msg);
        }
        elsif (ref($_) eq 'HASH') {
            for (grep Scalar::Util::tainted($_), values %$_) {
		my (undef, undef, undef, $subn) = caller 1;
		my $msg = ( $subn =~ /::([a-z]\w*)$/
			    ? "Insecure argument on '$1' method call"
			    : "Insecure argument on method call" );
		_tcroak($msg);
            }
        }
    }
}

sub _set_error {
    my $self = shift;
    my $code = shift || 0;
    my @extra = grep defined, @_;
    my $err = $self->{_error} = ( $code
                                  ? Scalar::Util::dualvar($code, join(': ', @{$self->{_error_prefix}},
                                                                      (@extra ? @extra : "Unknown error $code")))
                                  : 0 );
    $debug and $debug & 1 and _debug "set_error($code - $err)";
    return $err
}

my $check_eval_re = do {
    my $path = quotemeta $INC{"Net/OpenSSH.pm"};
    qr/at $path line \d+.$/
};

sub _check_eval_ok {
    my ($self, $code) = @_;
    if ($@) {
        my $err = $@;
        $err =~ s/$check_eval_re//;
        $self->_set_error($code, $err);
        return;
    }
    1
}

sub _or_set_error {
    my $self = shift;
    $self->{_error} or $self->_set_error(@_);
}

sub _first_defined { defined && return $_ for @_; return }

my $obfuscate = sub {
    # just for the casual observer...
    my $txt = shift;
    $txt =~ s/(.)/chr(ord($1) ^ 47)/ges
        if defined $txt;
    $txt;
};

my $deobfuscate = $obfuscate;

# regexp from Regexp::IPv6
my $IPv6_re = qr((?-xism::(?::[0-9a-fA-F]{1,4}){0,5}(?:(?::[0-9a-fA-F]{1,4}){1,2}|:(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})))|[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}|:)|(?::(?:[0-9a-fA-F]{1,4})?|(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))))|:(?:(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|[0-9a-fA-F]{1,4}(?::[0-9a-fA-F]{1,4})?|))|(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|:[0-9a-fA-F]{1,4}(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|(?::[0-9a-fA-F]{1,4}){0,2})|:))|(?:(?::[0-9a-fA-F]{1,4}){0,2}(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|(?::[0-9a-fA-F]{1,4}){1,2})|:))|(?:(?::[0-9a-fA-F]{1,4}){0,3}(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|(?::[0-9a-fA-F]{1,4}){1,2})|:))|(?:(?::[0-9a-fA-F]{1,4}){0,4}(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|(?::[0-9a-fA-F]{1,4}){1,2})|:))));

sub parse_connection_opts {
    my ($class, $opts) = @_;
    my ($user, $passwd, $ipv6, $host, $port, $host_squared);

    my $target = delete $opts->{host};
    defined $target or croak "mandatory host argument missing";

    ($user, $passwd, $ipv6, $host, $port) =
        $target =~ m{^
                       \s*               # space
                       (?:
                         ([^:]+)         # username
                         (?::(.*))?      # : password
                         \@              # @
                       )?
                       (?:               # host
                          (              #   IPv6...
                            \[$IPv6_re(?:\%[^\[\]]*)\] #     [IPv6]
                            |            #     or
                            $IPv6_re     #     IPv6
                          )
                          |              #   or
                          ([^\[\]\@:]+)  #   hostname / ipv4
                       )
                       (?::([^\@:]+))?   # port
                       \s*               # space
                     $}ix
                or croak "bad host/target '$target' specification";

    if (defined $ipv6) {
        ($host) = $ipv6 =~ /^\[?(.*?)\]?$/;
        $host_squared = "[$host]";
    }
    else {
        $host_squared = $host;
    }

    $user = delete $opts->{user} unless defined $user;
    $port = delete $opts->{port} unless defined $port;
    $passwd = delete $opts->{passwd} unless defined $passwd;
    $passwd = delete $opts->{password} unless defined $passwd;

    wantarray and return ($host, $port, $user, $passwd, $host_squared);

    my %r = ( user => $user,
              password => $passwd,
              host => $host,
              host_squared => $host_squared,
              port => $port );
    $r{ipv6} = 1 if defined $ipv6;
    return \%r;
}

my $sizeof_sun_path = ($^O eq 'linux' ? 108 :
                       $^O =~ /bsd/i  ? 104 :
                       $^O eq 'hpux'  ? 92  : undef);

sub new {
    ${^TAINT} and &_catch_tainted_args;

    my $class = shift;
    @_ & 1 and unshift @_, 'host';

    return $FACTORY->($class, @_) if defined $FACTORY;

    my %opts = @_;

    my $external_master = delete $opts{external_master};
    # reuse_master is an obsolete alias:
    $external_master = delete $opts{reuse_master} unless defined $external_master;

    if (not defined $opts{host} and defined $external_master) {
        $opts{host} = '0.0.0.0';
    }

    my ($host, $port, $user, $passwd, $host_squared) = $class->parse_connection_opts(\%opts);

    my ($passphrase, $key_path, $login_handler);
    unless (defined $passwd) {
        $key_path = delete $opts{key_path};
        $passwd = delete $opts{passphrase};
        if (defined $passwd) {
            $passphrase = 1;
        }
        else {
            $login_handler = delete $opts{login_handler};
        }
    }

    my $ssh_version = delete $opts{ssh_version};
    my $batch_mode = delete $opts{batch_mode};
    my $ctl_path = delete $opts{ctl_path};
    my $ctl_dir = delete $opts{ctl_dir};
    my $proxy_command = delete $opts{proxy_command};
    my $gateway = delete $opts{gateway} unless defined $proxy_command;
    my $ssh_cmd = _first_defined delete $opts{ssh_cmd}, 'ssh';
    my $rsync_cmd = _first_defined delete $opts{rsync_cmd}, 'rsync';
    my $scp_cmd = delete $opts{scp_cmd};
    my $sshfs_cmd = _first_defined delete $opts{sshfs_cmd}, 'sshfs';
    my $sftp_server_cmd = _first_defined delete $opts{sftp_server_cmd},
                                         '/usr/lib/openssh/sftp-server';
    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};
    my $vars = _first_defined delete $opts{vars}, {};
    my $default_encoding = delete $opts{default_encoding};
    my $default_stream_encoding =
        _first_defined delete $opts{default_stream_encoding}, $default_encoding;
    my $default_argument_encoding =
        _first_defined delete $opts{default_argument_encoding}, $default_encoding;
    my $forward_agent = delete $opts{forward_agent};
    $forward_agent and $passphrase and
        croak "agent forwarding can not be used when a passphrase has also been given";
    my $forward_X11 = delete $opts{forward_X11};
    my $passwd_prompt = delete $opts{password_prompt};
    my $master_pty_force = delete $opts{master_pty_force};
    $passwd_prompt = delete $opts{passwd_prompt} unless defined $passwd_prompt;

    my ($master_opts, @master_opts,
        $master_stdout_fh, $master_stderr_fh,
	$master_stdout_discard, $master_stderr_discard,
        $master_setpgrp);
    unless ($external_master) {
        ($master_stdout_fh = delete $opts{master_stdout_fh} or
         $master_stdout_discard = delete $opts{master_stdout_discard});

        ($master_stderr_fh = delete $opts{master_stderr_fh} or
         $master_stderr_discard = delete $opts{master_stderr_discard});

        $master_opts = delete $opts{master_opts};
        if (defined $master_opts) {
            if (ref $master_opts) {
                @master_opts = @$master_opts;
            }
            else {
                carp "'master_opts' argument looks like if it should be splited first"
                    if $master_opts =~ /^-\w\s+\S/;
                @master_opts = $master_opts;
            }
        }
        $master_setpgrp = delete $opts{master_setpgrp};

        # when a password/passphrase is given, calling setpgrp is
        # useless because the process runs attached to a different tty
        undef $master_setpgrp if $login_handler or defined $passwd;
    }

    my $default_ssh_opts = delete $opts{default_ssh_opts};
    carp "'default_ssh_opts' argument looks like if it should be splited first"
        if defined $default_ssh_opts and not ref $default_ssh_opts and $default_ssh_opts =~ /^-\w\s+\S/;

    my ($default_stdout_fh, $default_stderr_fh, $default_stdin_fh,
	$default_stdout_file, $default_stderr_file, $default_stdin_file,
	$default_stdout_discard, $default_stderr_discard, $default_stdin_discard);

    $default_stdout_file = (delete $opts{default_stdout_discard}
			    ? '/dev/null'
			    : delete $opts{default_stdout_file});
    $default_stdout_fh = delete $opts{default_stdout_fh}
	unless defined $default_stdout_file;

    $default_stderr_file = (delete $opts{default_stderr_discard}
			    ? '/dev/null'
			    : delete $opts{default_stderr_file});
    $default_stderr_fh = delete $opts{default_stderr_fh}
	unless defined $default_stderr_file;

    $default_stdin_file = (delete $opts{default_stdin_discard}
			    ? '/dev/null'
			    : delete $opts{default_stdin_file});
    $default_stdin_fh = delete $opts{default_stdin_fh}
	unless defined $default_stdin_file;

    _croak_bad_options %opts;

    my @ssh_opts;
    # TODO: are those options really requiered or just do they eat on
    # the command line limited length?
    push @ssh_opts, -l => $user if defined $user;
    push @ssh_opts, -p => $port if defined $port;

    my $home = do {
	local ($@, $SIG{__DIE__});
	eval { Cwd::realpath((getpwuid $>)[7]) }
    };

    if (${^TAINT}) {
	($home) = $home =~ /^(.*)$/;
	Scalar::Util::tainted($ENV{PATH}) and
		_tcroak('Insecure $ENV{PATH}');
    }

    my $self = { _error => 0,
		 _error_prefix => [],
		 _perl_pid => $$,
                 _thread_generation => $thread_generation,
                 _ssh_version => $ssh_version,
                 _ssh_cmd => $ssh_cmd,
		 _scp_cmd => $scp_cmd,
		 _rsync_cmd => $rsync_cmd,
                 _sshfs_cmd => $sshfs_cmd,
                 _sftp_server_cmd => $sftp_server_cmd,
                 _pid => undef,
                 _host => $host,
		 _host_squared => $host_squared,
                 _user => $user,
                 _port => $port,
                 _passwd => $obfuscate->($passwd),
                 _passwd_prompt => $passwd_prompt,
                 _passphrase => $passphrase,
                 _key_path => $key_path,
                 _login_handler => $login_handler,
                 _timeout => $timeout,
                 _proxy_command => $proxy_command,
                 _gateway_args => $gateway,
                 _kill_ssh_on_timeout => $kill_ssh_on_timeout,
                 _batch_mode => $batch_mode,
                 _home => $home,
                 _forward_agent => $forward_agent,
                 _forward_X11 => $forward_X11,
                 _external_master => $external_master,
                 _default_ssh_opts => $default_ssh_opts,
		 _default_stdin_fh => $default_stdin_fh,
		 _default_stdout_fh => $default_stdout_fh,
		 _default_stderr_fh => $default_stderr_fh,
		 _master_stdout_fh => $master_stdout_fh,
		 _master_stderr_fh => $master_stderr_fh,
		 _master_stdout_discard => $master_stdout_discard,
		 _master_stderr_discard => $master_stderr_discard,
                 _master_setpgrp => $master_setpgrp,
                 _master_pty_force => $master_pty_force,
		 _remote_shell => $remote_shell,
                 _default_stream_encoding => $default_stream_encoding,
                 _default_argument_encoding => $default_argument_encoding,
		 _expand_vars => $expand_vars,
		 _vars => $vars,
                 _master_state => _STATE_START,
               };
    bless $self, $class;

    $self->_detect_ssh_version;

    # default file handles are opened so late in order to have the
    # $self object to report errors
    $self->{_default_stdout_fh} = $self->_open_file('>', $default_stdout_file)
	if defined $default_stdout_file;
    $self->{_default_stderr_fh} = $self->_open_file('>', $default_stderr_file)
	if defined $default_stderr_file;
    $self->{_default_stdin_fh} = $self->_open_file('<', $default_stdin_file)
	if defined $default_stdin_file;

    if ($self->{_error} == OSSH_SLAVE_PIPE_FAILED) {
        $self->_master_fail($async, "Unable to create default slave stream", $self->{_error});
        return $self;
    }

    $self->{_ssh_opts} = [$self->_expand_vars(@ssh_opts)];
    $self->{_master_opts} = [$self->_expand_vars(@master_opts)];

    $ctl_path = $self->_expand_vars($ctl_path);
    $ctl_dir = $self->_expand_vars($ctl_dir);

    if  (defined $ctl_path) {
        if ($external_master) {
            unless (-S $ctl_path) {
                $self->_master_fail($async, "ctl_path $ctl_path does not point to a socket");
                return $self;
            }
        }
        else {
            if (-e $ctl_path) {
                $self->_master_fail($async, "unable to use ctl_path $ctl_path, a file object already exists there");
                return $self;
            }
        }
    }
    else {
        $external_master and croak "external_master is set but ctl_path is not defined";

        unless (defined $ctl_dir) {
            unless (defined $self->{_home}) {
                $self->_master_fail($async, "unable to determine home directory for uid $>");
                return $self;
            }

            $ctl_dir = File::Spec->catdir($self->{_home}, ".libnet-openssh-perl");
        }

        mkdir $ctl_dir, 0700;
        unless (-d $ctl_dir) {
            $self->_master_fail($async, "unable to create ctl_dir $ctl_dir");
            return $self;
        }

        my $target = join('-', grep defined, $user, $host, $port);

        for (1..10) {
            my $ctl_file = Digest::MD5::md5_hex(sprintf "%s-%d-%d-%d", $target, $$, time, rand 1e6);
            $ctl_path = File::Spec->join($ctl_dir, $ctl_file);
            last unless -e $ctl_path
        }
        if (-e $ctl_path) {
            $self->_master_fail($async, "unable to find unused name for ctl_path inside ctl_dir $ctl_dir");
            return $self;
        }
    }

    if (defined $sizeof_sun_path and length $ctl_path > $sizeof_sun_path) {
        $self->_master_fail($async, "ctl_path $ctl_path is too long (max permissible size for $^O is $sizeof_sun_path)");
        return $self;
    }

    $ctl_dir = File::Spec->catpath((File::Spec->splitpath($ctl_path))[0,1], "");
    $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->_master_fail($async, "ctl_dir $ctl_dir is not secure");
 	return $self;
    }

    $self->{_ctl_path} = $ctl_path;

    $self->_master_wait($async) if $connect;

    $self;
}

sub get_user { shift->{_user} }
sub get_host { shift->{_host} }
sub get_port { shift->{_port} }
sub get_master_pid { shift->{_pid} }
sub get_ctl_path { shift->{_ctl_path} }
sub get_expand_vars { shift->{_expand_vars} }

sub get_master_pty_log { shift->{_master_pty_log} }

sub set_expand_vars {
    my $self = shift;
    $self->{_expand_vars} = (shift(@_) ? 1 : 0);
}

sub set_var {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my $k = shift;
    $k =~ /^(?:USER|HOST|PORT)$/
	and croak "internal variable %$k% can not be set";
    $self->{_vars}{$k} = shift;
}

sub get_var {
    my ($self, $k) = @_;
    my $v = ( $k =~ /^(?:USER|HOST|PORT)$/
	      ? $self->{lc "_$k"}
	      : $self->{_vars}{$k} );
    (defined $v ? $v : '');
}

sub _expand_vars {
    my ($self, @str) = @_;
    if (ref $self and $self->{_expand_vars}) {
	for (@str) {
	    s{%(\w*)%}{length ($1) ? $self->get_var($1) : '%'}ge
		if defined $_;
	}
    }
    wantarray ? @str : $str[0]
}

sub error { shift->{_error} }

sub die_on_error {
    my $ssh = shift;
    $ssh->{_error} and croak(@_ ? "@_: $ssh->{_error}" : $ssh->{_error});
}


sub _is_secure_path {
    my ($self, $path) = @_;
    my @parts = File::Spec->splitdir(Cwd::realpath($path));
    my $home = $self->{_home};
    for my $last (reverse 0..$#parts) {
        my $dir = File::Spec->catdir(@parts[0..$last]);
        unless (-d $dir) {
            $debug and $debug & 2 and _debug "$dir is not a directory";
            return undef;
        }
        my ($mode, $uid) = (stat $dir)[2, 4];
        $debug and $debug & 2 and _debug "_is_secure_path(dir: $dir, file mode: $mode, file uid: $uid, euid: $>";
        return undef unless(($uid == $> or $uid == 0 ) and (($mode & 022) == 0 or ($mode & 01000)));
        return 1 if (defined $home and $home eq $dir);
    }
    return 1;
}

sub _detect_ssh_version {
    my $self = shift;
    if (defined $self->{_ssh_version}) {
        $debug and $debug & 4 and _debug "ssh version given as $self->{_ssh_version}";
    }
    else {
        my (undef, $out, undef, $pid) = $self->open_ex({_cmd => 'raw',
                                                        _no_master_required => 1,
                                                        stdout_pipe => 1,
                                                        stdin_discard => 1,
                                                        stderr_to_stdout => 1 },
                                                       $self->{_ssh_cmd}, '-V');
        my ($txt) = $self->_io3($out, undef, undef, undef, 10, 'bytes');
        local $self->{_kill_ssh_on_timeout} = 1;
        $self->_waitpid($pid, 10);
        if (my ($full, $num) = $txt =~ /^OpenSSH_((\d+\.\d+)\S*)/mi) {
            $debug and $debug & 4 and _debug "OpenSSH version is $full";
            $self->{_ssh_version} = $num;
        }
        else {
            $self->{_ssh_version} = 0;
            $debug and $debug & 4 and _debug "unable to determine version, '$self->{_ssh_cmd} -V', output:\n$txt"
        }
    }
}

sub _make_ssh_call {
    my $self = shift;
    my @before = @{shift || []};
    my @args = ($self->{_ssh_cmd}, @before,
		-S => $self->{_ctl_path},
                @{$self->{_ssh_opts}}, $self->{_host},
                '--',
                (@_ ? "@_" : ()));
    $debug and $debug & 8 and _debug_dump 'call args' => \@args;
    @args;
}

sub _scp_cmd {
    my $self = shift;
    $self->{_scp_cmd} ||= do {
	my $scp = $self->{_ssh_cmd};
	$scp =~ s/ssh$/scp/i or croak "scp command name not set";
	$scp;
    }
}

sub _make_scp_call {
    my $self = shift;
    my @before = @{shift || []};
    my @args = ($self->_scp_cmd, @before,
		-o => "ControlPath=$self->{_ctl_path}",
                -S => $self->{_ssh_cmd},
                (defined $self->{_port} ? (-P => $self->{_port}) : ()),
                '--', @_);

    $debug and $debug & 8 and _debug_dump 'scp call args' => \@args;
    @args;
}

sub _rsync_quote {
    my ($self, @args) = @_;
    for (@args) {
	if (/['"\s]/) {
	    s/"/""/g;
	    $_ = qq|"$_"|;
	}
	s/%/%%/;
    }
    wantarray ? @args : join(' ', @args);
}

sub _make_rsync_call {
    my $self = shift;
    my $before = shift;
    my @transport = ($self->{_ssh_cmd}, @$before,
                    -S => $self->{_ctl_path});
    my $transport = $self->_rsync_quote(@transport);
    my @args = ( $self->{_rsync_cmd},
		 -e => $transport,
		 @_);

    $debug and $debug & 8 and _debug_dump 'rsync call args' => \@args;
    @args;
}

sub _make_W_option {
    my $self = shift;
    if (@_ == 1) {
        my $path = shift;
        $path = "./$path" unless $path =~ m|/|;
        $path =~ s/([\\:])/\\$1/g;
        return "-W$path";
    }
    if (@_ == 2) {
        return "-W" . join(':', @_);
    }
    croak "bad number of arguments for creating a tunnel"
}

sub _make_tunnel_call {
    my $self = shift;
    my @before = @{shift||[]};
    push @before, $self->_make_W_option(@_);
    my @args = $self->_make_ssh_call(\@before);
    $debug and $debug & 8 and _debug_dump 'tunnel call args' => \@args;
    @args;
}

sub master_exited {
    my $self = shift;
    $self->_master_gone(1)
}

sub _master_gone {
    my $self = shift;
    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 __has_sigchld_handle {
    my $h = $SIG{CHLD};
    defined $h and $h ne 'IGNORE' and $h ne 'DEFAULT'
}

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 or __has_sigchld_handle;
        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 $deceased = waitpid($pid, WNOHANG);
            $debug and $debug & 32 and _debug "waitpid(master: $pid) => pid: $deceased, rc: $!";
            last if $deceased == $pid or ($deceased < 0 and $! == 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;
        }
    }
    else {
        $debug and $debug & 32 and _debug("not killing master SSH (", $self->{_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 disown_master {
    my $self = shift;
    if (my $pid = $self->_my_master_pid) {
        if ($self->wait_for_master) {
            $self->{_external_master} = 1;
            return $pid;
        }
    }
    undef;
}

sub restart {
    my ($self, $async) = @_;
    $self->{_external_master} and croak "Can restart SSH connection when using external master";

    # user is responsible for calling us in STATE_GONE in async mode
    $self->_disconnect($async, 1) unless $async;

    if ($self->{_master_state} != _STATE_GONE) {
	croak "restart method called in wrong state (terminate the connection first!)" if $async;
	return $self->_master_fail($async, "Unable to restart SSH session from state $self->{_master_state}")
    }

    # These slots should be deleted when exiting the KILLING state but
    # I like keeping them around for throubleshoting purposes.
    delete $self->{_master_kill_start};
    delete $self->{_master_kill_last};
    delete $self->{_master_kill_count};
    $self->_master_jump_state(_STATE_START, $async);
}

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 {
    my ($name, $fh) = @_;
    my $fn = fileno(defined $fh ? $fh : $name);
    defined $fn and $fn >= 0 and return;
    croak "child process $name is not a real system file handle";
}

sub _master_redirect {
    my $self = shift;
    my $uname = uc shift;
    my $name = lc $uname;

    no strict 'refs';
    if ($self->{"_master_${name}_discard"}) {
	open *$uname, '>>', '/dev/null';
    }
    else {
	my $fh = $self->{"_master_${name}_fh"};
	$fh = $self->{"_default_${name}_fh"} unless defined $fh;
	if (defined $fh) {
	    _check_is_system_fh $uname => $fh;
	    if (fileno $fh != fileno *$uname) {
		open *$uname, '>>&', $fh or POSIX::_exit(255);
	    }
	}
    }
}

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 {} unless __has_sigchld_handle;
	while (1) {
            my $deceased;
            if (defined $time_limit) {
                while (1) {
                    # TODO: we assume that all OSs return 0 when the
                    # process is still running, that may be wrong!
                    $deceased = 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";
                    $deceased = waitpid($pid, WNOHANG) and last;
                    select(undef, undef, undef, $sleep);
                }
            }
            else {
                $deceased = waitpid($pid, 0);
            }
            $debug and $debug & 16 and _debug "_waitpid($pid) => pid: $deceased, rc: $?, err: $!";
	    if ($deceased == $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;
	    }
	    elsif ($deceased < 0) {
		# at this point $deceased < 0 and so, $! has a valid error value.
		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) = $deceased. Report it, please!";
	    }
	    elsif ($deceased > 0) {
		warn "Internal error: spurious process $deceased exited"
	    }

	    # 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;

    my $timeout = int((($self->{_timeout} || 90) + 2)/3);
    my $ssh_flags= '-2MN';
    $ssh_flags .= ($self->{_forward_agent} ? 'A' : 'a') if defined $self->{_forward_agent};
    $ssh_flags .= ($self->{_forward_X11} ? 'X' : 'x');
    my @master_opts = (@{$self->{_master_opts}},
                       -o => "ServerAliveInterval=$timeout",
                       ($self->{_ssh_version} >= 5.6 ? (-o => "ControlPersist=no") : ()),
                      $ssh_flags);

    my ($mpty, $use_pty, $pref_auths);
    $use_pty = 1 if ( $self->{_master_pty_force} or
                      defined $self->{_login_handler} );
    if (defined $self->{_passwd}) {
        $use_pty = 1;
        $pref_auths = ($self->{_passphrase}
                       ? 'publickey'
                       : 'keyboard-interactive,password');
        push @master_opts, -o => 'NumberOfPasswordPrompts=1';
    }
    elsif ($self->{_batch_mode}) {
        push @master_opts, -o => 'BatchMode=yes';
    }

    if (defined $self->{_key_path}) {
        $pref_auths = 'publickey';
        push @master_opts, -i => $self->{_key_path};
    }

    my $proxy_command = $self->{_proxy_command};

    my $gateway;
    if (my $gateway_args = $self->{_gateway_args}) {
        if (ref $gateway_args eq 'HASH') {
            _load_module('Net::OpenSSH::Gateway');
            my $errors;
            unless ($gateway = Net::OpenSSH::Gateway->find_gateway(errors => $errors,
                                                                   host => $self->{_host}, port => $self->{_port},
                                                                   %$gateway_args)) {
                return $self->_master_fail($async, 'Unable to build gateway object', join(', ', @$errors));
            }
        }
        else {
            $gateway = $gateway_args
        }
        $self->{_gateway} = $gateway;
        $gateway->before_ssh_connect or
            return $self->_master_fail($async, 'Gateway setup failed', join(', ', $gateway->errors));
        $proxy_command = $gateway->proxy_command;
    }

    if (defined $proxy_command) {
        push @master_opts, -o => "ProxyCommand=$proxy_command";
    }

    if ($use_pty) {
        _load_module('IO::Pty');
        $self->{_mpty} = $mpty = IO::Pty->new;
    }

    push @master_opts, -o => "PreferredAuthentications=$pref_auths"
        if defined $pref_auths;

    my @call = $self->_make_ssh_call(\@master_opts);

    my $pid = fork;
    unless ($pid) {
        defined $pid
            or return $self->_master_fail($async, "unable to fork ssh master: $!");

        if ($debug and $debug & 512) {
            require Net::OpenSSH::OSTracer;
            Net::OpenSSH::OSTracer->trace;
        }

        $mpty->make_slave_controlling_terminal if $mpty;

	$self->_master_redirect('STDOUT');
	$self->_master_redirect('STDERR');

        delete $ENV{SSH_ASKPASS} if defined $self->{_passwd};
        delete $ENV{SSH_AUTH_SOCK} if defined $self->{_passphrase};

        setpgrp if $self->{_master_setpgrp};

	local $SIG{__DIE__};
        eval { exec @call };
        POSIX::_exit(255);
    }
    $self->{_pid} = $pid;
    1;
}

sub _master_check {
    my ($self, $async) = @_;
    my $error;
    if ($async) {
        if (-S $self->{_ctl_path}) {
            delete $self->{_master_pty_log};
            return 1
        }
        $error = "master SSH connection broken";
    }
    else {
        my $out = $self->_master_ctl('check');
        $error = $self->{_error};
        unless ($error) {
            my $pid = $self->{_pid};
            if ($out =~ /pid=(\d+)/) {
                if (!$pid or $1 == $pid) {
                    delete $self->{_master_pty_log};
                    return 1;
                }
                $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');
            }
        }
    }
    $self->_master_fail($async, $error);
}

sub _master_fail {
    my $self = shift;
    my $async = shift;
    if ($self->{_error} != OSSH_MASTER_FAILED) {
        $self->_set_error(OSSH_MASTER_FAILED, @_);
    }
    $self->_master_jump_state($self->{_pid} ? _STATE_KILLING : _STATE_GONE, $async);
}

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 _master_wait {
    my ($self, $async) = @_;

    my $pid = $self->_my_master_pid;
    if ($pid) {
	my $deceased = waitpid($pid, WNOHANG);
        if ($deceased == $pid or ($deceased < 0 and $! == Errno::ECHILD())) {
            $debug and $debug & 4 and _debug "master $pid exited, rc:", $?,", err: ",$!;
            return $self->_master_gone($async);
        }
    }

    if ($self->{_master_state} == _STATE_RUNNING) {
        return 1 if -S $self->{_ctl_path};
        return $self->_master_fail($async, "master SSH connection broken");
    }

    if ($self->{_master_state} == _STATE_KILLING) {
        $debug and $debug & 4 and _debug "killing master";
        return $self->_master_kill($async);
    }

    if ($self->{_master_state} == _STATE_START) {
        if ($self->{_external_master}) {
            return ($self->_master_jump_state(_STATE_RUNNING, $async) and
                    $self->_master_check($async))
        }

        $self->_master_start($async) or return;
        if ($self->{_mpty}) {
            $self->{_wfm_bout} = '';
            $self->{_master_pty_log} = '';
            if (defined $self->{_passwd} or $self->{_login_handler}) {
                return $self->_master_jump_state(_STATE_LOGIN, $async);
            }
        }
        return $self->_master_jump_state(_STATE_AWAITING_MUX, $async);
    }

    if ($self->{_master_state} == _STATE_GONE) {
	if (my $mpty = delete $self->{_mpty}) {
	    close($mpty)
	}
	return 0;
    }
    if ($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 ($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
            POSIX::tcsetpgrp(0, $pid);
        }
        else {
            undef $old_tcpgrp;
        }
    }

    my $mpty = $self->{_mpty};
    my $fnopty;
    my $rv = '';
    if ($mpty and
        ( $self->{_master_state} == _STATE_LOGIN or
          $self->{_master_state} == _STATE_AWAITING_MUX )) {
        $fnopty = fileno $mpty;
        vec($rv, $fnopty, 1) = 1
    }

    my $timeout = $self->{_timeout};
    my $dt = ($async ? 0 : 0.02);
    my $start_time = time;
    my $error;

    # Loop until the mux socket appears or something goes wrong:
    while (1) {
        $dt *= 1.10 if $dt < 0.2; # adaptative delay
        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 $self->{_ctl_path}, state:", $self->{_master_state};

        if (defined $timeout and (time - $start_time) > $timeout) {
            $error = "login timeout";
            last;
        }

	my $deceased = waitpid($pid, WNOHANG);
        if ($deceased == $pid or ($deceased < 0 and $! == Errno::ECHILD())) {
            $error = "master process exited unexpectedly";
            $error = "bad pass" . ($self->{_passphrase} ? 'phrase' : 'word') . " or $error"
                if defined $self->{_passwd};
            delete $self->{_pid};
            last;
        }

        if ($self->{_login_handler} and $self->{_master_state} == _STATE_LOGIN) {
            local ($@, $SIG{__DIE__});
            if (eval { $self->{_login_handler}->($self, $mpty, \$self->{_wfm_bout}) }) {
                $self->{_master_state} = _STATE_AWAITING_MUX;
                next;
            }
            if ($@) {
                $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, $self->{_wfm_bout}, 4096, length $self->{_wfm_bout});
                if ($read) {
                    $self->{_master_pty_log} .= substr($self->{_wfm_bout}, -$read);
                    if ((my $remove = length($self->{_master_pty_log}) - 4096) > 0) {
                        substr($self->{_master_pty_log}, 0, $remove) = ''
                    }

                    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 in the '~/.ssh/known_hosts' file";
                        last;
                    }

                    if ($self->{_wfm_bout} =~ /WARNING: REMOTE HOST IDENTIFICATION HAS CHANGED/si) {
                        $error = "the authenticity of the target host can't be established; the remote host " .
                            "public key doesn't match the one stored locally";
                        last;
                    }

                    my $passwd_prompt = _first_defined $self->{_passwd_prompt}, qr/[:?]/;
                    $passwd_prompt = quotemeta $passwd_prompt unless ref $passwd_prompt;

                    if ($self->{_master_state} == _STATE_LOGIN) {
                        if ($self->{_wfm_bout} =~ /^(.*$passwd_prompt)/s) {
                            $debug and $debug & 4 and _debug "passwd/passphrase requested ($1)";
                            print $mpty $deobfuscate->($self->{_passwd}) . "\n";
                            $self->{_wfm_bout} = ''; # reset
                            $self->{_master_state} = _STATE_AWAITING_MUX;
                        }
                    }
                    elsif (length($passwd_prompt) and $self->{_wfm_bout} =~ /^(.*$passwd_prompt)\s*$/s) {
                        $debug and $debug & 4 and _debug "passwd/passphrase requested again ($1)";
                        $error = "password authentication failed";
                        last;
                    }
                    next; # skip delay
                }
            }
        }
        return if $async;
        select(undef, undef, undef, $dt);
    }

    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);
    }

    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 = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $cmd = shift;

    local $?;
    local $self->{_error_prefix} = [@{$self->{_error_prefix}},
                                    "control command failed"];
    $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 {
    my ($self, $timeout) = @_;
    my $pid = $self->{_pid};
    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);
    }
}

sub _make_pipe {
    my $self = shift;
    my ($r, $w);
    if (pipe $r, $w) {
        my $old = select;
        select $r; $ |= 1;
        select $w; $ |= 1;
        select $old;
        return ($r, $w);
    }
    $self->_set_error(OSSH_SLAVE_PIPE_FAILED, "unable to create pipe: $!");
    return;
}

sub _remote_quoter {
    my ($self, $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);
}

sub _quote_args {
    my $self = shift;
    my $opts = shift;
    ref $opts eq 'HASH' or die "internal error";
    my $quote = delete $opts->{quote_args};
    my $quote_extended = delete $opts->{quote_args_extended};
    my $glob_quoting = delete $opts->{glob_quoting};
    $quote = (@_ > 1) unless defined $quote;

    if ($quote) {
        my $remote_shell = delete $opts->{remote_shell};
        my $quoter = $self->_remote_quoter($remote_shell);
        my $quote_method = ($glob_quoting ? 'quote_glob' : 'quote');
	# foo   => $quoter
	# \foo  => $quoter_glob
	# \\foo => no quoting at all and disable extended quoting as it is not safe
	my @quoted;
	for (@_) {
	    if (ref $_) {
		if (ref $_ eq 'SCALAR') {
		    push @quoted, $quoter->quote_glob($self->_expand_vars($$_));
		}
		elsif (ref $_ eq 'REF' and ref $$_ eq 'SCALAR') {
		    push @quoted, $self->_expand_vars($$$_);
		    undef $quote_extended;
		}
		else {
		    croak "invalid reference in remote command argument list"
		}
	    }
	    else {
		push @quoted, $quoter->$quote_method($self->_expand_vars($_));
	    }
	}

	if ($quote_extended) {
            my @fragments;
            if ( $opts->{stdout_discard} and
                 ( $opts->{stderr_discard} or $opts->{stderr_to_stdout} ) ) {
                @fragments = ('stdout_and_stderr_discard');
                push @fragments, 'stdin_discard' if $opts->{stdin_discard};
            }
            else {
                @fragments = grep $opts->{$_}, qw(stdin_discard stdout_discard
                                                  stderr_discard stderr_to_stdout);
            }
            push @quoted, $quoter->shell_fragments(@fragments);
	}
	wantarray ? @quoted : join(" ", @quoted);
    }
    else {
	croak "reference found in argument list when argument quoting is disabled"
	    if (grep ref, @_);

	my @args = $self->_expand_vars(@_);
	wantarray ? @args : join(" ", @args);
    }
}

sub shell_quote {
    shift->_quote_args({quote_args => 1}, @_);
}

sub shell_quote_glob {
    shift->_quote_args({quote_args => 1, glob_quoting => 1}, @_);
}

sub _array_or_scalar_to_list { map { defined($_) ? (ref $_ eq 'ARRAY' ? @$_ : $_ ) : () } @_ }

sub make_remote_command {
    my $self = shift;
    $self->wait_for_master or return;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my @ssh_opts = _array_or_scalar_to_list delete $opts{ssh_opts};
    my $tty = delete $opts{tty};
    my $ssh_flags = '';
    $ssh_flags .= ($tty ? 'qtt' : 'T') if defined $tty;
    if ($self->{_forward_agent}) {
	my $forward_always = (($self->{_forward_agent} eq 'always') ? 1 : undef);
        my $forward_agent = _first_defined(delete($opts{forward_agent}), $forward_always);
        $ssh_flags .= ($forward_agent ? 'A' : 'a') if defined $forward_agent;
    }
    if ($self->{_forward_X11}) {
        my $forward_X11 = delete $opts{forward_X11};
        $ssh_flags .= ($forward_X11 ? 'X' : 'x');
    }
    my $tunnel = delete $opts{tunnel};
    my (@args);
    if ($tunnel) {
        push @ssh_opts, $self->_make_W_option(@_);
    }
    else {
        my $subsystem = delete $opts{subsystem};
        if ($subsystem) {
            push @ssh_opts, '-s';
            @_ == 1 or croak "wrong number of arguments for subsystem command";
        }
        @args = $self->_quote_args(\%opts, @_);
    }
    _croak_bad_options %opts;

    push @ssh_opts, "-$ssh_flags" if length $ssh_flags;
    my @call = $self->_make_ssh_call(\@ssh_opts, @args);
    if (wantarray) {
	$debug and $debug & 16 and _debug_dump make_remote_command => \@call;
	return @call;
    }
    else {
	my $call = join ' ', $self->shell_quote(@call);
	$debug and $debug & 16 and _debug_dump 'make_remote_command (quoted)' => $call;
	return $call
    }
}

sub _open_file {
    my ($self, $default_mode, $name_or_args) = @_;
    my ($mode, @args) = (ref $name_or_args
			 ? @$name_or_args
			 : ($default_mode, $name_or_args));
    @args = $self->_expand_vars(@args);
    if (open my $fh, $mode, @args) {
	return $fh;
    }
    else {
	$self->_set_error(OSSH_SLAVE_PIPE_FAILED,
			  "Unable to open file '$args[0]': $!");
	return undef;
    }
}

sub _fileno_dup_over {
    my ($good_fn, $fh) = @_;
    if (defined $fh) {
        my $fn = fileno $fh;
        for (1..5) {
            $fn >= $good_fn and return $fn;
            $fn = POSIX::dup($fn);
        }
        POSIX::_exit(255);
    }
    undef;
}

sub _exec_dpipe {
    my ($self, $cmd, $io, $err) = @_;
    my $io_fd  = _fileno_dup_over(3 => $io);
    my $err_fd = _fileno_dup_over(3 => $err);
    POSIX::dup2($io_fd, 0);
    POSIX::dup2($io_fd, 1);
    POSIX::dup2($err_fd, 2) if defined $err_fd;
    if (ref $cmd) {
        exec @$cmd;
    }
    else {
        exec $cmd;
    }
}

sub _delete_stream_encoding {
    my ($self, $opts) = @_;
    _first_defined(delete $opts->{stream_encoding},
                   $opts->{encoding},
                   $self->{_default_stream_encoding});
}

sub _delete_argument_encoding {
    my ($self, $opts) = @_;
    _first_defined(delete $opts->{argument_encoding},
                   delete $opts->{encoding},
                   $self->{_default_argument_encoding});
}

sub open_ex {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    unless (delete $opts{_no_master_required}) {
        $self->wait_for_master or return;
    }

    my $ssh_flags = '';
    my $tunnel = delete $opts{tunnel};
    my ($cmd, $close_slave_pty, @args);
    if ($tunnel) {
	@args = @_;
    }
    else {
        my $argument_encoding = $self->_delete_argument_encoding(\%opts);
	my $tty = delete $opts{tty};
	$ssh_flags .= ($tty ? 'qtt' : 'T') if defined $tty;

	$cmd = delete $opts{_cmd} || 'ssh';
	$opts{quote_args_extended} = 1
	    if (not defined $opts{quote_args_extended} and $cmd eq 'ssh');
        @args = $self->_quote_args(\%opts, @_);
        $self->_encode_args($argument_encoding, @args) or return;
    }

    my ($stdinout_socket, $stdinout_dpipe_make_parent);
    my $stdinout_dpipe = delete $opts{stdinout_dpipe};
    if ($stdinout_dpipe) {
        $stdinout_dpipe_make_parent = delete $opts{stdinout_dpipe_make_parent};
        $stdinout_socket = 1;
    }
    else {
        $stdinout_socket = delete $opts{stdinout_socket};
    }

    my ($stdin_discard, $stdin_pipe, $stdin_fh, $stdin_file, $stdin_pty,
        $stdout_discard, $stdout_pipe, $stdout_fh, $stdout_file, $stdout_pty,
        $stderr_discard, $stderr_pipe, $stderr_fh, $stderr_file, $stderr_to_stdout);
    unless ($stdinout_socket) {
        unless ($stdin_discard = delete $opts{stdin_discard} or
                $stdin_pipe = delete $opts{stdin_pipe} or
                $stdin_fh = delete $opts{stdin_fh} or
                $stdin_file = delete $opts{stdin_file}) {
            unless ($tunnel) {
                if ($stdin_pty = delete $opts{stdin_pty}) {
                    $close_slave_pty = _first_defined delete $opts{close_slave_pty}, 1;
                }
            }
        }

        ( $stdout_discard = delete $opts{stdout_discard} or
          $stdout_pipe = delete $opts{stdout_pipe} or
          $stdout_fh = delete $opts{stdout_fh} or
          $stdout_file = delete $opts{stdout_file} or
          (not $tunnel and $stdout_pty = delete $opts{stdout_pty}) );

        $stdout_pty and !$stdin_pty
            and croak "option stdout_pty requires stdin_pty set";
    }

    ( $stderr_discard = delete $opts{stderr_discard} or
      $stderr_pipe = delete $opts{stderr_pipe} or
      $stderr_fh = delete $opts{stderr_fh} or
      $stderr_to_stdout = delete $opts{stderr_to_stdout} or
      $stderr_file = delete $opts{stderr_file} );

    my $ssh_opts = delete $opts{ssh_opts};
    $ssh_opts = $self->{_default_ssh_opts} unless defined $ssh_opts;
    my @ssh_opts = $self->_expand_vars(_array_or_scalar_to_list $ssh_opts);
    if ($self->{_forward_agent}) {
	my $forward_always = (($self->{_forward_agent} eq 'always') ? 1 : undef);
        my $forward_agent = _first_defined(delete($opts{forward_agent}), $forward_always);
        $ssh_flags .= ($forward_agent ? 'A' : 'a') if defined $forward_agent;
    }
    if ($self->{_forward_X11}) {
        my $forward_X11 = delete $opts{forward_X11};
        $ssh_flags .= ($forward_X11 ? 'X' : 'x');
    }
    if (delete $opts{subsystem}) {
        $ssh_flags .= 's';
    }

    my $setpgrp = delete $opts{setpgrp};
    undef $setpgrp if defined $stdin_pty;

    _croak_bad_options %opts;

    if (defined $stdin_file) {
	$stdin_fh = $self->_open_file('<', $stdin_file) or return
    }
    if (defined $stdout_file) {
	$stdout_fh = $self->_open_file('>', $stdout_file) or return
    }
    if (defined $stderr_file) {
	$stderr_fh = $self->_open_file('>', $stderr_file) or return
    }

    my ($rin, $win, $rout, $wout, $rerr, $werr);

    if ($stdinout_socket) {
        unless(socketpair $rin, $win, AF_UNIX, SOCK_STREAM, PF_UNSPEC) {
            $self->_set_error(OSSH_SLAVE_PIPE_FAILED, "socketpair failed: $!");
            return;
        }
        $wout = $rin;
    }
    else {
        if ($stdin_pipe) {
            ($rin, $win) = $self->_make_pipe or return;
        }
        elsif ($stdin_pty) {
            _load_module('IO::Pty');
            $win = IO::Pty->new;
            unless ($win) {
                $self->_set_error(OSSH_SLAVE_PIPE_FAILED, "unable to allocate pseudo-tty: $!");
                return;
            }
            $rin = $win->slave;
        }
        elsif (defined $stdin_fh) {
            $rin = $stdin_fh;
        }
        else {
            $rin = $self->{_default_stdin_fh}
        }
        _check_is_system_fh STDIN => $rin;

        if ($stdout_pipe) {
            ($rout, $wout) = $self->_make_pipe or return;
        }
        elsif ($stdout_pty) {
            $wout = $rin;
        }
        elsif (defined $stdout_fh) {
            $wout = $stdout_fh;
        }
        else {
            $wout = $self->{_default_stdout_fh};
        }
        _check_is_system_fh STDOUT => $wout;
    }

    unless ($stderr_to_stdout) {
	if ($stderr_pipe) {
	    ($rerr, $werr) = $self->_make_pipe or return;
	}
	elsif (defined $stderr_fh) {
	    $werr = $stderr_fh;
	}
	else {
	    $werr = $self->{_default_stderr_fh};
	}
	_check_is_system_fh STDERR => $werr;
    }

    push @ssh_opts, "-$ssh_flags" if length $ssh_flags;

    my @call = ( $tunnel         ? $self->_make_tunnel_call(\@ssh_opts, @args) :
                 $cmd eq 'ssh'   ? $self->_make_ssh_call(\@ssh_opts, @args)    :
		 $cmd eq 'scp'   ? $self->_make_scp_call(\@ssh_opts, @args)    :
		 $cmd eq 'rsync' ? $self->_make_rsync_call(\@ssh_opts, @args)  :
                 $cmd eq 'raw'   ? @args                                       :
		 die "Internal error: bad _cmd protocol" );

    $debug and $debug & 16 and _debug_dump open_ex => \@call;

    my $pid = fork;
    unless ($pid) {
        unless (defined $pid) {
            $self->_set_error(OSSH_SLAVE_FAILED,
                              "unable to fork new ssh slave: $!");
            return;
        }

        setpgrp if $setpgrp;

        $stdin_discard  and (open $rin,  '<', '/dev/null' or POSIX::_exit(255));
        $stdout_discard and (open $wout, '>', '/dev/null' or POSIX::_exit(255));
        $stderr_discard and (open $werr, '>', '/dev/null' or POSIX::_exit(255));

        if ($stdinout_dpipe) {
            my $pid1 = fork;
            defined $pid1 or POSIX::_exit(255);

            unless ($pid1 xor $stdinout_dpipe_make_parent) {
                eval { $self->_exec_dpipe($stdinout_dpipe, $win, $werr) };
                POSIX::_exit(255);
            }
        }

        my $rin_fd  = _fileno_dup_over(0 => $rin);
        my $wout_fd = _fileno_dup_over(1 => $wout);
        my $werr_fd = _fileno_dup_over(2 => $werr);

        if (defined $rin_fd) {
            $win->make_slave_controlling_terminal if $stdin_pty;
	    $rin_fd == 0 or POSIX::dup2($rin_fd, 0) or POSIX::_exit(255);
        }
	if (defined $wout_fd) {
            $wout_fd == 1 or POSIX::dup2($wout_fd, 1) or POSIX::_exit(255);
        }
        if (defined $werr_fd) {
            $werr_fd == 2 or POSIX::dup2($werr_fd, 2) or POSIX::_exit(255);
        }
        elsif ($stderr_to_stdout) {
            POSIX::dup2(1, 2) or POSIX::_exit(255);
        }
        do { exec @call };
        POSIX::_exit(255);
    }
    $win->close_slave() if $close_slave_pty;
    undef $win if defined $stdinout_dpipe;
    wantarray ? ($win, $rout, $rerr, $pid) : $pid;
}

sub pipe_in {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    $self->wait_for_master or return;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $argument_encoding = $self->_delete_argument_encoding(\%opts);
    my @args = $self->_quote_args(\%opts, @_);
    _croak_bad_options %opts;

    $self->_encode_args($argument_encoding, @args) or return;
    my @call = $self->_make_ssh_call([], @args);
    $debug and $debug & 16 and _debug_dump pipe_in => @call;
    my $pid = open my $rin, '|-', @call;
    unless ($pid) {
        $self->_set_error(OSSH_SLAVE_FAILED,
                          "unable to fork new ssh slave: $!");
        return;
    }
    wantarray ? ($rin, $pid) : $rin;
}

sub pipe_out {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    $self->wait_for_master or return;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $argument_encoding = $self->_delete_argument_encoding(\%opts);
    my @args = $self->_quote_args(\%opts, @_);
    _croak_bad_options %opts;

    $self->_encode_args($argument_encoding, @args) or return;
    my @call = $self->_make_ssh_call([], @args);
    $debug and $debug & 16 and _debug_dump pipe_out => @call;
    my $pid = open my $rout, '-|', @call;
    unless ($pid) {
        $self->_set_error(OSSH_SLAVE_FAILED,
                          "unable to fork new ssh slave: $!");
        return;
    }
    wantarray ? ($rout, $pid) : $rout;
}

sub _find_encoding {
    my ($self, $encoding, $data) = @_;
    if (defined $encoding and $encoding ne 'bytes') {
	_load_module('Encode');
        my $enc = Encode::find_encoding($encoding);
        unless (defined $enc) {
            $self->_set_error(OSSH_ENCODING_ERROR, "bad encoding '$encoding'");
            return
        }
        return $enc
    }
    return undef
}

sub _encode {
    my $self = shift;
    my $enc = shift;
    if (defined $enc and @_) {
        local ($@, $SIG{__DIE__});
        eval {
            for (@_) {
                defined or next;
                $_ = $enc->encode($_, Encode::FB_CROAK());
            }
        };
        $self->_check_eval_ok(OSSH_ENCODING_ERROR) or return undef;
    }
    1;
}

sub _encode_args {
    if (@_ > 2) {
        my $self = shift;
        my $encoding = shift;

        my $enc = $self->_find_encoding($encoding);
        if ($enc) {
            local $self->{_error_prefix} = [@{$self->{_error_prefix}}, "argument encoding failed"];
            $self->_encode($enc, @_);
        }
        return !$self->{_error};
    }
    1;
}

sub _decode {
    my $self = shift;
    my $enc = shift;
    local ($@, $SIG{__DIE__});
    eval {
        for (@_) {
            defined or next;
            $_ = $enc->decode($_, Encode::FB_CROAK());
        }
    };
    $self->_check_eval_ok(OSSH_ENCODING_ERROR);
}

my @retriable = (Errno::EINTR(), Errno::EAGAIN());
push @retriable, Errno::EWOULDBLOCK() if Errno::EWOULDBLOCK() != Errno::EAGAIN();

sub _io3 {
    my ($self, $out, $err, $in, $stdin_data, $timeout, $encoding, $keep_in_open) = @_;
    # $self->wait_for_master or return;
    my @data = _array_or_scalar_to_list $stdin_data;
    my ($cout, $cerr, $cin) = (defined($out), defined($err), defined($in));
    $timeout = $self->{_timeout} unless defined $timeout;

    my $has_input = grep { defined and length } @data;
    if ($cin and !$has_input) {
        close $in unless $keep_in_open;
        undef $cin;
    }
    elsif (!$cin and $has_input) {
        croak "remote input channel is not defined but data is available for sending"
    }

    my $enc = $self->_find_encoding($encoding);
    if ($enc and @data) {
        local $self->{_error_prefix} = [@{$self->{_error_prefix}}, "stdin data encoding failed"];
        $self->_encode($enc, @data) if $has_input;
        return if $self->{_error};
    }

    my $bout = '';
    my $berr = '';
    my ($fnoout, $fnoerr, $fnoin);
    local $SIG{PIPE} = 'IGNORE';

 MLOOP: while ($cout or $cerr or $cin) {
        $debug and $debug & 64 and _debug "io3 mloop, cin: " . ($cin || 0) .
            ", cout: " . ($cout || 0) . ", cerr: " . ($cerr || 0);
        my ($rv, $wv);

        if ($cout or $cerr) {
            $rv = '';
            if ($cout) {
                $fnoout = fileno $out;
                vec($rv, $fnoout, 1) = 1;
            }
            if ($cerr) {
                $fnoerr = fileno $err;
                vec($rv, $fnoerr, 1) = 1
            }
        }

        if ($cin) {
            $fnoin = fileno $in;
            $wv = '';
            vec($wv, $fnoin, 1) = 1;
        }

        my $recalc_vecs;
    FAST: until ($recalc_vecs) {
            $debug and $debug & 64 and
                _debug "io3 fast, cin: " . ($cin || 0) .
                    ", cout: " . ($cout || 0) . ", cerr: " . ($cerr || 0);
            my ($rv1, $wv1) = ($rv, $wv);
            my $n = select ($rv1, $wv1, undef, $timeout);
            if ($n > 0) {
                if ($cout and vec($rv1, $fnoout, 1)) {
                    my $offset = length $bout;
                    my $read = sysread($out, $bout, 20480, $offset);
                    if ($debug and $debug & 64) {
                        _debug "stdout, bytes read: ", $read, " at offset $offset";
                        $read and $debug & 128 and _hexdump substr $bout, $offset;
                    }
                    unless ($read or grep $! == $_, @retriable) {
                        close $out;
                        undef $cout;
                        $recalc_vecs = 1;
                    }
                }
                if ($cerr and vec($rv1, $fnoerr, 1)) {
                    my $read = sysread($err, $berr, 20480, length($berr));
                    $debug and $debug & 64 and _debug "stderr, bytes read: ", $read;
                    unless ($read or grep $! == $_, @retriable) {
                        close $err;
                        undef $cerr;
                        $recalc_vecs = 1;
                    }
                }
                if ($cin and vec($wv1, $fnoin, 1)) {
                    my $written = syswrite($in, $data[0], 20480);
                    if ($debug and $debug & 64) {
                        _debug "stdin, bytes written: ", $written;
                        $written and $debug & 128 and _hexdump substr $data[0], 0, $written;
                    }
                    if ($written) {
                        substr($data[0], 0, $written, '');
                        while (@data) {
                            next FAST
                                if (defined $data[0] and length $data[0]);
                            shift @data;
                        }
                        # fallback when stdin queue is exhausted
                    }
                    elsif (grep $! == $_, @retriable) {
                        next FAST;
                    }
                    close $in unless $keep_in_open;
                    undef $cin;
                    $recalc_vecs = 1;
                }
            }
            else {
                next if $n < 0 and grep $! == $_, @retriable;
                $self->_set_error(OSSH_SLAVE_TIMEOUT, 'ssh slave failed', 'timed out');
                last MLOOP;
            }
        }
    }
    close $out if $cout;
    close $err if $cerr;
    close $in if $cin and not $keep_in_open;

    if ($enc) {
        local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'output decoding failed'];
        unless ($self->_decode($enc, $bout, $berr)) {
            undef $bout;
            undef $berr;
        }
    }
    $debug and $debug & 64 and _debug "leaving _io3()";
    return ($bout, $berr);
}



_sub_options spawn => qw(stderr_to_stdout stdin_discard stdin_fh stdin_file stdout_discard stdout_fh
                         stdout_file stderr_discard stderr_fh stderr_file stdinout_dpipe
                         stdinout_dpipe_make_parent quote_args quote_args_extended remote_shell
                         glob_quoting tty ssh_opts tunnel encoding argument_encoding forward_agent
                         forward_X11 setpgrp subsystem);
sub spawn {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts =  (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;

    return scalar $self->open_ex(\%opts, @_);
}

_sub_options open2 => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file quote_args quote_args_extended
                         remote_shell glob_quoting tty ssh_opts tunnel encoding argument_encoding forward_agent
                         forward_X11 setpgrp subsystem);
sub open2 {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;
    _croak_scalar_context;

    my ($in, $out, undef, $pid) =
        $self->open_ex({ stdout_pipe => 1,
                         stdin_pipe => 1,
                         %opts }, @_) or return ();
    return ($in, $out, $pid);
}

_sub_options open2pty => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file
                            quote_args quote_args_extended remote_shell glob_quoting tty
                            close_slave_pty ssh_opts encoding argument_encoding forward_agent
                            forward_X11 setpgrp subsystem);
sub open2pty {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;

    my ($pty, undef, undef, $pid) =
        $self->open_ex({ stdout_pty => 1,
                         stdin_pty => 1,
			 tty => 1,
                       %opts }, @_) or return ();
    wantarray ? ($pty, $pid) : $pty;
}

_sub_options open2socket => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file
                               quote_args quote_args_extended remote_shell glob_quoting tty
                               ssh_opts tunnel encoding argument_encoding forward_agent
                               forward_X11 setpgrp subsystem);
sub open2socket {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;

    my ($socket, undef, undef, $pid) =
        $self->open_ex({ stdinout_socket => 1,
                         %opts }, @_) or return ();
    wantarray ? ($socket, $pid) : $socket;
}

_sub_options open3 => qw(quote_args quote_args_extended remote_shell glob_quoting tty ssh_opts
                         encoding argument_encoding forward_agent forward_X11 setpgrp subsystem);
sub open3 {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;
    _croak_scalar_context;

    my ($in, $out, $err, $pid) =
        $self->open_ex({ stdout_pipe => 1,
                         stdin_pipe => 1,
                         stderr_pipe => 1,
			 %opts },
                       @_) or return ();
    return ($in, $out, $err, $pid);
}

_sub_options open3pty => qw(quote_args quote_args_extended remote_shell glob_quoting tty close_slave_pty ssh_opts
                            encoding argument_encoding forward_agent forward_X11 setpgrp subsystem);
sub open3pty {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;
    _croak_scalar_context;

    my ($pty, undef, $err, $pid) =
        $self->open_ex({ stdout_pty => 1,
                         stdin_pty => 1,
			 tty => 1,
                         stderr_pipe => 1,
			 %opts },
                       @_) or return ();
    return ($pty, $err, $pid);
}

_sub_options open3socket => qw(quote_args quote_args_extended remote_shell glob_quoting tty ssh_opts encoding
                               argument_encoding forward_agent forward_X11 setpgrp subsystem);
sub open3socket {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;
    _croak_scalar_context;

    my ($socket, undef, $err, $pid) =
        $self->open_ex({ stdinout_socket => 1,
                         stderr_pipe => 1,
			 %opts }, @_) or return ();
    return ($socket, $err, $pid);
}

_sub_options system => qw(stdout_discard stdout_fh stdin_discard stdout_file stdin_fh stdin_file
                          quote_args quote_args_extended remote_shell glob_quoting
                          stderr_to_stdout stderr_discard stderr_fh stderr_file
                          stdinout_dpipe stdinout_dpipe_make_parent tty ssh_opts tunnel encoding
                          argument_encoding forward_agent forward_X11 setpgrp subsystem);
sub system {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $stdin_data = delete $opts{stdin_data};
    my $timeout = delete $opts{timeout};
    my $async = delete $opts{async};
    my $stdin_keep_open = ($async ? undef : delete $opts{stdin_keep_open});

    _croak_bad_options %opts;

    $stdin_data = '' if $stdin_keep_open and not defined $stdin_data;

    my $stream_encoding;
    if (defined $stdin_data) {
        $opts{stdin_pipe} = 1;
        $stream_encoding = $self->_delete_stream_encoding(\%opts);
    }

    local $SIG{INT} = 'IGNORE';
    local $SIG{QUIT} = 'IGNORE';
    local $SIG{CHLD};

    my ($in, undef, undef, $pid) = $self->open_ex(\%opts, @_) or return undef;

    $self->_io3(undef, undef, $in, $stdin_data,
                $timeout, $stream_encoding, $stdin_keep_open) if defined $stdin_data;
    return $pid if $async;
    $self->_waitpid($pid, $timeout);
}

_sub_options test => qw(stdout_discard stdout_fh stdin_discard stdout_file stdin_fh stdin_file
                        quote_args quote_args_extended remote_shell glob_quoting stderr_to_stdout
                        stderr_discard stderr_fh stderr_file stdinout_dpipe
                        stdinout_dpipe_make_parent tty ssh_opts timeout stdin_data stdin_keep_open
                        encoding stream_encoding argument_encoding forward_agent forward_X11
                        setpgrp subsystem);

sub test {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    $opts{stdout_discard} = 1 unless grep defined($opts{$_}), qw(stdout_discard stdout_fh
                                                                 stdout_file stdinout_dpipe);
    $opts{stderr_discard} = 1 unless grep defined($opts{$_}), qw(stderr_discard stderr_fh
                                                                 stderr_file stderr_to_stdout);
    _croak_bad_options %opts;

    $self->system(\%opts, @_);
    my $error = $self->{_error};
    unless ($error) {
        return 1;
    }
    if ($error == OSSH_SLAVE_CMD_FAILED) {
        $self->_set_error(0);
        return 0;
    }
    return undef;
}

_sub_options capture => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file stdin_discard
                           stdin_fh stdin_file quote_args quote_args_extended remote_shell
                           glob_quoting tty ssh_opts tunnel encoding argument_encoding forward_agent
                           forward_X11 setpgrp subsystem);
sub capture {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $stdin_data = delete $opts{stdin_data};
    my $stdin_keep_open = delete $opts{stdin_keep_open};
    my $timeout = delete $opts{timeout};
    _croak_bad_options %opts;

    $stdin_data = '' if $stdin_keep_open and not defined $stdin_data;

    my $stream_encoding = $self->_delete_stream_encoding(\%opts);
    $opts{stdout_pipe} = 1;
    $opts{stdin_pipe} = 1 if defined $stdin_data;

    local $SIG{INT} = 'IGNORE';
    local $SIG{QUIT} = 'IGNORE';
    local $SIG{CHLD};

    my ($in, $out, undef, $pid) = $self->open_ex(\%opts, @_) or return ();
    my ($output) = $self->_io3($out, undef, $in, $stdin_data,
                               $timeout, $stream_encoding, $stdin_keep_open);
    $self->_waitpid($pid, $timeout);
    if (wantarray) {
        my $pattern = quotemeta $/;
        return split /(?<=$pattern)/, $output;
    }
    $output
}

_sub_options capture2 => qw(stdin_discard stdin_fh stdin_file quote_args quote_args_extended
                            remote_shell glob_quoting tty ssh_opts encoding stream_encoding
                            argument_encoding forward_agent forward_X11 setpgrp subsystem);
sub capture2 {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $stdin_data = delete $opts{stdin_data};
    my $stdin_keep_open = delete $opts{stdin_keep_open};
    my $timeout = delete $opts{timeout};
    _croak_bad_options %opts;

    $stdin_data = '' if $stdin_keep_open and not defined $stdin_data;

    my $stream_encoding = $self->_delete_stream_encoding(\%opts);
    $opts{stdout_pipe} = 1;
    $opts{stderr_pipe} = 1;
    $opts{stdin_pipe} = 1 if defined $stdin_data;

    local $SIG{INT} = 'IGNORE';
    local $SIG{QUIT} = 'IGNORE';
    local $SIG{CHLD};

    my ($in, $out, $err, $pid) = $self->open_ex( \%opts, @_) or return ();
    my @capture = $self->_io3($out, $err, $in, $stdin_data,
                              $timeout, $stream_encoding, $stdin_keep_open);
    $self->_waitpid($pid, $timeout);
    wantarray ? @capture : $capture[0];
}

_sub_options open_tunnel => qw(ssh_opts stderr_discard stderr_fh stderr_file
                               encoding argument_encoding forward_agent setpgrp);
sub open_tunnel {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    $opts{stderr_discard} = 1 unless grep defined $opts{$_}, qw(stderr_discard stderr_fh stderr_file);
    _croak_bad_options %opts;
    @_ == 2 or croak 'Usage: $ssh->open_tunnel(\%opts, $host, $port)';
    $opts{tunnel} = 1;
    $self->open2socket(\%opts, @_);
}

_sub_options capture_tunnel => qw(ssh_opts stderr_discard stderr_fh stderr_file stdin_discard
				  stdin_fh stdin_file stdin_data timeout encoding stream_encoding
				  argument_encoding forward_agent setpgrp);
sub capture_tunnel {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    $opts{stderr_discard} = 1 unless grep defined $opts{$_}, qw(stderr_discard stderr_fh stderr_file);
    _croak_bad_options %opts;
    @_ == 2 or croak 'Usage: $ssh->capture_tunnel(\%opts, $host, $port)';
    $opts{tunnel} = 1;
    $self->capture(\%opts, @_);
}

sub _calling_method {
    my $method = (caller 2)[3];
    $method =~ s/.*:://;
    $method;
}

sub _scp_get_args {
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());

    @_ > 0 or croak
	'Usage: $ssh->' . _calling_method . '(\%opts, $remote_fn1, $remote_fn2, ..., $local_fn_or_dir)';

    my $glob = delete $opts{glob};

    my $target = (@_ > 1 ? pop @_ : '.');
    $target =~ m|^[^/]*:| and $target = "./$target";

    my $prefix = $self->{_host_squared};
    $prefix = "$self->{_user}\@$prefix" if defined $self->{_user};

    my $src = "$prefix:". join(" ", $self->_quote_args({quote_args => 1,
                                                        glob_quoting => $glob},
                                                       @_));
    ($self, \%opts, $target, $src);
}

sub scp_get {
    ${^TAINT} and &_catch_tainted_args;
    my ($self, $opts, $target, @src) = _scp_get_args @_;
    $self->_scp($opts, @src, $target);
}

sub rsync_get {
    ${^TAINT} and &_catch_tainted_args;
    my ($self, $opts, $target, @src) = _scp_get_args @_;
    $self->_rsync($opts, @src, $target);
}

sub _scp_put_args {
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());

    @_ > 0 or croak
	'Usage: $ssh->' . _calling_method . '(\%opts, $local_fn1, $local_fn2, ..., $remote_dir_or_fn)';

    my $glob = delete $opts{glob};
    my $glob_flags = ($glob ? delete $opts{glob_flags} || 0 : undef);

    my $prefix = $self->{_host_squared};
    $prefix = "$self->{_user}\@$prefix" if defined $self->{_user};

    my $remote_shell = delete $opts{remote_shell};
    my $target = $prefix . ':' . ( @_ > 1
                                   ? $self->_quote_args({quote_args => 1, remote_shell => $remote_shell}, pop(@_))
                                   : '');

    my @src = @_;
    if ($glob) {
	require File::Glob;
	@src = map File::Glob::bsd_glob($_, $glob_flags), @src;
	unless (@src) {
	    $self->_set_error(OSSH_SLAVE_FAILED,
			      "given file name patterns did not match any file");
	    return undef;
	}
    }
    $_ = "./$_" for grep m|^[^/]*:|, @src;

    ($self, \%opts, $target, @src);
}

sub scp_put {
    ${^TAINT} and &_catch_tainted_args;
    my ($self, $opts, $target, @src) = _scp_put_args @_;
    return unless $self;
    $self->_scp($opts, @src, $target);
}

sub rsync_put {
    ${^TAINT} and &_catch_tainted_args;
    my ($self, $opts, $target, @src) = _scp_put_args @_;
    return unless $self;
    $self->_rsync($opts, @src, $target);
}

_sub_options _scp => qw(stderr_to_stdout stderr_discard stderr_fh
			stderr_file stdout_discard stdout_fh
			stdout_file encoding argument_encoding
                        forward_agent setpgrp);
sub _scp {
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $quiet = delete $opts{quiet};
    $quiet = 1 unless defined $quiet;
    my $recursive = delete $opts{recursive};
    my $copy_attrs = delete $opts{copy_attrs};
    my $bwlimit = delete $opts{bwlimit};
    my $async = delete $opts{async};
    my $ssh_opts = delete $opts{ssh_opts};
    my $timeout = delete $opts{timeout};
    my $verbose = delete $opts{verbose};
    _croak_bad_options %opts;

    my @opts;
    @opts = @$ssh_opts if $ssh_opts;
    push @opts, '-q' if $quiet;
    push @opts, '-v' if $verbose;
    push @opts, '-r' if $recursive;
    push @opts, '-p' if $copy_attrs;
    push @opts, '-l', $bwlimit if $bwlimit;

    local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'scp failed'];

    my $pid = $self->open_ex({ %opts,
                               _cmd => 'scp',
			       ssh_opts => \@opts,
			       quote_args => 0 },
			     @_);

    return $pid if $async;
    $self->_waitpid($pid, $timeout);
}

my %rsync_opt_with_arg = map { $_ => 1 } qw(chmod suffix backup-dir rsync-path max-delete max-size min-size partial-dir
                                            timeout modify-window temp-dir compare-dest copy-dest link-dest compress-level
                                            skip-compress filter exclude exclude-from include include-from
                                            out-format log-file log-file-format bwlimit protocol iconv checksum-seed files-from);

my %rsync_opt_forbidden = map { $_ => 1 } qw(rsh address port sockopts password-file write-batch
                                            only-write-batch read-batch ipv4 ipv6 version help daemon config detach
                                            protect-args list-only);

$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',
		   3, 'errors selecting input/output files, dirs',
		   4, 'requested action not supported: an attempt was made to manipulate 64-bit files on a platform '.
                      'that  cannot  support them; or an option was specified that is supported by the client and not '.
                      'by the server.',
		   5, 'error starting client-server protocol',
		   6, 'daemon unable to append to log-file',
		   10, 'error in socket I/O',
		   11, 'error in file I/O',
		   12, 'error in rsync protocol data stream',
		   13, 'errors with program diagnostics',
		   14, 'error in IPC code',
		   20, 'received SIGUSR1 or SIGINT',
		   21, 'some error returned by waitpid()',
		   22, 'error allocating core memory buffers',
		   23, 'partial transfer due to error',
		   24, 'partial transfer due to vanished source files',
		   25, 'the --max-delete limit stopped deletions',
		   30, 'timeout in data send/receive',
		   35, 'timeout waiting for daemon connection');

my %rsync_opt_open_ex = map { $_ => 1 } qw(stderr_to_stdout
					   stderr_discard stderr_fh
					   stderr_file stdout_discard
					   stdout_fh stdout_file encoding
                                           argument_encoding);
sub _rsync {
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $async = delete $opts{async};
    my $verbose = delete $opts{verbose};
    my $quiet = delete $opts{quiet};
    my $copy_attrs = delete $opts{copy_attrs};
    my $timeout = delete $opts{timeout};
    $quiet = 1 unless (defined $quiet or $verbose);

    my @opts;
    push @opts, '-q' if $quiet;
    push @opts, '-pt' if $copy_attrs;
    push @opts, '-' . ($verbose =~ /^\d+$/ ? 'v' x $verbose : 'v') if $verbose;

    my %opts_open_ex = ( _cmd => 'rsync',
			 quote_args => 0 );

    for my $opt (keys %opts) {
	my $value = $opts{$opt};
	if (defined $value) {
	    if ($rsync_opt_open_ex{$opt}) {
		$opts_open_ex{$opt} = $value;
	    }
	    else {
		my $opt1 = $opt;
		$opt1 =~ tr/_/-/;
		$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)
		}
		else {
		    $value = !$value if $opt1 =~ s/^no-//;
		    push @opts, ($value ? "--$opt1" : "--no-$opt1");
		}
	    }
	}
    }

    local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'rsync failed'];

    my $pid = $self->open_ex(\%opts_open_ex, @opts, '--', @_);
    return $pid if $async;
    $self->_waitpid($pid, $timeout) and return 1;

    if ($self->{_error} == OSSH_SLAVE_CMD_FAILED and $?) {
	my $err = ($? >> 8);
	my $errstr = $rsync_error{$err};
	$errstr = 'Unknown rsync error' unless defined $errstr;
	my $signal = $? & 255;
	my $signalstr = ($signal ? " (signal $signal)" : '');
	$self->_set_error(OSSH_SLAVE_CMD_FAILED,
			  "command exited with code $err$signalstr: $errstr");
    }
    return undef
}

_sub_options sftp => qw(autoflush timeout argument_encoding encoding block_size queue_size autodie
			late_set_perm forward_agent setpgrp min_block_size read_ahead write_delay
			dirty_cleanup remote_has_volumes autodisconnect more);

sub sftp {
    ${^TAINT} and &_catch_tainted_args;
    @_ & 1 or croak 'Usage: $ssh->sftp(%sftp_opts)';
    _load_module('Net::SFTP::Foreign', '1.47');
    my ($self, %opts) = @_;
    my $stderr_fh = delete $opts{stderr_fh};
    my $stderr_discard = delete $opts{stderr_discard};
    my $fs_encoding = _first_defined(delete $opts{fs_encoding},
                                     $opts{argument_encoding},
                                     $opts{encoding},
                                     $self->{_default_argument_encoding});
    undef $fs_encoding if (defined $fs_encoding and $fs_encoding eq 'bytes');
    _croak_bad_options %opts;
    $opts{timeout} = $self->{_timeout} unless defined $opts{timeout};
    $self->wait_for_master or return undef;
    my ($in, $out, $pid) = $self->open2( { subsystem => 1,
					   stderr_fh => $stderr_fh,
					   stderr_discard => $stderr_discard },
					 'sftp' )
	or return undef;

    my $sftp = Net::SFTP::Foreign->new(transport => [$out, $in, $pid],
				       dirty_cleanup => 0,
                                       fs_encoding => $fs_encoding,
				       %opts);
    if ($sftp->error) {
	$self->_or_set_error(OSSH_SLAVE_SFTP_FAILED, "unable to create SFTP client", $sftp->error);
	return undef;
    }
    $sftp
}

_sub_options sshfs_import => qw(stderr_discard stderr_fh stderr_file
                                ssh_opts argument_encoding sshfs_opts setpgrp);
sub sshfs_import {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    @_ == 2 or croak 'Usage: $ssh->sshfs_import(\%opts, $remote, $local)';
    my ($from, $to) = @_;
    my @sshfs_opts = ( -o => 'slave',
                       _array_or_scalar_to_list delete $opts{sshfs_opts} );
    _croak_bad_options %opts;

    $opts{ssh_opts} = ['-s', _array_or_scalar_to_list delete $opts{ssh_opts}];
    $opts{stdinout_dpipe} = [$self->{_sshfs_cmd}, "$self->{_host_squared}:$from", $to, @sshfs_opts];
    $opts{stdinout_dpipe_make_parent} = 1;
    $self->spawn(\%opts, 'sftp');
}

_sub_options sshfs_export => qw(stderr_discard stderr_fh stderr_file
                                ssh_opts argument_encoding sshfs_opts setpgrp);
sub sshfs_export {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    @_ == 2 or croak 'Usage: $ssh->sshfs_export(\%opts, $local, $remote)';
    my ($from, $to) = @_;
    my @sshfs_opts = ( -o => 'slave',
                       _array_or_scalar_to_list delete $opts{sshfs_opts} );
    _croak_bad_options %opts;
    $opts{stdinout_dpipe} = $self->{_sftp_server_cmd};

    my $hostname = do {
        local ($@, $SIG{__DIE__});
        eval {
            require Sys::Hostname;
            Sys::Hostname::hostname();
        };
    };
    $hostname = 'remote' if (not defined $hostname   or
                             not length $hostname    or
                             $hostname=~/^localhost\b/);
    $self->spawn(\%opts, $self->{_sshfs_cmd}, "$hostname:$from", $to, @sshfs_opts);
}

sub object_remote {
    my $self = shift;
    _load_module('Object::Remote') or return;
    _load_module('Net::OpenSSH::ObjectRemote') or return;
    my $connector = Net::OpenSSH::ObjectRemote->new(net_openssh => $self);
    $connector->connect(@_);
}

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;
    $debug and $debug & 2 and _debug("DESTROY($self, pid: ", $self->{_pid}, ")");
    local ($SIG{__DIE__}, $@, $?, $!);
    $self->_disconnect;
}

1;
__END__