File Coverage

blib/lib/Net/SFTP/Foreign.pm

Criterion	Covered	Total	%
statement	94	1862	5.0
branch	13	1354	0.9
condition	7	721	0.9
subroutine	28	153	18.3
pod	48	49	97.9
total	190	4139	4.5

package Net::SFTP::Foreign;

our $VERSION = '1.92_03';

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

use Carp qw(carp croak);

use Symbol ();
use Errno ();
use Fcntl;
use File::Spec ();
use Time::HiRes ();
use POSIX ();

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

my $thread_generation = 1;
sub CLONE { $thread_generation++ }

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;
    $sftp->{incomming}{$id} = undef;
    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,
		 _incomming => {} };

    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->{_remote_has_volumes} = delete $opts{remote_has_volumes};

    $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 (not defined $ad or $ad == 2) {
        $debug and $debug & 4 and _debug "setting disconnecting pid to $$ and thread to $thread_generation";
        $sftp->{_disconnect_by_pid} = $$;
        $sftp->{_disconnect_by_thread} = $thread_generation;
    }
    else {
        delete $sftp->{_disconnect_by_thread};
        if ($ad == 0) {
            $sftp->{_disconnect_by_pid} = -1;
        }
        elsif ($ad == 1) {
            delete $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");
            OUT: 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 $deadline = Time::HiRes::time + 8;
                    my $dt = 0.01;
                    while (Time::HiRes::time < $deadline) {
                        my $wpr = waitpid($pid, POSIX::WNOHANG());
                        $debug and $debug & 4 and _debug("waitpid returned ", $wpr);
                        last OUT if $wpr or $! == Errno::ECHILD();
                        Time::HiRes::sleep($dt);
                        $dt *= 1.2;
                    }
		}
	    }
	    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};
    my $dbthread = $sftp->{_disconnect_by_thread};

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

    if (!defined $dbpid or ($dbpid == $$ and $dbthread == $thread_generation)) {
        $sftp->disconnect
    }
    else {
        $debug and $debug & 4 and _debug "skipping disconnection because pid and/or thread generation don't match";
    }
}

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_by_id {
    my ($sftp, $eid) = @_;
    while (1) {
	my $msg = delete($sftp->{incomming}{$eid}) || $sftp->_get_msg || return undef;
	my $id = unpack xN => $$msg;
	return $msg if $id == $eid;
	unless (exists $sftp->{incomming}{$id}) {
	    $sftp->_conn_lost(SSH2_FX_BAD_MESSAGE,
			      SFTP_ERR_REMOTE_BAD_MESSAGE,
			      $_[2], "bad packet sequence, expected $eid, got $id");
	    return undef;
	}
	$sftp->{incomming}{$id} = $msg
    }
}

