r77212 - in /branches/upstream/libnet-sftp-foreign-perl/current: Changes META.yml lib/Net/SFTP/Foreign.pm lib/Net/SFTP/Foreign/Backend/Unix.pm lib/Net/SFTP/Foreign/Backend/Windows.pm lib/Net/SFTP/Foreign/Common.pm
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Fri Jul 8 07:33:47 UTC 2011
Author: periapt-guest
Date: Fri Jul 8 07:33:38 2011
New Revision: 77212
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=77212
Log:
[svn-upgrade] new version libnet-sftp-foreign-perl (1.67+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/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
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=77212&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/Changes (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/Changes Fri Jul 8 07:33:38 2011
@@ -1,9 +1,26 @@
Revision history for Net::SFTP::Foreign
-1.65 May 17, 2011
+1.67 Jul 4, 2011
+ - released as stable in order to solve critical bug:
+ - solve regresion introduced in 1.63_05 that caused ssh to
+ hang when trying to access the tty
+
+ - pass password to plink via -pw and generate a warning when
+ doing so
+ - support for key_path constructor argument
+ - support for autodie mode
+ - docs misspelling errors corrected (reported by Michael
+ Stevens)
+
+1.66_01 Jun 3, 2011
+ - allow using regexp objects as patterns on glob and derived
+ methods
+ - some doc improvements
+
+1.65 May 17, 2011
- die_on_error was broken
-1.64 May 09, 2011
+1.64 May 09, 2011
- release as stable
- document the write_delay and read_ahead options
- minor doc corrections
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=77212&op=diff
==============================================================================
--- branches/upstream/libnet-sftp-foreign-perl/current/META.yml (original)
+++ branches/upstream/libnet-sftp-foreign-perl/current/META.yml Fri Jul 8 07:33:38 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-SFTP-Foreign
-version: 1.65
+version: 1.67
abstract: Secure File Transfer Protocol client
author:
- Salvador Fandino <sfandino at yahoo.com>
@@ -17,7 +17,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.55_02
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
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=77212&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 Fri Jul 8 07:33:38 2011
@@ -1,9 +1,11 @@
package Net::SFTP::Foreign;
-our $VERSION = '1.65';
+our $VERSION = '1.67';
use strict;
use warnings;
+use warnings::register;
+
use Carp qw(carp croak);
use Symbol ();
@@ -184,6 +186,7 @@
my %defs = $backend->_defaults;
+ $sftp->{_autodie} = delete $opts{autodie};
$sftp->{_block_size} = delete $opts{block_size} || $defs{block_size} || 32*1024;
$sftp->{_queue_size} = delete $opts{queue_size} || $defs{queue_size} || 32;
$sftp->{_read_ahead} = $defs{read_ahead} || $sftp->{_block_size} * 4;
@@ -210,6 +213,7 @@
%opts and _croak_bad_options(keys %opts);
$sftp->_init unless $sftp->error;
+ $backend->_after_init($sftp);
$sftp
}
@@ -1540,73 +1544,83 @@
my $adjustment = 0;
my $n = 0;
local $\;
-
- while (1) {
- # request a new block if queue is not full
- while (!@msgid or (($size == -1 or $size > $askoff) and @msgid < $queue_size and $n != 1)) {
-
- my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid,
- int64 => $askoff, int32 => $block_size);
- push @msgid, $id;
- push @askoff, $askoff;
- $askoff += $block_size;
- $n++;
- }
-
- my $eid = shift @msgid;
- my $roff = shift @askoff;
-
- my $msg = $sftp->_get_msg_and_check(SSH2_FXP_DATA, $eid,
- SFTP_ERR_REMOTE_READ_FAILED,
- "Couldn't read from remote file");
-
- unless ($msg) {
- if ($sftp->{_status} == SSH2_FX_EOF) {
- $sftp->_set_error();
- $roff != $loff and next;
- }
- last;
- }
-
- my $data = $msg->get_str;
- my $len = length $data;
-
- if ($roff != $loff or !$len) {
- $sftp->_set_error(SFTP_ERR_REMOTE_BLOCK_TOO_SMALL,
- "remote packet received is too small" );
- last;
- }
-
- $loff += $len;
- if ($len < $block_size) {
- $block_size = $len < 2048 ? 2048 : $len;
- $askoff = $loff;
- }
-
- my $adjustment_before = $adjustment;
- $adjustment += $converter->($data) if $converter;
-
- if (length($data) and defined $cb) {
- # $size = $loff if ($loff > $size and $size != -1);
- $cb->($sftp, $data,
- $lstart + $roff + $adjustment_before,
- $lstart + $size + $adjustment);
-
- last if $sftp->error;
- }
-
- if (length($data) and !$dont_save) {
- unless (print $fh $data) {
- $sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
- "unable to write data to local file $local", $!);
+ do {
+ # disable autodie here in order to do not leave unhandled
+ # responses queued on the connection in case of failure.
+ local $sftp->{_autodie};
+
+ while (1) {
+ # request a new block if queue is not full
+ while (!@msgid or (($size == -1 or $size > $askoff) and @msgid < $queue_size and $n != 1)) {
+
+ my $id = $sftp->_queue_new_msg(SSH2_FXP_READ, str=> $rfid,
+ int64 => $askoff, int32 => $block_size);
+ push @msgid, $id;
+ push @askoff, $askoff;
+ $askoff += $block_size;
+ $n++;
+ }
+
+ my $eid = shift @msgid;
+ my $roff = shift @askoff;
+
+ my $msg = $sftp->_get_msg_and_check(SSH2_FXP_DATA, $eid,
+ SFTP_ERR_REMOTE_READ_FAILED,
+ "Couldn't read from remote file");
+
+ unless ($msg) {
+ if ($sftp->{_status} == SSH2_FX_EOF) {
+ $sftp->_set_error();
+ $roff != $loff and next;
+ }
last;
}
+
+ my $data = $msg->get_str;
+ my $len = length $data;
+
+ if ($roff != $loff or !$len) {
+ $sftp->_set_error(SFTP_ERR_REMOTE_BLOCK_TOO_SMALL,
+ "remote packet received is too small" );
+ last;
+ }
+
+ $loff += $len;
+ if ($len < $block_size) {
+ $block_size = $len < 2048 ? 2048 : $len;
+ $askoff = $loff;
+ }
+
+ my $adjustment_before = $adjustment;
+ $adjustment += $converter->($data) if $converter;
+
+ if (length($data) and defined $cb) {
+ # $size = $loff if ($loff > $size and $size != -1);
+ $cb->($sftp, $data,
+ $lstart + $roff + $adjustment_before,
+ $lstart + $size + $adjustment);
+
+ last if $sftp->error;
+ }
+
+ if (length($data) and !$dont_save) {
+ unless (print $fh $data) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
+ "unable to write data to local file $local", $!);
+ last;
+ }
+ }
}
- }
+ };
$sftp->_get_msg for (@msgid);
- return undef if $sftp->error;
+ if ($sftp->error) {
+ # we are out of the pipeline loop, so we can now safely
+ # rethrow any error when autodie is on.
+ croak $sftp->error if $sftp->{_autodie};
+ return undef
+ }
# if a converter is in place, and aditional call has to be
# performed in order to flush any pending buffered data
@@ -1930,103 +1944,109 @@
# buffering introduced, we use $eof_t to account for that.
my ($eof, $eof_t);
my @msgid;
- OK: while (1) {
- if (!$eof and @msgid < $queue_size) {
- my ($data, $len);
- if ($converter) {
- while (!$eof_t and length $converted_input < $block_size) {
- my $read = CORE::read($fh, my $input, $block_size * 4);
- unless ($read) {
- unless (defined $read) {
+ do {
+ local $sftp->{_autodie};
+ OK: while (1) {
+ if (!$eof and @msgid < $queue_size) {
+ my ($data, $len);
+ if ($converter) {
+ while (!$eof_t and length $converted_input < $block_size) {
+ my $read = CORE::read($fh, my $input, $block_size * 4);
+ unless ($read) {
+ unless (defined $read) {
+ $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
+ "Couldn't read from local file '$local'", $!);
+ last OK;
+ }
+ $eof_t = 1;
+ }
+
+ # note that the $converter is called a last time
+ # with an empty string
+ $lsize += $converter->($input);
+ utf8::downgrade($input, 1)
+ or croak "converter introduced wide characters in data";
+ $converted_input .= $input;
+ }
+ $data = substr($converted_input, 0, $block_size, '');
+ $len = length $data;
+ $eof = 1 if ($eof_t and !$len);
+ }
+ else {
+ $debug and $debug & 16384 and
+ _debug "reading block at offset ".CORE::tell($fh)." block_size: $block_size";
+
+ $len = CORE::read($fh, $data, $block_size);
+
+ if ($len) {
+ $debug and $debug & 16384 and _debug "block read, size: $len";
+
+ utf8::downgrade($data, 1)
+ or croak "wide characters unexpectedly read from file";
+
+ $debug and $debug & 16384 and length $data != $len and
+ _debug "read data changed size on downgrade to " . length($data);
+ }
+ else {
+ unless (defined $len) {
$sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
"Couldn't read from local file '$local'", $!);
last OK;
}
- $eof_t = 1;
+ $eof = 1;
}
-
- # note that the $converter is called a last time
- # with an empty string
- $lsize += $converter->($input);
- utf8::downgrade($input, 1)
- or croak "converter introduced wide characters in data";
- $converted_input .= $input;
}
- $data = substr($converted_input, 0, $block_size, '');
- $len = length $data;
- $eof = 1 if ($eof_t and !$len);
- }
- else {
- $debug and $debug & 16384 and
- _debug "reading block at offset ".CORE::tell($fh)." block_size: $block_size";
-
- $len = CORE::read($fh, $data, $block_size);
+
+ my $nextoff = $writeoff + $len;
+
+ if (defined $cb) {
+ $lsize = $nextoff if $nextoff > $lsize;
+ $cb->($sftp, $data, $writeoff, $lsize);
+
+ last OK if $sftp->error;
+
+ utf8::downgrade($data, 1) or croak "callback introduced wide characters in data";
+
+ $len = length $data;
+ $nextoff = $writeoff + $len;
+ }
if ($len) {
- $debug and $debug & 16384 and _debug "block read, size: $len";
-
- utf8::downgrade($data, 1)
- or croak "wide characters unexpectedly read from file";
-
- $debug and $debug & 16384 and length $data != $len and
- _debug "read data changed size on downgrade to " . length($data);
- }
- else {
- unless (defined $len) {
- $sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,
- "Couldn't read from local file '$local'", $!);
- last OK;
- }
- $eof = 1;
+ $debug and $debug & 16384 and
+ _debug "writing block at offset $writeoff, length " . length($data);
+
+ my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid,
+ int64 => $writeoff, str => $data);
+ push @msgid, $id;
+ $writeoff = $nextoff;
}
}
- my $nextoff = $writeoff + $len;
-
- if (defined $cb) {
- $lsize = $nextoff if $nextoff > $lsize;
- $cb->($sftp, $data, $writeoff, $lsize);
-
- last OK if $sftp->error;
-
- utf8::downgrade($data, 1) or croak "callback introduced wide characters in data";
-
- $len = length $data;
- $nextoff = $writeoff + $len;
- }
-
- if ($len) {
- $debug and $debug & 16384 and
- _debug "writing block at offset $writeoff, length " . length($data);
-
- my $id = $sftp->_queue_new_msg(SSH2_FXP_WRITE, str => $rfid,
- int64 => $writeoff, str => $data);
- push @msgid, $id;
- $writeoff = $nextoff;
+ last if ($eof and !@msgid);
+
+ next unless ($eof
+ or @msgid >= $queue_size
+ or $sftp->_do_io(0));
+
+ my $id = shift @msgid;
+ unless ($sftp->_check_status_ok($id,
+ SFTP_ERR_REMOTE_WRITE_FAILED,
+ "Couldn't write to remote file")) {
+ last OK;
}
}
- last if ($eof and !@msgid);
-
- next unless ($eof
- or @msgid >= $queue_size
- or $sftp->_do_io(0));
-
- my $id = shift @msgid;
- unless ($sftp->_check_status_ok($id,
- SFTP_ERR_REMOTE_WRITE_FAILED,
- "Couldn't write to remote file")) {
- last OK;
- }
- }
-
- CORE::close $fh unless $local_is_fh;
-
- $sftp->_get_msg for (@msgid);
-
- $sftp->_close_save_status($rfh);
-
- return undef if $sftp->error;
+ CORE::close $fh unless $local_is_fh;
+
+ $sftp->_get_msg for (@msgid);
+
+ $sftp->_close_save_status($rfh);
+ };
+
+ if ($sftp->error) {
+ croak $sftp->error if $sftp->{_autodie};
+ return undef;
+ }
# for servers that does not support setting permissions on open files
if (defined $perm and $late_set_perm) {
@@ -2091,74 +2111,74 @@
my @dir;
my @msgid;
+ do {
+ local $sftp->{_autodie};
OK: while (1) {
- push @msgid, $sftp->_queue_str_request(SSH2_FXP_READDIR, $rdid)
- while (@msgid < $queue_size);
-
- my $id = shift @msgid;
- if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id,
- SFTP_ERR_REMOTE_READDIR_FAILED,
- "Couldn't read directory '$dir'" )) {
-
- my $count = $msg->get_int32 or last;
-
- if ($cheap) {
- for (1..$count) {
- my $fn = $sftp->_fs_decode($msg->get_str);
- push @dir, $fn if (!defined $cheap_wanted or $fn =~ $cheap_wanted);
- $msg->skip_str;
- Net::SFTP::Foreign::Attributes->skip_from_buffer($msg);
- }
- }
- else {
- for (1..$count) {
- my $fn = $sftp->_fs_decode($msg->get_str);
- my $ln = $sftp->_fs_decode($msg->get_str);
- # my $a = $msg->get_attributes;
- my $a = Net::SFTP::Foreign::Attributes->new_from_buffer($msg);
-
- my $entry = { filename => $fn,
- longname => $ln,
- a => $a };
-
- if ($follow_links and _is_lnk($a->perm)) {
-
- if ($a = $sftp->stat($sftp->join($dir, $fn))) {
- $entry->{a} = $a;
- }
- else {
- $sftp->_clear_error_and_status;
- }
- }
-
- if ($realpath) {
- my $rp = $sftp->realpath($sftp->join($dir, $fn));
- if (defined $rp) {
- $fn = $entry->{realpath} = $rp;
- }
- else {
- $sftp->_clear_error_and_status;
- }
- }
-
- if (!$wanted or $delayed_wanted or $wanted->($sftp, $entry)) {
- push @dir, (($names_only and !$delayed_wanted) ? $fn : $entry);
- }
- }
- }
-
- $queue_size ++ if $queue_size < $max_queue_size;
- }
- else {
- $sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF;
- $sftp->_get_msg for @msgid;
- last;
- }
- }
-
- $sftp->_closedir_save_status($rdh) if $rdh;
-
- unless ($sftp->{_error}) {
+ push @msgid, $sftp->_queue_str_request(SSH2_FXP_READDIR, $rdid)
+ while (@msgid < $queue_size);
+
+ my $id = shift @msgid;
+ if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id,
+ SFTP_ERR_REMOTE_READDIR_FAILED,
+ "Couldn't read directory '$dir'" )) {
+ my $count = $msg->get_int32 or last;
+
+ if ($cheap) {
+ for (1..$count) {
+ my $fn = $sftp->_fs_decode($msg->get_str);
+ push @dir, $fn if (!defined $cheap_wanted or $fn =~ $cheap_wanted);
+ $msg->skip_str;
+ Net::SFTP::Foreign::Attributes->skip_from_buffer($msg);
+ }
+ }
+ else {
+ for (1..$count) {
+ my $fn = $sftp->_fs_decode($msg->get_str);
+ my $ln = $sftp->_fs_decode($msg->get_str);
+ # my $a = $msg->get_attributes;
+ my $a = Net::SFTP::Foreign::Attributes->new_from_buffer($msg);
+
+ my $entry = { filename => $fn,
+ longname => $ln,
+ a => $a };
+
+ if ($follow_links and _is_lnk($a->perm)) {
+
+ if ($a = $sftp->stat($sftp->join($dir, $fn))) {
+ $entry->{a} = $a;
+ }
+ else {
+ $sftp->_clear_error_and_status;
+ }
+ }
+
+ if ($realpath) {
+ my $rp = $sftp->realpath($sftp->join($dir, $fn));
+ if (defined $rp) {
+ $fn = $entry->{realpath} = $rp;
+ }
+ else {
+ $sftp->_clear_error_and_status;
+ }
+ }
+
+ if (!$wanted or $delayed_wanted or $wanted->($sftp, $entry)) {
+ push @dir, (($names_only and !$delayed_wanted) ? $fn : $entry);
+ }
+ }
+ }
+
+ $queue_size ++ if $queue_size < $max_queue_size;
+ }
+ else {
+ $sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF;
+ $sftp->_get_msg for @msgid;
+ last;
+ }
+ }
+ $sftp->_closedir_save_status($rdh) if $rdh;
+ };
+ unless ($sftp->error) {
if ($delayed_wanted) {
@dir = grep { $wanted->($sftp, $_) } @dir;
@dir = map { defined $_->{realpath}
@@ -2176,6 +2196,7 @@
}
return \@dir;
}
+ croak $sftp->error if $sftp->{_autodie};
return undef;
}
@@ -2186,6 +2207,7 @@
my ($sftp, $dirs, %opts) = @_;
my $on_error = delete $opts{on_error};
+ local $sftp->{_autodie} if $on_error;
my $wanted = _gen_wanted( delete $opts{wanted},
delete $opts{no_wanted});
@@ -2336,6 +2358,7 @@
my $overwrite = delete $opts{overwrite};
my $newer_only = delete $opts{newer_only};
my $on_error = delete $opts{on_error};
+ local $sftp->{_autodie} if $on_error;
my $ignore_links = delete $opts{ignore_links};
my $conversion = delete $opts{conversion};
my $resume = delete $opts{resume};
@@ -2476,6 +2499,7 @@
my $numbered = delete $opts{numbered};
my $newer_only = delete $opts{newer_only};
my $on_error = delete $opts{on_error};
+ local $sftp->{_autodie} if $on_error;
my $ignore_links = delete $opts{ignore_links};
my $conversion = delete $opts{conversion};
my $resume = delete $opts{resume};
@@ -2627,6 +2651,7 @@
my %opts = @_;
my $on_error = $opts{on_error};
+ local $sftp->{_autodie} if $on_error;
my $ignore_links = delete $opts{ignore_links};
my %glob_opts = (map { $_ => delete $opts{$_} }
@@ -2682,6 +2707,7 @@
my %opts = @_;
my $on_error = $opts{on_error};
+ local $sftp->{_autodie} if $on_error;
my $ignore_links = delete $opts{ignore_links};
my %glob_opts = (map { $_ => delete $opts{$_} }
@@ -2699,7 +2725,7 @@
require Net::SFTP::Foreign::Local;
my $lfs = Net::SFTP::Foreign::Local->new;
my @local = map $lfs->glob($_, %glob_opts), _ensure_list $local;
-
+
my $count = 0;
require File::Spec;
for my $e (@local) {
@@ -2713,7 +2739,7 @@
my $remote = (File::Spec->splitpath($fn))[2];
$remote = $sftp->join($remotedir, $remote)
if defined $remotedir;
-
+
if (_is_lnk($perm)) {
next if $ignore_links;
$sftp->put_symlink($fn, $remote, %put_symlink_opts);
@@ -3135,12 +3161,41 @@
transport layer via the backend module
L<Net::SFTP::Foreign::Backend::Net_SSH2>.
-=head2 Usage
+=head2 Error handling
Most of the methods available from this package return undef on
failure and a true value or the requested data on
-success. C<$sftp-E<gt>error> can be used to check for errors
-explicitly after every method call.
+success. C<$sftp-E<gt>error> should be used to check for errors
+explicitly after every method call. For instance:
+
+ $sftp = Net::SFTP::Foreign->new($host);
+ $sftp->error and die "unable to connect to remote host: " . $sftp->error;
+
+Also, the L</die_on_error> method provides a handy shortcut for the last line:
+
+ $sftp = Net::SFTP::Foreign->new($host);
+ $sftp->die_on_error("unable to connect to remote host");
+
+Alternatively, the C<autodie> mode that makes the module die when any
+error is found can be activated from the constructor. For instance:
+
+ $sftp = Net::SFTP::Foreign->new($host, autodie => 1);
+ my $ls = $sftp->ls("/bar");
+ # dies as: "Couldn't open remote dir '/bar': No such file"
+
+The C<autodie> mode will be disabled when an C<on_error> handler is
+passed to methods accepting it:
+
+ my $sftp = Net::SFTP::Foreign->new($host, autodie => 1);
+ # prints "foo!" and does not die:
+ $sftp->find("/sdfjkalshfl", # nonexistent directory
+ on_error => sub { print "foo!\n" });
+ # dies:
+ $sftp->find("/sdfjkalshfl");
+
+=head2 API
+
+The methods available from this module are described below.
Don't forget to read also the FAQ and BUGS sections at the end of this
document!
@@ -3160,7 +3215,7 @@
my $sftp = Net::SFTP::Foreign->new(...);
$sftp->die_on_error("SSH connection failed");
-C<%args> can contain:
+The optional arguments accepted are as follows:
=over 4
@@ -3192,8 +3247,8 @@
more => '-v' # right
more => ['-v'] # right
- more => "-i $key" # wrong!!!
- more => [-i => $key] # right
+ more => "-c $cipher" # wrong!!!
+ more => [-c => $cipher] # right
=item ssh_cmd_interface =E<gt> 'plink' or 'ssh' or 'tectia'
@@ -3233,6 +3288,10 @@
This feature is not supported in perl 5.6 due to incomplete Unicode
support in the interpreter.
+
+=item key_path =E<gt> $filename
+
+asks C<ssh> to use the key in the given file for authentication.
=item password =E<gt> $password
@@ -3402,6 +3461,11 @@
Custom backends may change the set of options supported by the C<new>
method.
+=item autodie => $bool
+
+Enables the autodie mode that will cause the module to die when any
+error is found (a la L<autodie>).
+
=back
=item $sftp-E<gt>error
@@ -3445,7 +3509,7 @@
=item $sftp-E<gt>get($remote, $local, %options)
-Copies remote file C<$remote> to local $local. By default file
+X<get>Copies remote file C<$remote> to local $local. By default file
attributes are also copied (permissions, atime and mtime). For
instance:
@@ -3524,7 +3588,7 @@
=item conversion =E<gt> $conversion
on the fly data conversion of the file contents can be performed with
-this option. See L</On the fly data conversion> bellow.
+this option. See L</On the fly data conversion> below.
=item callback =E<gt> $callback
@@ -3649,7 +3713,7 @@
=item conversion =E<gt> $conversion
on the fly data conversion of the file contents can be performed with
-this option. See L</On the fly data conversion> bellow.
+this option. See L</On the fly data conversion> below.
=item callback =E<gt> $callback
@@ -3812,7 +3876,7 @@
=item $sftp-E<gt>find(\@paths, %opts)
-Does a recursive search over the given directory C<$path> (or
+X<find>Does a recursive search over the given directory C<$path> (or
directories C<@path>) and returns a list of the entries found or the
total number of them on scalar context.
@@ -3929,12 +3993,16 @@
=item $sftp-E<gt>glob($pattern, %opts)
-performs a remote glob and returns the list of matching entries in the
-same format as the L</find> method.
+X<glob>performs a remote glob and returns the list of matching entries
+in the same format as the L</find> method.
This method tries to recover and continue under error conditions.
-The options accepted:
+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.
+
+Accepted options:
=over 4
@@ -3942,6 +4010,8 @@
by default the matching over the file system is carried out in a case
sensitive fashion, this flag changes it to be case insensitive.
+
+This flag is ignored when a Regexp object is used as the pattern.
=item strict_leading_dot =E<gt> 0
@@ -3949,6 +4019,8 @@
name is not matched by willcards (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.
+
=item follow_links =E<gt> 1
=item ordered =E<gt> 1
@@ -3966,6 +4038,17 @@
these options perform as on the C<ls> method.
=back
+
+Some usage samples:
+
+ my $files = $sftp->glob("*/lib");
+
+ my $files = $sftp->glob("/var/log/dmesg.*.gz");
+
+ $sftp->set_cwd("/var/log");
+ my $files = $sftp->glob(qr/^dmesg\.[\d+]\.gz$/);
+
+ my $files = $sftp->glob("*/*.pdf", strict_leading_dot => 0);
=item $sftp-E<gt>rget($remote, $local, %opts)
@@ -4142,8 +4225,8 @@
=item $sftp-E<gt>mget(\@remote, $localdir, %opts)
-expands the wildcards on C<$remote> or C<@remote> and retrieves all
-the matching files.
+X<mget>expands the wildcards on C<$remote> or C<@remote> and retrieves
+all the matching files.
For instance:
@@ -4301,7 +4384,7 @@
=item $sftp-E<gt>flush($fh)
-writes to the remote file any pending data and discards the read
+X<flush>writes to the remote file any pending data and discards the read
cache.
=item $sftp-E<gt>sftpread($handle, $offset, $length)
@@ -4603,6 +4686,12 @@
my $sftp = Net::SFTP::Foreign->new($host,
more => [qw(-i /home/foo/.ssh/id_dsa)]);
+Note also that latest versions of Net::SFTP::Foreign support the
+C<key_path> argument:
+
+ my $sftp = Net::SFTP::Foreign->new($host,
+ key_path => '/home/foo/.ssh/id_dsa');
+
=item Plink and password authentication
B<Q>: Why password authentication is not supported for the plink SSH
@@ -4610,15 +4699,17 @@
B<A>: A bug in plink breaks it.
-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 local machine would be able to get the
-password. Use at your own risk!:
-
- # HIGHLY INSECURE!!!
+Newer versions of Net::SFTP::Foreign pass the password to C<plink>
+using its C<-pw> option. As this feature is not completely secure a
+warning is generated.
+
+It can be silenced (though, don't do it without understanding why it
+is there, please!) as follows:
+
+ no warnings 'Net::SFTP::Foreign';
my $sftp = Net::SFTP::Foreign->new('foo at bar',
ssh_cmd => 'plink',
- more => [-pw => $password]);
+ password => $password);
$sftp->die_on_error;
=item Plink
@@ -4768,9 +4859,9 @@
- multi-backend support
-- mput and mget methods
-
- numbered feature
+
+- autodie mode
=head1 SUPPORT
@@ -4813,6 +4904,8 @@
L<Test::SFTP> allows to run tests against a remote SFTP server.
+L<autodie>.
+
=head1 COPYRIGHT
Copyright (c) 2005-2011 Salvador FandiE<ntilde>o (sfandino at yahoo.com).
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=77212&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 Fri Jul 8 07:33:38 2011
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign::Backend::Unix;
-our $VERSION = '1.63_07';
+our $VERSION = '1.67';
use strict;
use warnings;
@@ -109,6 +109,8 @@
my $host = delete $opts->{host};
defined $host or croak "sftp target host not defined";
+ my $key_path = delete $opts->{key_path};
+
my $ssh_cmd = delete $opts->{ssh_cmd};
$ssh_cmd = 'ssh' unless defined $ssh_cmd;
@open2_cmd = ($ssh_cmd);
@@ -128,25 +130,39 @@
if (defined $more and !ref($more) and $more =~ /^-\w\s+\S/);
my @more = _ensure_list $more;
+ my @preferred_authentications;
+ if (defined $key_path) {
+ push @preferred_authentications, 'publickey' if defined $key_path;
+ push @open2_cmd, -i => $key_path;
+ }
+
if ($ssh_cmd_interface eq 'plink') {
- $pass and !$passphrase
- and croak "Password authentication via Expect is not supported for the plink client";
push @open2_cmd, -P => $port if defined $port;
+ if ($pass and !$passphrase) {
+ warnings::warnif("Net::SFTP::Foreign", "using insecure password authentication with plink");
+ push @open2_cmd, -pw => $pass;
+ undef $pass;
+ }
+
}
elsif ($ssh_cmd_interface eq 'ssh') {
push @open2_cmd, -p => $port if defined $port;
if ($pass and !$passphrase) {
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;
+ push @preferred_authentications, ('keyboard-interactive', 'password');
}
+ if (@preferred_authentications
+ and not grep { $more[$_] eq '-o' and
+ $more[$_ + 1] =~ /^PreferredAuthentications\W/ } 0..$#more-1) {
+ push @open2_cmd, -o => 'PreferredAuthentications=' . join(',', @preferred_authentications);
+ }
}
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, @more;
push @open2_cmd, $host;
@@ -258,16 +274,20 @@
$sftp->_conn_failed("Bad ssh command", $!);
return;
}
- # do not propagate signals sent from the terminal to the
- # slave SSH:
- eval {
- setpgrp($sftp->{pid}, 0);
- };
}
}
$backend->_init_transport_streams($sftp);
}
+sub _after_init {
+ my ($backend, $sftp) = @_;
+ unless ($sftp->error) {
+ # do not propagate signals sent from the terminal to the
+ # slave SSH:
+ local ($@, $!);
+ eval { setpgrp($sftp->{pid}, 0) };
+ }
+}
sub _do_io {
my (undef, $sftp, $timeout) = @_;
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=77212&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 Fri Jul 8 07:33:38 2011
@@ -58,6 +58,8 @@
}
}
+sub _after_init {}
+
sub _sysreadn {
my ($sftp, $n) = @_;
my $bin = \$sftp->{_bin};
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=77212&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 Fri Jul 8 07:33:38 2011
@@ -1,6 +1,6 @@
package Net::SFTP::Foreign::Common;
-our $VERSION = '1.65';
+our $VERSION = '1.66_01';
use strict;
use warnings;
@@ -59,7 +59,9 @@
$str = $code ? "Unknown error $code" : "OK";
}
$debug and $debug & 64 and _debug("_set_err code: $code, str: $str");
- return $sftp->{_error} = dualvar $code, $str;
+ my $error = $sftp->{_error} = dualvar $code, $str;
+ croak $error if $sftp->{_autodie};
+ return $error;
}
else {
return $sftp->{_error} = 0;
@@ -131,6 +133,7 @@
my $dirs = delete $opts{dirs};
my $follow_links = delete $opts{follow_links};
my $on_error = delete $opts{on_error};
+ local $self->{_autodie} if $on_error;
my $realpath = delete $opts{realpath};
my $ordered = delete $opts{ordered};
my $names_only = delete $opts{names_only};
@@ -262,6 +265,7 @@
return () if $glob eq '';
my $on_error = delete $opts{on_error};
+ local $sftp->{_autodie} if $on_error;
my $follow_links = delete $opts{follow_links};
my $ignore_case = delete $opts{ignore_case};
my $names_only = delete $opts{names_only};
@@ -276,10 +280,16 @@
my $wantarray = wantarray;
- my @parts = ($glob =~ m{\G/*([^/]+)}g);
- push @parts, '.' unless @parts;
-
- my $top = ($glob =~ m|^/|) ? '/' : '.';
+ my (@parts, $top);
+ if (ref $glob eq 'Regexp') {
+ @parts = ($glob);
+ $top = '.';
+ }
+ else {
+ @parts = ($glob =~ m{\G/*([^/]+)}g);
+ push @parts, '.' unless @parts;
+ $top = ( $glob =~ m|^/| ? '/' : '.');
+ }
my @res = ( {filename => $top} );
my $res = 0;
@@ -287,7 +297,14 @@
my @parents = @res;
@res = ();
my $part = shift @parts;
- my ($re, $has_wildcards) = _glob_to_regex($part, $strict_leading_dot, $ignore_case);
+ my ($re, $has_wildcards);
+ if (ref $part eq 'Regexp') {
+ $re = $part;
+ $has_wildcards = 1;
+ }
+ else {
+ ($re, $has_wildcards) = _glob_to_regex($part, $strict_leading_dot, $ignore_case);
+ }
for my $parent (@parents) {
my $pfn = $parent->{filename};
More information about the Pkg-perl-cvs-commits
mailing list