Net::OpenSSH - Perl SSH client package implemented on top of OpenSSH

  use Net::OpenSSH;

  my $ssh = Net::OpenSSH->new($host);
  $ssh->error and
    die "Couldn't establish SSH connection: ". $ssh->error;

  $ssh->system("ls /tmp") or
    die "remote command failed: " . $ssh->error;

  my @ls = $ssh->capture("ls");
  $ssh->error and
    die "remote ls command failed: " . $ssh->error;

  my ($out, $err) = $ssh->capture2("find /root");
  $ssh->error and
    die "remote find command failed: " . $ssh->error;

  my ($rin, $pid) = $ssh->pipe_in("cat >/tmp/foo") or
    die "pipe_in method failed: " . $ssh->error;

  print $rin, "hello\n";
  close $rin;

  my ($rout, $pid) = $ssh->pipe_out("cat /tmp/foo") or
    die "pipe_out method failed: " . $ssh->error;

  while (<$rout>) { print }
  close $rout;

  my ($in, $out ,$pid) = $ssh->open2("foo");
  my ($pty, $pid) = $ssh->open2pty("foo");
  my ($in, $out, $err, $pid) = $ssh->open3("foo");
  my ($pty, $err, $pid) = $ssh->open3pty("login");

  my $sftp = $ssh->sftp();
  $sftp->error and die "SFTP failed: " . $sftp->error;

  my $out1 = $ssh->capture(@cmd);
  my $out2 = $ssh->capture({}, @cmd);

  my ($output, $errput) = $ssh->capture2({timeout => 1}, "find /");
  $ssh->error and die "ssh failed: " . $ssh->error;

  Argument processing varies depending on the number of arguments.  If
  there is more than one argument in LIST, or if LIST is an array with
  more than one value, starts the program given by the first element
  of the list with arguments given by the rest of the list.  If there
  is only one scalar argument, the argument is checked for shell
  metacharacters, and if there are any, the entire argument is passed
  to the system's command shell for parsing (this is "/bin/sh -c" on
  Unix platforms, but varies on other platforms).

  $ssh->system("ls -l *");
  $ssh->system('ls', '-l', '/');

  $ssh->system({quote_args => 1}, "/path with spaces/bin/foo");

  $ssh->system({ stderr_discard => 1,
                 quote_args => 1, quote_args_extended => 0 },
               @cmd);

  $ssh->system({quote_args => 0}, 'ls', '-l', "/tmp/files_*.dat");

  $ssh->system({quote_args => 0},
               $ssh->shell_quote('ls', '-l'),
               "/tmp/files_*.dat");

  # quote the last argument for globing:
  $ssh->system('ls', '-l', \'/tmp/my files/filed_*dat');

  # append a redirection to the remote command
  $ssh->system('ls', '-lR', \\'>/tmp/ls-lR.txt');

  # expand remote shell variables and glob in the same command:
  $ssh->system('tar', 'czf', \\'$HOME/out.tgz', \'/var/log/server.*.log');

  $Net::OpenSSH::debug |= 16;

  # for VMS
  $ssh->system('DIR/SIZE NFOO::USERS:[JSMITH.DOCS]*.TXT;0');

  my $ssh = Net::OpenSSH->new('server.foo.com', expand_vars => 1);
  $ssh->set_var(ID => 42);
  $ssh->system("ls >/tmp/ls.out-%HOST%-%ID%");

  $ssh->system({tunnel => 1,
                stdin_data => "GET / HTTP/1.0\r\n\r\n",
                stdout_file => "/tmp/$server.res"},
               $server, 80)
      or die "unable to retrieve page: " . $ssh->error;

  my @pids;
  for (@servers) {
    my $pid = $ssh->spawn({tunnel => 1,
                           stdin_file => "/tmp/request.req",
                           stdout_file => "/tmp/$_.res"},
                          $_, 80);
    if ($pid) {
      push @pids, $pid;
    }
    else {
      warn "unable to spawn tunnel process to $_: " . $ssh->error;
    }
  }
  waitpid ($_, 0) for (@pids);

  my ($pty, $pid) = $ssh->open2pty(@cmd)
      or die "unable to run remote command @cmd";
  my $expect = Expect->init($pty);

  open my $def_in, '<', '/dev/null' or die "unable to open /dev/null";
  my $ssh = Net::OpenSSH->new($host,
                              default_stdin_fh => $def_in);

  my $out = $ssh->capture($cmd1);
  $ssh->system({stdout_discard => 1}, $cmd2);
  $ssh->system({stdout_to_file => '/tmp/output'}, $cmd3);

  use Net::OpenSSH;
  use IPC::PerlIPC;
  my $ssh = Net::OpenSSH->new(...);
  $ssh->error and die "unable to connect to remote host: " . $ssh->error;
  my @cmd = $ssh->make_remote_command('/usr/bin/perl');
  my $ipc = IPC::PerlSSH->new(Command => \@cmd);
  my @r = $ipc->eval('...');

  use GRID::Machine;
  ...
  my @cmd = $ssh->make_remote_command('/usr/bin/perl');
  my $grid = GRID::Machine->new(command => \@cmd);
  my $r = $grid->eval('print "hello world!\n"');

