/lib/Net/SFTP/Foreign.pm

Large files files are truncated, but you can click here to view the full file

package Net::SFTP::Foreign;

our $VERSION = '1.78_03';

use strict;
use warnings;
use warnings::register;

use Carp qw(carp croak);

use Symbol ();
use Errno ();
use Fcntl;
use File::Spec ();

BEGIN {
    if ($] >= 5.008) {
        require Encode;
    }
    else {
        # Work around for incomplete Unicode handling in perl 5.6.x
        require bytes;
        bytes->import();
        *Encode::encode = sub { $_[1] };
        *Encode::decode = sub { $_[1] };
        *utf8::downgrade = sub { 1 };
    }
}

# we make $Net::SFTP::Foreign::Helpers::debug an alias for
# $Net::SFTP::Foreign::debug so that the user can set it without
# knowing anything about the Helpers package!
our $debug;
BEGIN { *Net::SFTP::Foreign::Helpers::debug = \$debug };
use Net::SFTP::Foreign::Helpers qw(_is_reg _is_lnk _is_dir _debug
                                   _sort_entries _gen_wanted
                                   _gen_converter _hexdump
                                   _ensure_list _catch_tainted_args
                                   _file_part _umask_save_and_set);
use Net::SFTP::Foreign::Constants qw( :fxp :flags :att
				      :status :error
				      SSH2_FILEXFER_VERSION );
use Net::SFTP::Foreign::Attributes;
use Net::SFTP::Foreign::Buffer;
require Net::SFTP::Foreign::Common;
our @ISA = qw(Net::SFTP::Foreign::Common);

our $dirty_cleanup;
my $windows;

BEGIN {
    $windows = $^O =~ /Win(?:32|64)/;

    if ($^O =~ /solaris/i) {
	$dirty_cleanup = 1 unless defined $dirty_cleanup;
    }
}

sub _deprecated {
    if (warnings::enabled('deprecated') and warnings::enabled(__PACKAGE__)) {
        Carp::carp(join('', @_));
    }
}

sub _next_msg_id { shift->{_msg_id}++ }

use constant _empty_attributes => Net::SFTP::Foreign::Attributes->new;

sub _queue_new_msg {
    my $sftp = shift;
    my $code = shift;
    my $id = $sftp->_next_msg_id;
    my $msg = Net::SFTP::Foreign::Buffer->new(int8 => $code, int32 => $id, @_);
    $sftp->_queue_msg($msg);
    return $id;
}

sub _queue_msg {
    my ($sftp, $buf) = @_;

    my $bytes = $buf->bytes;
    my $len = length $bytes;

    if ($debug and $debug & 1) {
	$sftp->{_queued}++;
	_debug(sprintf("queueing msg len: %i, code:%i, id:%i ... [$sftp->{_queued}]",
		       $len, unpack(CN => $bytes)));

        $debug & 16 and _hexdump(pack('N', length($bytes)) . $bytes);
    }

    $sftp->{_bout} .= pack('N', length($bytes));
    $sftp->{_bout} .= $bytes;
}


sub _do_io { $_[0]->{_backend}->_do_io(@_) }

sub _conn_lost {
    my ($sftp, $status, $err, @str) = @_;

    $debug and $debug & 32 and _debug("_conn_lost");

    $sftp->{_status} or
	$sftp->_set_status(defined $status ? $status : SSH2_FX_CONNECTION_LOST);

    $sftp->{_error} or
	$sftp->_set_error((defined $err ? $err : SFTP_ERR_CONNECTION_BROKEN),
			  (@str ? @str : "Connection to remote server is broken"));

    undef $sftp->{_connected};
}

sub _conn_failed {
    my $sftp = shift;
    $sftp->_conn_lost(SSH2_FX_NO_CONNECTION,
                      SFTP_ERR_CONNECTION_BROKEN,
                      @_)
	unless $sftp->{_error};
}

sub _get_msg {
    my $sftp = shift;

    $debug and $debug & 1 and _debug("waiting for message... [$sftp->{_queued}]");

    unless ($sftp->_do_io($sftp->{_timeout})) {
	$sftp->_conn_lost(undef, undef, "Connection to remote server stalled");
	return undef;
    }

    my $bin = \$sftp->{_bin};
    my $len = unpack N => substr($$bin, 0, 4, '');
    my $msg = Net::SFTP::Foreign::Buffer->make(substr($$bin, 0, $len, ''));

    if ($debug and $debug & 1) {
	$sftp->{_queued}--;
        my ($code, $id, $status) = unpack( CNN => $$msg);
	$id = '-' if $code == SSH2_FXP_VERSION;
        $status = '-' unless $code == SSH2_FXP_STATUS;
	_debug(sprintf("got it!, len:%i, code:%i, id:%s, status: %s",
                       $len, $code, $id, $status));
        $debug & 8 and _hexdump($$msg);
    }

    return $msg;
}

sub _croak_bad_options {
    if (@_) {
        my $s = (@_ > 1 ? 's' : '');
        croak "Invalid option$s '" . CORE::join("', '", @_) . "' or bad combination of options";
    }
}

sub _fs_encode {
    my ($sftp, $path) = @_;
    Encode::encode($sftp->{_fs_encoding}, $path);
}

sub _fs_decode {
    my ($sftp, $path) = @_;
    Encode::decode($sftp->{_fs_encoding}, $path);
}

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

    my $class = shift;
    unshift @_, 'host' if @_ & 1;
    my %opts = @_;

    my $sftp = { _msg_id    => 0,
		 _bout      => '',
		 _bin       => '',
		 _connected => 1,
		 _queued    => 0,
                 _error     => 0,
                 _status    => 0 };

    bless $sftp, $class;

    if ($debug) {
        _debug "This is Net::SFTP::Foreign $Net::SFTP::Foreign::VERSION";
        _debug "Loaded from $INC{'Net/SFTP/Foreign.pm'}";
        _debug "Running on Perl $^V for $^O";
        _debug "debug set to $debug";
        _debug "~0 is " . ~0;
    }

    $sftp->_clear_error_and_status;

    my $backend = delete $opts{backend};
    unless (ref $backend) {
	$backend = ($windows ? 'Windows' : 'Unix')
	    unless (defined $backend);
	$backend =~ /^\w+$/
	    or croak "Bad backend name $backend";
	my $backend_class = "Net::SFTP::Foreign::Backend::$backend";
	eval "require $backend_class; 1"
	    or croak "Unable to load backend $backend: $@";
	$backend = $backend_class->_new($sftp, \%opts);
    }
    $sftp->{_backend} = $backend;

    if ($debug) {
        my $class = ref($backend) || $backend;
        no strict 'refs';
        my $version = ${$class .'::VERSION'} || 0;
        _debug "Using backend $class $version";
    }

    my %defs = $backend->_defaults;

    $sftp->{_autodie} = delete $opts{autodie};
    $sftp->{_block_size} = delete $opts{block_size} || $defs{block_size} || 32*1024;
    $sftp->{_min_block_size} = delete $opts{min_block_size} || $defs{min_block_size} || 512;
    $sftp->{_queue_size} = delete $opts{queue_size} || $defs{queue_size} || 32;
    $sftp->{_read_ahead} = $defs{read_ahead} || $sftp->{_block_size} * 4;
    $sftp->{_write_delay} = $defs{write_delay} || $sftp->{_block_size} * 8;
    $sftp->{_autoflush} = delete $opts{autoflush};
    $sftp->{_late_set_perm} = delete $opts{late_set_perm};
    $sftp->{_dirty_cleanup} = delete $opts{dirty_cleanup};

    $sftp->{_timeout} = delete $opts{timeout};
    defined $sftp->{_timeout} and $sftp->{_timeout} <= 0 and croak "invalid timeout";

    $sftp->{_fs_encoding} = delete $opts{fs_encoding};
    if (defined $sftp->{_fs_encoding}) {
        $] < 5.008
            and carp "fs_encoding feature is not supported in this perl version $]";
    }
    else {
        $sftp->{_fs_encoding} = 'utf8';
    }

    $sftp->autodisconnect(delete $opts{autodisconnect});

    $backend->_init_transport($sftp, \%opts);
    %opts and _croak_bad_options(keys %opts);

    $sftp->_init unless $sftp->{_error};
    $backend->_after_init($sftp);
    $sftp
}