sub _get_msg_and_check {
    my ($sftp, $etype, $eid, $err, $errstr) = @_;
    my $msg = $sftp->_get_msg_by_id($eid, $errstr);
    if ($msg) {
	my $type = $msg->get_int8;
	$msg->get_int32; # discard id, it has already been checked at _get_msg_by_id

	$sftp->_clear_error_and_status;

	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;
            _untaint($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 = '.' unless defined $path;
    $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_by_id($_) 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;

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

    return $datalen;
}

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

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

    defined $sftp->_rfid($rfh) or return;

    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;

	    $$bout = ''; # The full buffer is discarded even when some error happens.
	    $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};

    do {
        local $sftp->{_autodie};

        my @msgid;
        my $askoff = length $$bin;
        my $ensure_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) {
                    $ensure_eof = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid,
                                                        int64 => $pos + length $$bin, int32 => 1);
                }
                last;
            }
        }

        $sftp->_get_msg_by_id($_) for @msgid;

        if ($ensure_eof and
            $sftp->_get_msg_and_check(SSH2_FXP_DATA, $ensure_eof,
                                      SFTP_ERR_REMOTE_READ_FAILED,
                                      "Couldn't read from remote file")) {

            $sftp->_set_error(SFTP_ERR_REMOTE_BLOCK_TOO_SMALL,
                              "Received block was too small");
        }

        if ($sftp->{_status} == SSH2_FX_EOF) {
            $sftp->_set_error;
            $sftp->_set_status if length $$bin
        }
    };

    $sftp->_ok_or_autodie and 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 (length $line ? $line : undef);
	}
    }
}

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 upcoming 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 $vol = '';
    my $a = '.';
    while (@_) {
	my $b = shift;
	if (defined $b) {
            if (ref $sftp and   # this method can also be used as a static one
                $sftp->{_remote_has_volumes} and $b =~ /^([a-z]\:)(.*)/i) {
                $vol = $1;
                $a = '.';
                $b = $2;
            }
	    $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;
	    }
	}
    }
    "$vol$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) = @_;
    # When parent is set, the last path part is removed and the parent
    # directory of the path given created.

    my @parts = File::Spec->splitdir($path);
    $debug and $debug & 32768 and _debug "_mkpath_local($path, $perm, ".($parent||0).")";

    if ($parent) {
        pop @parts while @parts and not length $parts[-1];
        unless (@parts) {
            $sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED,
                              "mkpath failed, top dir reached");
            return;
        }
        pop @parts;
    }

    my @tail;
    while (@parts) {
        my $target = File::Spec->catdir(@parts);
        if (-e $target) {
            unless (-d $target) {
                $sftp->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT,
                                  "Local file '$target' is not a directory");
                return;
            }
            last
        }
        unshift @tail, pop @parts;
    }
    while (@tail) {
        push @parts, shift @tail;
        my $target = File::Spec->catdir(@parts);
        $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;
            }
        }
    }
    $debug and $debug & 32768 and _debug "_mkpath_local succeeded";
    return 1;
}

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 upcoming 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)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $rfh) = @_;
    # defined $sftp->_rfid($rfh) or return undef;
    # ^--- commented out because flush already checks it is an open 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('[e-mail]' => 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 => '[e-mail]',
                                   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('[e-mail]' => 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 => '[e-mail]',
                                   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 "'numbered' can not be used with 'overwrite', 'resume' or 'append'"
	if ($numbered and ($overwrite or $resume or $append));
    if ($resume or $append) {
        $resume and $append and croak "'resume' and 'append' options can not be used simultaneously";
        $atomic and croak "'atomic' can not be used with 'resume' or 'append'";
        $overwrite and croak "'overwrite' can not be used with 'resume' or 'append'";
    }

    if ($local_is_fh) {
	my $tail = 'option can not be used when target is a file handle';
	$resume and croak "'resume' $tail";
	$overwrite and croak "'overwrite' $tail";
	$numbered and croak "'numbered' $tail";
	$dont_save and croak "'dont_save' $tail";
        $atomic and croak "'croak' $tail";
    }
    %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 or $append);
    $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, $open_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, 2) if $append;
	    }
	}

	if (defined $perm) {
            my $error;
	    do {
                local ($@, $SIG{__DIE__}, $SIG{__WARN__});
                unless (eval { CORE::chmod($perm, $local) > 0 }) {
                    $error = ($@ ? $@ : $!);
                }
            };
	    if ($error and !$best_effort) {
                unlink $local unless $resume or $append;
		$sftp->_set_error(SFTP_ERR_LOCAL_CHMOD_FAILED,
				  "Can't chmod $local", $error);
		return undef
	    }
	}
    }

    my $converter = _gen_converter $conversion;

    my $rfid = $sftp->_rfid($rfh);
    defined $rfid or die "internal error: rfid not defined";

    my @msgid;
    my @askoff;
    my $loff = $askoff;
    my $adjustment = 0;
    local $\;

    my $slow_start = ($size == -1 ? $queue_size - 1 : 0);

    my $safe_block_size = $sftp->{_min_block_size} >= $block_size;

    do {
        # Disable autodie here in order to do not leave unhandled
        # responses queued on the connection in case of failure.
        local $sftp->{_autodie};

        # Again, once this point is reached, all code paths should end
        # through the CLEANUP block.

        while (1) {
            # request a new block if queue is not full
            while (!@msgid or ( ($size == -1 or $size + $block_size > $askoff)   and
                                @msgid < $queue_size - $slow_start and
                                $safe_block_size ) ) {
                my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid,
                                               int64 => $askoff, int32 => $block_size);
                push @msgid, $id;
                push @askoff, $askoff;
                $askoff += $block_size;
            }

            $slow_start-- if $slow_start;

            my $eid = shift @msgid;
            my $roff = shift @askoff;

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

            unless ($msg) {
                $sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF;
                last;
            }

            my $data = $msg->get_str;
            my $len = length $data;

            if ($roff != $loff or !$len) {
                $sftp->_set_error(SFTP_ERR_REMOTE_BLOCK_TOO_SMALL,
                                  "remote packet received is too small" );
                last;
            }

            $loff += $len;
            unless ($safe_block_size) {
                if ($len > $sftp->{_min_block_size}) {
                    $sftp->{min_block_size} = $len;
                    if ($len < $block_size) {
                        # auto-adjust block size
                        $block_size = $len;
                        $askoff = $loff;
                    }
                }
                $safe_block_size = 1;
            }

            my $adjustment_before = $adjustment;
            $adjustment += $converter->($data) if $converter;

            if (length($data) and defined $cb) {
                # $size = $loff if ($loff > $size and $size != -1);
                local $\;
                $cb->($sftp, $data,
                      $lstart + $roff + $adjustment_before,
                      $lstart + $size + $adjustment);

                last if $sftp->{_error};
            }

            if (length($data) and !$dont_save) {
                unless (print $fh $data) {
                    $sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
                                      "unable to write data to local file $local", $!);
                    last;
                }
            }
        }

        $sftp->_get_msg_by_id($_) for @msgid;

        goto CLEANUP if $sftp->{_error};

        # if a converter is in place, and aditional call has to be
        # performed in order to flush any pending buffered data
        if ($converter) {
            my $data = '';
            my $adjustment_before = $adjustment;
            $adjustment += $converter->($data);

            if (length($data) and defined $cb) {
                # $size = $loff if ($loff > $size and $size != -1);
                local $\;
                $cb->($sftp, $data, $askoff + $adjustment_before, $size + $adjustment);
                goto CLEANUP if $sftp->{_error};
            }

            if (length($data) and !$dont_save) {
                unless (print $fh $data) {
                    $sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
                                      "unable to write data to local file $local", $!);
                    goto CLEANUP;
                }
            }
        }

        # we call the callback one last time with an empty string;
        if (defined $cb) {
            my $data = '';
            do {
                local $\;
                $cb->($sftp, $data, $askoff + $adjustment, $size + $adjustment);
            };
            return undef if $sftp->{_error};
            if (length($data) and !$dont_save) {
                unless (print $fh $data) {
                    $sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
                                      "unable to write data to local file $local", $!);
                    goto CLEANUP;
                }
            }
        }

        unless ($dont_save) {
            unless ($local_is_fh or CORE::close $fh) {
                $sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
                                  "unable to write data to local file $local", $!);
                goto CLEANUP;
            }

            # we can be running on taint mode, so some checks are
            # performed to untaint data from the remote side.

            if ($copy_time) {
                unless (utime($atime, $mtime, $local) or $best_effort) {
                    $sftp->_set_error(SFTP_ERR_LOCAL_UTIME_FAILED,
                                      "Can't utime $local", $!);
                    goto CLEANUP;
                }
            }

            if ($atomic) {
                if (!$overwrite) {
                    while (1) {
                        # performing a non-overwriting atomic rename is
                        # quite burdensome: first, link is tried, if that
                        # fails, non-overwriting is favoured over
                        # atomicity and an empty file is used to lock the
                        # path before atempting an overwriting rename.
                        if (link $local, $atomic_local) {
                            unlink $local;
                            last;
                        }
                        my $err = $!;
                        unless (-e $atomic_local) {
                            if (sysopen my $lock, $atomic_local,
                                Fcntl::O_CREAT|Fcntl::O_EXCL|Fcntl::O_WRONLY,
                                0600) {
                                $atomic_cleanup = 1;
                                goto OVERWRITE;
                            }
                            $err = $!;
                            unless (-e $atomic_local) {
                                $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
                                                  "Can't open $local", $err);
                                goto CLEANUP;
                            }
                        }
                        unless ($numbered) {
                            $sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,
                                              "local file $atomic_local already exists");
                            goto CLEANUP;
                        }
                        _inc_numbered($atomic_local);
                    }
                }
                else {
                OVERWRITE:
                    unless (CORE::rename $local, $atomic_local) {
                        $sftp->_set_error(SFTP_ERR_LOCAL_RENAME_FAILED,
                                          "Unable to rename temporal file to its final position '$atomic_local'", $!);
                        goto CLEANUP;
                    }
                }
                $$atomic_numbered = $local if ref $atomic_numbered;
            }
        }
    CLEANUP:
        if ($cleanup and $sftp->{_error}) {
            unlink $local;
            unlink $atomic_local if $atomic_cleanup;
        }
    }; # autodie flag is restored here!

    $sftp->_ok_or_autodie;
}

# return file contents on success, undef on failure
sub get_content {
    @_ == 2 or croak 'Usage: $sftp->get_content($remote)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $name) = @_;
    #$name = $sftp->_rel2abs($name);
    my @data;

    my $rfh = $sftp->open($name)
	or return undef;

    scalar $sftp->readline($rfh, undef);
}