package Net::OpenSSH;

our $VERSION = '0.52';

use strict;
use warnings;

our $debug ||= 0;

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

sub _debug { print STDERR '# ', (map { defined($_) ? $_ : '<undef>' } @_), "\n" }

sub _debug_dump {
    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 STDERR "#> ", 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 = ( $good ? grep !$good->{$_}, keys %$opts : keys %$opts);
            if (@keys) {
                croak "Invalid or bad combination of options ('" . CORE::join("', '", @keys) . "')";
            }
        }
    }
}

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 $err = $self->{_error} = ( $code
                                  ? Scalar::Util::dualvar($code, join(': ', @{$self->{_error_prefix}},
                                                                      (@_ ? @_ : "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 new {
    ${^TAINT} and &_catch_tainted_args;
    my $class = shift;
    @_ & 1 and unshift @_, 'host';
    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;

    my ($user, $passwd, $ipv6, $host, $port, $host_ssh, $passphrase, $key_path);
    my $target = delete $opts{host};
    if (defined $target) {
        ($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_ssh) = $ipv6 =~ /^\[?(.*?)\]?$/;
            $host = "[$host_ssh]";
        }
        else {
            $host_ssh = $host;
        }
    }
    else {
        $external_master or croak "mandatory host argument missing";
        $host_ssh = 'UNKNOWN'
    }

    $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;
    unless (defined $passwd) {
        $passwd = delete $opts{passphrase};
        $passphrase = 1 if defined $passwd;
        $key_path = delete $opts{key_path};
    }
    my $ctl_path = delete $opts{ctl_path};
    my $ctl_dir = delete $opts{ctl_dir};
    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 $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 $async = delete $opts{async};
    my $target_os = _first_defined delete $opts{target_os}, 'unix';
    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 ($master_opts, @master_opts,
        $master_stdout_fh, $master_stderr_fh,
	$master_stdout_discard, $master_stderr_discard);
    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;
            }
        }
    }

    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_discard});
    $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_discard});
    $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_discard});
    $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, -o => "User=$user" if defined $user;
    push @ssh_opts, -o => "Port=$port" if defined $port;

    my $home = do {
	local $SIG{__DIE__};
	local $SIG{__WARN__};
	local $@;
	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 => $$,
                 _ssh_cmd => $ssh_cmd,
		 _scp_cmd => $scp_cmd,
		 _rsync_cmd => $rsync_cmd,
                 _pid => undef,
                 _host => $host,
		 _host_ssh => $host_ssh,
                 _user => $user,
                 _port => $port,
                 _passwd => $obfuscate->($passwd),
                 _passphrase => $passphrase,
                 _key_path => $key_path,
                 _timeout => $timeout,
                 _kill_ssh_on_timeout => $kill_ssh_on_timeout,
                 _home => $home,
                 _external_master => $external_master,
		 _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,
		 _target_os => $target_os,
                 _default_stream_encoding => $default_stream_encoding,
                 _default_argument_encoding => $default_argument_encoding,
		 _expand_vars => $expand_vars,
		 _vars => $vars };
    bless $self, $class;

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

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

    unless (defined $ctl_path) {
        $external_master and croak "external_master is set but ctl_path is not defined";

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

	my $old_umask = umask 077;
        mkdir $ctl_dir;
	umask $old_umask;
        unless (-d $ctl_dir) {
            $self->_set_error(OSSH_MASTER_FAILED, "unable to create ctl_dir $ctl_dir");
            return $self;
        }

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

        for (1..10) {
            $ctl_path = File::Spec->join($ctl_dir, sprintf("%s-%d-%d", substr($target, 0, 20), $$, rand(1e6)));
            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");
            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->_set_error(OSSH_MASTER_FAILED, "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;
}

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 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 _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));
        return 1 if (defined $home and $home eq $dir);
    }
    return 1;
}

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_ssh},
                (@_ ? "@_" : ()));
    $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}",
                @{$self->{_ssh_opts}}, '--', @_);

    $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/%/%%/;
    }
    @args
}