sub autodisconnect {
    my ($sftp, $ad) = @_;
    if (defined $ad and $ad != 1) {
        if ($ad == 0) {
            $sftp->{_disconnect_by_pid} = -1;
        }
        elsif ($ad == 2) {
            $sftp->{_disconnect_by_pid} = $$;
        }
        else {
            croak "bad value '$ad' for autodisconnect";
        }
    }
    1;
}

sub disconnect {
    my $sftp = shift;
    my $pid = delete $sftp->{pid};

    $debug and $debug & 4 and _debug("$sftp->disconnect called (ssh pid: ".($pid||'').")");

    local $sftp->{_autodie};
    $sftp->_conn_lost;

    if (defined $pid) {
        close $sftp->{ssh_out} if (defined $sftp->{ssh_out} and not $sftp->{_ssh_out_is_not_dupped});
        close $sftp->{ssh_in} if defined $sftp->{ssh_in};
        if ($windows) {
	    kill KILL => $pid
                and waitpid($pid, 0);
            $debug and $debug & 4 and _debug "process $pid reaped";
        }
        else {
	    my $dirty = ( defined $sftp->{_dirty_cleanup}
			  ? $sftp->{_dirty_cleanup}
			  : $dirty_cleanup );

	    if ($dirty or not defined $dirty) {
                $debug and $debug & 4 and _debug("starting dirty cleanup of process $pid");
		for my $sig (($dirty ? () : 0), qw(TERM TERM KILL KILL)) {
                    $debug and $debug & 4 and _debug("killing process $pid with signal $sig");
		    $sig and kill $sig, $pid;

                    local ($@, $SIG{__DIE__}, $SIG{__WARN__});
                    my $wpr;
                    eval {
                        local $SIG{ALRM} = sub { die "timeout\n" };
                        alarm 8;
                        $wpr = waitpid($pid, 0);
                        alarm 0;
                    };
                    $debug and $debug & 4 and _debug("waitpid returned " . (defined $wpr ? $wpr : '<undef>'));
                    if ($wpr) {
                        # $wpr > 0 ==> the process has ben reaped
                        # $wpr < 0 ==> some error happened, retry unless ECHILD
                        last if $wpr > 0 or $! == Errno::ECHILD();
                    }
		}
	    }
	    else {
		while (1) {
		    last if waitpid($pid, 0) > 0;
		    if ($! != Errno::EINTR) {
			warn "internal error: unexpected error in waitpid($pid): $!"
			    if $! != Errno::ECHILD;
			last;
		    }
		}
	    }
            $debug and $debug & 4 and _debug "process $pid reaped";
        }
    }
    close $sftp->{_pty} if defined $sftp->{_pty};
    1
}

sub DESTROY {
    local ($?, $!, $@);

    my $sftp = shift;
    my $dbpid = $sftp->{_disconnect_by_pid};

    $debug and $debug & 4 and _debug("$sftp->DESTROY called (current pid: $$, disconnect_by_pid: ".($dbpid||'').")");

    $sftp->disconnect if (!defined $dbpid or $dbpid == $$);
}

sub _init {
    my $sftp = shift;
    $sftp->_queue_msg( Net::SFTP::Foreign::Buffer->new(int8 => SSH2_FXP_INIT,
						       int32 => SSH2_FILEXFER_VERSION));

    if (my $msg = $sftp->_get_msg) {
	my $type = $msg->get_int8;
	if ($type == SSH2_FXP_VERSION) {
	    my $version = $msg->get_int32;

	    $sftp->{server_version} = $version;
            $sftp->{server_extensions} = {};
            while (length $$msg) {
                my $key = $msg->get_str;
                my $value = $msg->get_str;
                $sftp->{server_extensions}{$key} = $value;

                if ($key eq 'vendor-id') {
                    my $vid = Net::SFTP::Foreign::Buffer->make("$value");
                    $sftp->{_ext__vendor_id} = [ Encode::decode(utf8 => $vid->get_str),
                                                 Encode::decode(utf8 => $vid->get_str),
                                                 Encode::decode(utf8 => $vid->get_str),
                                                 $vid->get_int64 ];
                }
                elsif ($key eq 'supported2') {
                    my $s2 = Net::SFTP::Foreign::Buffer->make("$value");
                    $sftp->{_ext__supported2} = [ $s2->get_int32,
                                                  $s2->get_int32,
                                                  $s2->get_int32,
                                                  $s2->get_int32,
                                                  $s2->get_int32,
                                                  $s2->get_int16,
                                                  $s2->get_int16,
                                                  [map Encode::decode(utf8 => $_), $s2->get_str_list],
                                                  [map Encode::decode(utf8 => $_), $s2->get_str_list] ];
                }
            }

	    return $version;
	}

	$sftp->_conn_lost(SSH2_FX_BAD_MESSAGE,
			  SFTP_ERR_REMOTE_BAD_MESSAGE,
			  "bad packet type, expecting SSH2_FXP_VERSION, got $type");
    }
    elsif ($sftp->{_status} == SSH2_FX_CONNECTION_LOST
	   and $sftp->{_password_authentication}
	   and $sftp->{_password_sent}) {
	$sftp->_set_error(SFTP_ERR_PASSWORD_AUTHENTICATION_FAILED,
			  "Password authentication failed or connection lost");
    }
    return undef;
}

sub server_extensions { %{shift->{server_extensions}} }

sub _check_extension {
    my ($sftp, $name, $version, $error, $errstr) = @_;
    my $ext = $sftp->{server_extensions}{$name};
    return 1 if (defined $ext and $ext == $version);

    $sftp->_set_status(SSH2_FX_OP_UNSUPPORTED);
    $sftp->_set_error($error, "$errstr: extended operation not supported by server");
    return undef;
}