sub put {
    @_ >= 2 or croak 'Usage: $sftp->put($local, $remote, %opts)';
    ${^TAINT} and &_catch_tainted_args;

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

    $sftp->_clear_error_and_status;

    my $local_is_fh = (ref $local and $local->isa('GLOB'));
    unless (defined $remote) {
        $local_is_fh and croak "unable to infer remote file name when a file handler is passed as local";
        $remote = (File::Spec->splitpath($local))[2];
    }
    # $remote = $sftp->_rel2abs($remote);

    my $cb = delete $opts{callback};
    my $umask = delete $opts{umask};
    my $perm = delete $opts{perm};
    my $copy_perm = delete $opts{copy_perm};
    $copy_perm = delete $opts{copy_perms} unless defined $copy_perm;
    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 $conversion = delete $opts{conversion};
    my $late_set_perm = delete $opts{late_set_perm};
    my $numbered = delete $opts{numbered};
    my $atomic = delete $opts{atomic};
    my $cleanup = delete $opts{cleanup};
    my $best_effort = delete $opts{best_effort};
    my $sparse = delete $opts{sparse};
    my $mkpath = delete $opts{mkpath};

    croak "'perm' and 'umask' options can not be used simultaneously"
	if (defined $perm and defined $umask);
    croak "'perm' and 'copy_perm' options can not be used simultaneously"
	if (defined $perm and $copy_perm);
    croak "'resume' and 'append' options can not be used simultaneously"
	if ($resume and $append);
    croak "'resume' and 'overwrite' options can not be used simultaneously"
	if ($resume and $overwrite);
    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));

    %opts and _croak_bad_options(keys %opts);

    $overwrite = 1 unless (defined $overwrite 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);
    $late_set_perm = $sftp->{_late_set_perm} unless defined $late_set_perm;
    $cleanup = ($atomic || $numbered) unless defined $cleanup;
    $mkpath = 1 unless defined $mkpath;

    my $neg_umask;
    if (defined $perm) {
	$neg_umask = $perm;
    }
    else {
	$umask = umask unless defined $umask;
	$neg_umask = 0777 & ~$umask;
    }

    my ($fh, $lmode, $lsize, $latime, $lmtime);
    if ($local_is_fh) {
	$fh = $local;
	# we don't set binmode for the passed file handle on purpose
    }
    else {
	unless (CORE::open $fh, '<', $local) {
	    $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
			      "Unable to open local file '$local'", $!);
	    return undef;
	}
	binmode $fh;
    }

    {
	# as $fh can come from the outside, it may be a tied object
	# lacking support for some methods, so we call them wrapped
	# inside eval blocks
	local ($@, $SIG{__DIE__}, $SIG{__WARN__});
	if ((undef, undef, $lmode, undef, undef,
	     undef, undef, $lsize, $latime, $lmtime) =
	    eval {
		no warnings; # Calling stat on a tied handler
                             # generates a warning because the op is
                             # not supported by the tie API.
		CORE::stat $fh;
	    }
	   ) {
            $debug and $debug & 16384 and _debug "local file size is " . (defined $lsize ? $lsize : '');

	    # $fh can point at some place inside the file, not just at the
	    # begining
	    if ($local_is_fh and defined $lsize) {
		my $tell = eval { CORE::tell $fh };
		$lsize -= $tell if $tell and $tell > 0;
	    }
	}
	elsif ($copy_perm or $copy_time) {
	    $sftp->_set_error(SFTP_ERR_LOCAL_STAT_FAILED,
			      "Couldn't stat local file '$local'", $!);
	    return undef;
	}
	elsif ($resume and $resume eq 'auto') {
            $debug and $debug & 16384 and _debug "not resuming because stat'ing the local file failed";
	    undef $resume
	}
    }

    $perm = $lmode & $neg_umask if $copy_perm;
    my $attrs = Net::SFTP::Foreign::Attributes->new;
    $attrs->set_perm($perm) if defined $perm;

    my $rfh;
    my $writeoff = 0;
    my $converter = _gen_converter $conversion;
    my $converted_input = '';
    my $rattrs;

    if ($resume or $append) {
	$rattrs = do {
            local $sftp->{_autodie};
            $sftp->stat($remote);
        };
	if ($rattrs) {
	    if ($resume and $resume eq 'auto' and $rattrs->mtime <= $lmtime) {
                $debug and $debug & 16384 and
                    _debug "not resuming because local file is newer, r: ".$rattrs->mtime." l: $lmtime";
		undef $resume;
	    }
	    else {
		$writeoff = $rattrs->size;
		$debug and $debug & 16384 and _debug "resuming from $writeoff";
	    }
	}
        else {
            if ($append) {
                $sftp->{_status} == SSH2_FX_NO_SUCH_FILE
                    or $sftp->_ok_or_autodie or return undef;
                # no such file, no append
                undef $append;
            }
            $sftp->_clear_error_and_status;
        }
    }

    my ($atomic_numbered, $atomic_remote);
    if ($writeoff) {
        # one of $resume or $append is set
        if ($resume) {
            $debug and $debug & 16384 and _debug "resuming file transfer from $writeoff";
            if ($converter) {
                # as size could change, we have to read and convert
                # data until we reach the given position on the local
                # file:
                my $off = 0;
                my $eof_t;
                while (1) {
                    my $len = length $converted_input;
                    my $delta = $writeoff - $off;
                    if ($delta <= $len) {
                        $debug and $debug & 16384 and _debug "discarding $delta converted bytes";
                        substr $converted_input, 0, $delta, '';
                        last;
                    }
                    else {
                        $off += $len;
                        if ($eof_t) {
                            $sftp->_set_error(SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL,
                                              "Couldn't resume transfer, remote file is bigger than local");
                            return undef;
                        }
                        my $read = CORE::read($fh, $converted_input, $block_size * 4);
                        unless (defined $read) {
                            $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
                                              "Couldn't read from local file '$local' to the resume point $writeoff", $!);
                            return undef;
                        }
                        $lsize += $converter->($converted_input) if defined $lsize;
                        utf8::downgrade($converted_input, 1)
                                or croak "converter introduced wide characters in data";
                        $read or $eof_t = 1;
                    }
                }
            }
            elsif ($local_is_fh) {
                # as some PerlIO layer could be installed on the $fh,
                # just seeking to the resume position will not be
                # enough. We have to read and discard data until the
                # desired offset is reached
                my $off = $writeoff;
                while ($off) {
                    my $read = CORE::read($fh, my($buf), ($off < 16384 ? $off : 16384));
                    if ($read) {
                        $debug and $debug & 16384 and _debug "discarding $read bytes";
                        $off -= $read;
                    }
                    else {
                        $sftp->_set_error(defined $read
                                          ? ( SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL,
                                              "Couldn't resume transfer, remote file is bigger than local")
                                          : ( SFTP_ERR_LOCAL_READ_ERROR,
                                              "Couldn't read from local file handler '$local' to the resume point $writeoff", $!));
                    }
                }
            }
            else {
                if (defined $lsize and $writeoff > $lsize) {
                    $sftp->_set_error(SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL,
                                      "Couldn't resume transfer, remote file is bigger than local");
                    return undef;
                }
                unless (CORE::seek($fh, $writeoff, 0)) {
                    $sftp->_set_error(SFTP_ERR_LOCAL_SEEK_FAILED,
                                      "seek operation on local file failed: $!");
                    return undef;
                }
            }
            if (defined $lsize and $writeoff == $lsize) {
                if (defined $perm and $rattrs->perm != $perm) {
                    # FIXME: do copy_time here if required
                    return $sftp->_best_effort($best_effort, setstat => $remote, $attrs);
                }
                return 1;
            }
        }
        $rfh = $sftp->open($remote, SSH2_FXF_WRITE)
            or return undef;
    }
    else {
        if ($atomic) {
            # check that does not exist a file of the same name that
            # would block the rename operation at the end
            if (!($numbered or $overwrite) and
                $sftp->test_e($remote)) {
                $sftp->_set_status(SSH2_FX_FAILURE);
                $sftp->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS,
                                  "Remote file '$remote' already exists");
                return undef;
            }
            $atomic_remote = $remote;
            $remote .= sprintf("(%d).tmp", rand(10000));
            $atomic_numbered = $numbered;
            $numbered = 1;
            $debug and $debug & 128 and _debug("temporal remote file name: $remote");
        }
        local $sftp->{_autodie};
	if ($numbered) {
            while (1) {
                $rfh = $sftp->_open_mkpath($remote,
                                          $mkpath,
                                          SSH2_FXF_WRITE | SSH2_FXF_CREAT | SSH2_FXF_EXCL,
                                          $attrs);
                last if ($rfh or
                         $sftp->{_status} != SSH2_FX_FAILURE or
                         !$sftp->test_e($remote));
                _inc_numbered($remote);
	    }
            $$numbered = $remote if $rfh and ref $numbered;
	}
        else {
            # open can fail due to a remote file with the wrong
            # permissions being already there. We are optimistic here,
            # first we try to open the remote file and if it fails due
            # to a permissions error then we remove it and try again.
            for my $rep (0, 1) {
                $rfh = $sftp->_open_mkpath($remote,
                                           $mkpath,
                                           SSH2_FXF_WRITE | SSH2_FXF_CREAT |
                                           ($overwrite ? SSH2_FXF_TRUNC : SSH2_FXF_EXCL),
                                           $attrs);

                last if $rfh or $rep or !$overwrite or $sftp->{_status} != SSH2_FX_PERMISSION_DENIED;

                $debug and $debug & 2 and _debug("retrying open after removing remote file");
                local ($sftp->{_status}, $sftp->{_error});
                $sftp->remove($remote);
            }
        }
    }

    $sftp->_ok_or_autodie or return undef;
    # Once this point is reached and for the remaining of the sub,
    # code should never return but jump into the CLEANUP block.

    my $last_block_was_zeros;

    do {
        local $sftp->{autodie};

        # In some SFTP server implementations, open does not set the
        # attributes for existent files so we do it again. The
        # $late_set_perm work around is for some servers that do not
        # support changing the permissions of open files
        if (defined $perm and !$late_set_perm) {
            $sftp->_best_effort($best_effort, setstat => $rfh, $attrs) or goto CLEANUP;
        }

        my $rfid = $sftp->_rfid($rfh);
        defined $rfid or die "internal error: rfid is undef";

        # In append mode we add the size of the remote file in
        # writeoff, if lsize is undef, we initialize it to $writeoff:
        $lsize += $writeoff if ($append or not defined $lsize);

        # when a converter is used, the EOF can become delayed by the
        # buffering introduced, we use $eof_t to account for that.
        my ($eof, $eof_t);
        my @msgid;
    OK: while (1) {
            if (!$eof and @msgid < $queue_size) {
                my ($data, $len);
                if ($converter) {
                    while (!$eof_t and length $converted_input < $block_size) {
                        my $read = CORE::read($fh, my $input, $block_size * 4);
                        unless ($read) {
                            unless (defined $read) {
                                $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
                                                  "Couldn't read from local file '$local'", $!);
                                last OK;
                            }
                            $eof_t = 1;
                        }

                        # note that the $converter is called a last time
                        # with an empty string
                        $lsize += $converter->($input);
                        utf8::downgrade($input, 1)
                                or croak "converter introduced wide characters in data";
                        $converted_input .= $input;
                    }
                    $data = substr($converted_input, 0, $block_size, '');
                    $len = length $data;
                    $eof = 1 if ($eof_t and !$len);
                }
                else {
                    $debug and $debug & 16384 and
                        _debug "reading block at offset ".CORE::tell($fh)." block_size: $block_size";

                    $len = CORE::read($fh, $data, $block_size);

                    if ($len) {
                        $debug and $debug & 16384 and _debug "block read, size: $len";

                        utf8::downgrade($data, 1)
                                or croak "wide characters unexpectedly read from file";

                        $debug and $debug & 16384 and length $data != $len and
                            _debug "read data changed size on downgrade to " . length($data);
                    }
                    else {
                        unless (defined $len) {
                            $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
                                              "Couldn't read from local file '$local'", $!);
                            last OK;
                        }
                        $eof = 1;
                    }
                }

                my $nextoff = $writeoff + $len;

                if (defined $cb) {
                    $lsize = $nextoff if $nextoff > $lsize;
                    $cb->($sftp, $data, $writeoff, $lsize);

                    last OK if $sftp->{_error};

                    utf8::downgrade($data, 1) or croak "callback introduced wide characters in data";

                    $len = length $data;
                    $nextoff = $writeoff + $len;
                }

                if ($len) {
                    if ($sparse and $data =~ /^\x{00}*$/s) {
                        $last_block_was_zeros = 1;
                        $debug and $debug & 16384 and _debug "skipping zeros block at offset $writeoff, length $len";
                    }
                    else {
                        $debug and $debug & 16384 and _debug "writing block at offset $writeoff, length $len";

                        my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid,
                                                       int64 => $writeoff, str => $data);
                        push @msgid, $id;
                        $last_block_was_zeros = 0;
                    }
                    $writeoff = $nextoff;
                }
            }

            last if ($eof and !@msgid);

            next unless  ($eof
                          or @msgid >= $queue_size
                          or $sftp->_do_io(0));

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

        CORE::close $fh unless $local_is_fh;

        $sftp->_get_msg_by_id($_) for @msgid;

        $sftp->truncate($rfh, $writeoff)
            if $last_block_was_zeros and not $sftp->{_error};

        $sftp->_close_save_status($rfh);

        goto CLEANUP if $sftp->{_error};

        # set perm for servers that does not support setting
        # permissions on open files and also atime and mtime:
        if ($copy_time or ($late_set_perm and defined $perm)) {
            $attrs->set_perm unless $late_set_perm and defined $perm;
            $attrs->set_amtime($latime, $lmtime) if $copy_time;
            $sftp->_best_effort($best_effort, setstat => $remote, $attrs) or goto CLEANUP
        }

        if ($atomic) {
            $sftp->rename($remote, $atomic_remote,
                          overwrite => $overwrite,
                          numbered => $atomic_numbered) or goto CLEANUP;
        }

    CLEANUP:
        if ($cleanup and $sftp->{_error}) {
            warn "cleanup $remote";
            $sftp->_remove_save_status($remote);
        }
    };
    $sftp->_ok_or_autodie;
}