sub _make_rsync_call {
    my $self = shift;
    my $before = shift;
    my @ssh_args = $self->_make_ssh_call($before);
    pop @ssh_args; # rsync adds the target host itself
    my $transport = join(' ', $self->_rsync_quote(@ssh_args));
    my @args = ( $self->{_rsync_cmd},
		 -e => $transport,
		 @_);

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

sub _make_tunnel_call {
    @_ == 4 or croak "bad number of arguments for creating a tunnel";
    my $self = shift;
    my @before = @{shift||[]};
    my $dest = join(':', @_);
    push @before, "-W$dest";
    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;
    my $pid = delete $self->{_pid};
    delete $self->{_wfm_status};
    $self->_set_error(OSSH_MASTER_FAILED, "master ssh connection broken");
    undef;
}

sub _kill_master {
    my $self = shift;
    my $pid = delete $self->{_pid};
    $debug and $debug & 32 and _debug '_kill_master: ', $pid;
    if ($pid and $self->{_perl_pid} == $$) {
	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);
	    }
        }
	warn "unable to kill SSH master connection (pid: $pid)";
    }
}

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

    my $timeout = int((($self->{_timeout} || 90) + 2)/3);
    my @master_opts = (@{$self->{_master_opts}},
                       -o => "ServerAliveInterval=$timeout",
                       '-x2MN');

    my $pref_auths;
    my $mpty;
    if (defined $self->{_passwd}) {
        _load_module('IO::Pty');
        $self->{_mpty} = $mpty = IO::Pty->new;
        $pref_auths = ($self->{_passphrase}
                       ? 'publickey'
                       : 'keyboard-interactive,password');
        push @master_opts, -o => 'NumberOfPasswordPrompts=1';
    }
    if (defined $self->{_key_path}) {
        $pref_auths = 'publickey';
        push @master_opts, -i => $self->{_key_path};
    }

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

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

    local $SIG{CHLD};
    my $pid = fork;
    unless (defined $pid) {
        $self->_set_error(OSSH_MASTER_FAILED, "unable to fork ssh master: $!");
        return undef;
    }
    unless ($pid) {
        $mpty->make_slave_controlling_terminal if $mpty;

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

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

	local $SIG{__DIE__};
	local $SIG{__WARN__};
        eval { exec @call };
        POSIX::_exit(255);
    }
    $self->{_pid} = $pid;
    my $r = $self->_wait_for_master($async, 1);
    $mpty->close_slave if $mpty;
    $r;
}

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

sub wait_for_master {
    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_status};

    unless (-S $self->{_ctl_path}) {
	$self->_set_error(OSSH_MASTER_FAILED, "master ssh connection broken");
	return undef;
    }
    1;
}

sub check_master {
    my $self = shift;
    @_ and croak 'Usage: $ssh->check_master()';
    $self->{_error} = 0;
    $self->_wait_for_master;
}

sub _wait_for_master {
    my ($self, $async, $reset) = @_;

    my $status = delete $self->{_wfm_status} || 'waiting_for_mux_socket';
    my $bout = \ ($self->{_wfm_bout});

    my $mpty = $self->{_mpty};
    my $passwd = $deobfuscate->($self->{_passwd});
    my $pid = $self->{_pid};
    # an undefined pid indicates we are reusing a master connection

    if ($reset) {
        $$bout = '';
        $status = ( (defined $passwd and $pid)
                    ? 'waiting_for_password_prompt'
                    : 'waiting_for_socket' );
    }

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

    my $fnopty;
    my $rv = '';
    if ($status eq 'waiting_for_password_prompt') {
        $fnopty = fileno $mpty;
        vec($rv, $fnopty, 1) = 1
    }

    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");
                $self->_kill_master;
                return undef;
            }
            my $check = $self->_master_ctl('check');
            if (defined $check) {
                my $error;
		if ($check =~ /pid=(\d+)/) {
		    return 1 if (!$pid or $1 == $pid);
		    $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);
            }
	    $self->_kill_master;
            return undef;
        }
        $debug and $debug & 4 and _debug "file object not yet found at $ctl_path";

        if ($self->{_perl_pid} != $$) {
            $self->_set_error(OSSH_MASTER_FAILED,
                              "process was forked before SSH connection had been established");
            return undef;
        }
        if (!$pid) {
            $self->_set_error(OSSH_MASTER_FAILED,
                              "socket does not exist");
            return undef;
        }
        elsif (waitpid($pid, WNOHANG) == $pid or $! == Errno::ECHILD) {
            my $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);
            return undef;
        }
        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);
            if ($read) {
                if ($status eq 'waiting_for_password_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");
                        $self->_kill_master;
                        return undef;
                    }
                    if ($$bout =~ s/^(.*:)//s) {
                        $debug and $debug & 4 and _debug "passwd/passphrase requested ($1)";
                        print $mpty "$passwd\n";
                        $status = 'waiting_for_mux_socket';
                    }
                }
                else { $$bout = '' }
                next;
            }
            $async or select(undef, undef, undef, $dt);
        }
        if ($async) {
            $self->{_wfm_status} = $status;
            return 0;
        }
    }
    $self->_set_error(OSSH_MASTER_FAILED, "login timeout");
    $self->_kill_master;
    undef;
}