# helper methods:
sub _get_msg_and_check {
    my ($sftp, $etype, $eid, $err, $errstr) = @_;
    my $msg = $sftp->_get_msg;
    if ($msg) {
	my $type = $msg->get_int8;
	my $id = $msg->get_int32;

	$sftp->_clear_error_and_status;

	if ($id != $eid) {
	    $sftp->_conn_lost(SSH2_FX_BAD_MESSAGE,
			      SFTP_ERR_REMOTE_BAD_MESSAGE,
			      $errstr, "bad packet sequence, expected $eid, got $id");
	    return undef;
	}

	if ($type != $etype) {
	    if ($type == SSH2_FXP_STATUS) {
                my $code = $msg->get_int32;
                my $str = Encode::decode(utf8 => $msg->get_str);
		my $status = $sftp->_set_status($code, (defined $str ? $str : ()));
		$sftp->_set_error($err, $errstr, $status);
	    }
	    else {
		$sftp->_conn_lost(SSH2_FX_BAD_MESSAGE,
				  SFTP_ERR_REMOTE_BAD_MESSAGE,
				  $errstr, "bad packet type, expected $etype packet, got $type");
	    }
	    return undef;
	}
    }
    $msg;
}

# reads SSH2_FXP_HANDLE packet and returns handle, or undef on failure
sub _get_handle {
    my ($sftp, $eid, $error, $errstr) = @_;
    if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_HANDLE, $eid,
					    $error, $errstr)) {
	return $msg->get_str;
    }
    return undef;
}

sub _rid {
    my ($sftp, $rfh) = @_;
    my $rid = $rfh->_rid;
    unless (defined $rid) {
	$sftp->_set_error(SFTP_ERR_REMOTE_ACCESING_CLOSED_FILE,
			  "Couldn't access a file that has been previosly closed");
    }
    $rid
}

sub _rfid {
    $_[1]->_check_is_file;
    &_rid;
}

sub _rdid {
    $_[1]->_check_is_dir;
    &_rid;
}

sub _queue_rid_request {
    my ($sftp, $code, $fh, $attrs) = @_;
    my $rid = $sftp->_rid($fh);
    return undef unless defined $rid;

    $sftp->_queue_new_msg($code, str => $rid,
			 (defined $attrs ? (attr => $attrs) : ()));
}

sub _queue_rfid_request {
    $_[2]->_check_is_file;
    &_queue_rid_request;
}

sub _queue_rdid_request {
    $_[2]->_check_is_dir;
    &_queue_rid_request;
}

sub _queue_str_request {
    my($sftp, $code, $str, $attrs) = @_;
    $sftp->_queue_new_msg($code, str => $str,
			 (defined $attrs ? (attr => $attrs) : ()));
}

sub _check_status_ok {
    my ($sftp, $eid, $error, $errstr) = @_;
    if (defined $eid) {
        if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_STATUS, $eid,
                                                $error, $errstr)) {
            my $status = $sftp->_set_status($msg->get_int32, $msg->get_str);
            return 1 if $status == SSH2_FX_OK;

            $sftp->_set_error($error, $errstr, $status);
        }
    }
    return undef;
}

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

    my ($sftp, $cwd, %opts) = @_;
    $sftp->_clear_error_and_status;

    my $check = delete $opts{check};
    $check = 1 unless defined $check;

    %opts and _croak_bad_options(keys %opts);

    if (defined $cwd) {
        if ($check) {
            $cwd = $sftp->realpath($cwd);
            return undef unless defined $cwd;
            my $a = $sftp->stat($cwd)
                or return undef;
            unless (_is_dir($a->perm)) {
                $sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
                                  "Remote object '$cwd' is not a directory");
                return undef;
            }
        }
        else {
            $cwd = $sftp->_rel2abs($cwd);
        }
        return $sftp->{cwd} = $cwd;
    }
    else {
        delete $sftp->{cwd};
        return $sftp->cwd if defined wantarray;
    }
}

sub cwd {
    @_ == 1 or croak 'Usage: $sftp->cwd()';

    my $sftp = shift;
    return defined $sftp->{cwd} ? $sftp->{cwd} : $sftp->realpath('');
}

## SSH2_FXP_OPEN (3)
# returns handle on success, undef on failure
sub open {
    (@_ >= 2 and @_ <= 4)
	or croak 'Usage: $sftp->open($path [, $flags [, $attrs]])';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $path, $flags, $a) = @_;
    $path = $sftp->_rel2abs($path);
    defined $flags or $flags = SSH2_FXF_READ;
    defined $a or $a = Net::SFTP::Foreign::Attributes->new;
    my $id = $sftp->_queue_new_msg(SSH2_FXP_OPEN,
                                   str => $sftp->_fs_encode($path),
                                   int32 => $flags, attr => $a);

    my $rid = $sftp->_get_handle($id,
				SFTP_ERR_REMOTE_OPEN_FAILED,
				"Couldn't open remote file '$path'");

    if ($debug and $debug & 2) {
        if (defined $rid) {
            _debug("new remote file '$path' open, rid:");
            _hexdump($rid);
        }
        else {
            _debug("open failed: $sftp->{_status}");
        }
    }

    defined $rid or return undef;

    my $fh = Net::SFTP::Foreign::FileHandle->_new_from_rid($sftp, $rid);
    $fh->_flag(append => 1) if ($flags & SSH2_FXF_APPEND);

    $fh;
}

sub _open_mkpath {
    my ($sftp, $filename, $mkpath, $flags, $attrs) = @_;
    $flags = ($flags || 0) | SSH2_FXF_WRITE|SSH2_FXF_CREAT;
    my $fh = do {
        local $sftp->{_autodie};
        $sftp->open($filename, $flags, $attrs);
    };
    unless ($fh) {
        if ($mkpath and $sftp->status == SSH2_FX_NO_SUCH_FILE) {
            my $da = $attrs->clone;
            $da->set_perm(($da->perm || 0) | 0700);
            $sftp->mkpath($filename, $da, 1) or return;
            $fh = $sftp->open($filename, $flags, $attrs);
        }
        else {
            $sftp->_ok_or_autodie;
        }
    }
    $fh;
}

## SSH2_FXP_OPENDIR (11)
sub opendir {
    @_ == 2 or croak 'Usage: $sftp->opendir($path)';
    ${^TAINT} and &_catch_tainted_args;

    my $sftp = shift;
    my $path = shift;
    $path = $sftp->_rel2abs($path);
    my $id = $sftp->_queue_str_request(SSH2_FXP_OPENDIR, $sftp->_fs_encode($path), @_);
    my $rid = $sftp->_get_handle($id, SFTP_ERR_REMOTE_OPENDIR_FAILED,
				 "Couldn't open remote dir '$path'");

    if ($debug and $debug & 2) {
        _debug("new remote dir '$path' open, rid:");
        _hexdump($rid);
    }

    defined $rid
	or return undef;

    Net::SFTP::Foreign::DirHandle->_new_from_rid($sftp, $rid, 0)
}

