Net::SFTP::Foreign - SSH File Transfer Protocol client

    use Net::SFTP::Foreign;
    my $sftp = Net::SFTP::Foreign->new($host);
    $sftp->die_on_error("Unable to establish SFTP connection");

    $sftp->setcwd($path) or die "unable to change cwd: " . $sftp->error;

    $sftp->get("foo", "bar") or die "get failed: " . $sftp->error;

    $sftp->put("bar", "baz") or die "put failed: " . $sftp->error;

package Net::SFTP::Foreign;

our $VERSION = '1.65';

use strict;
use warnings;
use Carp qw(carp croak);

use Symbol ();
use Errno ();
use Scalar::Util;

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);
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 =~ /Win32/;

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

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

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

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

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

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

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

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

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


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

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

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

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

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

    undef $sftp->{_connected};
}

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

sub _get_msg {
    my $sftp = shift;

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

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

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

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

    return $msg;
}

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

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

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

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

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

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

    bless $sftp, $class;

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

    my %defs = $backend->_defaults;

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

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

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

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

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

    $sftp->_init unless $sftp->error;
    $sftp
}

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

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

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

    $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);
        }
        else {
	    my $dirty = ( defined $sftp->{_dirty_cleanup}
			  ? $sftp->{_dirty_cleanup}
			  : $dirty_cleanup );

	    if ($dirty or not defined $dirty) {
		for my $sig (($dirty ? () : 0), qw(TERM TERM KILL KILL)) {
		    $sig and kill $sig, $pid;

		    my $except;
		    {
			local ($@, $SIG{__DIE__}, $SIG{__WARN__});
			eval {
			    local $SIG{ALRM} = sub { die "timeout\n" };
			    alarm 8;
			    waitpid($pid, 0);
			    alarm 0;
			};
			$except = $@;
		    }
		    if ($except) {
			next if $except =~ /^timeout/;
			die $except;
		    }
		    last;
		}
	    }
	    else {
		while (1) {
		    last if waitpid($pid, 0) > 0;
		    if ($! != Errno::EINTR) {
			warn "internal error: unexpected error in waitpid($pid): $!"
			    if $! != Errno::ECHILD;
			last;
		    }
		}
	    }
        }
    }
    1
}

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

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

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

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

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

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

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

	    return $version;
	}

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

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

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

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

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

	$sftp->_clear_error_and_status;

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

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

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

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

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

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

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

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

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

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

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

sub _check_status_ok {
    my ($sftp, $eid, $error, $errstr) = @_;
    if (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 {
    @_ <= 2 or croak 'Usage: $sftp->setcwd($path)';
    ${^TAINT} and &_catch_tainted_args;

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

    if (defined $cwd) {
        $cwd = $sftp->realpath($cwd);
        return undef unless defined $cwd;
	my $a = $sftp->stat($cwd)
	    or return undef;
	if (_is_dir($a->perm)) {
	    return $sftp->{cwd} = $cwd;
	}
	else {
	    $sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
			      "Remote object '$cwd' is not a directory");
	    return undef;
	}
    }
    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) {
        _debug("new remote file '$path' open, rid:");
        _hexdump($rid);
    }

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

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

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

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

    defined $rid
	or return undef;

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

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

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

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

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

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

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

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

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

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

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

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

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

    $whence ||= 0;

    if ($whence == 0) {
	return $rfh->_pos($pos)
    }
    elsif ($whence == 1) {
	return $rfh->_inc_pos($pos)
    }
    elsif ($whence == 2) {
	if (my $a = $sftp->fstat($rfh)) {
	    return $rfh->_pos($pos + $a->size);
	}
	else {
	    return undef;
	}
    }
    else {
	croak "invalid whence argument";
    }
}

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

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

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

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

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

    $sftp->_clear_error_and_status;

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

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

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

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

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

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

    return $written;
}

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

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

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

    return $datalen;
}

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

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

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

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

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

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

    $sftp->_clear_error_and_status;

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

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

    my $bin = $rfh->_bin;

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

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

    my $pos = $rfh->_pos;

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

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

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

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

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

    }

    $sftp->_get_msg for @msgid;

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

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

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

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

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

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

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

    my $sl = length $sep;

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

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

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

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

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

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

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

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

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

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