sub _master_ctl {
    my ($self, $cmd) = @_;
    local $self->{_error_prefix} = [@{$self->{_error_prefix}},
                                    "control command failed"];
    $self->capture({ encoding => 'bytes', # don't let the encoding
					  # stuff go in the way
		     stdin_discard => 1, tty => 0,
                     stderr_to_stdout => 1, ssh_opts => [-O => $cmd]});
}

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

my %loaded_module;
sub _load_module {
    my ($module, $version) = @_;
    $loaded_module{$module} ||= do {
	do {
	    local $SIG{__DIE__};
	    local $SIG{__WARN__};
	    local $@;
	    eval "require $module; 1"
	} or croak "unable to load Perl module $module";
        1
    };
    if (defined $version) {
	local $SIG{__DIE__};
	local $SIG{__WARN__};
	local $@;
	my $mv = eval "\$${module}::VERSION" || 0;
	(my $mv1 = $mv) =~ s/_\d*$//;
	croak "$module version $version required, $mv is available"
	    if $mv1 < $version;
    }
    1
}

sub _arg_quoter {
    sub {
	my $arg = shift;
	return "''" if $arg eq '';
        $arg =~ s|([^\w/\-.])|(ord($1) > 127 ? $1 : "\\$1")|ge;
        $arg
    }
}

sub _arg_quoter_glob {
    sub {
	my $arg = shift;
	return "''" if $arg eq '';
        $arg =~ s|(?<!\\)([^\w/\-+=*?\[\],{}:\@!.^\\~])|(ord($1) > 127 ? $1 : "\\$1")|ge;
	$arg;
    }
}

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 $quoter_glob = $self->_arg_quoter_glob;
	my $quoter = ($glob_quoting
		      ? $quoter_glob
		      : $self->_arg_quoter);

	# 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_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->($self->_expand_vars($_));
	    }
	}

	if ($quote_extended) {
	    push @quoted, '</dev/null' if $opts->{stdin_discard};
	    if ($opts->{stdout_discard}) {
		push @quoted, '>/dev/null';
		push @quoted, '2>&1' if ($opts->{stderr_to_stdout} || $opts->{stderr_discard})
	    }
	    else {
		push @quoted, '2>/dev/null' if $opts->{stderr_discard};
	    }
	}
	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 $tty = delete $opts{tty};
    my @ssh_opts = _array_or_scalar_to_list delete $opts{ssh_opts};
    my @args = $self->_quote_args(\%opts, @_);
    _croak_bad_options %opts;
    push @ssh_opts, ($tty ? '-qtt' : '-T') if defined $tty;
    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 @keep_open;
        my $fn = fileno $fh;
        for (1..5) {
            $fn >= $good_fn and return $fn;
            $fn = POSIX::dup($fn);
            push @keep_open, $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;
    $self->wait_for_master or return;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    my $tunnel = delete $opts{tunnel};
    my ($stdinout_socket, $stdinout_dpipe_is_parent);
    my $stdinout_dpipe = delete $opts{stdinout_dpipe};
    if ($stdinout_dpipe) {
        $stdinout_dpipe_is_parent = delete $opts{stdinout_dpipe_is_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) {
        ( $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} or
          (not $tunnel and $stdin_pty = delete $opts{stdin_pty}) );

        ( $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 $argument_encoding = $self->_delete_argument_encoding(\%opts);

    my @ssh_opts = $self->_expand_vars(_array_or_scalar_to_list delete $opts{ssh_opts});

    my ($cmd, $close_slave_pty, @args);
    if ($tunnel) {
	@_ == 2 or croak 'bad number of arguments for tunnel, use $ssh->method(\\%opts, $host, $port)';
	@args = @_;
    }
    else {
	if ($stdin_pty) {
	    $close_slave_pty = delete $opts{close_slave_pty};
	    $close_slave_pty = 1 unless defined $close_slave_pty;
	}

	my $tty = delete $opts{tty};
	push @ssh_opts, ($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;
    }

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

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

        $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_is_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;
    }
    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;
    }
    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 $@;
        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 $@;
    eval {
        for (@_) {
            defined or next;
            $_ = $enc->decode($_, Encode::FB_CROAK());
        }
    };
    $self->_check_eval_ok(OSSH_ENCODING_ERROR);
}

sub _io3 {
    my ($self, $out, $err, $in, $stdin_data, $timeout, $encoding) = @_;
    $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;
    croak "remote input channel is not defined but data is available for sending"
        if ($has_input and !$cin);
    close $in if ($cin and !$has_input);

    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) {
                        close $out;
                        undef $cout;
                        $recalc_vecs = 1;
                        last unless $rv =~ /[^\x00]/;
                    }
                }
                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) {
                        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;
                        }
                    }
                    close $in;
                    undef $cin;
                    $recalc_vecs = 1;
                }
            }
            else {
                next if ($n < 0 and $! == Errno::EINTR());
                $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;

    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 stdintout_dpipe_is_parent quote_args tty ssh_opts tunnel
                         encoding argument_encoding);
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
                         tty ssh_opts tunnel encoding argument_encoding);