## SSH2_FXP_READ (4)
# returns data on success undef on failure
sub sftpread {
    (@_ >= 3 and @_ <= 4)
	or croak 'Usage: $sftp->sftpread($fh, $offset [, $size])';

    my ($sftp, $rfh, $offset, $size) = @_;

    unless ($size) {
	return '' if defined $size;
	$size = $sftp->{_block_size};
    }

    my $rfid = $sftp->_rfid($rfh);
    defined $rfid or return undef;

    my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid,
				  int64 => $offset, int32 => $size);

    if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_DATA, $id,
					    SFTP_ERR_REMOTE_READ_FAILED,
					    "Couldn't read from remote file")) {
	return $msg->get_str;
    }
    return undef;
}

## SSH2_FXP_WRITE (6)
# returns true on success, undef on failure
sub sftpwrite {
    @_ == 4 or croak 'Usage: $sftp->sftpwrite($fh, $offset, $data)';

    my ($sftp, $rfh, $offset) = @_;
    my $rfid = $sftp->_rfid($rfh);
    defined $rfid or return undef;
    utf8::downgrade($_[3], 1) or croak "wide characters found in data";

    my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid,
				  int64 => $offset, str => $_[3]);

    if ($sftp->_check_status_ok($id,
				SFTP_ERR_REMOTE_WRITE_FAILED,
				"Couldn't write to remote file")) {
	return 1;
    }
    return undef;
}

sub seek {
    (@_ >= 3 and @_ <= 4)
	or croak 'Usage: $sftp->seek($fh, $pos [, $whence])';

    my ($sftp, $rfh, $pos, $whence) = @_;
    $sftp->flush($rfh) or return undef;

    if (!$whence) {
        $rfh->_pos($pos)
    }
    elsif ($whence == 1) {
        $rfh->_inc_pos($pos)
    }
    elsif ($whence == 2) {
	my $a = $sftp->stat($rfh) or return undef;
        $rfh->_pos($pos + $a->size);
    }
    else {
	croak "invalid value for whence argument ('$whence')";
    }
    1;
}

sub tell {
    @_ == 2 or croak 'Usage: $sftp->tell($fh)';

    my ($sftp, $rfh) = @_;
    return $rfh->_pos + length ${$rfh->_bout};
}

sub eof {
    @_ == 2 or croak 'Usage: $sftp->eof($fh)';

    my ($sftp, $rfh) = @_;
    $sftp->_fill_read_cache($rfh, 1);
    return length(${$rfh->_bin}) == 0
}

sub _write {
    my ($sftp, $rfh, $off, $cb) = @_;

    $sftp->_clear_error_and_status;

    my $rfid = $sftp->_rfid($rfh);
    defined $rfid or return undef;

    my $qsize = $sftp->{_queue_size};

    my @msgid;
    my @written;
    my $written = 0;
    my $end;

    while (!$end or @msgid) {
	while (!$end and @msgid < $qsize) {
	    my $data = $cb->();
	    if (defined $data and length $data) {
		my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid,
					      int64 => $off + $written, str => $data);
		push @written, $written;
		$written += length $data;
		push @msgid, $id;
	    }
	    else {
		$end = 1;
	    }
	}

	my $eid = shift @msgid;
	my $last = shift @written;
	unless ($sftp->_check_status_ok($eid,
					SFTP_ERR_REMOTE_WRITE_FAILED,
					"Couldn't write to remote file")) {

	    # discard responses to queued requests:
	    $sftp->_get_msg for @msgid;
	    return $last;
	}
    }

    return $written;
}

sub write {
    @_ == 3 or croak 'Usage: $sftp->write($fh, $data)';

    my ($sftp, $rfh) = @_;
    $sftp->flush($rfh, 'in') or return undef;
    utf8::downgrade($_[2], 1) or croak "wide characters found in data";
    my $datalen = length $_[2];
    my $bout = $rfh->_bout;
    $$bout .= $_[2];
    my $len = length $$bout;

    $sftp->flush($rfh, 'out')
	if ($len >= $sftp->{_write_delay} or ($len and $sftp->{_autoflush} ));

    return $datalen;
}

sub flush {
    (@_ >= 2 and @_ <= 3)
	or croak 'Usage: $sftp->flush($fh [, $direction])';

    my ($sftp, $rfh, $dir) = @_;
    $dir ||= '';

    if ($dir ne 'out') { # flush in!
	${$rfh->_bin} = '';
    }

    if ($dir ne 'in') { # flush out!
	my $bout = $rfh->_bout;
	my $len = length $$bout;
	if ($len) {
	    my $start;
	    my $append = $rfh->_flag('append');
	    if ($append) {
		my $attr = $sftp->stat($rfh)
		    or return undef;
		$start = $attr->size;
	    }
	    else {
		$start = $rfh->_pos;
		${$rfh->_bin} = '';
	    }
	    my $off = 0;
	    my $written = $sftp->_write($rfh, $start,
					sub {
					    my $data = substr($$bout, $off, $sftp->{_block_size});
					    $off += length $data;
					    $data;
					} );
	    $rfh->_inc_pos($written)
		unless $append;

	    substr($$bout, 0, $written, '');
	    $written == $len or return undef;
	}
    }
    1;
}

sub _fill_read_cache {
    my ($sftp, $rfh, $len) = @_;

    $sftp->_clear_error_and_status;

    $sftp->flush($rfh, 'out')
	or return undef;

    my $rfid = $sftp->_rfid($rfh);
    defined $rfid or return undef;

    my $bin = $rfh->_bin;

    if (defined $len) {
	return 1 if ($len < length $$bin);

	my $read_ahead = $sftp->{_read_ahead};
	$len = length($$bin) + $read_ahead
	    if $len - length($$bin) < $read_ahead;
    }

    my $pos = $rfh->_pos;

    my $qsize = $sftp->{_queue_size};
    my $bsize = $sftp->{_block_size};

    my @msgid;
    my $askoff = length $$bin;
    my $eof;

    while (!defined $len or length $$bin < $len) {
	while ((!defined $len or $askoff < $len) and @msgid < $qsize) {
	    my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid,
					  int64 => $pos + $askoff, int32 => $bsize);
	    push @msgid, $id;
	    $askoff += $bsize;
	}

	my $eid = shift @msgid;
	my $msg = $sftp->_get_msg_and_check(SSH2_FXP_DATA, $eid,
					    SFTP_ERR_REMOTE_READ_FAILED,
					    "Couldn't read from remote file")
	    or last;

	my $data = $msg->get_str;
	$$bin .= $data;
	if (length $data < $bsize) {
	    unless (defined $len) {
		$eof = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid,
					     int64 => $pos + length $$bin, int32 => 1);
	    }
	    last;
	}

    }

    $sftp->_get_msg for @msgid;

    if ($eof) {
	$sftp->_get_msg_and_check(SSH2_FXP_DATA, $eof,
				  SFTP_ERR_REMOTE_BLOCK_TOO_SMALL,
				  "received block was too small")
    }

    if ($sftp->{_status} == SSH2_FX_EOF and length $$bin) {
	$sftp->_clear_error_and_status;
    }

    return $sftp->{_error} ? undef : length $$bin;
}

