r74685 - in /branches/upstream/libnet-sftp-foreign-perl/current: ./ lib/Net/SFTP/ lib/Net/SFTP/Foreign/ lib/Net/SFTP/Foreign/Backend/

periapt-guest at users.alioth.debian.org periapt-guest at users.alioth.debian.org
Wed May 18 14:39:49 UTC 2011


Author: periapt-guest
Date: Wed May 18 14:39:23 2011
New Revision: 74685

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=74685
Log:
[svn-upgrade] new version libnet-sftp-foreign-perl (1.65+dfsg)

Modified:
    branches/upstream/libnet-sftp-foreign-perl/current/Changes
    branches/upstream/libnet-sftp-foreign-perl/current/META.yml
    branches/upstream/libnet-sftp-foreign-perl/current/README
    branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign.pm
    branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Unix.pm
    branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Windows.pm
    branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Common.pm
    branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Constants.pm
    branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Helpers.pm

Modified: branches/upstream/libnet-sftp-foreign-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/Changes?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/Changes (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/Changes Wed May 18 14:39:23 2011
@@ -1,5 +1,58 @@
 Revision history for Net::SFTP::Foreign
 
+1.65 May 17, 2011
+        - die_on_error was broken
+
+1.64 May 09, 2011
+        - release as stable
+        - document the write_delay and read_ahead options
+        - minor doc corrections
+
+1.63_10  Apr 13, 2011
+        - workaround bug in perl 5.6 calling STORE in a tied
+          filehandle
+        - solve "not enough arguments for grep" when using an old
+          version of Scalar::Util
+
+1.63_09  Apr 12, 2011
+        - an error in the handler accessors was adding and useless
+          wrapping layer
+          
+1.63_08  Jan 22, 2011
+        - bad method call inside mkpath corrected (bug report and
+          solution by Adam Pingel)
+
+1.63_07  Jan 20, 2011
+        - do not override PreferredAuthentication when explicitly set
+          by the user (bug report and solution by Ave Wrigley)
+
+1.63_06  Dec 10, 2010
+        - redirect_stderr_to_tty was redirecting to the wrong side of
+          the tty (bug report by Russ Brewer)
+
+1.63_05  Dec 6, 2010
+        - add support for hardlink at openssh.com extension
+        - add die_on_error method
+        - create a new process group for slave ssh process so that
+          signals sent from the terminal are not propagated
+        - better error messages
+
+1.63_04	 Nov 11, 2010
+	- workaround for IPC::Open3::open3 not working with tied file
+          handles on Windows (bug report by Barnabas Bona)
+        - several spelling corrections (contributed by Philippe Bruhat)
+
+1.63_03  Nov 10, 2010
+        - On some OSs (i.e. AIX) reading/writing from non-blocking fds
+          can result in EAGAIN even when select has indicated that
+          data was available (bug report and patch by Bill Godfrey)
+
+1.63_02  Nov 2, 2010
+        - Windows backend was not pipelining requests when called from
+          put method
+
+1.63_01
+        - support for Tectia client added (bug report by Russ Brewer)
 
 1.62  Oct 5, 2010
         - _catch_tainted_args was not being imported from helpers (bug

Modified: branches/upstream/libnet-sftp-foreign-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/META.yml?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/META.yml (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/META.yml Wed May 18 14:39:23 2011
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Net-SFTP-Foreign
-version:            1.62
+version:            1.65
 abstract:           Secure File Transfer Protocol client
 author:
     - Salvador Fandino <sfandino at yahoo.com>

Modified: branches/upstream/libnet-sftp-foreign-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/README?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/README (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/README Wed May 18 14:39:23 2011
@@ -33,7 +33,7 @@
 
 COPYRIGHT AND LICENCE
 
-Copyright (c) 2005-2010 by Salvador Fandino
+Copyright (c) 2005-2011 by Salvador Fandino
 
 Copyright (c) 2001 Benjamin Trott, Copyright (c) 2003 David Rolsky.
 

Modified: branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign.pm?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign.pm (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign.pm Wed May 18 14:39:23 2011
@@ -1,6 +1,6 @@
 package Net::SFTP::Foreign;
 
-our $VERSION = '1.62';
+our $VERSION = '1.65';
 
 use strict;
 use warnings;
@@ -188,12 +188,14 @@
     $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->{_timeout} = delete $opts{timeout};
     $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 $]";
@@ -1024,8 +1026,8 @@
 	    last;
 	}
 	unless (length $path) {
-	    $sftp->set_error(SFTP_ERR_REMOTE_MKDIR_FAILED,
-			     "Unable to make path, bad root");
+	    $sftp->_set_error(SFTP_ERR_REMOTE_MKDIR_FAILED,
+                              "Unable to make path, bad root");
 	    return undef;
 	}
 	unshift @path, $p;
@@ -1300,6 +1302,27 @@
 
     $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 at 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 at 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 {
@@ -2765,7 +2788,7 @@
 my $gen_accessor = sub {
     my $ix = shift;
     sub {
-	my $st = *{shift()}->{ARRAY};
+	my $st = *{shift()}{ARRAY};
 	if (@_) {
 	    $st->[$ix] = shift;
 	}
@@ -2815,19 +2838,19 @@
 
     my $self = Symbol::gensym;
     bless $self, $class;
+    *$self = [ $sftp, $rid, 0, $flags, @_];
     tie *$self, $self;
-    *{$self}->{ARRAY} = [ $sftp, $rid, 0, $flags, @_];
 
     $self;
 }
 
 sub _close {
     my $self = shift;
-    @{*$self->{ARRAY}} = ();
+    @{*{$self}{ARRAY}} = ();
 }
 
 sub _check {
-    return 1 if defined(*{shift()}->{ARRAY}[0]);
+    return 1 if defined(*{shift()}{ARRAY}[0]);
     $! = Errno::EBADF;
     undef;
 }
@@ -2841,21 +2864,21 @@
     "-1:sftp(0x$hrid)"
 }
 
-sub _sftp { *{shift()}->{ARRAY}[0] }
-sub _rid { *{shift()}->{ARRAY}[1] }
+sub _sftp { *{shift()}{ARRAY}[0] }
+sub _rid { *{shift()}{ARRAY}[1] }
 
 * _pos = $gen_accessor->(2);
 
 sub _inc_pos {
     my ($self, $inc) = @_;
-    *{shift()}->{ARRAY}[2] += $inc;
+    *{shift()}{ARRAY}[2] += $inc;
 }
 
 
 my %flag_bit = (append => 0x1);
 
 sub _flag {
-    my $st = *{shift()}->{ARRAY};
+    my $st = *{shift()}{ARRAY};
     my $fn = shift;
     my $flag = $flag_bit{$fn};
     Carp::croak("unknown flag $fn") unless defined $flag;
@@ -2908,8 +2931,8 @@
 
 sub _check_is_file {}
 
-sub _bin { \(*{shift()}->{ARRAY}[4]) }
-sub _bout { \(*{shift()}->{ARRAY}[5]) }
+sub _bin { \(*{shift()}{ARRAY}[4]) }
+sub _bout { \(*{shift()}{ARRAY}[5]) }
 
 sub WRITE {
     my ($self, undef, $length, $offset) = @_;
@@ -3006,7 +3029,7 @@
 
 sub _check_is_dir {}
 
-sub _cache { *{shift()}->{ARRAY}[4] }
+sub _cache { *{shift()}{ARRAY}[4] }
 
 *CLOSEDIR = $gen_proxy_method->('closedir');
 *READDIR = $gen_proxy_method->('_readdir');
@@ -3042,8 +3065,7 @@
 
     use Net::SFTP::Foreign;
     my $sftp = Net::SFTP::Foreign->new($host);
-    $sftp->error and
-       die "Unable to stablish SFTP connection: " . $sftp->error;
+    $sftp->die_on_error("Unable to establish SFTP connection");
 
     $sftp->setcwd($path) or die "unable to change cwd: " . $sftp->error;
 
@@ -3079,7 +3101,7 @@
 
 Well, both modules have their pros and cons:
 
-Net::SFTP::Foreign does not requiere a bunch of additional modules and
+Net::SFTP::Foreign does not require a bunch of additional modules and
 external libraries to work, just the OpenBSD SSH client (or any other
 client compatible enough).
 
@@ -3136,7 +3158,7 @@
 constructor call:
 
   my $sftp = Net::SFTP::Foreign->new(...);
-  $sftp->error and die "SSH connection failed: " . $sftp->error;
+  $sftp->die_on_error("SSH connection failed");
 
 C<%args> can contain:
 
@@ -3173,20 +3195,14 @@
   more => "-i $key"    # wrong!!!
   more => [-i => $key] # right
 
-=item ssh_cmd_interface =E<gt> 'plink' or 'ssh'
+=item ssh_cmd_interface =E<gt> 'plink' or 'ssh' or 'tectia'
 
 declares the command line interface that the SSH client used to
-connect to the remote host understands. Currently C<plink> and C<ssh>
-are supported.
+connect to the remote host understands. Currently C<plink>, C<ssh> and
+C<tectia> are supported.
 
 This option would be rarely required as the module infers the
 interface from the SSH command name.
-
-=item autoflush =E<gt> $bool
-
-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.
 
 =item timeout =E<gt> $seconds
 
@@ -3208,7 +3224,7 @@
 
 For instance:
 
-  $sftp = Net::SFTP::Foreign->new('user at host', fs_encoding => latin1);
+  $sftp = Net::SFTP::Foreign->new('user at host', fs_encoding => 'latin1');
 
 will convert any path name passed to any method in this package to its
 C<latin1> representation before sending it to the remote side.
@@ -3309,6 +3325,33 @@
 default C<block_size> and C<queue_size> used for read and write
 operations (see the C<put> or C<get> documentation).
 
+=item autoflush =E<gt> $bool
+
+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.
+
+=item write_delay =E<gt> $bytes
+
+This option determines how many bytes are buffered before the real
+SFTP write operation is performed.
+
+=item read_ahead =E<gt> $bytes
+
+On read operations this option determines how many bytes to read in
+advance so that later read operations can be fulfilled from the
+buffer.
+
+Using a high value will increase the performance of the module for a
+sequential reads access pattern but degrade it for a short random
+reads access pattern. It can also cause synchronization problems if
+the file is concurrently modified by other parties (L</flush> can be
+used to discard all the data inside the read buffer on demand).
+
+The default value is set dynamically considering some runtime
+parameters and given options, though it tends to favor the sequential
+read access pattern.
+
 =item autodisconnect =E<gt> $ad
 
 by default, the SSH connection is closed from the DESTROY method when
@@ -3326,7 +3369,7 @@
 
 Never try to disconnect this object when exiting from any process.
 
-On most operative systems, the SSH process will exit when the last
+On most operating systems, the SSH process will exit when the last
 process connected to it ends, but this is not guaranteed.
 
 =item 1
@@ -3369,6 +3412,14 @@
 
 See L<Net::SFTP::Foreign::Constants> for a list of possible error
 codes and how to import them on your scripts.
+
+=item $sftp-E<gt>die_on_error($msg)
+
+Convenience method:
+
+  $sftp->die_on_error("Something bad happened");
+  # is a shortcut for...
+  $sftp->error and die "Something bad happened: " . $sftp->error;
 
 =item $sftp-E<gt>status
 
@@ -3683,7 +3734,7 @@
 
 =item wanted =E<gt> qr/.../
 
-Only elements which filename match the regular expresion are included
+Only elements which filename match the regular expression are included
 on the listing.
 
 =item wanted =E<gt> sub {...}
@@ -3810,7 +3861,7 @@
 
 =item ordered =E<gt> 1
 
-By default, the file system is searched in an implementation dependant
+By default, the file system is searched in an implementation dependent
 order (actually optimized for low memory comsumption). If this option
 is included, the file system is searched in a deep-first, sorted by
 filename fashion.
@@ -3894,7 +3945,7 @@
 
 =item strict_leading_dot =E<gt> 0
 
-by default, a dot character at the begining of a file or directory
+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
 a false value changes this behaviour.
 
@@ -4275,7 +4326,7 @@
 =item $sftp-E<gt>opendir($path)
 
 Sends a C<SSH_FXP_OPENDIR> command to open the remote directory
-C<$path>, and returns an open handle on success (unfortunatelly,
+C<$path>, and returns an open handle on success (unfortunately,
 current versions of perl does not support directory operations via
 tied handles, so it is not possible to use the returned handle as a
 native one).
@@ -4409,6 +4460,13 @@
 it. Use C<realpath> to normalize it:
 
   $sftp->symlink("foo.lnk" => $sftp->realpath("../bar"))
+
+=item $sftp-E<gt>hardlink($hl, $target)
+
+Creates a hardlink on the server.
+
+This command requires support for the 'hardlink at openssh.com' extension
+on the server (available in OpenSSH from version 5.7).
 
 =item $sftp-E<gt>statvfs($path)
 
@@ -4561,7 +4619,7 @@
   my $sftp = Net::SFTP::Foreign->new('foo at bar',
                                      ssh_cmd => 'plink',
                                      more => [-pw => $password]);
-  $sftp->error and die $sftp->error;
+  $sftp->die_on_error;
 
 =item Plink
 
@@ -4577,7 +4635,7 @@
 B<Q>: put fails with the following error:
 
   Couldn't setstat remote file (fsetstat): The requested operation
-    cannot be performed because there is a file transfer in progress.
+  cannot be performed because there is a file transfer in progress.
 
 B<A>: Try passing the C<late_set_perm> option to the put method:
 
@@ -4647,7 +4705,7 @@
 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.
+when asked to confirm the key supplied.
 
 Example:
 
@@ -4683,7 +4741,7 @@
 
 =item - Dirty cleanup:
 
-On some operative systems, closing the pipes used to comunicate with
+On some operating systems, closing the pipes used to comunicate 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>
@@ -4704,6 +4762,8 @@
 
 Also, the following features should be considered experimental:
 
+- support for Tectia server
+
 - redirecting SSH stderr stream
 
 - multi-backend support
@@ -4755,7 +4815,7 @@
 
 =head1 COPYRIGHT
 
-Copyright (c) 2005-2010 Salvador FandiE<ntilde>o (sfandino at yahoo.com).
+Copyright (c) 2005-2011 Salvador FandiE<ntilde>o (sfandino at yahoo.com).
 
 Copyright (c) 2001 Benjamin Trott, Copyright (c) 2003 David Rolsky.
 

Modified: branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Unix.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Unix.pm?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Unix.pm (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Unix.pm Wed May 18 14:39:23 2011
@@ -1,6 +1,6 @@
 package Net::SFTP::Foreign::Backend::Unix;
 
-our $VERSION = '1.58_07';
+our $VERSION = '1.63_07';
 
 use strict;
 use warnings;
@@ -22,7 +22,7 @@
 }
 
 sub _init_transport_streams {
-    my ($self, $sftp) = @_;
+    my (undef, $sftp) = @_;
     for my $dir (qw(ssh_in ssh_out)) {
 	binmode $sftp->{$dir};
 	my $flags = fcntl($sftp->{$dir}, F_GETFL, 0);
@@ -50,6 +50,7 @@
 }
 
 sub _open3 {
+    my $backend = shift;
     my $sftp = shift;
     if (defined $_[2]) {
 	my $sftp_err = $_[2];
@@ -70,7 +71,7 @@
 }
 
 sub _init_transport {
-    my ($class, $sftp, $opts) = @_;
+    my ($backend, $sftp, $opts) = @_;
 
     my $transport = delete $opts->{transport};
 
@@ -98,6 +99,7 @@
 	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 $ssh_cmd_interface = delete $opts->{ssh_cmd_interface};
 
 	my @open2_cmd;
         if (defined $open2_cmd) {
@@ -111,11 +113,10 @@
             $ssh_cmd = 'ssh' unless defined $ssh_cmd;
             @open2_cmd = ($ssh_cmd);
 
-            my $ssh_cmd_interface = delete $opts->{ssh_cmd_interface};
             unless (defined $ssh_cmd_interface) {
-                $ssh_cmd_interface = ( $ssh_cmd =~ /\bplink(?:\.exe)?$/i
-                                       ? 'plink'
-                                       : 'ssh');
+                $ssh_cmd_interface = ( $ssh_cmd =~ /\bplink(?:\.exe)?$/i ? 'plink'  :
+                                       $ssh_cmd =~ /\bsshg3$/i           ? 'tectia' :
+                                                                           'ssh'    );
             }
 
             my $port = delete $opts->{port};
@@ -125,6 +126,7 @@
             my $more = delete $opts->{more};
             carp "'more' argument looks like if it should be splited first"
                 if (defined $more and !ref($more) and $more =~ /^-\w\s+\S/);
+            my @more = _ensure_list $more;
 
             if ($ssh_cmd_interface eq 'plink') {
                 $pass and !$passphrase
@@ -134,19 +136,32 @@
             elsif ($ssh_cmd_interface eq 'ssh') {
                 push @open2_cmd, -p => $port if defined $port;
 		if ($pass and !$passphrase) {
-		    push @open2_cmd, (-o => 'NumberOfPasswordPrompts=1',
-				      -o => 'PreferredAuthentications=keyboard-interactive,password');
+		    push @open2_cmd, -o => 'NumberOfPasswordPrompts=1';
+                    push @open2_cmd, -o => 'PreferredAuthentications=keyboard-interactive,password'
+                        unless grep { $more[$_] eq '-o' and
+                                      $more[$_ + 1] =~ /^PreferredAuthentications\W/ } 0..$#more-1;
 		}
+            }
+            elsif ($ssh_cmd_interface eq 'tectia') {
             }
             else {
                 die "Unsupported ssh_cmd_interface '$ssh_cmd_interface'";
             }
             push @open2_cmd, -l => $user if defined $user;
-            push @open2_cmd, _ensure_list($more) if defined $more;
+            push @open2_cmd, @more;
             push @open2_cmd, $host;
 	    push @open2_cmd, ($ssh1 ? "/usr/lib/sftp-server" : -s => 'sftp');
         }
-	_debug "ssh cmd: @open2_cmd\n" if ($debug and $debug & 1);
+
+        my $redirect_stderr_to_tty = ( (defined $pass or defined $passphrase) and
+                                       (delete $opts->{redirect_stderr_to_tty} or
+                                        $ssh_cmd_interface eq 'tectia' ) );
+
+        $redirect_stderr_to_tty and ($stderr_discard or $stderr_fh)
+            and croak "stderr_discard or stderr_fh can not be used together with password/passphrase "
+                          . "authentication when Tectia client is used";
+
+	$debug and $debug & 1 and _debug "ssh cmd: @open2_cmd\n";
 
 	%$opts and return; # Net::SFTP::Foreign will find the
                            # unhandled options and croak
@@ -156,7 +171,7 @@
         }
 
 	if ($stderr_discard) {
-	    $stderr_fh = $class->_open_dev_null($sftp) or return;
+	    $stderr_fh = $backend->_open_dev_null($sftp) or return;
 	}
 
         my $this_pid = $$;
@@ -185,7 +200,9 @@
 		$expect->raw_pty(1);
 		$expect->log_user($expect_log_user);
 
-		$child = _open3($sftp, $sftp->{ssh_in}, $sftp->{ssh_out}, $stderr_fh, '-');
+                $redirect_stderr_to_tty and $stderr_fh = $pty->slave;
+
+		$child = $backend->_open3($sftp, $sftp->{ssh_in}, $sftp->{ssh_out}, $stderr_fh, '-');
 
 		if (defined $child and !$child) {
 		    $pty->make_slave_controlling_terminal;
@@ -196,6 +213,9 @@
 		# $pty->close_slave();
 	    }
 	    else {
+                $redirect_stderr_to_tty and
+                    croak "In order to support password/passphrase authentication with the Tectia client, " .
+                        "IPC::Open3 version 1.0105 is required (current version is $IPC::Open3::VERSION)";
 		$expect = Expect->new;
 		$expect->raw_pty(1);
 		$expect->log_user($expect_log_user);
@@ -231,21 +251,26 @@
 	    $expect->close_slave();
         }
         else {
-	    $sftp->{pid} = _open3($sftp, $sftp->{ssh_in}, $sftp->{ssh_out}, $stderr_fh, @open2_cmd);
+	    $sftp->{pid} = $backend->_open3($sftp, $sftp->{ssh_in}, $sftp->{ssh_out}, $stderr_fh, @open2_cmd);
             _ipc_open2_bug_workaround $this_pid;
 
             unless (defined $sftp->{pid}) {
                 $sftp->_conn_failed("Bad ssh command", $!);
                 return;
             }
-        }
-    }
-    $class->_init_transport_streams($sftp);
+            # do not propagate signals sent from the terminal to the
+            # slave SSH:
+            eval {
+                setpgrp($sftp->{pid}, 0);
+            };
+        }
+    }
+    $backend->_init_transport_streams($sftp);
 }
 
 
 sub _do_io {
-    my ($self, $sftp, $timeout) = @_;
+    my (undef, $sftp, $timeout) = @_;
 
     $debug and $debug & 32 and _debug(sprintf "_do_io connected: %s", $sftp->{_connected} || 0);
 
@@ -295,11 +320,13 @@
 			    64 * 1024, $!);
 		    $debug & 2048 and $written and _hexdump(substr($$bout, 0, $written));
 		}
-                unless ($written) {
+                if ($written) {
+                    substr($$bout, 0, $written, '');
+                }
+                elsif ($! != Errno::EAGAIN() and $! != Errno::EINTR()) {
                     $sftp->_conn_lost;
                     return undef;
                 }
-                substr($$bout, 0, $written, '');
             }
             if (vec($rv1, $fnoin, 1)) {
                 my $read = sysread($sftp->{ssh_in}, $$bin, 64 * 1024, length($$bin));
@@ -310,7 +337,7 @@
 			    $!);
 		    $debug & 1024 and $read and _hexdump(substr($$bin, -$read));
 		}
-                unless ($read) {
+                if (!$read and $! != Errno::EAGAIN() and $! != Errno::EINTR()) {
                     $sftp->_conn_lost;
                     return undef;
                 }
@@ -318,7 +345,7 @@
         }
         else {
             $debug and $debug & 32 and _debug "_do_io select failed: $!";
-            next if ($n < 0 and $! == Errno::EINTR());
+            next if ($n < 0 and ($! == Errno::EINTR() or $! == Errno::EAGAIN()));
             return undef;
         }
     }

Modified: branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Windows.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Windows.pm?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Windows.pm (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Backend/Windows.pm Wed May 18 14:39:23 2011
@@ -1,6 +1,6 @@
 package Net::SFTP::Foreign::Backend::Windows;
 
-our $VERSION = '1.58_05';
+our $VERSION = '1.63_05';
 
 use strict;
 use warnings;
@@ -20,7 +20,7 @@
 }
 
 sub _init_transport_streams {
-    my ($self, $sftp) = @_;
+    my ($backend, $sftp) = @_;
     binmode $sftp->{ssh_in};
     binmode $sftp->{ssh_out};
 }
@@ -28,11 +28,34 @@
 sub _open_dev_null {
     my $sftp = shift;
     my $dev_null;
-    unless (open $dev_null, '>', "NUL:") {
-	$sftp->_conn_failed("Unable to redirect stderr to NUL:");
+    unless (open $dev_null, '>', 'NUL:') {
+	$sftp->_conn_failed("Unable to redirect stderr for slave SSH process to NUL: $!");
 	return;
     }
     $dev_null
+}
+
+# workaround for IPC::Open3 not working with tied filehandles even
+# when they implement FILENO
+sub _open3 {
+    my $backend = shift;
+    my $sftp = shift;
+    if (tied(*STDERR)) {
+	my $fn = eval { defined $_[2] ? fileno $_[2] : fileno *STDERR };
+	unless (defined $fn and $fn >= 0) {
+	    $sftp->_conn_failed("STDERR or stderr_fh is not a real file handle: " . (length $@ ? $@ : $!));
+	    return;
+	}
+	local *STDERR;
+	unless (open STDERR, ">&=$fn") {
+	    $sftp->_conn_failed("Unable to reattach STDERR to fd $fn: $!");
+	    return;
+	}
+	$backend->SUPER::_open3($sftp, @_);
+    }
+    else {
+	$backend->SUPER::_open3($sftp, @_);
+    }
 }
 
 sub _sysreadn {
@@ -51,7 +74,7 @@
 }
 
 sub _do_io {
-    my ($self, $sftp, $timeout) = @_;
+    my ($backend, $sftp, $timeout) = @_;
 
     return undef unless $sftp->{_connected};
 
@@ -67,14 +90,16 @@
 	substr($$bout, 0, $written, "");
     }
 
+    defined $timeout and $timeout <= 0 and return;
+
     _sysreadn($sftp, 4) or return undef;
 
     my $len = 4 + unpack N => $$bin;
     if ($len > 256 * 1024) {
-	$sftp->_set_status(SSH2_FX_BAD_MESSAGE);
-	$sftp->_set_error(SFTP_ERR_REMOTE_BAD_MESSAGE,
-			  "bad remote message received");
-	return undef;
+        $sftp->_set_status(SSH2_FX_BAD_MESSAGE);
+        $sftp->_set_error(SFTP_ERR_REMOTE_BAD_MESSAGE,
+                          "bad remote message received");
+        return undef;
     }
     _sysreadn($sftp, $len);
 }

Modified: branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Common.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Common.pm?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Common.pm (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Common.pm Wed May 18 14:39:23 2011
@@ -1,6 +1,6 @@
 package Net::SFTP::Foreign::Common;
 
-our $VERSION = '1.57';
+our $VERSION = '1.65';
 
 use strict;
 use warnings;
@@ -77,6 +77,11 @@
 }
 
 sub error { shift->{_error} }
+
+sub die_on_error {
+    my $sftp = shift;
+    $sftp->{_error} and croak(@_ ? "@_: $sftp->{_error}" : $sftp->{_error});
+}
 
 sub _set_errno {
     my $sftp = shift;

Modified: branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Constants.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Constants.pm?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Constants.pm (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Constants.pm Wed May 18 14:39:23 2011
@@ -1,6 +1,6 @@
 package Net::SFTP::Foreign::Constants;
 
-our $VERSION = '1.52';
+our $VERSION = '1.63_05';
 
 use strict;
 use warnings;
@@ -117,6 +117,7 @@
                       SFTP_ERR_REMOTE_STATVFS_FAILED => 48,
                       SFTP_ERR_REMOTE_FSTATVFS_FAILED => 49,
 		      SFTP_ERR_PASSWORD_AUTHENTICATION_FAILED => 50,
+                      SFTP_ERR_REMOTE_HARDLINK_FAILED => 51,
                     );
 
     for my $key (keys %constants) {
@@ -215,8 +216,9 @@
 C<SFTP_ERR_REMOTE_REALPATH_FAILED>, C<SFTP_ERR_REMOTE_REMOVE_FAILED>,
 C<SFTP_ERR_REMOTE_RENAME_FAILED>, C<SFTP_ERR_REMOTE_RMDIR_FAILED>,
 C<SFTP_ERR_REMOTE_READLINK_FAILED>, C<SFTP_ERR_REMOTE_SYMLINK_FAILED>,
-C<SFTP_ERR_REMOTE_SETSTAT_FAILED>, C<SFTP_ERR_REMOTE_STAT_FAILED> and
-C<SFTP_ERR_REMOTE_WRITE_FAILED>.
+C<SFTP_ERR_REMOTE_SETSTAT_FAILED>, C<SFTP_ERR_REMOTE_STAT_FAILED>,
+C<SFTP_ERR_REMOTE_WRITE_FAILED> and
+C<SFTP_ERR_REMOTE_HARDLINK_FAILED>.
 
 Note: these constants are not defined on the SFTP draft.
 

Modified: branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Helpers.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Helpers.pm?rev=74685&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Helpers.pm (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/lib/Net/SFTP/Foreign/Helpers.pm Wed May 18 14:39:23 2011
@@ -207,7 +207,7 @@
     my $i;
     for (@_) {
         next unless $i++;
-        if (tainted $_) {
+        if (tainted($_)) {
             my (undef, undef, undef, $subn) = caller 1;
             my $msg = ( $subn =~ /::([a-z]\w*)$/
                         ? "Insecure argument '$_' on '$1' method call"
@@ -215,7 +215,7 @@
             _tcroak($msg);
         }
         elsif (ref($_)) {
-            for (grep tainted $_,
+            for (grep tainted($_),
 		 do { local ($@, $SIG{__DIE__}); eval { values %$_ }}) {
 		my (undef, undef, undef, $subn) = caller 1;
 		my $msg = ( $subn =~ /::([a-z]\w*)$/




More information about the Pkg-perl-cvs-commits mailing list