sub open2 {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;

    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 tty
                            close_slave_pty ssh_opts encoding argument_encoding);
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 ();
    return ($pty, $pid);
}

_sub_options open2socket => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file quote_args tty
                               ssh_opts tunnel encoding argument_encoding);
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 ();
    return ($socket, $pid);
}

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

    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 tty close_slave_pty ssh_opts
                            encoding argument_encoding);
sub open3pty {
    ${^TAINT} and &_catch_tainted_args;
    my $self = shift;
    my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
    _croak_bad_options %opts;

    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 system => qw(stdout_discard stdout_fh stdin_discard stdout_file stdin_fh stdin_file
                          quote_args stderr_to_stdout stderr_discard stderr_fh stderr_file
                          stdinout_dpipe stdinout_dpipe_is_parent tty ssh_opts tunnel encoding
                          argument_encoding);
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};
    _croak_bad_options %opts;

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

    my $stream_encoding;
    if (defined $stdin_data) {
        $opts{stdin_pipe} = 1;
        $stream_encoding = $self->_delete_stream_encoding(\%opts);
    }
    my ($in, undef, undef, $pid) = $self->open_ex(\%opts, @_) or return undef;

    $self->_io3(undef, undef, $in, $stdin_data, $timeout, $stream_encoding) 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 stderr_to_stdout stderr_discard stderr_fh stderr_file
                        stdinout_dpipe stdinout_dpipe_is_parent stdtty ssh_opts timeout stdin_data
                        encoding stream_encoding argument_encoding);
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 tty ssh_opts tunnel
                           encoding argument_encoding);
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 $timeout = delete $opts{timeout};
    _croak_bad_options %opts;

    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);
    $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 tty ssh_opts encoding argument_encoding);
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 $timeout = delete $opts{timeout};
    _croak_bad_options %opts;

    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);
    $self->_waitpid($pid, $timeout);
    wantarray ? @capture : $capture[0];
}

_sub_options open_tunnel => qw(ssh_opts stderr_discard stderr_fh stderr_file encoding argument_encoding);
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);
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 @src = map "$self->{_host}:$_", $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 $target = $self->{_host}. ':' . ( @_ > 1
					 ? $self->_quote_args({quote_args => 1}, 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 @_;
    $self->_scp($opts, @src, $target);
}

sub rsync_put {
    ${^TAINT} and &_catch_tainted_args;
    my ($self, $opts, $target, @src) = _scp_put_args @_;
    $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);
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};
    _croak_bad_options %opts;

    my @opts;
    @opts = @$ssh_opts if $ssh_opts;
    push @opts, '-q' if $quiet;
    push @opts, '-r' if $recursive;
    push @opts, '-p' if $copy_attrs;
    push @opts, '-l', $bwlimit if defined $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);

my %rsync_opt_forbiden = 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);

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 = qw(--blocking-io) ;
    push @opts, '-q' if $quiet;
    push @opts, '-p' 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_forbiden{$opt1} and croak "forbiden 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 late_set_perm);

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( { ssh_opts => '-s',
					   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 DESTROY {
    my $self = shift;
    my $pid = $self->{_pid};
    local $@;
    $debug and $debug & 2 and _debug("DESTROY($self, pid: ", $pid, ")");
    if ($pid and $self->{_perl_pid} == $$) {
	$debug and $debug & 32 and _debug("killing master");
        local $?;
	local $!;

	unless ($self->{_wfm_status}) {
	    # 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;
    }
}

1;
__END__