sub read {
    @_ == 3 or croak 'Usage: $sftp->read($fh, $len)';

    my ($sftp, $rfh, $len) = @_;
    if ($sftp->_fill_read_cache($rfh, $len)) {
	my $bin = $rfh->_bin;
	my $data = substr($$bin, 0, $len, '');
	$rfh->_inc_pos(length $data);
	return $data;
    }
    return undef;
}

sub _readline {
    my ($sftp, $rfh, $sep) = @_;

    $sep = "\n" if @_ < 3;

    my $sl = length $sep;

    my $bin = $rfh->_bin;
    my $last = 0;

    while(1) {
	my $ix = index $$bin, $sep, $last + 1 - $sl ;
	if ($ix >= 0) {
	    $ix += $sl;
	    $rfh->_inc_pos($ix);
	    return substr($$bin, 0, $ix, '');
	}

	$last = length $$bin;
	$sftp->_fill_read_cache($rfh, length($$bin) + 1);

	unless (length $$bin > $last) {
	    $sftp->{_error}
		and return undef;

	    my $line = $$bin;
	    $rfh->_inc_pos(length $line);
	    $$bin = '';
	    return $line;
	}
    }
}

sub readline {
    (@_ >= 2 and @_ <= 3)
	or croak 'Usage: $sftp->readline($fh [, $sep])';

    my ($sftp, $rfh, $sep) = @_;
    $sep = "\n" if @_ < 3;
    if (!defined $sep or $sep eq '') {
	$sftp->_fill_read_cache($rfh);
	$sftp->{_error}
	    and return undef;
	my $bin = $rfh->_bin;
	my $line = $$bin;
	$rfh->_inc_pos(length $line);
	$$bin = '';
	return $line;
    }
    if (wantarray) {
	my @lines;
	while (defined (my $line = $sftp->_readline($rfh, $sep))) {
	    push @lines, $line;
	}
	return @lines;
    }
    return $sftp->_readline($rfh, $sep);
}

sub getc {
    @_ == 2 or croak 'Usage: $sftp->getc($fh)';

    my ($sftp, $rfh) = @_;

    $sftp->_fill_read_cache($rfh, 1);
    my $bin = $rfh->_bin;
    if (length $bin) {
	$rfh->_inc_pos(1);
	return substr $$bin, 0, 1, '';
    }
    return undef;
}

## SSH2_FXP_LSTAT (7), SSH2_FXP_FSTAT (8), SSH2_FXP_STAT (17)
# these all return a Net::SFTP::Foreign::Attributes object on success, undef on failure

sub lstat {
    @_ <= 2 or croak 'Usage: $sftp->lstat($path)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $path) = @_;
    $path = '.' unless defined $path;
    $path = $sftp->_rel2abs($path);
    my $id = $sftp->_queue_str_request(SSH2_FXP_LSTAT, $sftp->_fs_encode($path));
    if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id,
                                            SFTP_ERR_REMOTE_LSTAT_FAILED, "Couldn't stat remote link")) {
        return $msg->get_attributes;
    }
    return undef;
}

sub stat {
    @_ <= 2 or croak 'Usage: $sftp->stat($path_or_fh)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $pofh) = @_;
    $pofh = '.' unless defined $pofh;
    my $id = $sftp->_queue_new_msg( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle'))
                                    ? ( SSH2_FXP_FSTAT, str => $sftp->_rid($pofh))
                                    : ( SSH2_FXP_STAT,  str => $sftp->_fs_encode($sftp->_rel2abs($pofh))) );
    if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id,
                                            SFTP_ERR_REMOTE_STAT_FAILED, "Couldn't stat remote file")) {
        return $msg->get_attributes;
    }
    return undef;
}

sub fstat {
    _deprecated "fstat is deprecated and will be removed on the upcomming 2.xx series, "
        . "stat method accepts now both file handlers and paths";
    goto &stat;
}

## SSH2_FXP_RMDIR (15), SSH2_FXP_REMOVE (13)
# these return true on success, undef on failure

sub _gen_remove_method {
    my($name, $code, $error, $errstr) = @_;
    my $sub = sub {
	@_ == 2 or croak "Usage: \$sftp->$name(\$path)";
        ${^TAINT} and &_catch_tainted_args;

        my ($sftp, $path) = @_;
        $path = $sftp->_rel2abs($path);
        my $id = $sftp->_queue_str_request($code, $sftp->_fs_encode($path));
        $sftp->_check_status_ok($id, $error, $errstr);
    };
    no strict 'refs';
    *$name = $sub;
}

_gen_remove_method(remove => SSH2_FXP_REMOVE,
                   SFTP_ERR_REMOTE_REMOVE_FAILED, "Couldn't delete remote file");
_gen_remove_method(rmdir => SSH2_FXP_RMDIR,
                   SFTP_ERR_REMOTE_RMDIR_FAILED, "Couldn't remove remote directory");

## SSH2_FXP_MKDIR (14), SSH2_FXP_SETSTAT (9)
# these return true on success, undef on failure

sub mkdir {
    (@_ >= 2 and @_ <= 3)
        or croak 'Usage: $sftp->mkdir($path [, $attrs])';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $path, $attrs) = @_;
    $attrs = _empty_attributes unless defined $attrs;
    $path = $sftp->_rel2abs($path);
    my $id = $sftp->_queue_str_request(SSH2_FXP_MKDIR,
                                       $sftp->_fs_encode($path),
                                       $attrs);
    $sftp->_check_status_ok($id,
                            SFTP_ERR_REMOTE_MKDIR_FAILED,
                            "Couldn't create remote directory");
}

sub join {
    my $sftp = shift;
    my $a = '.';
    while (@_) {
	my $b = shift;
	if (defined $b) {
	    $b =~ s|^(?:\./+)+||;
	    if (length $b and $b ne '.') {
		if ($b !~ m|^/| and $a ne '.' ) {
		    $a = ($a =~ m|/$| ? "$a$b" : "$a/$b");
		}
		else {
		    $a = $b
		}
		$a =~ s|(?:/+\.)+/?$|/|;
		$a =~ s|(?<=[^/])/+$||;
		$a = '.' unless length $a;
	    }
	}
    }
    $a;
}

sub _rel2abs {
    my ($sftp, $path) = @_;
    my $old = $path;
    my $cwd = $sftp->{cwd};
    $path = $sftp->join($sftp->{cwd}, $path);
    $debug and $debug & 4096 and _debug("'$old' --> '$path'");
    return $path
}