sub put_content {
    @_ >= 3 or croak 'Usage: $sftp->put_content($content, $remote, %opts)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, undef, $remote, %opts) = @_;
    my %put_opts = ( map { $_ => delete $opts{$_} }
                     qw(perm umask block_size queue_size overwrite conversion resume
                        numbered late_set_perm atomic best_effort mkpath));
    %opts and _croak_bad_options(keys %opts);

    my $fh;
    unless (CORE::open $fh, '<', \$_[1]) {
        $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED, "Can't open scalar as file handle", $!);
        return undef;
    }
    $sftp->put($fh, $remote, %opts);
}

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

    my $sftp = shift;
    my %opts = @_ & 1 ? (dir => @_) : @_;

    my $dir = delete $opts{dir};
    my $ordered = delete $opts{ordered};
    my $follow_links = delete $opts{follow_links};
    my $atomic_readdir = delete $opts{atomic_readdir};
    my $names_only = delete $opts{names_only};
    my $realpath = delete $opts{realpath};
    my $queue_size = delete $opts{queue_size};
    my $cheap = ($names_only and !$realpath);
    my ($cheap_wanted, $wanted);
    if ($cheap and
	ref $opts{wanted} eq 'Regexp' and
	not defined $opts{no_wanted}) {
	$cheap_wanted = delete $opts{wanted}
    }
    else {
	$wanted = (delete $opts{_wanted} ||
		   _gen_wanted(delete $opts{wanted},
			       delete $opts{no_wanted}));
	undef $cheap if defined $wanted;
    }

    %opts and _croak_bad_options(keys %opts);

    my $delayed_wanted = ($atomic_readdir and $wanted);
    $queue_size = 1 if ($follow_links or $realpath or
			($wanted and not $delayed_wanted));
    my $max_queue_size = $queue_size || $sftp->{_queue_size};
    $queue_size ||= ($max_queue_size < 2 ? $max_queue_size : 2);

    $dir = '.' unless defined $dir;
    $dir = $sftp->_rel2abs($dir);

    my $rdh = $sftp->opendir($dir);
    return unless defined $rdh;

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

    my @dir;
    my @msgid;

    do {
        local $sftp->{_autodie};
    OK: while (1) {
            push @msgid, $sftp->_queue_str_request(SSH2_FXP_READDIR, $rdid)
                while (@msgid < $queue_size);

            my $id = shift @msgid;
            my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id,
						SFTP_ERR_REMOTE_READDIR_FAILED,
						"Couldn't read directory '$dir'" ) or last;
	    my $count = $msg->get_int32 or last;

	    if ($cheap) {
		for (1..$count) {
		    my $fn = $sftp->_fs_decode($msg->get_str);
		    push @dir, $fn if (!defined $cheap_wanted or $fn =~ $cheap_wanted);
		    $msg->skip_str;
		    Net::SFTP::Foreign::Attributes->skip_from_buffer($msg);
		}
	    }
	    else {
		for (1..$count) {
		    my $fn = $sftp->_fs_decode($msg->get_str);
		    my $ln = $sftp->_fs_decode($msg->get_str);
		    # my $a = $msg->get_attributes;
		    my $a = Net::SFTP::Foreign::Attributes->new_from_buffer($msg);

		    my $entry =  { filename => $fn,
				   longname => $ln,
				   a => $a };

		    if ($follow_links and _is_lnk($a->perm)) {

			if ($a = $sftp->stat($sftp->join($dir, $fn))) {
			    $entry->{a} = $a;
			}
			else {
			    $sftp->_clear_error_and_status;
			}
		    }

		    if ($realpath) {
			my $rp = $sftp->realpath($sftp->join($dir, $fn));
			if (defined $rp) {
			    $fn = $entry->{realpath} = $rp;
			}
			else {
			    $sftp->_clear_error_and_status;
			}
		    }

		    if (!$wanted or $delayed_wanted or $wanted->($sftp, $entry)) {
			push @dir, (($names_only and !$delayed_wanted) ? $fn : $entry);
		    }
                }
	    }
	    $queue_size++ if $queue_size < $max_queue_size;
	}
	$sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF;
	$sftp->_get_msg_by_id($_) for @msgid;
        $sftp->_closedir_save_status($rdh) if $rdh;
    };
    unless ($sftp->{_error}) {
	if ($delayed_wanted) {
	    @dir = grep { $wanted->($sftp, $_) } @dir;
	    @dir = map { defined $_->{realpath}
			 ? $_->{realpath}
			 : $_->{filename} } @dir
		if $names_only;
	}
        if ($ordered) {
            if ($names_only) {
                @dir = sort @dir;
            }
            else {
                _sort_entries \@dir;
            }
        }
	return \@dir;
    }
    croak $sftp->{_error} if $sftp->{_autodie};
    return undef;
}

