@@ -1,5 +1,73 @@
Revision history for Net::SFTP::Foreign
+1.77 Nov 5, 2013
+ - release as stable
+ - fix misspellings in error message
+
+1.76_04 Oct 2, 2013
+ - fix 'Use of "goto" to jump into a construct is deprecated'
+ warning (bug report by Brent Bates)
+ - don't force permissions from rput when copy_perm is unset
+
+1.76_03 Aug 26, 2013
+ - fix several spelling errors
+ - add spell checking test
+ - remove pod test from MANIFEST
+ - ensure that pty is not destroyed before main object (bug
+ report by Stephen Wylie) during global destruction
+
+1.76_02 Apr 29, 2013
+ - remove warning happening when best_effort was set, specially
+ visible from Compat module (bug report by emerlyn at
+ PerlMonks)
+
+1.76_01 Apr 26, 2013
+ - protect against callbacks setting $\ (bug report by Thomas
+ Wadley)
+
+1.75 Apr 2, 2013
+ - release as stable
+
+1.74_07 Mar 21, 2013
+ - seek method was returning offset instead of success value
+ (bug report by Paul Kolano).
+
+1.74_06 Mar 12, 2013
+ - disconnect may kill some unrelated process when called
+ repeatly (bug report by Douglas Wilson)
+ - debug was clobbering $!
+
+1.74_05 Feb 5, 2013
+ - error was not being set on timeouts (bug report by Kqfh
+ Jjgrn)
+
+1.74_04 Oct 25, 2012
+ - overwriting rename of a file over itself was broken (bug
+ report by Mike Wilder)
+ - stat and lstat path arguments is now optional and defaults
+ to '.' (bug report by Paul Kolano)
+ - fstat was broken
+ - add git repository and bugtracker into meta files
+
+1.74_03 Sep 21, 2012
+ - put_content was broken (bug report by Caleb Cushing)
+ - document put_content method
+ - add more tests
+
+1.74_02 Jul 11, 2012
+ - rget was dieing when trying to copy remote symbolic links
+ - add support for get method slow-start feature: when file
+ size is unknown don't start asking for $queue_size packets
+ as it slows down the transfer of small files, instead,
+ starting from a queue size of one go gradually increasing it
+ until the stated maximum is reached (bug report by David
+ R. Wagner)
+ - parse supported2 extension
+
+1.74_01
+ - add support for password_prompt (feature request by Douglas
+ Wilson)
+
1.73 May 11, 2012
- password authentication was broken on Solaris (maybe also on
others) due to an incorrect waitpid call (bug report and
@@ -134,6 +202,7 @@ Revision history for Net::SFTP::Foreign
get_symlink options using hashes
- remove operation inside put_symlink was clobbering error and
status from previous symlink call
+ - solve several minor bugs related to autodie handling
- do not die from inside DESTROY methods when autodie is set
- resume feature in get method was broken
- refactor numbered logic inside _inc_numbered sub
@@ -26,7 +26,6 @@ samples/psftp
samples/sftp_tail.pl
samples/resume_put.pl
t/1_run.t
-t/2_pods.t
t/3_convert.t
t/4_perl5_11.t
t/5_join.t
@@ -38,5 +38,13 @@
}
},
"release_status" : "stable",
- "version" : "1.73"
+ "resources" : {
+ "bugtracker" : {
+ "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Net-SFTP-Foreign"
+ },
+ "repository" : {
+ "url" : "http://github.com/salva/p5-Net-SFTP-Foreign"
+ }
+ },
+ "version" : "1.77"
}
@@ -20,4 +20,7 @@ no_index:
requires:
Scalar::Util: 0
Test::More: 0
-version: 1.73
+resources:
+ bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Net-SFTP-Foreign
+ repository: http://github.com/salva/p5-Net-SFTP-Foreign
+version: 1.77
@@ -8,4 +8,9 @@ WriteMakefile( NAME => 'Net::SFTP::Foreign',
AUTHOR => 'Salvador Fandino <sfandino@yahoo.com>',
ABSTRACT => 'Secure File Transfer Protocol client',
PREREQ_PM => { Test::More => 0,
- Scalar::Util => 0 } );
+ Scalar::Util => 0 },
+ META_MERGE =>
+ { resources =>
+ { repository => 'http://github.com/salva/p5-Net-SFTP-Foreign',
+ bugtracker => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Net-SFTP-Foreign' } }
+ );
@@ -33,7 +33,7 @@ To install this module type the following:
COPYRIGHT AND LICENCE
-Copyright (c) 2005-2012 by Salvador Fandino
+Copyright (c) 2005-2013 by Salvador Fandino
Copyright (c) 2001 Benjamin Trott, Copyright (c) 2003 David Rolsky.
@@ -2,6 +2,9 @@
TODO
====
+- audit fatal error handling, currently fatal errors can dissapear
+ under best_effort and other similar conditions
+
- port to OpenVMS
- add support for later protocol versions
@@ -12,6 +15,10 @@ TODO
- implement save_status methods as a wrapper like best_effort
+- reimplement autodie in a saner way
+
+- allow per-method enabling/disabling autodie
+
DONE
====
@@ -1,6 +1,6 @@
1 - message queueing/dequeuing
2 - remote file/dir open/close
- 4 - DESTROY calls
+ 4 - DESTROY and disconnect calls
8 - hexdumps of incomming packets
16 - hexdumps of outgoing packets
32 - _do_io, _conn_lost
@@ -34,7 +34,7 @@ __END__
=head1 NAME
-Net::SFTP::Foreign::Attributes::Compat - adaptor for Net::SFTP::Attributes compatibility
+Net::SFTP::Foreign::Attributes::Compat - adapter for Net::SFTP::Attributes compatibility
=head1 SYNOPSIS
@@ -305,7 +305,7 @@ field. The flags field is adjusted accordingly.
=item $attrs-E<gt>set_perm($perm)
-sets the value of the permsissions field or removes it if the value is
+sets the value of the permissions field or removes it if the value is
undefined. The flags field is also adjusted.
=item $attr-E<gt>set_ugid($uid, $gid)
@@ -313,7 +313,7 @@ undefined. The flags field is also adjusted.
sets the values of the uid and gid fields, or removes them if they are
undefined values. The flags field is adjusted.
-This pair of fields can not be set separatelly because they share the
+This pair of fields can not be set separately because they share the
same bit on the flags field and so both have to be set or not.
=item $attr-E<gt>set_amtime($atime, $mtime)
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign::Backend::Unix;
-our $VERSION = '1.73';
+our $VERSION = '1.76_03';
use strict;
use warnings;
@@ -127,20 +127,36 @@ sub _init_transport {
else {
my $user = delete $opts->{user};
my $pass = delete $opts->{passphrase};
- my $asks_for_username_at_login;
+ my $ask_for_username_at_login;
my $pass_is_passphrase;
+ my $password_prompt;
if (defined $pass) {
$pass_is_passphrase = 1;
}
else {
$pass = delete $opts->{password};
- defined $pass and $sftp->{_password_authentication} = 1;
- $asks_for_username_at_login = $sftp->{_asks_for_username_at_login} = delete $opts->{asks_for_username_at_login};
- croak "asks_for user is set but user was not given"
- if $asks_for_username_at_login and not defined $user;
+ if (defined $pass) {
+ $sftp->{_password_authentication} = 1;
+ $password_prompt = $sftp->{_password_prompt} = delete $opts->{password_prompt};
+ if (defined $password_prompt) {
+ unless (ref $password_prompt eq 'Regexp') {
+ $password_prompt = quotemeta $password_prompt;
+ $password_prompt = qr/$password_prompt\s*$/i;
+ }
+ }
+ $ask_for_username_at_login =
+ $sftp->{_ask_for_username_at_login} =
+ ( delete($opts->{ask_for_username_at_login}) ||
+ delete($opts->{asks_for_username_at_login}) );
+ if ($ask_for_username_at_login) {
+ croak "ask_for_username_at_login set but user was not given" unless defined $user;
+ croak "ask_for_username_at_login can not be used with a custom password prompt"
+ if defined $password_prompt;
+ }
+ }
}
- my $expect_log_user = delete $opts->{expect_log_user} || 0;
+ delete $opts->{expect_log_user}; # backward compatibility, not used anymore
my $stderr_discard = delete $opts->{stderr_discard};
my $stderr_fh = ($stderr_discard ? undef : delete $opts->{stderr_fh});
my $open2_cmd = delete $opts->{open2_cmd};
@@ -255,7 +271,10 @@ sub _init_transport {
return;
}
$sftp->{pid} = $child;
- $sftp->{_pty} = $pty;
+ open my $pty_dup, '+>&', $pty; # store pty as a file handler instead of a object in
+ # order to save it from being destroyed too early
+ # during global destruction
+ $sftp->{_pty} = $pty_dup;
$debug and $debug & 65536 and _debug "starting password authentication";
my $rv = '';
@@ -302,12 +321,18 @@ sub _init_transport {
}
else {
$debug and $debug & 65536 and _debug "looking for user/password prompt";
- if (substr($buffer, $at) =~ /(user|name|login)?[:?]\s*$/) {
- if ($asks_for_username_at_login and
- ($asks_for_username_at_login ne 'auto' or defined $1)) {
+ my $re = ( defined $password_prompt
+ ? $password_prompt
+ : qr/(user|name|login)?[:?]\s*$/i );
+
+ $debug and $debug & 65536 and _debug "matching against $re";
+
+ if (substr($buffer, $at) =~ $re) {
+ if ($ask_for_username_at_login and
+ ($ask_for_username_at_login ne 'auto' or defined $1)) {
$debug and $debug & 65536 and _debug "sending username";
print $pty "$user\n";
- undef $asks_for_username_at_login;
+ undef $ask_for_username_at_login;
}
else {
$debug and $debug & 65536 and _debug "sending password";
@@ -33,6 +33,11 @@ sub get_int8 {
unpack(C => substr(${$_[0]}, 0, 1, ''));
}
+sub get_int16 {
+ length ${$_[0]} >=2 or return undef;
+ unpack(n => substr(${$_[0]}, 0, 2, ''));
+}
+
sub get_int32 {
length ${$_[0]} >=4 or return undef;
unpack(N => substr(${$_[0]}, 0, 4, ''));
@@ -82,6 +87,19 @@ sub get_str {
substr($$self, 0, $len, '');
}
+sub get_str_list {
+ my $self = shift;
+ my @a;
+ if (my $n = $self->get_int32) {
+ for (1..$n) {
+ my $str = $self->get_str;
+ last unless defined $str;
+ push @a, $str;
+ }
+ }
+ return @a;
+}
+
sub get_attributes { Net::SFTP::Foreign::Attributes->new_from_buffer($_[0]) }
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign::Common;
-our $VERSION = '1.68_01';
+our $VERSION = '1.76_02';
use strict;
use warnings;
@@ -70,22 +70,30 @@ sub _set_error {
}
$debug and $debug & 64 and _debug("_set_err code: $code, str: $str");
my $error = $sftp->{_error} = dualvar $code, $str;
+
+ # FIXME: use a better approach to determine when some error is fatal
croak $error if $sftp->{_autodie};
- return $error;
}
- else {
- return $sftp->{_error} = 0;
+ elsif ($sftp->{_error}) {
+ # FIXME: use a better approach to determine when some error is fatal
+ if ($sftp->{_error} != Net::SFTP::Foreign::Constants::SFTP_ERR_CONNECTION_BROKEN()) {
+ $sftp->{_error} = 0;
+ }
}
+ return $sftp->{_error}
}
sub _clear_error_and_status {
my $sftp = shift;
- $sftp->{_error} = 0;
- $sftp->{_status} = 0;
+ $sftp->_set_error;
+ $sftp->_set_status;
}
sub _copy_error {
- $_[0]->{_error} = $_[1]->{_error};
+ my ($sftp, $other) = @_;
+ unless ($sftp->{_error} == Net::SFTP::Foreign::Constants::SFTP_ERR_CONNECTION_BROKEN()) {
+ $sftp->{_error} = $other->{_error};
+ }
}
sub error { shift->{_error} }
@@ -141,8 +149,7 @@ sub _call_on_error {
my ($sftp, $on_error, $entry) = @_;
$on_error and $sftp->error
and $on_error->($sftp, $entry);
- $sftp->_set_error;
- $sftp->_set_status;
+ $sftp->_clear_error_and_status;
}
# this method code is a little convoluted because we are trying to
@@ -153,8 +160,7 @@ sub find {
my $self = shift;
my %opts = @_ & 1 ? ('dirs', @_) : @_;
- $self->_set_error;
- $self->_set_status;
+ $self->_clear_error_and_status;
my $dirs = delete $opts{dirs};
my $follow_links = delete $opts{follow_links};
@@ -347,7 +353,7 @@ sub glob {
$e->{a} = $a;
}
else {
- $sftp->_call_on_error($on_error, $e);
+ $on_error and $sftp->_call_on_error($on_error, $e);
return undef;
}
}
@@ -359,7 +365,7 @@ sub glob {
if ($realpath) {
my $rp = $e->{realpath} = $sftp->realpath($e->{filename});
unless (defined $rp) {
- $sftp->_call_on_error($on_error, $e);
+ $on_error and $sftp->_call_on_error($on_error, $e);
return undef;
}
}
@@ -372,7 +378,7 @@ sub glob {
}
return undef
} )
- or $sftp->_call_on_error($on_error, $parent);
+ or ($on_error and $sftp->_call_on_error($on_error, $parent));
}
else {
my $fn = $sftp->join($pfn, $part);
@@ -387,7 +393,7 @@ sub glob {
if ($realpath) {
my $rp = $fn = $e->{realpath} = $sftp->realpath($fn);
unless (defined $rp) {
- $sftp->_call_on_error($on_error, $e);
+ $on_error and $sftp->_call_on_error($on_error, $e);
next;
}
}
@@ -43,11 +43,12 @@ our %DEFAULTS = ( put => [best_effort => 1],
new => [] );
BEGIN {
- my @forbidden = qw( setcwd cwd open opendir sftpread sftpwrite seek
- tell eof write flush read getc lstat stat fstat
- remove rmdir mkdir setstat fsetstat close closedir
- readdir realpath readlink rename symlink abort
- get_content join glob rremove rget rput error );
+ my @forbidden = qw( setcwd cwd open opendir sftpread sftpwrite
+ seek tell eof write flush read getc lstat stat
+ fstat remove rmdir mkdir setstat fsetstat
+ close closedir readdir realpath readlink
+ rename symlink abort get_content join glob
+ rremove rget rput error die_on_error );
for my $method (@forbidden) {
my $super = "SUPER::$method";
@@ -231,7 +232,7 @@ __END__
=head1 NAME
-Net::SFTP::Foreign::Compat - Adaptor for Net::SFTP compatibility
+Net::SFTP::Foreign::Compat - Adapter for Net::SFTP compatibility
=head1 SYNOPSIS
@@ -261,7 +262,7 @@ to Net::SFTP::Foreign.
The hash C<%Net::SFTP::Foreign::DEFAULTS> can be used to set default
values for L<Net::SFTP::Foreign> methods called under the hood and
-otherwise not accesible through the Net::SFTP API.
+otherwise not accessible through the Net::SFTP API.
The entries currently supported are:
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign::Helpers;
-our $VERSION = '1.70_06';
+our $VERSION = '1.74_06';
use strict;
use warnings;
@@ -38,7 +38,7 @@ BEGIN {
}
sub _debug {
- local $\;
+ local ($\, $!);
my $caller = '';
if ( $debug & 8192) {
$caller = (caller 1)[3];
@@ -55,6 +55,7 @@ sub _debug {
}
sub _hexdump {
+ local ($\, $!);
no warnings qw(uninitialized);
my $data = shift;
while ($data =~ /(.{1,32})/smg) {
@@ -112,7 +112,7 @@ __END__
=head1 NAME
-Net::SFTP::Foreign::Local - access local fs with Net::SFTP::Foreign API.
+Net::SFTP::Foreign::Local - access local file system through Net::SFTP::Foreign API.
=head1 SYNOPSIS
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign;
-our $VERSION = '1.73';
+our $VERSION = '1.77';
use strict;
use warnings;
@@ -169,11 +169,13 @@ sub new {
unshift @_, 'host' if @_ & 1;
my %opts = @_;
- my $sftp = { _msg_id => 0,
- _bout => '',
- _bin => '',
+ my $sftp = { _msg_id => 0,
+ _bout => '',
+ _bin => '',
_connected => 1,
- _queued => 0 };
+ _queued => 0,
+ _error => 0,
+ _status => 0 };
bless $sftp, $class;
@@ -258,7 +260,7 @@ sub autodisconnect {
sub disconnect {
my $sftp = shift;
- my $pid = $sftp->{pid};
+ my $pid = delete $sftp->{pid};
$debug and $debug & 4 and _debug("$sftp->disconnect called (ssh pid: ".($pid||'').")");
@@ -271,6 +273,7 @@ sub disconnect {
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}
@@ -278,25 +281,25 @@ sub disconnect {
: $dirty_cleanup );
if ($dirty or not defined $dirty) {
+ $debug and $debug & 4 and _debug("starting dirty cleanup of process $pid");
for my $sig (($dirty ? () : 0), qw(TERM TERM KILL KILL)) {
+ $debug and $debug & 4 and _debug("killing process $pid with signal $sig");
$sig and kill $sig, $pid;
- 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;
+ local ($@, $SIG{__DIE__}, $SIG{__WARN__});
+ my $wpr;
+ eval {
+ local $SIG{ALRM} = sub { die "timeout\n" };
+ alarm 8;
+ $wpr = waitpid($pid, 0);
+ alarm 0;
+ };
+ $debug and $debug & 4 and _debug("waitpid returned " . (defined $wpr ? $wpr : '<undef>'));
+ if ($wpr) {
+ # $wpr > 0 ==> the process has ben reaped
+ # $wpr < 0 ==> some error happened, retry unless ECHILD
+ last if $wpr > 0 or $! == Errno::ECHILD();
+ }
}
}
else {
@@ -309,8 +312,10 @@ sub disconnect {
}
}
}
+ $debug and $debug & 4 and _debug "process $pid reaped";
}
}
+ close $sftp->{_pty} if defined $sftp->{_pty};
1
}
@@ -349,7 +354,18 @@ sub _init {
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;
@@ -633,25 +649,20 @@ sub seek {
my ($sftp, $rfh, $pos, $whence) = @_;
$sftp->flush($rfh) or return undef;
- $whence ||= 0;
-
- if ($whence == 0) {
- return $rfh->_pos($pos)
+ if (!$whence) {
+ $rfh->_pos($pos)
}
elsif ($whence == 1) {
- return $rfh->_inc_pos($pos)
+ $rfh->_inc_pos($pos)
}
elsif ($whence == 2) {
- if (my $a = $sftp->stat($rfh)) {
- return $rfh->_pos($pos + $a->size);
- }
- else {
- return undef;
- }
+ my $a = $sftp->stat($rfh) or return undef;
+ $rfh->_pos($pos + $a->size);
}
else {
- croak "invalid whence argument";
+ croak "invalid value for whence argument ('$whence')";
}
+ 1;
}
sub tell {
@@ -935,10 +946,11 @@ sub getc {
# these all return a Net::SFTP::Foreign::Attributes object on success, undef on failure
sub lstat {
- @_ == 2 or croak 'Usage: $sftp->lstat($path)';
+ @_ <= 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,
@@ -949,10 +961,11 @@ sub lstat {
}
sub stat {
- @_ == 2 or croak 'Usage: $sftp->stat($path_or_fh)';
+ @_ <= 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))) );
@@ -966,7 +979,7 @@ sub stat {
sub fstat {
_deprecated "fstat is deprecated and will be removed on the upcomming 2.xx series, "
. "stat method accepts now both file handlers and paths";
- goto &fstat;
+ goto &stat;
}
## SSH2_FXP_RMDIR (15), SSH2_FXP_REMOVE (13)
@@ -1325,7 +1338,7 @@ sub rename {
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;
+ $sftp->_clear_error_and_status;
}
elsif ($sftp->remove($new)) {
$overwrite = 0;
@@ -1639,6 +1652,9 @@ sub get {
my $adjustment = 0;
my $n = 0;
local $\;
+
+ my $slow_start = ($size == -1 ? $queue_size - 1 : 0);
+
do {
# Disable autodie here in order to do not leave unhandled
# responses queued on the connection in case of failure.
@@ -1649,8 +1665,9 @@ sub get {
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)) {
-
+ while (!@msgid or ( ($size == -1 or $size > $askoff) and
+ @msgid < $queue_size - $slow_start and
+ $n != 1 ) ) {
my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid,
int64 => $askoff, int32 => $block_size);
push @msgid, $id;
@@ -1659,6 +1676,8 @@ sub get {
$n++;
}
+ $slow_start-- if $slow_start;
+
my $eid = shift @msgid;
my $roff = shift @askoff;
@@ -1668,7 +1687,7 @@ sub get {
unless ($msg) {
if ($sftp->{_status} == SSH2_FX_EOF) {
- $sftp->_set_error();
+ $sftp->_set_error;
$roff != $loff and next;
}
last;
@@ -1694,6 +1713,7 @@ sub get {
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);
@@ -1723,6 +1743,7 @@ sub get {
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};
}
@@ -1739,7 +1760,10 @@ sub get {
# we call the callback one last time with an empty string;
if (defined $cb) {
my $data = '';
- $cb->($sftp, $data, $askoff + $adjustment, $size + $adjustment);
+ do {
+ local $\;
+ $cb->($sftp, $data, $askoff + $adjustment, $size + $adjustment);
+ };
return undef if $sftp->{_error};
if (length($data) and !$dont_save) {
unless (print $fh $data) {
@@ -1813,12 +1837,11 @@ sub get {
}
$$atomic_numbered = $local if ref $atomic_numbered;
}
-
- CLEANUP:
- if ($cleanup and $sftp->{_error}) {
- unlink $local;
- unlink $atomic_local if $atomic_cleanup;
- }
+ }
+ CLEANUP:
+ if ($cleanup and $sftp->{_error}) {
+ unlink $local;
+ unlink $atomic_local if $atomic_cleanup;
}
}; # autodie flag is restored here!
@@ -2292,12 +2315,11 @@ sub put_content {
%opts and _croak_bad_options(keys %opts);
my $fh;
- unless (CORE::open $fh, '<', \$_[0]) {
+ 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 {
@@ -2679,7 +2701,7 @@ sub rget {
($lpath) = $lpath =~ /(.*)/ if ${^TAINT};
if (_is_lnk($e->{a}->perm) and !$ignore_links) {
if ($sftp->get_symlink($fn, $lpath,
- copy_time => $copy_time,
+ # copy_time => $copy_time,
%get_symlink_opts)) {
$count++;
return undef;
@@ -2847,7 +2869,9 @@ sub rput {
}
else {
if ($sftp->put($fn, $rpath,
- perm => ($copy_perm ? $e->{a}->perm : 0777) & $mask,
+ ($copy_perm
+ ? (perm => $e->{a}->perm & 0777 & $mask)
+ : (umask => $umask) ),
copy_time => $copy_time,
%put_opts)) {
$count++;
@@ -3368,7 +3392,7 @@ from Net::SFTP as for instance C<find>, C<glob>, C<rget>, C<rput>,
C<rremove>, C<mget>, C<mput>.
On the other hand, using the external command means an additional
-proccess being launched and running, depending on your OS this could
+process being launched and running, depending on your OS this could
eat more resources than the in process pure perl implementation
provided by L<Net::SSH::Perl>.
@@ -3528,7 +3552,7 @@ protocol. But under some uncommon servers or configurations it is
possible that a username is also requested.
When this flag is set to C<1>, the username will be send
-inconditionally at the first remote prompt and then the password at
+unconditionally at the first remote prompt and then the password at
the second.
When it is set to C<auto> the module will use some heuristics in order
@@ -3537,6 +3561,21 @@ to determine if it is being asked for an username.
When set to C<0>, the username will never be sent during the
authentication dialog. This is the default.
+=item password_prompt => $regex_or_str
+
+The module expects the password prompt from the remote server to end
+in a colon or a question mark. This seems to cover correctly 99% of
+real life cases.
+
+Otherwise this option can be used to handle the exceptional cases. For
+instance:
+
+ $sftp = Net::SFTP::Foreign->new($host, password => $password,
+ password_prompt => qr/\bpassword>\s*$/);
+
+Note that your script will hang at the login phase if the wrong prompt
+is used.
+
=item passphrase =E<gt> $passphrase
Logs into the remote server using a passphrase protected private key.
@@ -3645,7 +3684,7 @@ operations (see the C<put> or C<get> documentation).
by default, and for performance reasons, write operations are cached,
and only when the write buffer becomes big enough is the data written to
-the remote file. Setting this flag makes the write operations inmediate.
+the remote file. Setting this flag makes the write operations immediate.
=item write_delay =E<gt> $bytes
@@ -3698,7 +3737,7 @@ Disconnect on exit from the current process only.
=back
-See also the disconnect and autodisconnect methods.
+See also the C<disconnect> and C<autodisconnect> methods.
=item late_set_perm =E<gt> $bool
@@ -3712,7 +3751,7 @@ section).
=item backend => $backend
From version 1.57 Net::SFTP::Foreign supports plugable backends in
-order to allow other ways to comunicate with the remote server in
+order to allow other ways to communicate with the remote server in
addition to the default I<pipe-to-ssh-process>.
Custom backends may change the set of options supported by the C<new>
@@ -3794,18 +3833,18 @@ copied from remote file. Default is to copy them.
=item copy_perm =E<gt> $bool
-determines if permision attributes have to be copied from remote
+determines if permission attributes have to be copied from remote
file. Default is to copy them after applying the local process umask.
=item umask =E<gt> $umask
allows one to select the umask to apply when setting the permissions
of the copied file. Default is to use the umask for the current
-process or C<0> if the C<perm> option is algo used.
+process or C<0> if the C<perm> option is also used.
=item perm =E<gt> $perm
-sets the permision mask of the file to be $perm, remote
+sets the permission mask of the file to be $perm, remote
permissions are ignored.
=item resume =E<gt> 1 | 'auto'
@@ -3840,8 +3879,8 @@ For instance:
$sftp->get("data.txt", "data.txt", numbered => 1);
}
-will copy the remote file as "data.txt" the first time and as
-"data(1).txt" the second one.
+will copy the remote file as C<data.txt> the first time and as
+C<data(1).txt> the second one.
If a scalar reference is passed as the numbered value, the final
target will be stored in the value pointed by the reference. For
@@ -3916,7 +3955,7 @@ C<stat> SFTP command before the data transfer starts).
=item block_size =E<gt> $bytes
size of the blocks the file is being split on for transfer.
-Incrementing this value can improve performance but some servers limit
+Incrementing this value can improve performance but most servers limit
the maximum size.
=item queue_size =E<gt> $size
@@ -3940,9 +3979,9 @@ same effect as for the C<get> method.
=item $sftp-E<gt>put($local, $remote, %opts)
-Uploads a file C<$local> from the local host to the remote host, and
-saves it as C<$remote>. By default file attributes are also
-copied. For instance:
+Uploads a file C<$local> from the local host to the remote host saving
+it as C<$remote>. By default file attributes are also copied. For
+instance:
$sftp->put("test.txt", "test.txt")
or die "put failed: " . $sftp->error;
@@ -3950,9 +3989,9 @@ copied. For instance:
A file handle can also be passed in the C<$local> argument. In that
case, data is read from there and stored in the remote file. UTF8 data
is not supported unless a custom converter callback is used to
-transform it to bytes and the method will croak if it encounters any
-data in perl internal UTF8 format. Note also that the handle is not
-closed when the transmission finish.
+transform it to bytes. The method will croak if it encounters any data
+in perl internal UTF8 format. Note also that the handle is not closed
+when the transmission finish.
Example:
@@ -3971,7 +4010,7 @@ copied from remote file. Default is to copy them.
=item copy_perm =E<gt> $bool
-determines if permision attributes have to be copied from remote
+determines if permission attributes have to be copied from remote
file. Default is to copy them after applying the local process umask.
=item umask =E<gt> $umask
@@ -3982,7 +4021,7 @@ process.
=item perm =E<gt> $perm
-sets the permision mask of the file to be $perm, umask and local
+sets the permission mask of the file to be $perm, umask and local
permissions are ignored.
=item overwrite =E<gt> 0
@@ -3993,8 +4032,8 @@ method fail in that case.
=item numbered =E<gt> 1
-when required, adds a sequence number to local file names in order to
-avoid overwriting pre-existent files. Off by default.
+when set, a sequence number is added to the remote file name in order
+to avoid overwriting pre-existent files. Off by default.
=item append =E<gt> 1
@@ -4024,19 +4063,17 @@ overwriting/non-overwriting atomic rename operation free of race
conditions.
OpenSSH server does it correctly on top of Linux/UNIX native file
-systems (i.e. ext[234], ffs or zfs) but has problems on file systems
+systems (i.e. ext[234]>, ffs or zfs) but has problems on file systems
not supporting hard links (i.e. FAT) or on operating systems with
broken POSIX semantics as Windows.
=item cleanup =E<gt> 1
-If the transfer fails, attempts to remove the incomplete file.
+If the transfer fails, attempts to remove the incomplete file. Cleanup
+may fail (for example, if the SSH connection gets broken).
-Cleanup may fail if for example the SSH connection gets broken.
-
-This option is set to by default when there is not possible to resume
-the transfer afterwards (i.e., when using `atomic` or `numbered`
-options).
+This option is set by default when the transfer is not resumable
+(i.e., when using `atomic` or `numbered` options).
=item best_effort =E<gt> 1
@@ -4050,7 +4087,7 @@ this option. See L</On the fly data conversion> below.
=item callback =E<gt> $callback
-C<$callback> is a reference to a subrutine that will be called after
+C<$callback> is a reference to a subroutine that will be called after
every iteration of the upload process.
The callback function will receive as arguments: the current
@@ -4088,9 +4125,14 @@ See the FAQ below.
=back
+=item $sftp-E<gt>put_content($bytes, $remote, %opts)
+
+Creates (or overwrites) a remote file whose content is the passed
+data.
+
=item $sftp-E<gt>put_symlink($local, $remote, %opts)
-copies a local symlink to the remote host.
+Copies a local symlink to the remote host.
The accepted options are C<overwrite> and C<numbered>.
@@ -4130,8 +4172,8 @@ directories):
=item wanted =E<gt> qr/.../
-Only elements whose filename matchs the regular expression are included
-on the listing.
+Only elements whose name matches the given regular expression are
+included on the listing.
=item wanted =E<gt> sub {...}
@@ -4154,7 +4196,7 @@ before). For instance:
=item no_wanted =E<gt> sub {...}
-those options have the oposite result to their C<wanted> counterparts:
+those options have the opposite result to their C<wanted> counterparts:
my $no_hidden = $sftp->ls( '/home/homer',
no_wanted => qr/^\./ )
@@ -4173,8 +4215,8 @@ the list of entries is ordered by filename.
by default, the attributes on the listing correspond to a C<lstat>
operation, setting this option causes the method to perform C<stat>
-requests instead. C<lstat> attributes will stil appear for links
-pointing to non existant places.
+requests instead. C<lstat> attributes will still appear for links
+pointing to non existent places.
=item atomic_readdir =E<gt> 1
@@ -4247,18 +4289,18 @@ high latency.
By default symbolic links are not resolved and appear as that on the
final listing. This option causes then to be resolved and substituted
by the target file system object. Dangling links are ignored, though
-they generate a call to the C<on_error> callback when stat'ing them
-fails.
+they generate a call to the C<on_error> callback when stat fails on
+them.
-Following sym links can introduce loops on the search. Infinite loops
-are detected and broken but files can still appear repeated on the
-final listing under different names unless the option C<realpath> is
-also actived.
+Following symbolic links can introduce loops on the search. Infinite
+loops are detected and broken but files can still appear repeated on
+the final listing under different names unless the option C<realpath>
+is also active.
=item ordered =E<gt> 1
By default, the file system is searched in an implementation dependent
-order (actually optimized for low memory comsumption). If this option
+order (actually optimized for low memory consumption). If this option
is included, the file system is searched in a deep-first, sorted by
filename fashion.
@@ -4306,7 +4348,7 @@ search, discarding full subdirectories. For instance:
C<descend> and C<wanted> rules are unrelated. A directory discarded by
a C<wanted> rule will still be recursively searched unless it is also
-discarded on a C<descend> rule and vice-versa.
+discarded on a C<descend> rule and vice versa.
=item atomic_readdir =E<gt> 1
@@ -4330,7 +4372,7 @@ in the same format as the L</find> method.
This method tries to recover and continue under error conditions.
-The given pattern can be a Unix style pattern (see L<glob(7)>) or a
+The given pattern can be a UNIX style pattern (see L<glob(7)>) or a
Regexp object (i.e C<qr/foo/>). In the later case, only files on the
current working directory will be matched against the Regexp.
@@ -4348,7 +4390,7 @@ This flag is ignored when a Regexp object is used as the pattern.
=item strict_leading_dot =E<gt> 0
by default, a dot character at the beginning of a file or directory
-name is not matched by willcards (C<*> or C<?>). Setting this flags to
+name is not matched by wildcards (C<*> or C<?>). Setting this flags to
a false value changes this behaviour.
This flag is ignored when a Regexp object is used as the pattern.
@@ -4386,7 +4428,7 @@ Some usage samples:
Recursively copies the contents of remote directory C<$remote> to
local directory C<$local>. Returns the total number of elements
-(files, dirs and symbolic links) successfully copied.
+(files, directories and symbolic links) successfully copied.
This method tries to recover and continue when some error happens.
@@ -4575,7 +4617,8 @@ For instance:
The method accepts all the options valid for L</glob> and for L</get>
(except those that do not make sense :-)
-C<$localdir> is optional and defaults to the process cwd.
+C<$localdir> is optional and defaults to the process current working
+directory (C<cwd>).
Files are saved with the same name they have in the remote server
excluding the directory parts.
@@ -4598,7 +4641,7 @@ files from the local side to the remote one.
=item $sftp-E<gt>join(@paths)
returns the given path fragments joined in one path (currently the
-remote file system is expected to be Unix like).
+remote file system is expected to be UNIX like).
=item $sftp-E<gt>open($path, $flags [, $attrs ])
@@ -4643,7 +4686,7 @@ Force all writes to append data at the end of the file.
As OpenSSH SFTP server implementation ignores this flag, the module
emulates it (I will appreciate receiving feedback about the
-interoperation of this module with other server implementations when
+inter-operation of this module with other server implementations when
this flag is used).
=item SSH2_FXF_CREAT
@@ -4673,7 +4716,7 @@ L<Net::SFTP::Foreign::Attributes>.
Closes the remote file handle C<$handle>.
Files are automatically closed on the handle C<DESTROY> method when
-not done explicitelly.
+not done explicitly.
Returns true on success and undef on failure.
@@ -4812,7 +4855,7 @@ this method is deprecated.
=item $sftp-E<gt>utime($path_or_fh, $atime, $mtime)
-Shortcuts around setstat.
+Shortcuts around C<setstat> method.
=item $sftp-E<gt>remove($path)
@@ -4833,7 +4876,7 @@ Returns a true value on success and undef on failure.
=item $sftp-E<gt>mkpath($path, $attrs)
-This method is similar to C<mkdir> but also creates any non-existant
+This method is similar to C<mkdir> but also creates any non-existent
parent directories recursively.
=item $sftp-E<gt>rmdir($path)
@@ -4861,7 +4904,7 @@ Accepted options are:
=item overwrite => $bool
By default, the rename operation fails when a file C<$new> already
-exists. When this options is set, any previous existant file is
+exists. When this options is set, any previous existent file is
deleted first (the C<atomic_rename> operation will be used if
available).
@@ -4880,7 +4923,7 @@ Unlike the C<rename> method, it overwrites any previous C<$new> file.
=item $sftp-E<gt>readlink($path)
Sends a C<SSH_FXP_READLINK> command to read the path where the
-simbolic link is pointing.
+symbolic link is pointing.
Returns the target path on success and undef on failure.
@@ -4961,15 +5004,15 @@ values:
=item conversion =E<gt> 'dos2unix'
Converts CR+LF line endings (as commonly used under MS-DOS) to LF
-(Unix).
+(UNIX).
=item conversion =E<gt> 'unix2dos'
-Converts LF line endings (Unix) to CR+LF (DOS).
+Converts LF line endings (UNIX) to CR+LF (DOS).
=item conversion =E<gt> sub { CONVERT $_[0] }
-When a callback is given, it is invoked repeatly as chunks of data
+When a callback is given, it is invoked repeatedly as chunks of data
become available. It has to change C<$_[0]> in place in order to
perform the conversion.
@@ -5069,7 +5112,7 @@ B<Q>: What is C<plink>?
B<A>: Plink is a command line tool distributed with the
L<PuTTY|http://the.earth.li/~sgtatham/putty/> SSH client. Very popular
between MS Windows users, it is also available for Linux and other
-Unixes now.
+UNIX now.
=item Put method fails
@@ -5095,10 +5138,10 @@ work-around automatically.
=item Put method fails even with late_set_perm set
B<Q>: I added C<late_set_perm =E<gt> 1> to the put call, but we are still
-receiving the error "Couldn't setstat remote file (setstat)".
+receiving the error C<Couldn't setstat remote file (setstat)>.
B<A>: Some servers forbid the SFTP C<setstat> operation used by the
-C<put> method for replicating the file permissions and timestamps on
+C<put> method for replicating the file permissions and time-stamps on
the remote side.
As a work around you can just disable the feature:
@@ -5182,7 +5225,7 @@ are welcome!
=item - Dirty cleanup:
-On some operating systems, closing the pipes used to comunicate with
+On some operating systems, closing the pipes used to communicate with
the slave SSH process does not terminate it and a work around has to
be applied. If you find that your scripts hung when the $sftp object
gets out of scope, try setting C<$Net::SFTP::Foreign::dirty_cleanup>
@@ -5266,7 +5309,7 @@ L<autodie>.
=head1 COPYRIGHT
-Copyright (c) 2005-2012 Salvador FandiE<ntilde>o (sfandino@yahoo.com).
+Copyright (c) 2005-2013 Salvador FandiE<ntilde>o (sfandino@yahoo.com).
Copyright (c) 2001 Benjamin Trott, Copyright (c) 2003 David Rolsky.
@@ -19,7 +19,7 @@ plan skip_all => "tests not supported on inferior OS"
my @new_args = new_args;
-plan tests => 793;
+plan tests => 811;
use_ok('Net::SFTP::Foreign');
use Net::SFTP::Foreign::Constants qw(:flags SFTP_ERR_CONNECTION_BROKEN);
@@ -93,6 +93,9 @@ for my $setcwd (0, 1) {
ok($sftp->rename($drfn1, $drfn), "rename - $i");
diag ($sftp->error) if $sftp->error;
+ ok($sftp->rename($drfn, $drfn, overwrite => 1));
+ diag ($sftp->error) if $sftp->error;
+
mktestfile($drfn1_l, $i, "blah, blah, blah...");
ok(!$sftp->rename($drfn, $drfn1), "rename no overwrite - $i");
@@ -219,24 +222,30 @@ for my $setcwd (0, 1) {
}
ok (close($fh), "close write file");
+ my $ctn = $sftp->get_content($drfn);
+ is($ctn, $cp, "get_content");
+
+ unlink $drfn_l;
+ $sftp->put_content($cp, $drfn);
+
$fh = $sftp->open($drfn);
ok($fh, "open read file 3");
ok(!$sftp->eof($fh), "not at eof");
while (1) {
- my $data = $sftp->read($fh, 1+int(rand 64000));
+ my $data = $sftp->read($fh, 1 + int(rand 64000));
last unless defined $data;
$all .= $data;
}
-
is($all, $cp, "write and read chunks");
ok(eof($fh), "at eof");
for my $pos (0, 1000, 0, 234, 4500, 1025) {
my $d1;
- is(seek($fh, $pos, 0), $pos, "seek");
+ seek($fh, $pos, 0);
+ is(tell($fh), $pos, "seek & tell");
is(read($fh, my $data, $pos), $pos, "read");
is($d1 = $sftp->sftpread($fh, $pos, $pos), $data, "sftpread");
# D($d1, $data) and diag "got: $a\nexp: $b\n\n";
@@ -246,7 +255,7 @@ for my $setcwd (0, 1) {
next unless $pos1 + $off >= 0;
$pos1 += $off;
- is(seek($fh, $off, 1), $pos1, "seek - 2");
+ ok(seek($fh, $off, 1), "seek - 2");
is(tell($fh), $pos1, "tell"); # if $pos1 > 2000;
is(read($fh, $data, $pos), $pos, "read - 2 ($pos1, $pos)");
is($d1 = $sftp->sftpread($fh, $pos1, $pos), $data, "sftpread - 2 ($pos1, $pos)");
@@ -255,11 +264,10 @@ for my $setcwd (0, 1) {
}
}
- my $ctn = $sftp->get_content($drfn);
- is($ctn, $all, "get_content");
# D($ctn, $all, -10, 30) and diag "got: $a\nexp: $b\n\n";
- is(seek($fh, 0, 0), 0, 'seek - 3');
+ ok(seek($fh, 0, 0), 'seek - 3');
+ is(tell($fh), 0, 'tell - 3');
my $line = readline $fh;
my $wfh = $sftp->open($drfn, SSH2_FXF_WRITE);
@@ -1,12 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use Test::More;
-
-plan skip_all => "Only the author needs to check that POD docs are right"
- unless eval "no warnings; getlogin eq 'salva'";
-
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-
-all_pod_files_ok( all_pod_files( qw(blib) ) );