sub mkpath {
    (@_ >= 2 and @_ <= 4)
        or croak 'Usage: $sftp->mkpath($path [, $attrs [, $parent]])';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $path, $attrs, $parent) = @_;
    $sftp->_clear_error_and_status;
    my $first = !$parent; # skips file name
    $path =~ s{^(/*)}{};
    my $start = $1;
    $path =~ s{/+$}{};
    my @path;
    while (1) {
        if ($first) {
            $first = 0
        }
        else {
            $path =~ s{/*[^/]*$}{}
        }
	my $p = "$start$path";
	$debug and $debug & 8192 and _debug "checking $p";
	if ($sftp->test_d($p)) {
	    $debug and $debug & 8192 and _debug "$p is a dir";
	    last;
	}
	unless (length $path) {
	    $sftp->_set_error(SFTP_ERR_REMOTE_MKDIR_FAILED,
                              "Unable to make path, bad root");
	    return undef;
	}
	unshift @path, $p;

    }
    for my $p (@path) {
	$debug and $debug & 8192 and _debug "mkdir $p";
	if ($p =~ m{^(?:.*/)?\.{1,2}$} or $p =~ m{/$}) {
	    $debug and $debug & 8192 and _debug "$p is a symbolic dir, skipping";
	    unless ($sftp->test_d($p)) {
		$debug and $debug & 8192 and _debug "symbolic dir $p can not be checked";
		$sftp->{_error} or
		    $sftp->_set_error(SFTP_ERR_REMOTE_MKDIR_FAILED,
				      "Unable to make path, bad name");
		return undef;
	    }
	}
	else {
	    $sftp->mkdir($p, $attrs)
                or return undef;
	}
    }
    1;
}

sub _mkpath_local {
    my ($sftp, $path, $perm, $parent) = @_;
    my @parts = File::Spec->splitdir($path);
    my @tail;
    if ($debug and $debug & 32768) {
        my $target = File::Spec->join(@parts);
        _debug "_mkpath_local('$target')";
    }
    if ($parent) {
        pop @parts while @parts and not length $parts[-1];
        @parts or goto top_dir_reached;
        pop @parts;
    }
    while (1) {
        my $target = File::Spec->join(@parts);
        $target = '' unless defined $target;
        if (-e $target) {
            if (-d $target) {
                while (@tail) {
                    $target = File::Spec->join($target, shift(@tail));
                    $debug and $debug and 32768 and _debug "creating local directory $target";
                    unless (CORE::mkdir $target, $perm) {
                        unless (do { local $!; -d $target}) {
                            $sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED,
                                              "mkdir '$target' failed", $!);
                            return;
                        }
                    }
                }
                return 1;
            }
            else {
                $sftp->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT,
                                  "Local file '$target' is not a directory");
                return;
            }
        }
        @parts or last;
        unshift @tail, pop @parts;
    }

 top_dir_reached:
    $sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED,
                      "mkpath failed, top dir reached");
    return;
}

sub setstat {
    @_ == 3 or croak 'Usage: $sftp->setstat($path_or_fh, $attrs)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $pofh, $attrs) = @_;
    my $id = $sftp->_queue_new_msg( ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle') )
                                      ? ( SSH2_FXP_FSETSTAT, str => $sftp->_rid($pofh) )
                                      : ( SSH2_FXP_SETSTAT,  str => $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) ),
                                    attr => $attrs );
    return $sftp->_check_status_ok($id,
                                   SFTP_ERR_REMOTE_SETSTAT_FAILED,
                                   "Couldn't setstat remote file");
}

## SSH2_FXP_CLOSE (4), SSH2_FXP_FSETSTAT (10)
# these return true on success, undef on failure

sub fsetstat {
    _deprecated "fsetstat is deprecated and will be removed on the upcomming 2.xx series, "
        . "setstat method accepts now both file handlers and paths";
    goto &setstat;
}

sub _gen_setstat_shortcut {
    my ($name, $rid_type, $attrs_flag, @arg_types) = @_;
    my $nargs = 2 + @arg_types;
    my $usage = ("\$sftp->$name("
                 . CORE::join(', ', '$path_or_fh', map "arg$_", 1..@arg_types)
                 . ')');
    my $rid_method = ($rid_type eq 'file' ? '_rfid' :
                      $rid_type eq 'dir'  ? '_rdid' :
                      $rid_type eq 'any'  ? '_rid'  :
                      croak "bad rid type $rid_type");
    my $sub = sub {
        @_ == $nargs or croak $usage;
        my $sftp = shift;
        my $pofh = shift;
        my $id = $sftp->_queue_new_msg( ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle') )
                                          ? ( SSH2_FXP_FSETSTAT, str => $sftp->$rid_method($pofh) )
                                          : ( SSH2_FXP_SETSTAT,  str => $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) ),
                                        int32 => $attrs_flag,
                                        map { $arg_types[$_] => $_[$_] } 0..$#arg_types );
        $sftp->_check_status_ok($id,
                                SFTP_ERR_REMOTE_SETSTAT_FAILED,
                                "Couldn't setstat remote file ($name)");
    };
    no strict 'refs';
    *$name = $sub;
}

_gen_setstat_shortcut(truncate => 'file', SSH2_FILEXFER_ATTR_SIZE,        'int64');
_gen_setstat_shortcut(chown    => 'any' , SSH2_FILEXFER_ATTR_UIDGID,      'int32', 'int32');
_gen_setstat_shortcut(chmod    => 'any' , SSH2_FILEXFER_ATTR_PERMISSIONS, 'int32');
_gen_setstat_shortcut(utime    => 'any' , SSH2_FILEXFER_ATTR_ACMODTIME,   'int32', 'int32');

sub _close {
    @_ == 2 or croak 'Usage: $sftp->close($fh, $attrs)';

    my $sftp = shift;
    my $id = $sftp->_queue_rid_request(SSH2_FXP_CLOSE, @_);
    defined $id or return undef;

    my $ok = $sftp->_check_status_ok($id,
                                     SFTP_ERR_REMOTE_CLOSE_FAILED,
                                     "Couldn't close remote file");

    if ($debug and $debug & 2) {
        _debug sprintf("closing file handle, return: %s, rid:", (defined $ok ? $ok : '-'));
        _hexdump($sftp->_rid($_[0]));
    }

    return $ok;
}

sub close {
    @_ == 2 or croak 'Usage: $sftp->close($fh)';

    my ($sftp, $rfh) = @_;
    $rfh->_check_is_file;
    $sftp->flush($rfh)
	or return undef;

    if ($sftp->_close($rfh)) {
	$rfh->_close;
	return 1
    }
    undef
}

sub closedir {
    @_ == 2 or croak 'Usage: $sftp->closedir($dh)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $rdh) = @_;
    $rdh->_check_is_dir;

    if ($sftp->_close($rdh)) {
	$rdh->_close;
	return 1;
    }
    undef
}