sub rremove {
    @_ >= 2 or croak 'Usage: $sftp->rremove($dirs, %opts)';
    ${^TAINT} and &_catch_tainted_args;

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

    my $on_error = delete $opts{on_error};
    local $sftp->{_autodie} if $on_error;
    my $wanted = _gen_wanted( delete $opts{wanted},
			      delete $opts{no_wanted});

    %opts and _croak_bad_options(keys %opts);

    my $count = 0;

    my @dirs;
    $sftp->find( $dirs,
		 on_error => $on_error,
		 atomic_readdir => 1,
		 wanted => sub {
		     my $e = $_[1];
		     my $fn = $e->{filename};
		     if (_is_dir($e->{a}->perm)) {
			 push @dirs, $e;
		     }
		     else {
			 if (!$wanted or $wanted->($sftp, $e)) {
			     if ($sftp->remove($fn)) {
				 $count++;
			     }
			     else {
				 $sftp->_call_on_error($on_error, $e);
			     }
			 }
		     }
		 } );

    _sort_entries(\@dirs);

    while (@dirs) {
	my $e = pop @dirs;
	if (!$wanted or $wanted->($sftp, $e)) {
	    if ($sftp->rmdir($e->{filename})) {
		$count++;
	    }
	    else {
		$sftp->_call_on_error($on_error, $e);
	    }
	}
    }

    return $count;
}

sub get_symlink {
    @_ >= 3 or croak 'Usage: $sftp->get_symlink($remote, $local, %opts)';
    my ($sftp, $remote, $local, %opts) = @_;
    my $overwrite = delete $opts{overwrite};
    my $numbered = delete $opts{numbered};

    croak "'overwrite' and 'numbered' can not be used together"
	if ($overwrite and $numbered);
   %opts and _croak_bad_options(keys %opts);

    $overwrite = 1 unless (defined $overwrite or $numbered);

    my $a = $sftp->lstat($remote) or return undef;
    unless (_is_lnk($a->perm)) {
	$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
			  "Remote object '$remote' is not a symlink");
	return undef;
    }

    my $link = $sftp->readlink($remote) or return undef;

    # TODO: this is too weak, may contain race conditions.
    if ($numbered) {
        _inc_numbered($local) while -e $local;
    }
    elsif (-e $local) {
	if ($overwrite) {
	    unlink $local;
	}
	else {
	    $sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,
			      "local file $local already exists");
	    return undef
	}
    }

    unless (eval { CORE::symlink $link, $local }) {
	$sftp->_set_error(SFTP_ERR_LOCAL_SYMLINK_FAILED,
			  "creation of symlink '$local' failed", $!);
	return undef;
    }
    $$numbered = $local if ref $numbered;

    1;
}

sub put_symlink {
    @_ >= 3 or croak 'Usage: $sftp->put_symlink($local, $remote, %opts)';
    my ($sftp, $local, $remote, %opts) = @_;
    my $overwrite = delete $opts{overwrite};
    my $numbered = delete $opts{numbered};

    croak "'overwrite' and 'numbered' can not be used together"
	if ($overwrite and $numbered);
    %opts and _croak_bad_options(keys %opts);

    $overwrite = 1 unless (defined $overwrite or $numbered);
    my $perm = (CORE::lstat $local)[2];
    unless (defined $perm) {
	$sftp->_set_error(SFTP_ERR_LOCAL_STAT_FAILED,
			  "Couldn't stat local file '$local'", $!);
	return undef;
    }
    unless (_is_lnk($perm)) {
	$sftp->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT,
			  "Local file $local is not a symlink");
	return undef;
    }
    my $target = readlink $local;
    unless (defined $target) {
	$sftp->_set_error(SFTP_ERR_LOCAL_READLINK_FAILED,
			  "Couldn't read link '$local'", $!);
	return undef;
    }

    while (1) {
        local $sftp->{_autodie};
        $sftp->symlink($remote, $target);
        if ($sftp->{_error} and
            $sftp->{_status} == SSH2_FX_FAILURE) {
            if ($numbered and $sftp->test_e($remote)) {
                _inc_numbered($remote);
                redo;
            }
            elsif ($overwrite and $sftp->_remove_save_status($remote)) {
                $overwrite = 0;
                redo;
            }
        }
        last
    }
    $$numbered = $remote if ref $numbered;
    $sftp->_ok_or_autodie;
}