sub _gen_stat_method {
    my ($code, $error, $errstr) = @_;
    return sub {
	@_ == 2 or croak 'Usage: $sftp->stat|lstat($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_ATTRS, $id,
						$error, $errstr)) {
	    return $msg->get_attributes;
	}
	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

*lstat = _gen_stat_method(SSH2_FXP_LSTAT,
			  SFTP_ERR_REMOTE_LSTAT_FAILED,
			  "Couldn't stat remote file (lstat)");

*stat = _gen_stat_method(SSH2_FXP_STAT,
			 SFTP_ERR_REMOTE_FSTAT_FAILED,
			 "Couldn't stat remote file (stat)");

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

    my $sftp = shift;
    my $id = $sftp->_queue_rfid_request(SSH2_FXP_FSTAT, @_);
    defined $id or return undef;
    if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id,
					    SFTP_ERR_REMOTE_STAT_FAILED,
					    "Couldn't stat remote file (fstat)")) {
	return $msg->get_attributes;
    }
    return undef;
}

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

sub _gen_remove_method {
    my($code, $error, $errstr) = @_;
    return sub {
	@_ == 2 or croak 'Usage: $sftp->remove|rmdir($path)';
        ${^TAINT} and &_catch_tainted_args;

        my ($sftp, $path) = @_;
        $path = $sftp->_rel2abs($path);
        my $id = $sftp->_queue_str_request($code, $sftp->_fs_encode($path));
        return $sftp->_check_status_ok($id, $error, $errstr);
    };
}

*remove = _gen_remove_method(SSH2_FXP_REMOVE,
			     SFTP_ERR_REMOTE_REMOVE_FAILED,
			     "Couldn't delete remote file");