sub readdir {
    @_ == 2 or croak 'Usage: $sftp->readdir($dh)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $rdh) = @_;

    my $rdid = $sftp->_rdid($rdh);
    defined $rdid or return undef;

    my $cache = $rdh->_cache;

    while (!@$cache or wantarray) {
	my $id = $sftp->_queue_str_request(SSH2_FXP_READDIR, $rdid);
	if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id,
						SFTP_ERR_REMOTE_READDIR_FAILED,
						"Couldn't read remote directory" )) {
	    my $count = $msg->get_int32 or last;

	    for (1..$count) {
		push @$cache, { filename => $sftp->_fs_decode($msg->get_str),
				longname => $sftp->_fs_decode($msg->get_str),
				a => $msg->get_attributes };
	    }
	}
	else {
	    $sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF;
	    last;
	}
    }

    if (wantarray) {
	my $old = $cache;
	$cache = [];
	return @$old;
    }
    shift @$cache;
}

sub _readdir {
    my ($sftp, $rdh);
    if (wantarray) {
	my $line = $sftp->readdir($rdh);
	if (defined $line) {
	    return $line->{filename};
	}
    }
    else {
	return map { $_->{filename} } $sftp->readdir($rdh);
    }
}

sub _gen_getpath_method {
    my ($code, $error, $name) = @_;
    return sub {
	@_ == 2 or croak 'Usage: $sftp->some_method($path)';
        ${^TAINT} and &_catch_tainted_args;

	my ($sftp, $path) = @_;
	$path = $sftp->_rel2abs($path);
	my $id = $sftp->_queue_str_request($code, $sftp->_fs_encode($path));

	if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id,
						$error,
						"Couldn't get $name for remote '$path'")) {
	    $msg->get_int32 > 0
		and return $sftp->_fs_decode($msg->get_str);

	    $sftp->_set_error($error,
			      "Couldn't get $name for remote '$path', no names on reply")
	}
	return undef;
    };
}

## SSH2_FXP_REALPATH (16)
## SSH2_FXP_READLINK (19)
# return path on success, undef on failure
*realpath = _gen_getpath_method(SSH2_FXP_REALPATH,
				SFTP_ERR_REMOTE_REALPATH_FAILED,
				"realpath");
*readlink = _gen_getpath_method(SSH2_FXP_READLINK,
				SFTP_ERR_REMOTE_READLINK_FAILED,
				"link target");

## SSH2_FXP_RENAME (18)
# true on success, undef on failure

sub _rename {
    my ($sftp, $old, $new) = @_;

    $old = $sftp->_rel2abs($old);
    $new = $sftp->_rel2abs($new);

    my $id = $sftp->_queue_new_msg(SSH2_FXP_RENAME,
                                   str => $sftp->_fs_encode($old),
                                   str => $sftp->_fs_encode($new));

    $sftp->_check_status_ok($id, SFTP_ERR_REMOTE_RENAME_FAILED,
                            "Couldn't rename remote file '$old' to '$new'");
}

sub rename {
    (@_ & 1) or croak 'Usage: $sftp->rename($old, $new, %opts)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $old, $new, %opts) = @_;

    my $overwrite = delete $opts{overwrite};
    my $numbered = delete $opts{numbered};
    croak "'overwrite' and 'numbered' options can not be used together"
        if ($overwrite and $numbered);
    %opts and _croak_bad_options(keys %opts);

    if ($overwrite) {
        $sftp->atomic_rename($old, $new) and return 1;
        $sftp->{_status} != SSH2_FX_OP_UNSUPPORTED and return undef;
    }

    for (1) {
        local $sftp->{_autodie};
        # we are optimistic here and try to rename it without testing
        # if a file of the same name already exists first
        if (!$sftp->_rename($old, $new) and
            $sftp->{_status} == SSH2_FX_FAILURE) {
            if ($numbered and $sftp->test_e($new)) {
                _inc_numbered($new);
                redo;
            }
            elsif ($overwrite) {
                my $rp_old = $sftp->realpath($old);
                my $rp_new = $sftp->realpath($new);
                if (defined $rp_old and defined $rp_new and $rp_old eq $rp_new) {
                    $sftp->_clear_error_and_status;
                }
                elsif ($sftp->remove($new)) {
                    $overwrite = 0;
                    redo;
                }
            }
        }
    }
    $sftp->_ok_or_autodie;
}

sub atomic_rename {
    @_ == 3 or croak 'Usage: $sftp->atomic_rename($old, $new)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $old, $new) = @_;

    $sftp->_check_extension('posix-rename@openssh.com' => 1,
                             SFTP_ERR_REMOTE_RENAME_FAILED,
                            "atomic rename failed")
        or return undef;

    $old = $sftp->_rel2abs($old);
    $new = $sftp->_rel2abs($new);

    my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED,
                                   str => 'posix-rename@openssh.com',
                                   str => $sftp->_fs_encode($old),
                                   str => $sftp->_fs_encode($new));

    $sftp->_check_status_ok($id, SFTP_ERR_REMOTE_RENAME_FAILED,
                            "Couldn't rename remote file '$old' to '$new'");
}

## SSH2_FXP_SYMLINK (20)
# true on success, undef on failure
sub symlink {
    @_ == 3 or croak 'Usage: $sftp->symlink($sl, $target)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $sl, $target) = @_;
    $sl = $sftp->_rel2abs($sl);
    my $id = $sftp->_queue_new_msg(SSH2_FXP_SYMLINK,
                                   str => $sftp->_fs_encode($target),
                                   str => $sftp->_fs_encode($sl));

    $sftp->_check_status_ok($id, SFTP_ERR_REMOTE_SYMLINK_FAILED,
                            "Couldn't create symlink '$sl' pointing to '$target'");
}

sub hardlink {
    @_ == 3 or croak 'Usage: $sftp->hardlink($hl, $target)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $hl, $target) = @_;

    $sftp->_check_extension('hardlink@openssh.com' => 1,
                            SFTP_ERR_REMOTE_HARDLINK_FAILED,
                            "hardlink failed")
        or return undef;
    $hl = $sftp->_rel2abs($hl);
    $target = $sftp->_rel2abs($target);

    my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED,
                                   str => 'hardlink@openssh.com',
                                   str => $sftp->_fs_encode($target),
                                   str => $sftp->_fs_encode($hl));
    $sftp->_check_status_ok($id, SFTP_ERR_REMOTE_HARDLINK_FAILED,
                            "Couldn't create hardlink '$hl' pointing to '$target'");
}

sub _gen_save_status_method {
    my $method = shift;
    sub {
	my $sftp = shift;
        local ($sftp->{_error}, $sftp->{_status}) if $sftp->{_error};
	$sftp->$method(@_);
    }
}


*_close_save_status = _gen_save_status_method('close');
*_closedir_save_status = _gen_save_status_method('closedir');
*_remove_save_status = _gen_save_status_method('remove');

sub _inc_numbered {
    $_[0] =~ s{^(.*)\((\d+)\)((?:\.[^\.]*)?)$}{"$1(" . ($2+1) . ")$3"}e or
    $_[0] =~ s{((?:\.[^\.]*)?)$}{(1)$1};
    $debug and $debug & 128 and _debug("numbering to: $_[0]");
}