sub rget {
    @_ >= 2 or croak 'Usage: $sftp->rget($remote, $local, %opts)';
    ${^TAINT} and &_catch_tainted_args;
    my ($sftp, $remote, $local, %opts) = @_;

    defined $remote or croak "remote file path is undefined";
    $local = File::Spec->curdir unless defined $local;

    # my $cb = delete $opts{callback};
    my $umask = delete $opts{umask};
    my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'};
    my $copy_time = delete $opts{copy_time};
    my $newer_only = delete $opts{newer_only};
    my $on_error = delete $opts{on_error};
    local $sftp->{_autodie} if $on_error;
    my $ignore_links = delete $opts{ignore_links};
    my $mkpath = delete $opts{mkpath};

    # my $relative_links = delete $opts{relative_links};

    my $wanted = _gen_wanted( delete $opts{wanted},
			      delete $opts{no_wanted} );

    my %get_opts = (map { $_ => delete $opts{$_} }
                    qw(block_size queue_size overwrite conversion
                       resume numbered atomic best_effort));

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

    my %get_symlink_opts = (map { $_ => $get_opts{$_} }
                            qw(overwrite numbered));

    %opts and _croak_bad_options(keys %opts);

    $remote = $sftp->join($remote, './');
    my $qremote = quotemeta $remote;
    my $reremote = qr/^$qremote(.*)$/i;

    my $save = _umask_save_and_set $umask;

    $copy_perm = 1 unless defined $copy_perm;
    $copy_time = 1 unless defined $copy_time;
    $mkpath    = 1 unless defined $mkpath;

    my $count = 0;
    $sftp->find( [$remote],
		 descend => sub {
		     my $e = $_[1];
		     # print "descend: $e->{filename}\n";
		     if (!$wanted or $wanted->($sftp, $e)) {
			 my $fn = $e->{filename};
			 if ($fn =~ $reremote) {
			     my $lpath = File::Spec->catdir($local, $1);
                             ($lpath) = $lpath =~ /(.*)/ if ${^TAINT};
			     if (-d $lpath) {
				 $sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,
						   "directory '$lpath' already exists");
				 $sftp->_call_on_error($on_error, $e);
				 return 1;
			     }
			     else {
                                 my $perm = ($copy_perm ? $e->{a}->perm & 0777 : 0777);
                                 if (CORE::mkdir($lpath, $perm) or
                                     ($mkpath and $sftp->_mkpath_local($lpath, $perm))) {
				     $count++;
				     return 1;
				 }
                                 $sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED,
                                                   "mkdir '$lpath' failed", $!);
			     }
			 }
			 else {
			     $sftp->_set_error(SFTP_ERR_REMOTE_BAD_PATH,
					       "bad remote path '$fn'");
			 }
			 $sftp->_call_on_error($on_error, $e);
		     }
		     return undef;
		 },
		 wanted => sub {
		     my $e = $_[1];
		     unless (_is_dir($e->{a}->perm)) {
			 if (!$wanted or $wanted->($sftp, $e)) {
			     my $fn = $e->{filename};
			     if ($fn =~ $reremote) {
				 my $lpath = ((length $1) ? File::Spec->catfile($local, $1) : $local);
                                 # print "file fn:$e->{filename}, lpath:$lpath, re:$reremote\n";
                                 ($lpath) = $lpath =~ /(.*)/ if ${^TAINT};
				 if (_is_lnk($e->{a}->perm) and !$ignore_links) {
				     if ($sftp->get_symlink($fn, $lpath,
							    # copy_time => $copy_time,
                                                            %get_symlink_opts)) {
					 $count++;
					 return undef;
				     }
				 }
				 elsif (_is_reg($e->{a}->perm)) {
				     if ($newer_only and -e $lpath
					 and (CORE::stat _)[9] >= $e->{a}->mtime) {
					 $sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,
							   "newer local file '$lpath' already exists");
				     }
				     else {
					 if ($sftp->get($fn, $lpath,
							copy_perm => $copy_perm,
							copy_time => $copy_time,
                                                        %get_opts)) {
					     $count++;
					     return undef;
					 }
				     }
				 }
				 else {
				     $sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
						       ( $ignore_links
							 ? "remote file '$fn' is not regular file or directory"
							 : "remote file '$fn' is not regular file, directory or link"));
				 }
			     }
			     else {
				 $sftp->_set_error(SFTP_ERR_REMOTE_BAD_PATH,
						   "bad remote path '$fn'");
			     }
			     $sftp->_call_on_error($on_error, $e);
			 }
		     }
		     return undef;
		 } );

    return $count;
}

sub rput {
    @_ >= 2 or croak 'Usage: $sftp->rput($local, $remote, %opts)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $local, $remote, %opts) = @_;

    defined $local or croak "local path is undefined";
    $remote = '.' unless defined $remote;

    # 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 $newer_only = delete $opts{newer_only};
    my $on_error = delete $opts{on_error};
    local $sftp->{_autodie} if $on_error;
    my $ignore_links = delete $opts{ignore_links};
    my $mkpath = delete $opts{mkpath};

    my $wanted = _gen_wanted( delete $opts{wanted},
			      delete $opts{no_wanted} );

    my %put_opts = (map { $_ => delete $opts{$_} }
		    qw(block_size queue_size overwrite
                       conversion resume numbered
                       late_set_perm atomic best_effort
                       sparse));

    my %put_symlink_opts = (map { $_ => $put_opts{$_} }
                            qw(overwrite numbered));

    croak "'perm' and 'umask' options can not be used simultaneously"
        if (defined $perm and defined $umask);
    croak "'perm' and 'copy_perm' options can not be used simultaneously"
        if (defined $perm and $copy_perm);

    %opts and _croak_bad_options(keys %opts);

    require Net::SFTP::Foreign::Local;
    my $lfs = Net::SFTP::Foreign::Local->new;

    $local = $lfs->join($local, './');
    my $relocal;
    if ($local =~ m|^\./?$|) {
	$relocal = qr/^(.*)$/;
    }
    else {
	my $qlocal = quotemeta $local;
	$relocal = qr/^$qlocal(.*)$/i;
    }

    $copy_perm = 1 unless defined $copy_perm;
    $copy_time = 1 unless defined $copy_time;
    $mkpath = 1 unless defined $mkpath;

    my $mask;
    if (defined $perm) {
        $mask = $perm & 0777;
    }
    else {
        $umask = umask unless defined $umask;
        $mask = 0777 & ~$umask;
    }

    if ($on_error) {
	my $on_error1 = $on_error;
	$on_error = sub {
	    my $lfs = shift;
	    $sftp->_copy_error($lfs);
	    $sftp->_call_on_error($on_error1, @_);
	}
    }

    my $count = 0;
    $lfs->find( [$local],
		descend => sub {
		    my $e = $_[1];
		    # print "descend: $e->{filename}\n";
		    if (!$wanted or $wanted->($lfs, $e)) {
			my $fn = $e->{filename};
			$debug and $debug & 32768 and _debug "rput handling $fn";
			if ($fn =~ $relocal) {
			    my $rpath = $sftp->join($remote, File::Spec->splitdir($1));
			    $debug and $debug & 32768 and _debug "rpath: $rpath";
                            my $a = Net::SFTP::Foreign::Attributes->new;
                            if (defined $perm) {
                                $a->set_perm($mask | 0300);
                            }
                            elsif ($copy_perm) {
                                $a->set_perm($e->{a}->perm & $mask);
                            }
                            if ($sftp->mkdir($rpath, $a)) {
                                $count++;
                                return 1;
                            }
                            if ($mkpath and
                                $sftp->status == SSH2_FX_NO_SUCH_FILE) {
                                $sftp->_clear_error_and_status;
                                if ($sftp->mkpath($rpath, $a)) {
                                    $count++;
                                    return 1;
                                }
                            }
                            $lfs->_copy_error($sftp);
                            if ($sftp->test_d($rpath)) {
				$lfs->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS,
						 "Remote directory '$rpath' already exists");
				$lfs->_call_on_error($on_error, $e);
				return 1;
			    }
			}
			else {
			    $lfs->_set_error(SFTP_ERR_LOCAL_BAD_PATH,
					      "Bad local path '$fn'");
			}
			$lfs->_call_on_error($on_error, $e);
		    }
		    return undef;
		},
		wanted => sub {
		    my $e = $_[1];
		    # print "file fn:$e->{filename}, a:$e->{a}\n";
		    unless (_is_dir($e->{a}->perm)) {
			if (!$wanted or $wanted->($lfs, $e)) {
			    my $fn = $e->{filename};
			    $debug and $debug & 32768 and _debug "rput handling $fn";
			    if ($fn =~ $relocal) {
				my (undef, $d, $f) = File::Spec->splitpath($1);
				my $rpath = $sftp->join($remote, File::Spec->splitdir($d), $f);
				if (_is_lnk($e->{a}->perm) and !$ignore_links) {
				    if ($sftp->put_symlink($fn, $rpath,
                                                           %put_symlink_opts)) {
					$count++;
					return undef;
				    }
				    $lfs->_copy_error($sftp);
				}
				elsif (_is_reg($e->{a}->perm)) {
				    my $ra;
				    if ( $newer_only and
					 $ra = $sftp->stat($rpath) and
					 $ra->mtime >= $e->{a}->mtime) {
					$lfs->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS,
							 "Newer remote file '$rpath' already exists");
				    }
				    else {
					if ($sftp->put($fn, $rpath,
                                                       ( defined($perm) ? (perm => $perm)
                                                         : $copy_perm   ? (perm => $e->{a}->perm & $mask)
                                                         : (copy_perm => 0, umask => $umask) ),
						       copy_time => $copy_time,
                                                       %put_opts)) {
					    $count++;
					    return undef;
					}
					$lfs->_copy_error($sftp);
				    }
				}
				else {
				    $lfs->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT,
						      ( $ignore_links
							? "Local file '$fn' is not regular file or directory"
							: "Local file '$fn' is not regular file, directory or link"));
				}
			    }
			    else {
				$lfs->_set_error(SFTP_ERR_LOCAL_BAD_PATH,
						  "Bad local path '$fn'");
			    }
			    $lfs->_call_on_error($on_error, $e);
			}
		    }
		    return undef;
		} );

    return $count;
}

