r63665 - in /trunk/libnet-sftp-foreign-perl: ./ debian/ lib/Net/SFTP/ lib/Net/SFTP/Foreign/ lib/Net/SFTP/Foreign/Backend/ samples/ t/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Tue Oct 12 21:39:38 UTC 2010
Author: periapt-guest
Date: Tue Oct 12 21:39:03 2010
New Revision: 63665
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=63665
Log:
New upstream release
Added:
trunk/libnet-sftp-foreign-perl/samples/resume_put.pl
- copied unchanged from r63664, branches/upstream/libnet-sftp-foreign-perl/current/samples/resume_put.pl
Modified:
trunk/libnet-sftp-foreign-perl/Changes
trunk/libnet-sftp-foreign-perl/MANIFEST
trunk/libnet-sftp-foreign-perl/META.yml
trunk/libnet-sftp-foreign-perl/TODO
trunk/libnet-sftp-foreign-perl/debian/changelog
trunk/libnet-sftp-foreign-perl/debug.txt
trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm
trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Unix.pm
trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Windows.pm
trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Common.pm
trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm
trunk/libnet-sftp-foreign-perl/samples/capture_stderr.pl
trunk/libnet-sftp-foreign-perl/samples/psftp
trunk/libnet-sftp-foreign-perl/t/1_run.t
Modified: trunk/libnet-sftp-foreign-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/Changes?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/Changes (original)
+++ trunk/libnet-sftp-foreign-perl/Changes Tue Oct 12 21:39:03 2010
@@ -1,14 +1,66 @@
Revision history for Net::SFTP::Foreign
+
+1.62 Oct 5, 2010
+ - _catch_tainted_args was not being imported from helpers (bug
+ report by rfbits at PerlMonks)
+
+1.61 Sep 22, 2010
+ - remove some dead code introducing unneded constraints that
+ cause the Net::SSH2 backend to fail (bug report by Philippe
+ Vouters)
+
+1.60 Sep 20, 2010
+ - _ensure_list was not being imported from Helpers (bug report
+ and solution by Jean-Benoît Baudens)
+
+1.59 Sep 16, 2010
+ - kill ssh subprocess with KILL signal on Windows
+
+1.58_08 Aug 22, 2010
+ - import _hexdump from Helpers.pm (bug report by Chuck Kozak)
+ - call kill passing the signal name instead of using POSIX to
+ get its number
+
+1.58_07 Aug 2, 2010
+ - dump $! on failed sysreads and syswrites
+
+1.58_06 Jul 12, 2010
+ - rput was broken under Windows (bug report by Brian
+ E. Lozier)
+ - do not use Fcntl S_IS* macro wrappers as S_ISLNK is not
+ available under Windows
+ - new FAQ about put failing because of forbidden setstat
+ - minor doc improvements
+ - use "kill $name" instead of using POSIX to get the signal
+ number
+
+1.58_05 Jun 7, 2010
+ - add support for stderr_discard also in Windows backend
+
+1.58_04 Jun 7, 2010
+ - add support for stderr_discard
+
+1.58_03 May 27, 2010
+ - even more debugging for put method and the resume feature
+
+1.58_02
+ - add FAQ about strict host key checking
+ - better debugging for put method
+
+1.58_01 Apr 19, 2010
+ - add stderr redirection feature
+ - minor doc corrections
+ - add donating to OpenSSH entry in docs
+
1.57 Mar 14, 2010
- - release as stable
+ - release as stable
1.56_09 Mar 11, 2010
- - realpath feature was broken on find and ls methods (bug
- report by Paul Kolano)
- - taint checks on hashes where not reporting problemns
- properly
- - minor doc corrections
+ - realpath feature was broken on find and ls methods (bug
+ report by Paul Kolano)
+ - taint checks on hashes were not reporting problems properly
+ - minor doc corrections
1.56_08 Jan 5, 2010
- put'ting a tied file handle was generating some warnings
Modified: trunk/libnet-sftp-foreign-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/MANIFEST?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/MANIFEST (original)
+++ trunk/libnet-sftp-foreign-perl/MANIFEST Tue Oct 12 21:39:03 2010
@@ -19,6 +19,7 @@
samples/passwd_conn.pl
samples/psftp
samples/sftp_tail.pl
+samples/resume_put.pl
t/1_run.t
t/2_pods.t
t/3_convert.t
Modified: trunk/libnet-sftp-foreign-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/META.yml?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/META.yml (original)
+++ trunk/libnet-sftp-foreign-perl/META.yml Tue Oct 12 21:39:03 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-SFTP-Foreign
-version: 1.57
+version: 1.62
abstract: Secure File Transfer Protocol client
author:
- Salvador Fandino <sfandino at yahoo.com>
Modified: trunk/libnet-sftp-foreign-perl/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/TODO?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/TODO (original)
+++ trunk/libnet-sftp-foreign-perl/TODO Tue Oct 12 21:39:03 2010
@@ -1,8 +1,6 @@
TODO
====
-
-- add support for capture_stderr option in constructor
- port to OpenVMS
@@ -18,6 +16,8 @@
DONE
====
+- add support for capture_stderr option in constructor
+
- add support for new extension methods available from late OpenSSH
SFTP server (http://www.sfr-fresh.com/unix/misc/openssh-5.1.tar.gz:a/ssh/PROTOCOL)
Modified: trunk/libnet-sftp-foreign-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/debian/changelog?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/debian/changelog (original)
+++ trunk/libnet-sftp-foreign-perl/debian/changelog Tue Oct 12 21:39:03 2010
@@ -1,12 +1,13 @@
-libnet-sftp-foreign-perl (1.57+dfsg-4) UNRELEASED; urgency=low
+libnet-sftp-foreign-perl (1.62+dfsg-1) UNRELEASED; urgency=low
[ Salvatore Bonaccorso ]
* Update carnil's email address
[ Nicholas Bamber ]
* Added myself to Uploaders
+ * New upstream release
- -- Salvatore Bonaccorso <carnil at debian.org> Sun, 10 Oct 2010 15:03:27 +0200
+ -- Nicholas Bamber <nicholas at periapt.co.uk> Tue, 12 Oct 2010 22:38:02 +0100
libnet-sftp-foreign-perl (1.57+dfsg-3) unstable; urgency=low
Modified: trunk/libnet-sftp-foreign-perl/debug.txt
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/debug.txt?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/debug.txt (original)
+++ trunk/libnet-sftp-foreign-perl/debug.txt Tue Oct 12 21:39:03 2010
@@ -1,14 +1,16 @@
- 1 - message queueing/dequeuing
- 2 - remote file/dir open/close
- 4 - DESTROY calls
- 8 - hexdumps of incomming packets
- 16 - hexdumps of outgoing packets
- 32 - _do_io, _conn_lost
- 64 - _set_error, _set_status
- 128 - on the fly transformations
- 256 - add timestamp and process id
- 512 -
-1024 - hexdump of sysreads
-2048 - hexdump of syswrites
-4096 - _rel2abs
-8192 - mkpath
+ 1 - message queueing/dequeuing
+ 2 - remote file/dir open/close
+ 4 - DESTROY calls
+ 8 - hexdumps of incomming packets
+ 16 - hexdumps of outgoing packets
+ 32 - _do_io, _conn_lost
+ 64 - _set_error, _set_status
+ 128 - on the fly transformations
+ 256 - add timestamp and process id
+ 512 -
+ 1024 - hexdump of sysreads
+ 2048 - hexdump of syswrites
+ 4096 - _rel2abs
+ 8192 - mkpath
+16384 - put method
+32768 - recursive methods
Modified: trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm (original)
+++ trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign.pm Tue Oct 12 21:39:03 2010
@@ -1,12 +1,11 @@
package Net::SFTP::Foreign;
-our $VERSION = '1.57';
+our $VERSION = '1.62';
use strict;
use warnings;
use Carp qw(carp croak);
-use Fcntl qw(:mode);
use Symbol ();
use Errno ();
use Scalar::Util;
@@ -30,7 +29,9 @@
# knowing anything about the Helpers package!
our $debug;
BEGIN { *Net::SFTP::Foreign::Helpers::debug = \$debug };
-use Net::SFTP::Foreign::Helpers;
+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 );
@@ -100,9 +101,11 @@
}
sub _conn_failed {
- shift->_conn_lost(SSH2_FX_NO_CONNECTION,
+ my $sftp = shift;
+ $sftp->_conn_lost(SSH2_FX_NO_CONNECTION,
SFTP_ERR_CONNECTION_BROKEN,
@_)
+ unless $sftp->error;
}
sub _get_msg {
@@ -236,8 +239,7 @@
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) {
- require POSIX;
- kill POSIX::SIGTERM(), $pid
+ kill KILL => $pid
and waitpid($pid, 0);
}
else {
@@ -246,10 +248,7 @@
: $dirty_cleanup );
if ($dirty or not defined $dirty) {
- require POSIX;
- my $TERM = POSIX::SIGTERM();
- my $KILL = POSIX::SIGKILL();
- for my $sig (($dirty ? () : 0), $TERM, $TERM, $KILL, $KILL) {
+ for my $sig (($dirty ? () : 0), qw(TERM TERM KILL KILL)) {
$sig and kill $sig, $pid;
my $except;
@@ -456,7 +455,7 @@
return undef unless defined $cwd;
my $a = $sftp->stat($cwd)
or return undef;
- if (S_ISDIR($a->perm)) {
+ if (_is_dir($a->perm)) {
return $sftp->{cwd} = $cwd;
}
else {
@@ -639,9 +638,6 @@
my @written;
my $written = 0;
my $end;
-
- my $selin = '';
- vec($selin, fileno($sftp->{ssh_in}), 1) = 1;
while (!$end or @msgid) {
while (!$end and @msgid < $qsize) {
@@ -1450,7 +1446,7 @@
unless (defined $perm or $local_is_fh);
if ($resume) {
- if (CORE::open $fh, '>>', $local) {
+ if (CORE::open $fh, '>', $local) {
binmode $fh;
CORE::seek($fh, 0, 2);
$askoff = CORE::tell $fh;
@@ -1466,7 +1462,6 @@
"Couldn't resume transfer, local file is bigger than remote");
return undef;
}
-
$size == $askoff and return 1;
}
}
@@ -1519,13 +1514,9 @@
my @msgid;
my @askoff;
my $loff = $askoff;
- my $rfno = fileno($sftp->{ssh_in});
my $adjustment = 0;
- my $selin = '';
my $n = 0;
local $\;
-
- vec ($selin, $rfno, 1) = 1;
while (1) {
# request a new block if queue is not full
@@ -1756,7 +1747,7 @@
) {
# $fh can point at some place inside the file, not just at the
# begining
- if ($local_is_fh) {
+ if ($local_is_fh and defined $lsize) {
my $tell = eval { CORE::tell $fh };
$lsize -= $tell if ($tell and $tell > 0);
}
@@ -1766,8 +1757,9 @@
"Couldn't stat local file '$local'", $!);
return undef;
}
- else {
- undef $resume if ($resume and $resume eq 'auto');
+ elsif ($resume and $resume eq 'auto') {
+ $debug and $debug & 16384 and _debug "not resuming because stat'ing the local file failed";
+ undef $resume
}
}
@@ -1784,10 +1776,13 @@
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) {
@@ -1796,6 +1791,7 @@
}
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
@@ -1806,6 +1802,7 @@
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;
}
@@ -1838,6 +1835,7 @@
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 {
@@ -1905,7 +1903,6 @@
# if lsize is undef, we initialize it to $writeoff:
$lsize += $writeoff if ($append or not defined $lsize);
- my $rfno = fileno($sftp->{ssh_in});
# 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);
@@ -1924,6 +1921,7 @@
}
$eof_t = 1;
}
+
# note that the $converter is called a last time
# with an empty string
$lsize += $converter->($input);
@@ -1936,10 +1934,19 @@
$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";
+ 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) {
@@ -1966,6 +1973,9 @@
}
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;
@@ -2088,7 +2098,7 @@
longname => $ln,
a => $a };
- if ($follow_links and S_ISLNK($a->perm)) {
+ if ($follow_links and _is_lnk($a->perm)) {
if ($a = $sftp->stat($sftp->join($dir, $fn))) {
$entry->{a} = $a;
@@ -2167,7 +2177,7 @@
wanted => sub {
my $e = $_[1];
my $fn = $e->{filename};
- if (S_ISDIR($e->{a}->perm)) {
+ if (_is_dir($e->{a}->perm)) {
push @dirs, $e;
}
else {
@@ -2212,7 +2222,7 @@
$overwrite = 1 unless (defined $overwrite or $numbered);
my $a = $sftp->lstat($remote) or return undef;
- unless (S_ISLNK($a->perm)) {
+ unless (_is_lnk($a->perm)) {
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
"Remote object '$remote' is not a symlink");
return undef;
@@ -2264,7 +2274,7 @@
"Couldn't stat local file '$local'", $!);
return undef;
}
- unless (S_ISLNK($perm)) {
+ unless (_is_lnk($perm)) {
$sftp->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT,
"Local file $local is not a symlink");
return undef;
@@ -2369,13 +2379,13 @@
wanted => sub {
my $e = $_[1];
# print "file fn:$e->{filename}, a:$e->{a}\n";
- unless (S_ISDIR($e->{a}->perm)) {
+ 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 (S_ISLNK($e->{a}->perm) and !$ignore_links) {
+ if (_is_lnk($e->{a}->perm) and !$ignore_links) {
if ($sftp->get_symlink($fn, $lpath,
overwrite => $overwrite,
numbered => $numbered,
@@ -2384,7 +2394,7 @@
return undef;
}
}
- elsif (S_ISREG($e->{a}->perm)) {
+ 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,
@@ -2490,11 +2500,13 @@
# 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, $1);
+ 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");
+ "Remote directory '$rpath' already exists");
$lfs->_call_on_error($on_error, $e);
return 1;
}
@@ -2521,12 +2533,14 @@
wanted => sub {
my $e = $_[1];
# print "file fn:$e->{filename}, a:$e->{a}\n";
- unless (S_ISDIR($e->{a}->perm)) {
+ 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 $rpath = $sftp->join($remote, $1);
- if (S_ISLNK($e->{a}->perm) and !$ignore_links) {
+ 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)) {
@@ -2535,7 +2549,7 @@
}
$lfs->_copy_error($sftp);
}
- elsif (S_ISREG($e->{a}->perm)) {
+ elsif (_is_reg($e->{a}->perm)) {
my $ra;
if ( $newer_only and
$ra = $sftp->stat($rpath) and
@@ -2612,7 +2626,7 @@
require File::Spec;
for my $e (@remote) {
my $perm = $e->{a}->perm;
- if (S_ISDIR($perm)) {
+ if (_is_dir($perm)) {
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
"Remote object '$e->{filename}' is a directory");
}
@@ -2623,7 +2637,7 @@
$local = File::Spec->catfile($localdir, $local)
if defined $localdir;
- if (S_ISLNK($perm)) {
+ if (_is_lnk($perm)) {
next if $ignore_links;
$sftp->get_symlink($fn, $local, %get_symlink_opts);
}
@@ -2667,7 +2681,7 @@
require File::Spec;
for my $e (@local) {
my $perm = $e->{a}->perm;
- if (S_ISDIR($perm)) {
+ if (_is_dir($perm)) {
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
"Remote object '$e->{filename}' is a directory");
}
@@ -2677,7 +2691,7 @@
$remote = $sftp->join($remotedir, $remote)
if defined $remotedir;
- if (S_ISLNK($perm)) {
+ if (_is_lnk($perm)) {
next if $ignore_links;
$sftp->put_symlink($fn, $remote, %put_symlink_opts);
}
@@ -3229,7 +3243,7 @@
=item ssh1 =E<gt> 1
-Use old SSH1 approach for starting the remote SFTP server.
+use old SSH1 approach for starting the remote SFTP server.
=item transport =E<gt> $fh
@@ -3259,6 +3273,35 @@
passed to L<IPC::Open2::open2> to open a pipe to the remote
server.
+=item stderr_fh =E<gt> $fh
+
+redirects the output sent to stderr by the SSH subprocess to the given
+file handle.
+
+It can be used to suppress banners:
+
+ open my $ssherr, '>', '/dev/null' or die "unable to open /dev/null";
+ my $sftp = Net::SFTP::Foreign->new($host,
+ stderr_fh => $ssherr);
+
+Or to send SSH stderr to a file in order to capture errors for later
+analysis:
+
+ my $ssherr = File::Temp->new or die "File::Temp->new failed";
+ my $sftp = Net::SFTP::Foreign->new($hostname, more => ['-v'],
+ stderr_fh => $ssherr);
+ if ($sftp->error) {
+ print "sftp error: ".$sftp->error."\n";
+ seek($ssherr, 0, 0);
+ while (<$ssherr>) {
+ print "captured stderr: $_";
+ }
+ }
+
+=item stderr_discard =E<gt> 1
+
+redirects stderr to /dev/null
+
=item block_size =E<gt> $default_block_size
=item queue_size =E<gt> $default_queue_size
@@ -3268,7 +3311,7 @@
=item autodisconnect =E<gt> $ad
-By default, the SSH connection is closed from the DESTROY method when
+by default, the SSH connection is closed from the DESTROY method when
the object goes out of scope. But on scripts that fork new processes,
that results on the SSH connection being closed by the first process
where the object goes out of scope, something undesirable.
@@ -4363,7 +4406,7 @@
C<$sl> pointing to C<$target>.
C<$target> is stored as-is, without any path expansion taken place on
-it. User C<realpath> to normalize it:
+it. Use C<realpath> to normalize it:
$sftp->symlink("foo.lnk" => $sftp->realpath("../bar"))
@@ -4511,8 +4554,8 @@
As a work around, you can use plink C<-pw> argument to pass the
password on the command line, but it is B<highly insecure>, anyone
-with a shell account on the machine would be able to get the password.
-Use at your own risk!:
+with a shell account on the local machine would be able to get the
+password. Use at your own risk!:
# HIGHLY INSECURE!!!
my $sftp = Net::SFTP::Foreign->new('foo at bar',
@@ -4550,6 +4593,20 @@
can add code for your particular server software to activate the
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)".
+
+B<A>: Some servers forbid the SFTP C<setstat> operation used by the
+C<put> method for replicating the file permissions and timestamps on
+the remote side.
+
+As a work around you can just disable the feature:
+
+ $sftp->put($local_file, $remote_file,
+ copy_perms => 0, copy_time => 0);
+
=item Disable password authentication completely
B<Q>: When we try to open a session and the key either doesn't exist
@@ -4578,6 +4635,38 @@
print "$entry->{filename} is a directory\n";
}
}
+
+=item Host key checking
+
+B<Q>: Connecting to a remote server with password authentication fails
+with the following error:
+
+ The authenticity of the target host can not be established,
+ connect from the command line first
+
+B<A>: That probably means that the public key from the remote server
+is not stored in the C<~/.ssh/known_hosts> file. Run an SSH Connection
+from the command line as the same user as the script and answer C<yes>
+when asked to confirm the key suplied.
+
+Example:
+
+ $ ssh pluto /bin/true
+ The authenticity of host 'pluto (172.25.1.4)' can't be established.
+ RSA key fingerprint is 41:b1:a7:86:d2:a9:7b:b0:7f:a1:00:b7:26:51:76:52.
+ Are you sure you want to continue connecting (yes/no)? yes
+
+Your SSH client may also support some flag to disable this check, but
+doing it can ruin the security of the SSH protocol so I advise against
+its usage.
+
+Example:
+
+ # Warning: don't do that unless you fully understand
+ # its security implications!!!
+ $sftp = Net::SFTP::Foreign->new($host,
+ more => [-o => 'StrictHostKeyChecking no'],
+ ...);
=back
@@ -4615,13 +4704,13 @@
Also, the following features should be considered experimental:
+- redirecting SSH stderr stream
+
- multi-backend support
-- passing file handles to put and get methods
-
- mput and mget methods
-- numbered option
+- numbered feature
=head1 SUPPORT
@@ -4640,6 +4729,9 @@
If you like this module and you're feeling generous, take a look at my
Amazon Wish List: L<http://amzn.com/w/1WU1P6IR5QZ42>
+Also consider contributing to the OpenSSH project this module builds
+upon: L<http://www.openssh.org/donations.html>.
+
=head1 SEE ALSO
Information about the constants used on this module is available from
@@ -4653,11 +4745,13 @@
Net::SFTP::Foreign integrates nicely with my other module
L<Net::OpenSSH>.
+L<Net::SFTP::Foreign::Backend::Net_SSH2> allows to run
+Net::SFTP::Foreign on top of L<Net::SSH2>.
+
Modules offering similar functionality available from CPAN are
L<Net::SFTP> and L<Net::SSH2>.
-L<Net::SFTP::Foreign::Backend::Net_SSH2> allows to run
-Net::SFTP::Foreign on top of L<Net::SSH2>.
+L<Test::SFTP> allows to run tests against a remote SFTP server.
=head1 COPYRIGHT
Modified: trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Unix.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Unix.pm?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Unix.pm (original)
+++ trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Unix.pm Tue Oct 12 21:39:03 2010
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign::Backend::Unix;
-our $VERSION = '0.02';
+our $VERSION = '1.58_07';
use strict;
use warnings;
@@ -9,6 +9,7 @@
our @CARP_NOT = qw(Net::SFTP::Foreign);
use Fcntl qw(O_NONBLOCK F_SETFL F_GETFL);
+use IPC::Open3;
use IPC::Open2;
use Net::SFTP::Foreign::Helpers qw(_tcroak _ensure_list _debug _hexdump $debug);
use Net::SFTP::Foreign::Constants qw(SSH2_FX_BAD_MESSAGE
@@ -29,6 +30,16 @@
}
}
+sub _open_dev_null {
+ my $sftp = shift;
+ my $dev_null;
+ unless (open $dev_null, '>', "/dev/null") {
+ $sftp->_conn_failed("Unable to redirect stderr to /dev/null");
+ return;
+ }
+ $dev_null
+}
+
sub _ipc_open2_bug_workaround {
# in some cases, IPC::Open3::open2 returns from the child
my $pid = shift;
@@ -38,6 +49,26 @@
}
}
+sub _open3 {
+ my $sftp = shift;
+ if (defined $_[2]) {
+ my $sftp_err = $_[2];
+ my $fno = eval { no warnings; fileno($sftp_err) };
+ local *SSHERR;
+ unless (defined $fno and $fno >= 0 and
+ open(SSHERR, ">>&=", $fno)) {
+ $sftp->_conn_failed("Unable to duplicate stderr redirection file handle: $!");
+ return undef;
+ }
+ local ($@, $SIG{__DIE__}, $SIG{__WARN__});
+ return eval { open3(@_[1,0], ">&SSHERR", @_[3..$#_]) }
+ }
+ else {
+ local ($@, $SIG{__DIE__}, $SIG{__WARN__});
+ return eval { open2(@_[0,1], @_[3..$#_]) };
+ }
+}
+
sub _init_transport {
my ($class, $sftp, $opts) = @_;
@@ -53,10 +84,8 @@
}
}
else {
- my (@open2_cmd, $pass, $passphrase, $expect_log_user);
-
- $pass = delete $opts->{passphrase};
-
+ my $pass = delete $opts->{passphrase};
+ my $passphrase;
if (defined $pass) {
$passphrase = 1;
}
@@ -65,9 +94,12 @@
defined $pass and $sftp->{_password_authentication} = 1;
}
- $expect_log_user = delete $opts->{expect_log_user} || 0;
-
+ my $expect_log_user = delete $opts->{expect_log_user} || 0;
+ my $stderr_discard = delete $opts->{stderr_discard};
+ my $stderr_fh = ($stderr_discard ? undef : delete $opts->{stderr_fh});
my $open2_cmd = delete $opts->{open2_cmd};
+
+ my @open2_cmd;
if (defined $open2_cmd) {
@open2_cmd = _ensure_list($open2_cmd);
}
@@ -122,6 +154,10 @@
if (${^TAINT} and Scalar::Util::tainted($ENV{PATH})) {
_tcroak('Insecure $ENV{PATH}')
}
+
+ if ($stderr_discard) {
+ $stderr_fh = $class->_open_dev_null($sftp) or return;
+ }
my $this_pid = $$;
@@ -149,10 +185,8 @@
$expect->raw_pty(1);
$expect->log_user($expect_log_user);
- $child = do {
- local ($@, $SIG{__DIE__}, $SIG{__WARN__});
- eval { open2($sftp->{ssh_in}, $sftp->{ssh_out}, '-') }
- };
+ $child = _open3($sftp, $sftp->{ssh_in}, $sftp->{ssh_out}, $stderr_fh, '-');
+
if (defined $child and !$child) {
$pty->make_slave_controlling_terminal;
do { exec @open2_cmd }; # work around suppress warning under mod_perl
@@ -197,10 +231,7 @@
$expect->close_slave();
}
else {
- do {
- local ($@, $SIG{__DIE__}, $SIG{__WARN__});
- $sftp->{pid} = eval { open2($sftp->{ssh_in}, $sftp->{ssh_out}, @open2_cmd) };
- };
+ $sftp->{pid} = _open3($sftp, $sftp->{ssh_in}, $sftp->{ssh_out}, $stderr_fh, @open2_cmd);
_ipc_open2_bug_workaround $this_pid;
unless (defined $sftp->{pid}) {
@@ -258,10 +289,10 @@
if (vec($wv1, $fnoout, 1)) {
my $written = syswrite($sftp->{ssh_out}, $$bout, 64 * 1024);
if ($debug and $debug & 32) {
- _debug (sprintf "_do_io write queue: %d, syswrite: %s, max: %d",
+ _debug (sprintf "_do_io write queue: %d, syswrite: %s, max: %d, \$!: %s",
length $$bout,
(defined $written ? $written : 'undef'),
- 64 * 1024);
+ 64 * 1024, $!);
$debug & 2048 and $written and _hexdump(substr($$bout, 0, $written));
}
unless ($written) {
@@ -273,9 +304,10 @@
if (vec($rv1, $fnoin, 1)) {
my $read = sysread($sftp->{ssh_in}, $$bin, 64 * 1024, length($$bin));
if ($debug and $debug & 32) {
- _debug (sprintf "_do_io read sysread: %s, total read: %d",
+ _debug (sprintf "_do_io read sysread: %s, total read: %d, \$!: %s",
(defined $read ? $read : 'undef'),
- length $$bin);
+ length $$bin,
+ $!);
$debug & 1024 and $read and _hexdump(substr($$bin, -$read));
}
unless ($read) {
Modified: trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Windows.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Windows.pm?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Windows.pm (original)
+++ trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Backend/Windows.pm Tue Oct 12 21:39:03 2010
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign::Backend::Windows;
-our $VERSION = '0.01';
+our $VERSION = '1.58_05';
use strict;
use warnings;
@@ -23,6 +23,16 @@
my ($self, $sftp) = @_;
binmode $sftp->{ssh_in};
binmode $sftp->{ssh_out};
+}
+
+sub _open_dev_null {
+ my $sftp = shift;
+ my $dev_null;
+ unless (open $dev_null, '>', "NUL:") {
+ $sftp->_conn_failed("Unable to redirect stderr to NUL:");
+ return;
+ }
+ $dev_null
}
sub _sysreadn {
Modified: trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Common.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Common.pm?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Common.pm (original)
+++ trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Common.pm Tue Oct 12 21:39:03 2010
@@ -6,9 +6,8 @@
use warnings;
use Carp;
use Scalar::Util qw(dualvar tainted);
-use Fcntl qw(S_ISLNK S_ISDIR);
-
-use Net::SFTP::Foreign::Helpers qw(_gen_wanted _ensure_list _debug _glob_to_regex $debug);
+
+use Net::SFTP::Foreign::Helpers qw(_gen_wanted _ensure_list _debug _glob_to_regex _is_lnk _is_dir $debug);
use Net::SFTP::Foreign::Constants qw(:status);
my %status_str = ( SSH2_FX_OK, "OK",
@@ -155,7 +154,7 @@
my $entry = shift;
my $fn = $entry->{filename};
for (1) {
- my $follow = ($follow_links and S_ISLNK($entry->{a}->perm));
+ my $follow = ($follow_links and _is_lnk($entry->{a}->perm));
if ($follow or $realpath) {
unless (defined $entry->{realpath}) {
@@ -201,11 +200,11 @@
my $a = $try->{a} ||= $self->lstat($fn)
or next;
- next if (S_ISDIR($a->perm) and $done{$fn}++);
+ next if (_is_dir($a->perm) and $done{$fn}++);
$task->($try);
- if (S_ISDIR($a->perm)) {
+ if (_is_dir($a->perm)) {
if (!$descend or $descend->($self, $try)) {
if ($ordered or $atomic_readdir) {
my $ls = $self->ls( $fn,
@@ -229,7 +228,7 @@
if ($child !~ /^\.\.?$/) {
$entry->{filename} = $self->join($fn, $child);
- if (S_ISDIR($entry->{a}->perm)) {
+ if (_is_dir($entry->{a}->perm)) {
push @queue, $entry;
}
else {
@@ -295,7 +294,7 @@
if ($e->{filename} =~ $re) {
my $fn = $e->{filename} = $sftp->join($pfn, $e->{filename});
if ( (@parts or $follow_links)
- and S_ISLNK($e->{a}->perm) ) {
+ and _is_lnk($e->{a}->perm) ) {
if (my $a = $sftp->stat($fn)) {
$e->{a} = $a;
}
@@ -305,7 +304,7 @@
}
}
if (@parts) {
- push @res, $e if S_ISDIR($e->{a}->perm)
+ push @res, $e if _is_dir($e->{a}->perm)
}
elsif (!$wanted or $wanted->($sftp, $e)) {
if ($wantarray) {
@@ -333,7 +332,7 @@
if (my $a = $sftp->$method($fn)) {
my $e = { filename => $fn, a => $a };
if (@parts) {
- push @res, $e if S_ISDIR($a->{perm})
+ push @res, $e if _is_dir($a->{perm})
}
elsif (!$wanted or $wanted->($sftp, $e)) {
if ($wantarray) {
@@ -358,7 +357,7 @@
sub test_d {
my ($sftp, $name) = @_;
my $a = $sftp->stat($name);
- $a ? S_ISDIR($a->perm) : undef;
+ $a ? _is_dir($a->perm) : undef;
}
1;
Modified: trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm (original)
+++ trunk/libnet-sftp-foreign-perl/lib/Net/SFTP/Foreign/Helpers.pm Tue Oct 12 21:39:03 2010
@@ -21,7 +21,10 @@
_hexdump
$debug
);
-our @EXPORT_OK = qw( _do_nothing
+our @EXPORT_OK = qw( _is_lnk
+ _is_dir
+ _is_reg
+ _do_nothing
_glob_to_regex
_tcroak );
@@ -301,5 +304,9 @@
}
}
+sub _is_lnk { (0120000 & shift) == 0120000 }
+sub _is_dir { (0040000 & shift) == 0040000 }
+sub _is_reg { (0100000 & shift) == 0100000 }
+
1;
Modified: trunk/libnet-sftp-foreign-perl/samples/capture_stderr.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/samples/capture_stderr.pl?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/samples/capture_stderr.pl (original)
+++ trunk/libnet-sftp-foreign-perl/samples/capture_stderr.pl Tue Oct 12 21:39:03 2010
@@ -5,27 +5,18 @@
use Net::SFTP::Foreign;
use File::Temp;
-use IPC::Open3;
-use IPC::Open2;
-use Fcntl qw(:mode O_NONBLOCK F_SETFL F_GETFL);
-my $hostname = 'localhost';
+my $hostname = shift // 'localhost';
-my $ssherr = File::Temp->new
- or die "tempfile failed";
+my $ssherr = File::Temp->new or die "tempfile failed";
-open my $stderr_save, '>&STDERR' or die "unable to dup STDERR";
-open STDERR, '>&'.fileno($ssherr);
-
-my $sftp = Net::SFTP::Foreign->new($hostname, more => qw(-v));
-
-open STDERR, '>&'.fileno($stderr_save);
+my $sftp = Net::SFTP::Foreign->new($hostname, more => qw(-v), stderr_fh => $ssherr);
if ($sftp->error) {
print "sftp error: ".$sftp->error."\n";
seek($ssherr, 0, 0);
while (<$ssherr>) {
- print "error: $_";
+ print " ssh error: $_";
}
}
Modified: trunk/libnet-sftp-foreign-perl/samples/psftp
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/samples/psftp?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/samples/psftp (original)
+++ trunk/libnet-sftp-foreign-perl/samples/psftp Tue Oct 12 21:39:03 2010
@@ -1,4 +1,7 @@
#!/usr/bin/perl
+
+# This script has not being updated and still uses the Net::SFTP API
+# available from the adapter module Net::SFTP::Foreign::Compat.
use strict;
use warnings;
Modified: trunk/libnet-sftp-foreign-perl/t/1_run.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-sftp-foreign-perl/t/1_run.t?rev=63665&op=diff
==============================================================================
--- trunk/libnet-sftp-foreign-perl/t/1_run.t (original)
+++ trunk/libnet-sftp-foreign-perl/t/1_run.t Tue Oct 12 21:39:03 2010
@@ -129,7 +129,6 @@
unlink $dlfn1;
unlink $drfn_l;
unlink $dlfn;
-
}
# mkdir and rmdir
More information about the Pkg-perl-cvs-commits
mailing list