## High-level client -> server methods.

sub abort {
    my $sftp = shift;
    $sftp->_set_error(SFTP_ERR_ABORTED, ($@ ? $_[0] : "Aborted"));
}

# returns true on success, undef on failure
sub get {
    @_ >= 2 or croak 'Usage: $sftp->get($remote, $local, %opts)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $remote, $local, %opts) = @_;
    defined $remote or croak "remote file path is undefined";

    $sftp->_clear_error_and_status;

    $remote = $sftp->_rel2abs($remote);
    $local = _file_part($remote) unless defined $local;
    my $local_is_fh = (ref $local and $local->isa('GLOB'));

    my $cb = delete $opts{callback};
    my $umask = delete $opts{umask};
    my $perm = delete $opts{perm};
    my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'};
    my $copy_time = delete $opts{copy_time};
    my $overwrite = delete $opts{overwrite};
    my $resume = delete $opts{resume};
    my $append = delete $opts{append};
    my $block_size = delete $opts{block_size} || $sftp->{_block_size};
    my $queue_size = delete $opts{queue_size} || $sftp->{_queue_size};
    my $dont_save = delete $opts{dont_save};
    my $conversion = delete $opts{conversion};
    my $numbered = delete $opts{numbered};
    my $cleanup = delete $opts{cleanup};
    my $atomic = delete $opts{atomic};
    my $best_effort = delete $opts{best_effort};
    my $mkpath = delete $opts{mkpath};

    croak "'perm' and 'copy_perm' options can not be used simultaneously"
	if (defined $perm and defined $copy_perm);
    croak "'resume' and 'append' options can not be used simultaneously"
	if ($resume and $append);
    croak "'numbered' can not be used with 'overwrite', 'resume' or 'append'"
	if ($numbered and ($overwrite or $resume or $append));
    croak "'atomic' can not be used with 'resume' or 'append'"
        if ($atomic and ($resume or $append));
    if ($local_is_fh) {
	my $append = 'option can not be used when target is a file handle';
	$resume and croak "'resume' $append";
	$overwrite and croak "'overwrite' $append";
	$numbered and croak "'numbered' $append";
	$dont_save and croak "'dont_save' $append";
        $atomic and croak "'croak' $append";
    }
    %opts and _croak_bad_options(keys %opts);

    if ($resume and $conversion) {
        carp "resume option is useless when data conversion has also been requested";
        undef $resume;
    }

    $overwrite = 1 unless (defined $overwrite or $local_is_fh or $numbered);
    $copy_perm = 1 unless (defined $perm or defined $copy_perm or $local_is_fh);
    $copy_time = 1 unless (defined $copy_time or $local_is_fh);
    $mkpath    = 1 unless defined $mkpath;
    $cleanup = ($atomic || $numbered) unless defined $cleanup;

    my $a = do {
        local $sftp->{_autodie};
        $sftp->stat($remote);
    };
    my ($rperm, $size, $atime, $mtime) = ($a ? ($a->perm, $a->size, $a->atime, $a->mtime) : ());
    $size = -1 unless defined $size;

    if ($copy_time and not defined $atime) {
        if ($best_effort) {
            undef $copy_time;
        }
        else {
            $sftp->_ok_or_autodie and $sftp->_set_error(SFTP_ERR_REMOTE_STAT_FAILED,
                                                        "Not enough information on stat, amtime not included");
            return undef;
        }
    }

    $umask = (defined $perm ? 0 : umask) unless defined $umask;
    if ($copy_perm) {
        if (defined $rperm) {
            $perm = $rperm;
        }
        elsif ($best_effort) {
            undef $copy_perm
        }
        else {
            $sftp->_ok_or_autodie and $sftp->_set_error(SFTP_ERR_REMOTE_STAT_FAILED,
                                                        "Not enough information on stat, mode not included");
            return undef
        }
    }
    $perm &= ~$umask if defined $perm;

    $sftp->_clear_error_and_status;

    if ($resume and $resume eq 'auto') {
        undef $resume;
        if (defined $mtime) {
            if (my @lstat = CORE::stat $local) {
                $resume = ($mtime <= $lstat[9]);
            }
        }
    }

    my ($atomic_numbered, $atomic_local, $atomic_cleanup);

    my ($rfh, $fh);
    my $askoff = 0;
    my $lstart = 0;

    if ($dont_save) {
        $rfh = $sftp->open($remote, SSH2_FXF_READ);
        defined $rfh or return undef;
    }
    else {
        unless ($local_is_fh or $overwrite or $append or $resume or $numbered) {
	    if (-e $local) {
                $sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,
                                  "local file $local already exists");
                return undef
	    }
        }

        if ($atomic) {
            $atomic_local = $local;
            $local .= sprintf("(%d).tmp", rand(10000));
            $atomic_numbered = $numbered;
            $numbered = 1;
            $debug and $debug & 128 and _debug("temporal local file name: $local");
        }

        if ($resume) {
            if (CORE::open $fh, '+<', $local) {
                binmode $fh;
		CORE::seek($fh, 0, 2);
                $askoff = CORE::tell $fh;
                if ($askoff < 0) {
                    # something is going really wrong here, fall
                    # back to non-resuming mode...
                    $askoff = 0;
                    undef $fh;
                }
                else {
                    if ($size >=0 and $askoff > $size) {
                        $sftp->_set_error(SFTP_ERR_LOCAL_BIGGER_THAN_REMOTE,
                                          "Couldn't resume transfer, local file is bigger than remote");
                        return undef;
                    }
                    $size == $askoff and return 1;
                }
            }
        }

        # we open the remote file so late in order to skip it when
        # resuming an already completed transfer:
        $rfh = $sftp->open($remote, SSH2_FXF_READ);
        defined $rfh or return undef;

	unless (defined $fh) {
	    if ($local_is_fh) {
		$fh = $local;
		local ($@, $SIG{__DIE__}, $SIG{__WARN__});
		eval { $lstart = CORE::tell($fh) };
		$lstart = 0 unless ($lstart and $lstart > 0);
	    }
	    else {
                my $flags = Fcntl::O_CREAT|Fcntl::O_WRONLY;
                $flags |= Fcntl::O_APPEND if $append;
                $flags |= Fcntl::O_EXCL if ($numbered or (!$overwrite and !$append));
                unlink $local if $overwrite;
                my $open_perm = (defined $perm ? $perm : 0666);
                my $save = _umask_save_and_set($umask);
                $sftp->_mkpath_local($local, $perm|0700, 1) if $mkpath;
                while (1) {
                    sysopen ($fh, $local, $flags, $open_perm) and last;
                    unless ($numbered and -e $local) {
                        $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
                                          "Can't open $local", $!);
                        return undef;
                    }
                    _inc_numbered($local);
                }
                $$numbered = $local if ref $numbered;
		binmode $fh;
		$lstart = sysseek($fh, 0, …