sub mget {
    @_ >= 2 or croak 'Usage: $sftp->mget($remote, $localdir, %opts)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $remote, $localdir, %opts) = @_;

    defined $remote or croak "remote pattern is undefined";

    my $on_error = $opts{on_error};
    local $sftp->{_autodie} if $on_error;
    my $ignore_links = delete $opts{ignore_links};

    my %glob_opts = (map { $_ => delete $opts{$_} }
		     qw(on_error follow_links ignore_case
                        wanted no_wanted strict_leading_dot));

    my %get_symlink_opts = (map { $_ => $opts{$_} }
			    qw(overwrite numbered));

    my %get_opts = (map { $_ => delete $opts{$_} }
		    qw(umask perm copy_perm copy_time block_size queue_size
                       overwrite conversion resume numbered atomic best_effort mkpath));

    %opts and _croak_bad_options(keys %opts);

    my @remote = map $sftp->glob($_, %glob_opts), _ensure_list $remote;

    my $count = 0;

    require File::Spec;
    for my $e (@remote) {
	my $perm = $e->{a}->perm;
	if (_is_dir($perm)) {
	    $sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
			      "Remote object '$e->{filename}' is a directory");
	}
	else {
	    my $fn = $e->{filename};
	    my ($local) = $fn =~ m{([^\\/]*)$};

	    $local = File::Spec->catfile($localdir, $local)
		if defined $localdir;

	    if (_is_lnk($perm)) {
		next if $ignore_links;
		$sftp->get_symlink($fn, $local, %get_symlink_opts);
	    }
	    else {
		$sftp->get($fn, $local, %get_opts);
	    }
	}
	$count++ unless $sftp->{_error};
	$sftp->_call_on_error($on_error, $e);
    }
    $count;
}

sub mput {
    @_ >= 2 or croak 'Usage: $sftp->mput($local, $remotedir, %opts)';

    my ($sftp, $local, $remotedir, %opts) = @_;

    defined $local or die "local pattern is undefined";

    my $on_error = $opts{on_error};
    local $sftp->{_autodie} if $on_error;
    my $ignore_links = delete $opts{ignore_links};

    my %glob_opts = (map { $_ => delete $opts{$_} }
		     qw(on_error follow_links ignore_case
                        wanted no_wanted strict_leading_dot));
    my %put_symlink_opts = (map { $_ => $opts{$_} }
			    qw(overwrite numbered));

    my %put_opts = (map { $_ => delete $opts{$_} }
		    qw(umask perm copy_perm copy_time block_size queue_size
                       overwrite conversion resume numbered late_set_perm
                       atomic best_effort sparse mkpath));

    %opts and _croak_bad_options(keys %opts);

    require Net::SFTP::Foreign::Local;
    my $lfs = Net::SFTP::Foreign::Local->new;
    my @local = map $lfs->glob($_, %glob_opts), _ensure_list $local;

    my $count = 0;
    require File::Spec;
    for my $e (@local) {
	my $perm = $e->{a}->perm;
	if (_is_dir($perm)) {
	    $sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
			      "Remote object '$e->{filename}' is a directory");
	}
	else {
	    my $fn = $e->{filename};
	    my $remote = (File::Spec->splitpath($fn))[2];
	    $remote = $sftp->join($remotedir, $remote)
		if defined $remotedir;

	    if (_is_lnk($perm)) {
		next if $ignore_links;
		$sftp->put_symlink($fn, $remote, %put_symlink_opts);
	    }
	    else {
		$sftp->put($fn, $remote, %put_opts);
	    }
	}
	$count++ unless $sftp->{_error};
	$sftp->_call_on_error($on_error, $e);
    }
    $count;
}

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

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

    $sftp->flush($fh, "out");
    $sftp->_check_extension('[e-mail]' => 1,
                            SFTP_ERR_REMOTE_FSYNC_FAILED,
                            "fsync failed, not implemented")
        or return undef;

    my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED,
                                   str => '[e-mail]',
                                   str => $sftp->_rid($fh));
    if ($sftp->_check_status_ok($id,
                                SFTP_ERR_REMOTE_FSYNC_FAILED,
                                "Couldn't fsync remote file")) {
        return 1;
    }
    return undef;
}

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

    my ($sftp, $pofh) = @_;
    my ($extension, $arg) = ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle'))
                              ? ('[e-mail]', $sftp->_rid($pofh) )
                              : ('[e-mail]' , $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) );

    $sftp->_check_extension($extension => 2,
                            SFTP_ERR_REMOTE_STATVFS_FAILED,
                            "statvfs failed, not implemented")
        or return undef;

    my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED,
                                   str => $extension,
                                   str => $arg);

    if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_EXTENDED_REPLY, $id,
                                            SFTP_ERR_REMOTE_STATVFS_FAILED,
                                            "Couldn't stat remote file system")) {
        my %statvfs = map { $_ => $msg->get_int64 } qw(bsize frsize blocks
                                                       bfree bavail files ffree
                                                       favail fsid flag namemax);
        return \%statvfs;
    }
    return undef;
}

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