*rmdir = _gen_remove_method(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);
    return $sftp->_check_status_ok($id,
                                   SFTP_ERR_REMOTE_MKDIR_FAILED,
                                   "Couldn't create remote directory");
}

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

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

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

    my ($sftp, $path, $attrs) = @_;
    $sftp->_clear_error_and_status;

    $path =~ s{^(/*)}{};
    my $start = $1;
    my @path;
    while (1) {
	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;
	$path =~ s{/*[^/]*$}{};
    }
    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 setstat {
    @_ == 3 or croak 'Usage: $sftp->setstat($str, $attrs)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $path, $attrs) = @_;
    $path = $sftp->_rel2abs($path);
    my $id = $sftp->_queue_str_request(SSH2_FXP_SETSTAT,
                                       $sftp->_fs_encode($path),
                                       $attrs);
    return $sftp->_check_status_ok($id,
                                   SFTP_ERR_REMOTE_SETSTAT_FAILED,
                                   "Couldn't setstat remote file (setstat)'");
}

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

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

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

    return $sftp->_check_status_ok($id,
                                   SFTP_ERR_REMOTE_FSETSTAT_FAILED,
                                   "Couldn't setstat remote file (fsetstat)");
}

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

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

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

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

    return $ok;
}

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

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

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

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

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

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

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

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

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

    my $cache = $rdh->_cache;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    my $overwrite = delete $opts{overwrite};
    %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;
    }

    # we are optimistic here and try to rename it without testing if a
    # file of the same name already exists first
    $sftp->_rename($old, $new) and return 1;

    if ($overwrite and $sftp->status == SSH2_FX_FAILURE) {
        if ($sftp->realpath($old) eq $sftp->realpath($new)) {
            $sftp->_set_status(SSH2_FX_FAILURE);
            $sftp->_set_error(SFTP_ERR_REMOTE_RENAME_FAILED,
                             "Couldn't rename, both '$old' and '$new' point to the same file");
            return undef;
        }

        $sftp->remove($new);
        return $sftp->_rename($old, $new);
    }
    return undef;
}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


## 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 {
    @_ >= 3 or croak 'Usage: $sftp->get($remote, $local, %opts)';
    ${^TAINT} and &_catch_tainted_args;

    my ($sftp, $remote, $local, %opts) = @_;
    $remote = $sftp->_rel2abs($remote);
    my $local_is_fh = (ref $local and $local->isa('GLOB'));

    $sftp->_clear_error_and_status;

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

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

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

    my $oldumask = umask;
    my $neg_umask;

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

    $overwrite = 1 unless (defined $overwrite or $local_is_fh or $numbered);
    $copy_perm = 1 unless (defined $perm or defined $copy_perm or $local_is_fh);
    $copy_time = 1 unless (defined $copy_time or $local_is_fh);

    my $size;
    my $a = $sftp->stat($remote);
    if (defined $a) {
        $size = $a->size
    }
    else {
        return undef if ($copy_time or $copy_perm);
        $size = -1;
    }

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

    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) {
	    while (-e $local) {
		if ($numbered) {
		    my $old = $local;
		    $local =~ s{^(.*)\((\d+)\)((?:\.[^\.]*)?)$}{"$1(" . ($2+1) . ")$3"}e
			or $local =~ s{((?:\.[^\.]*)?)$}{(1)$1};
		    $debug and $debug & 128 and _debug("numbering: $old => $local");
		}
		else {
		    $sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,
				      "local file $local already exists");
		    return undef
		}
	    }
        }

        if ($copy_perm) {
            my $aperm = $a->perm;
            $aperm = 0666 unless defined $aperm;
            $aperm =~ /^(\d+)$/ or die "perm is not numeric";
            $perm = int $1;
        }

        $perm = (0666 & $neg_umask)
	    unless (defined $perm or $local_is_fh);

        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 $lumask = ~$perm & 0666;
		umask $lumask;
		unlink $local unless $append;
		unless (CORE::open $fh, ($append ? '>>' : '>'), $local) {
		    umask $oldumask;
		    $sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
                                  "Can't open $local", $!);
		    return undef;
		}
		umask $oldumask;
		binmode $fh;
		$lstart = CORE::tell $fh if $append;
	    }
	}

	if (defined $perm) {
	    local ($@, $SIG{__DIE__}, $SIG{__WARN__});
	    my $e = eval { chmod($perm & $neg_umask, $local) };
	    if ($@ or $e <= 0) {
		$sftp->_set_error(SFTP_ERR_LOCAL_CHMOD_FAILED,
				  "Can't chmod $local", ($@ ? $@ : $!));
		return undef
	    }
	}
    }

    my $converter = _gen_converter $conversion;

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

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

    while (1) {
	# request a new block if queue is not full
	while (!@msgid or (($size == -1 or $size > $askoff) and @msgid < $queue_size and $n != 1)) {

	    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;
            $n++;
	}

	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) {
	    if ($sftp->{_status} == SSH2_FX_EOF) {
		$sftp->_set_error();
                $roff != $loff and next;
	    }
	    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;
        if ($len < $block_size) {
          $block_size = $len < 2048 ? 2048 : $len;
          $askoff = $loff;
        }

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

        if (length($data) and defined $cb) {
	    # $size = $loff if ($loff > $size and $size != -1);
	    $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 for (@msgid);

    return undef 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);
	    $cb->($sftp, $data, $askoff + $adjustment_before, $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", $!);
                return undef;
            }
        }
    }

    # we call the callback one last time with an empty string;
    if (defined $cb) {
        my $data = '';
        $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", $!);
                return undef;
            }
        }
    }

    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", $!);
	    return undef;
        }

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

        if ($copy_time) {
            if ($a->flags & SSH2_FILEXFER_ATTR_ACMODTIME) {
                $a->atime =~ /^(\d+)$/ or die "Bad atime from remote file $remote";
                my $atime = int $1;
                $a->mtime =~ /^(\d+)$/ or die "Bad mtime from remote file $remote";
                my $mtime = int $1;

                unless (utime $atime, $mtime, $local) {
                    $sftp->_set_error(SFTP_ERR_LOCAL_UTIME_FAILED,
                                      "Can't utime $local", $!);
                    return undef;
                }
            }
        }
    }

    return !$sftp->{_error}
}

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

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

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

    my ($sftp, $local, $remote, %opts) = @_;
    $remote = $sftp->_rel2abs($remote);
    my $local_is_fh = (ref $local and $local->isa('GLOB'));

    $sftp->_clear_error_and_status;

    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 $conversion = delete $opts{conversion};
    my $late_set_perm = delete $opts{late_set_perm};
    my $numbered = delete $opts{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);
    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));

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

    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;
	    }
	   ) {
	    # $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 = '';

    if ($resume or $append) {
	my $rattrs = $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";
	    }
	}
	elsif ($append) {
	    return undef unless $sftp->status == SSH2_FX_NO_SUCH_FILE;
	    undef $append;
	}

	if ($resume and $writeoff) {
            $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) {
                    return $sftp->setstat($remote, $attrs);
                }
                return 1;
            }
            $rfh = $sftp->open($remote, SSH2_FXF_WRITE)
                or return undef;
        }
    }

    unless (defined $rfh) {
	if ($numbered) {
	    while ($sftp->stat($remote)) {
		my $old = $remote;
		$remote =~ s{^(.*)\((\d+)\)((?:\.[^\.]*)?)$}{"$1(" . ($2+1) . ")$3"}e
		    or $remote =~ s{((?:\.[^\.]*)?)$}{(1)$1};
		$debug and $debug & 128 and _debug("numbering remote: $old => $local");
	    }
	}

        $rfh = $sftp->open($remote,
                           SSH2_FXF_WRITE | SSH2_FXF_CREAT |
                           ($append ? 0 : ($overwrite ? SSH2_FXF_TRUNC : SSH2_FXF_EXCL)),
                           $attrs)
            or return undef;
    }

    # 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->fsetstat($rfh, $attrs)
            or return undef;
    }

    my $rfid = $sftp->_rfid($rfh);
    defined $rfid or return 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) {
		$debug and $debug & 16384 and
		    _debug "writing block at offset $writeoff, length " . length($data);

                my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid,
                                               int64 => $writeoff, str => $data);
                push @msgid, $id;
                $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 for (@msgid);

    $sftp->_close_save_status($rfh);

    return undef if $sftp->error;

    # for servers that does not support setting permissions on open files
    if (defined $perm and $late_set_perm) {
        $sftp->setstat($remote, $attrs)
            or return undef;
    }

    if ($copy_time) {
	$attrs = Net::SFTP::Foreign::Attributes->new;
	$attrs->set_amtime($latime, $lmtime);
	$sftp->setstat($remote, $attrs);
    }

    return $sftp->{_error} == 0;
}

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

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

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

	    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;
	}
	else {
	    $sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF;
	    $sftp->_get_msg for @msgid;
	    last;
	}
    }

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

    if ($numbered) {
	while (-e $local) {
	    my $old = $local;
	    $local =~ s{^(.*)\((\d+)\)((?:\.[^\.]*)?)$}{"$1(" . ($2+1) . ")$3"}e
		or $local =~ s{((?:\.[^\.]*)?)$}{(1)$1};
	    $debug and $debug & 128 and _debug("numbering: $old => $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;
    }
    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 = (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;
    }

    if ($numbered) {
	while ($sftp->stat($remote)) {
	    my $old = $remote;
	    $remote =~ s{^(.*)\((\d+)\)((?:\.[^\.]*)?)$}{"$1(" . ($2+1) . ")$3"}e
		or $remote =~ s{((?:\.[^\.]*)?)$}{(1)$1};
	    $debug and $debug & 128 and _debug("numbering remote: $old => $local");
	}
    }
    $sftp->remove($remote) if $overwrite;
    $sftp->symlink($remote, $target);
}

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

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

    # 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 $block_size = delete $opts{block_size};
    my $queue_size = delete $opts{queue_size};
    my $overwrite = delete $opts{overwrite};
    my $newer_only = delete $opts{newer_only};
    my $on_error = delete $opts{on_error};
    my $ignore_links = delete $opts{ignore_links};
    my $conversion = delete $opts{conversion};
    my $resume = delete $opts{resume};
    my $numbered = delete $opts{numbered};

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

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

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

    %opts and _croak_bad_options(keys %opts);

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

    $umask = umask $umask if (defined $umask);

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

    require File::Spec;

    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 {
				 if (CORE::mkdir $lpath, ($copy_perm ? $e->{a}->perm & 0777 : 0777)) {
				     $count++;
				     return 1;
				 }
				 else {
				     $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];
		     # print "file fn:$e->{filename}, a:$e->{a}\n";
		     unless (_is_dir($e->{a}->perm)) {
			 if (!$wanted or $wanted->($sftp, $e)) {
			     my $fn = $e->{filename};
			     if ($fn =~ $reremote) {
				 my $lpath = File::Spec->catfile($local, $1);
                                 ($lpath) = $lpath =~ /(.*)/ if ${^TAINT};
				 if (_is_lnk($e->{a}->perm) and !$ignore_links) {
				     if ($sftp->get_symlink($fn, $lpath,
							    overwrite => $overwrite,
							    numbered => $numbered,
							    copy_time => $copy_time)) {
					 $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,
							overwrite => $overwrite,
							numbered => $numbered,
							queue_size => $queue_size,
							block_size => $block_size,
							copy_perm => $copy_perm,
							copy_time => $copy_time,
                                                        conversion => $conversion,
                                                        resume => $resume )) {
					     $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;
		 } );

    umask $umask if defined $umask;

    return $count;
}

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

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

    # 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 $block_size = delete $opts{block_size};
    my $queue_size = delete $opts{queue_size};
    my $overwrite = delete $opts{overwrite};
    my $numbered = delete $opts{numbered};
    my $newer_only = delete $opts{newer_only};
    my $on_error = delete $opts{on_error};
    my $ignore_links = delete $opts{ignore_links};
    my $conversion = delete $opts{conversion};
    my $resume = delete $opts{resume};
    my $late_set_perm = delete $opts{late_set_perm};

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

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

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

    $umask = umask unless defined $umask;
    my $mask = ~$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 and 32768 and _debug "rput handling $fn";
			if ($fn =~ $relocal) {
			    my $rpath = $sftp->join($remote, File::Spec->splitdir($1));
			    $debug and $debug and 32768 and _debug "rpath: $rpath";
			    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 {
				my $a = Net::SFTP::Foreign::Attributes->new;
				$a->set_perm(($copy_perm ? $e->{a}->perm & 0777 : 0777) & $mask);
				if ($sftp->mkdir($rpath, $a)) {
				    $count++;
				    return 1;
				}
				else {
				    $lfs->_copy_error($sftp);
				}
			    }
			}
			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 and 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, $remote,
							   overwrite => $overwrite,
							   numbered => $numbered)) {
					$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,
						       overwrite => $overwrite,
						       numbered => $numbered,
						       queue_size => $queue_size,
						       block_size => $block_size,
						       perm => ($copy_perm ? $e->{a}->perm : 0777) & $mask,
						       copy_time => $copy_time,
                                                       conversion => $conversion,
                                                       resume => $resume,
                                                       late_set_perm => $late_set_perm )) {
					    $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 = shift;
    my $remote = shift;
    my $localdir = (@_ & 1 ? shift : undef);
    my %opts = @_;

    my $on_error = $opts{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 copy_perm copy_time block_size queue_size
                       overwrite conversion resume numbered));

    %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 = shift;
    my $local = shift;
    my $remotedir = (@_ & 1 ? shift : undef);
    my %opts = @_;

    my $on_error = $opts{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 copy_perm copy_time block_size queue_size
                       overwrite conversion resume numbered late_set_perm));

    %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 _get_statvfs {
    my ($sftp, $eid, $error, $errstr) = @_;
    if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_EXTENDED_REPLY,
                                            $eid, $error, $errstr)) {
        # printf STDERR "msg length: %i\n", length $$msg;
        my %statvfs = map { $_ => $msg->get_int64 } qw(bsize frsize blocks
                                                       bfree bavail files ffree
                                                       favail fsid flag namemax);
        return \%statvfs;
    }
    return undef;
}

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

    my ($sftp, $path) = @_;
    $sftp->_check_extension('statvfs@openssh.com' => 2,
                            SFTP_ERR_REMOTE_STATVFS_FAILED,
                            "statvfs failed")
        or return undef;

    $path = $sftp->_rel2abs($path);
    my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED,
                                   str => 'statvfs@openssh.com',
                                   str => $sftp->_fs_encode($path));
    $sftp->_get_statvfs($id,
                        SFTP_ERR_REMOTE_STATVFS_FAILED,
                        "Couldn't stat remote file system");
}

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

    my ($sftp, $fh) = @_;
    $sftp->_check_extension('fstatvfs@openssh.com' => 2,
                            SFTP_ERR_REMOTE_FSTATVFS_FAILED,
                            "fstatvfs failed")
        or return undef;

    my $rid = $sftp->_rid($fh);
    my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED,
                                   str => 'fstatvfs@openssh.com',
                                   str => $rid);
    $sftp->_get_statvfs($id,
                        SFTP_ERR_REMOTE_FSTATVFS_FAILED,
                        "Couldn't stat remote file system");
}

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 {
    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) {
	$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 {
    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) {
	$sftp->_closedir_save_status($self)
    }
}

1;
__END__