package Net::SFTP::Foreign::Handle;

use Tie::Handle;
our @ISA = qw(Tie::Handle);
our @CARP_NOT = qw(Net::SFTP::Foreign Tie::Handle);

my $gen_accessor = sub {
    my $ix = shift;
    sub {
	my $st = *{shift()}{ARRAY};
	if (@_) {
	    $st->[$ix] = shift;
	}
	else {
	    $st->[$ix]
	}
    }
};

my $gen_proxy_method = sub {
    my $method = shift;
    sub {
	my $self = $_[0];
	$self->_check
	    or return undef;

	my $sftp = $self->_sftp;
	if (wantarray) {
	    my @ret = $sftp->$method(@_);
	    $sftp->_set_errno unless @ret;
	    return @ret;
	}
	else {
	    my $ret = $sftp->$method(@_);
	    $sftp->_set_errno unless defined $ret;
	    return $ret;
	}
    }
};

my $gen_not_supported = sub {
    sub {
	$! = Errno::ENOTSUP();
	undef
    }
};

sub TIEHANDLE { return shift }

# sub UNTIE {}

sub _new_from_rid {
    my $class = shift;
    my $sftp = shift;
    my $rid = shift;
    my $flags = shift || 0;

    my $self = Symbol::gensym;
    bless $self, $class;
    *$self = [ $sftp, $rid, 0, $flags, @_];
    tie *$self, $self;

    $self;
}

sub _close {
    my $self = shift;
    @{*{$self}{ARRAY}} = ();
}

sub _check {
    return 1 if defined(*{shift()}{ARRAY}[0]);
    $! = Errno::EBADF();
    undef;
}

sub FILENO {
    my $self = shift;
    $self->_check
	or return undef;

    my $hrid = unpack 'H*' => $self->_rid;
    "-1:sftp(0x$hrid)"
}

sub _sftp { *{shift()}{ARRAY}[0] }
sub _rid { *{shift()}{ARRAY}[1] }

* _pos = $gen_accessor->(2);

sub _inc_pos {
    my ($self, $inc) = @_;
    *{shift()}{ARRAY}[2] += $inc;
}


my %flag_bit = (append => 0x1);

sub _flag {
    my $st = *{shift()}{ARRAY};
    my $fn = shift;
    my $flag = $flag_bit{$fn};
    Carp::croak("unknown flag $fn") unless defined $flag;
    if (@_) {
	if (shift) {
	    $st->[3] |= $flag;
	}
	else {
	    $st->[3] &= ~$flag;
	}
    }
    $st->[3] & $flag ? 1 : 0
}

sub _check_is_file {
    Carp::croak("expecting remote file handler, got directory handler");
}
sub _check_is_dir {
    Carp::croak("expecting remote directory handler, got file handler");
}

my $autoloaded;
sub AUTOLOAD {
    my $self = shift;
    our $AUTOLOAD;
    if ($autoloaded) {
	my $class = ref $self || $self;
	Carp::croak qq|Can't locate object method "$AUTOLOAD" via package "$class|;
    }
    else {
	$autoloaded = 1;
	require IO::File;
	require IO::Dir;
	my ($method) = $AUTOLOAD =~ /^.*::(.*)$/;
	$self->$method(@_);
    }
}

package Net::SFTP::Foreign::FileHandle;
our @ISA = qw(Net::SFTP::Foreign::Handle IO::File);

sub _new_from_rid {
    my $class = shift;
    my $sftp = shift;
    my $rid = shift;
    my $flags = shift;

    my $self = $class->SUPER::_new_from_rid($sftp, $rid, $flags, '', '');
}

sub _check_is_file {}

sub _bin { \(*{shift()}{ARRAY}[4]) }
sub _bout { \(*{shift()}{ARRAY}[5]) }

sub WRITE {
    my ($self, undef, $length, $offset) = @_;
    $self->_check
	or return undef;

    $offset = 0 unless defined $offset;
    $offset = length $_[1] + $offset if $offset < 0;
    $length = length $_[1] unless defined $length;

    my $sftp = $self->_sftp;

    my $ret = $sftp->write($self, substr($_[1], $offset, $length));
    $sftp->_set_errno unless defined $ret;
    $ret;
}

sub READ {
    my ($self, undef, $len, $offset) = @_;
    $self->_check
	or return undef;

    $_[1] = '' unless defined $_[1];
    $offset ||= 0;
    if ($offset > length $_[1]) {
	$_[1] .= "\0" x ($offset - length $_[1])
    }

    if ($len == 0) {
	substr($_[1], $offset) = '';
	return 0;
    }

    my $sftp = $self->_sftp;
    $sftp->_fill_read_cache($self, $len);

    my $bin = $self->_bin;
    if (length $$bin) {
	my $data = substr($$bin, 0, $len, '');
	$self->_inc_pos($len);
	substr($_[1], $offset) = $data;
	return length $data;
    }
    return 0 if $sftp->{_status} == $sftp->SSH2_FX_EOF;
    $sftp->_set_errno;
    undef;
}

sub EOF {
    my $self = $_[0];
    $self->_check or return undef;
    my $sftp = $self->_sftp;
    my $ret = $sftp->eof($self);
    $sftp->_set_errno unless defined $ret;
    $ret;
}

*GETC = $gen_proxy_method->('getc');
*TELL = $gen_proxy_method->('tell');
*SEEK = $gen_proxy_method->('seek');
*CLOSE = $gen_proxy_method->('close');

my $readline = $gen_proxy_method->('readline');
sub READLINE { $readline->($_[0], $/) }

sub OPEN {
    shift->CLOSE;
    undef;
}

sub DESTROY {
    local ($@, $!, $?);
    my $self = shift;
    my $sftp = $self->_sftp;
    $debug and $debug & 4 and Net::SFTP::Foreign::_debug("$self->DESTROY called (sftp: ".($sftp||'').")");
    if ($self->_check and $sftp) {
        local $sftp->{_autodie};
	$sftp->_close_save_status($self)
    }
}

package Net::SFTP::Foreign::DirHandle;
our @ISA = qw(Net::SFTP::Foreign::Handle IO::Dir);

sub _new_from_rid {
    my $class = shift;
    my $sftp = shift;
    my $rid = shift;
    my $flags = shift;

    my $self = $class->SUPER::_new_from_rid($sftp, $rid, $flags, []);
}


sub _check_is_dir {}

sub _cache { *{shift()}{ARRAY}[4] }

*CLOSEDIR = $gen_proxy_method->('closedir');
*READDIR = $gen_proxy_method->('_readdir');

sub OPENDIR {
    shift->CLOSEDIR;
    undef;
}

*REWINDDIR = $gen_not_supported->();
*TELLDIR = $gen_not_supported->();
*SEEKDIR = $gen_not_supported->();

sub DESTROY {
    local ($@, $!, $?);
    my $self = shift;
    my $sftp = $self->_sftp;

    $debug and $debug & 4 and Net::SFTP::Foreign::_debug("$self->DESTROY called (sftp: ".($sftp||'').")");

    if ($self->_check and $sftp) {
        local $sftp->{_autodie};
	$sftp->_closedir_save_status($self)
    }
}

1;
__END__