App-SimpleBackuper
view release on metacpan or search on metacpan
local/lib/perl5/Module/Implementation.pm view on Meta::CPAN
my $package = shift;
my $env_value = shift;
my $implementations = shift;
if ($env_value) {
die "$env_value is not a valid implementation for $package"
unless grep { $_ eq $env_value } @{$implementations};
my $requested = "${package}::$env_value";
# Values from the %ENV hash are tainted. We know it's safe to untaint
# this value because the value was one of our known implementations.
($requested) = $requested =~ /^(.+)$/;
try {
require_module($requested);
}
catch {
require Carp;
Carp::croak("Could not load $requested: $_");
};
local/lib/perl5/Module/Runtime.pm view on Meta::CPAN
sub use_module($;$) {
my($name, $version) = @_;
require_module($name);
$name->VERSION($version) if @_ >= 2;
return $name;
}
=item use_package_optimistically(NAME[, VERSION])
This is an analogue of L</use_module> for the situation where there is
uncertainty as to whether a package/class is defined in its own module
or by some other means. It attempts to arrange for the named package to
be available, either by loading a module or by doing nothing and hoping.
An attempt is made to load the named module (as if by the bareword form
of C<require>). If the module cannot be found then it is assumed that
the package was actually already loaded by other means, and no error
is signalled. That's the optimistic bit.
I<Warning:> this optional module loading is liable to cause unreliable
behaviour, including security problems. It interacts especially badly
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
# we make $Net::SFTP::Foreign::Helpers::debug an alias for
# $Net::SFTP::Foreign::debug so that the user can set it without
# knowing anything about the Helpers package!
our $debug;
BEGIN { *Net::SFTP::Foreign::Helpers::debug = \$debug };
use Net::SFTP::Foreign::Helpers qw(_is_reg _is_lnk _is_dir _debug
_sort_entries _gen_wanted
_gen_converter _hexdump
_ensure_list _catch_tainted_args
_file_part _umask_save_and_set
_untaint);
use Net::SFTP::Foreign::Constants qw( :fxp :flags :att
:status :error
SSH2_FILEXFER_VERSION );
use Net::SFTP::Foreign::Attributes;
use Net::SFTP::Foreign::Buffer;
require Net::SFTP::Foreign::Common;
our @ISA = qw(Net::SFTP::Foreign::Common);
our $dirty_cleanup;
my $windows;
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my ($sftp, $path) = @_;
Encode::encode($sftp->{_fs_encoding}, $path);
}
sub _fs_decode {
my ($sftp, $path) = @_;
Encode::decode($sftp->{_fs_encoding}, $path);
}
sub new {
${^TAINT} and &_catch_tainted_args;
my $class = shift;
unshift @_, 'host' if @_ & 1;
my %opts = @_;
my $sftp = { _msg_id => 0,
_bout => '',
_bin => '',
_connected => 1,
_queued => 0,
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my $status = $sftp->_set_status($msg->get_int32, $msg->get_str);
return 1 if $status == SSH2_FX_OK;
$sftp->_set_error($error, $errstr, $status);
}
}
return undef;
}
sub setcwd {
${^TAINT} and &_catch_tainted_args;
my ($sftp, $cwd, %opts) = @_;
$sftp->_clear_error_and_status;
my $check = delete $opts{check};
$check = 1 unless defined $check;
%opts and _croak_bad_options(keys %opts);
if (defined $cwd) {
if ($check) {
$cwd = $sftp->realpath($cwd);
return undef unless defined $cwd;
_untaint($cwd);
my $a = $sftp->stat($cwd)
or return undef;
unless (_is_dir($a->perm)) {
$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,
"Remote object '$cwd' is not a directory");
return undef;
}
}
else {
$cwd = $sftp->_rel2abs($cwd);
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my $sftp = shift;
return defined $sftp->{cwd} ? $sftp->{cwd} : $sftp->realpath('');
}
## SSH2_FXP_OPEN (3)
# returns handle on success, undef on failure
sub open {
(@_ >= 2 and @_ <= 4)
or croak 'Usage: $sftp->open($path [, $flags [, $attrs]])';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $path, $flags, $a) = @_;
$path = $sftp->_rel2abs($path);
defined $flags or $flags = SSH2_FXF_READ;
defined $a or $a = Net::SFTP::Foreign::Attributes->new;
my $id = $sftp->_queue_new_msg(SSH2_FXP_OPEN,
str => $sftp->_fs_encode($path),
int32 => $flags, attr => $a);
my $rid = $sftp->_get_handle($id,
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
else {
$sftp->_ok_or_autodie;
}
}
$fh;
}
## SSH2_FXP_OPENDIR (11)
sub opendir {
@_ <= 2 or croak 'Usage: $sftp->opendir($path)';
${^TAINT} and &_catch_tainted_args;
my $sftp = shift;
my $path = shift;
$path = '.' unless defined $path;
$path = $sftp->_rel2abs($path);
my $id = $sftp->_queue_str_request(SSH2_FXP_OPENDIR, $sftp->_fs_encode($path), @_);
my $rid = $sftp->_get_handle($id, SFTP_ERR_REMOTE_OPENDIR_FAILED,
"Couldn't open remote dir '$path'");
if ($debug and $debug & 2) {
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
return substr $$bin, 0, 1, '';
}
return undef;
}
## SSH2_FXP_LSTAT (7), SSH2_FXP_FSTAT (8), SSH2_FXP_STAT (17)
# these all return a Net::SFTP::Foreign::Attributes object on success, undef on failure
sub lstat {
@_ <= 2 or croak 'Usage: $sftp->lstat($path)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $path) = @_;
$path = '.' unless defined $path;
$path = $sftp->_rel2abs($path);
my $id = $sftp->_queue_str_request(SSH2_FXP_LSTAT, $sftp->_fs_encode($path));
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id,
SFTP_ERR_REMOTE_LSTAT_FAILED, "Couldn't stat remote link")) {
return $msg->get_attributes;
}
return undef;
}
sub stat {
@_ <= 2 or croak 'Usage: $sftp->stat($path_or_fh)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $pofh) = @_;
$pofh = '.' unless defined $pofh;
my $id = $sftp->_queue_new_msg( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle'))
? ( SSH2_FXP_FSTAT, str => $sftp->_rid($pofh))
: ( SSH2_FXP_STAT, str => $sftp->_fs_encode($sftp->_rel2abs($pofh))) );
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_ATTRS, $id,
SFTP_ERR_REMOTE_STAT_FAILED, "Couldn't stat remote file")) {
return $msg->get_attributes;
}
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
goto &stat;
}
## SSH2_FXP_RMDIR (15), SSH2_FXP_REMOVE (13)
# these return true on success, undef on failure
sub _gen_remove_method {
my($name, $code, $error, $errstr) = @_;
my $sub = sub {
@_ == 2 or croak "Usage: \$sftp->$name(\$path)";
${^TAINT} and &_catch_tainted_args;
my ($sftp, $path) = @_;
$path = $sftp->_rel2abs($path);
my $id = $sftp->_queue_str_request($code, $sftp->_fs_encode($path));
$sftp->_check_status_ok($id, $error, $errstr);
};
no strict 'refs';
*$name = $sub;
}
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
SFTP_ERR_REMOTE_REMOVE_FAILED, "Couldn't delete remote file");
_gen_remove_method(rmdir => SSH2_FXP_RMDIR,
SFTP_ERR_REMOTE_RMDIR_FAILED, "Couldn't remove remote directory");
## SSH2_FXP_MKDIR (14), SSH2_FXP_SETSTAT (9)
# these return true on success, undef on failure
sub mkdir {
(@_ >= 2 and @_ <= 3)
or croak 'Usage: $sftp->mkdir($path [, $attrs])';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $path, $attrs) = @_;
$attrs = _empty_attributes unless defined $attrs;
$path = $sftp->_rel2abs($path);
my $id = $sftp->_queue_str_request(SSH2_FXP_MKDIR,
$sftp->_fs_encode($path),
$attrs);
$sftp->_check_status_ok($id,
SFTP_ERR_REMOTE_MKDIR_FAILED,
"Couldn't create remote directory");
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my $old = $path;
my $cwd = $sftp->{cwd};
$path = $sftp->join($sftp->{cwd}, $path);
$debug and $debug & 4096 and _debug("'$old' --> '$path'");
return $path
}
sub mkpath {
(@_ >= 2 and @_ <= 4)
or croak 'Usage: $sftp->mkpath($path [, $attrs [, $parent]])';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $path, $attrs, $parent) = @_;
$sftp->_clear_error_and_status;
my $first = !$parent; # skips file name
$path =~ s{^(/*)}{};
my $start = $1;
$path =~ s{/+$}{};
my @path;
while (1) {
if ($first) {
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
return;
}
}
}
$debug and $debug & 32768 and _debug "_mkpath_local succeeded";
return 1;
}
sub setstat {
@_ == 3 or croak 'Usage: $sftp->setstat($path_or_fh, $attrs)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $pofh, $attrs) = @_;
my $id = $sftp->_queue_new_msg( ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle') )
? ( SSH2_FXP_FSETSTAT, str => $sftp->_rid($pofh) )
: ( SSH2_FXP_SETSTAT, str => $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) ),
attr => $attrs );
return $sftp->_check_status_ok($id,
SFTP_ERR_REMOTE_SETSTAT_FAILED,
"Couldn't setstat remote file");
}
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
if ($debug and $debug & 2) {
_debug sprintf("closing file handle, return: %s, rid:", (defined $ok ? $ok : '-'));
_hexdump($sftp->_rid($_[0]));
}
return $ok;
}
sub close {
@_ == 2 or croak 'Usage: $sftp->close($fh)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $rfh) = @_;
# defined $sftp->_rfid($rfh) or return undef;
# ^--- commented out because flush already checks it is an open file
$sftp->flush($rfh)
or return undef;
if ($sftp->_close($rfh)) {
$rfh->_close;
return 1
}
undef
}
sub closedir {
@_ == 2 or croak 'Usage: $sftp->closedir($dh)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $rdh) = @_;
$rdh->_check_is_dir;
if ($sftp->_close($rdh)) {
$rdh->_close;
return 1;
}
undef
}
sub readdir {
@_ == 2 or croak 'Usage: $sftp->readdir($dh)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $rdh) = @_;
my $rdid = $sftp->_rdid($rdh);
defined $rdid or return undef;
my $cache = $rdh->_cache;
while (!@$cache or wantarray) {
my $id = $sftp->_queue_str_request(SSH2_FXP_READDIR, $rdid);
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
else {
return map { $_->{filename} } $sftp->readdir($rdh);
}
}
sub _gen_getpath_method {
my ($code, $error, $name) = @_;
return sub {
@_ == 2 or croak 'Usage: $sftp->some_method($path)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $path) = @_;
$path = $sftp->_rel2abs($path);
my $id = $sftp->_queue_str_request($code, $sftp->_fs_encode($path));
if (my $msg = $sftp->_get_msg_and_check(SSH2_FXP_NAME, $id,
$error,
"Couldn't get $name for remote '$path'")) {
$msg->get_int32 > 0
and return $sftp->_fs_decode($msg->get_str);
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my $id = $sftp->_queue_new_msg(SSH2_FXP_RENAME,
str => $sftp->_fs_encode($old),
str => $sftp->_fs_encode($new));
$sftp->_check_status_ok($id, SFTP_ERR_REMOTE_RENAME_FAILED,
"Couldn't rename remote file '$old' to '$new'");
}
sub rename {
(@_ & 1) or croak 'Usage: $sftp->rename($old, $new, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $old, $new, %opts) = @_;
my $overwrite = delete $opts{overwrite};
my $numbered = delete $opts{numbered};
croak "'overwrite' and 'numbered' options can not be used together"
if ($overwrite and $numbered);
%opts and _croak_bad_options(keys %opts);
if ($overwrite) {
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
redo;
}
}
}
}
$sftp->_ok_or_autodie;
}
sub atomic_rename {
@_ == 3 or croak 'Usage: $sftp->atomic_rename($old, $new)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $old, $new) = @_;
$sftp->_check_extension('posix-rename@openssh.com' => 1,
SFTP_ERR_REMOTE_RENAME_FAILED,
"atomic rename failed")
or return undef;
$old = $sftp->_rel2abs($old);
$new = $sftp->_rel2abs($new);
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
str => $sftp->_fs_encode($new));
$sftp->_check_status_ok($id, SFTP_ERR_REMOTE_RENAME_FAILED,
"Couldn't rename remote file '$old' to '$new'");
}
## SSH2_FXP_SYMLINK (20)
# true on success, undef on failure
sub symlink {
@_ == 3 or croak 'Usage: $sftp->symlink($sl, $target)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $sl, $target) = @_;
$sl = $sftp->_rel2abs($sl);
my $id = $sftp->_queue_new_msg(SSH2_FXP_SYMLINK,
str => $sftp->_fs_encode($target),
str => $sftp->_fs_encode($sl));
$sftp->_check_status_ok($id, SFTP_ERR_REMOTE_SYMLINK_FAILED,
"Couldn't create symlink '$sl' pointing to '$target'");
}
sub hardlink {
@_ == 3 or croak 'Usage: $sftp->hardlink($hl, $target)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $hl, $target) = @_;
$sftp->_check_extension('hardlink@openssh.com' => 1,
SFTP_ERR_REMOTE_HARDLINK_FAILED,
"hardlink failed")
or return undef;
$hl = $sftp->_rel2abs($hl);
$target = $sftp->_rel2abs($target);
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
## High-level client -> server methods.
sub abort {
my $sftp = shift;
$sftp->_set_error(SFTP_ERR_ABORTED, ($@ ? $_[0] : "Aborted"));
}
# returns true on success, undef on failure
sub get {
@_ >= 2 or croak 'Usage: $sftp->get($remote, $local, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $remote, $local, %opts) = @_;
defined $remote or croak "remote file path is undefined";
$sftp->_clear_error_and_status;
$remote = $sftp->_rel2abs($remote);
$local = _file_part($remote) unless defined $local;
my $local_is_fh = (ref $local and $local->isa('GLOB'));
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
}
unless ($dont_save) {
unless ($local_is_fh or CORE::close $fh) {
$sftp->_set_error(SFTP_ERR_LOCAL_WRITE_FAILED,
"unable to write data to local file $local", $!);
goto CLEANUP;
}
# we can be running on taint mode, so some checks are
# performed to untaint data from the remote side.
if ($copy_time) {
unless (utime($atime, $mtime, $local) or $best_effort) {
$sftp->_set_error(SFTP_ERR_LOCAL_UTIME_FAILED,
"Can't utime $local", $!);
goto CLEANUP;
}
}
if ($atomic) {
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
unlink $atomic_local if $atomic_cleanup;
}
}; # autodie flag is restored here!
$sftp->_ok_or_autodie;
}
# return file contents on success, undef on failure
sub get_content {
@_ == 2 or croak 'Usage: $sftp->get_content($remote)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $name) = @_;
#$name = $sftp->_rel2abs($name);
my @data;
my $rfh = $sftp->open($name)
or return undef;
scalar $sftp->readline($rfh, undef);
}
sub put {
@_ >= 2 or croak 'Usage: $sftp->put($local, $remote, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $local, $remote, %opts) = @_;
defined $local or croak "local file path is undefined";
$sftp->_clear_error_and_status;
my $local_is_fh = (ref $local and $local->isa('GLOB'));
unless (defined $remote) {
$local_is_fh and croak "unable to infer remote file name when a file handler is passed as local";
$remote = (File::Spec->splitpath($local))[2];
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
if ($cleanup and $sftp->{_error}) {
warn "cleanup $remote";
$sftp->_remove_save_status($remote);
}
};
$sftp->_ok_or_autodie;
}
sub put_content {
@_ >= 3 or croak 'Usage: $sftp->put_content($content, $remote, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, undef, $remote, %opts) = @_;
my %put_opts = ( map { $_ => delete $opts{$_} }
qw(perm umask block_size queue_size overwrite conversion resume
numbered late_set_perm atomic best_effort mkpath));
%opts and _croak_bad_options(keys %opts);
my $fh;
unless (CORE::open $fh, '<', \$_[1]) {
$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED, "Can't open scalar as file handle", $!);
return undef;
}
$sftp->put($fh, $remote, %put_opts);
}
sub ls {
@_ >= 1 or croak 'Usage: $sftp->ls($remote_dir, %opts)';
${^TAINT} and &_catch_tainted_args;
my $sftp = shift;
my %opts = @_ & 1 ? (dir => @_) : @_;
my $dir = delete $opts{dir};
my $ordered = delete $opts{ordered};
my $follow_links = delete $opts{follow_links};
my $atomic_readdir = delete $opts{atomic_readdir};
my $names_only = delete $opts{names_only};
my $realpath = delete $opts{realpath};
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
}
return \@dir;
}
croak $sftp->{_error} if $sftp->{_autodie};
return undef;
}
sub rremove {
@_ >= 2 or croak 'Usage: $sftp->rremove($dirs, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $dirs, %opts) = @_;
my $on_error = delete $opts{on_error};
local $sftp->{_autodie} if $on_error;
my $wanted = _gen_wanted( delete $opts{wanted},
delete $opts{no_wanted});
%opts and _croak_bad_options(keys %opts);
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
}
last
}
$$numbered = $remote if ref $numbered;
$sftp->_ok_or_autodie;
}
sub rget {
@_ >= 2 or croak 'Usage: $sftp->rget($remote, $local, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $remote, $local, %opts) = @_;
defined $remote or croak "remote file path is undefined";
$local = File::Spec->curdir unless defined $local;
# my $cb = delete $opts{callback};
my $umask = delete $opts{umask};
my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'};
my $copy_time = delete $opts{copy_time};
my $newer_only = delete $opts{newer_only};
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
}
return undef;
} );
return $count;
}
sub rput {
@_ >= 2 or croak 'Usage: $sftp->rput($local, $remote, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $local, $remote, %opts) = @_;
defined $local or croak "local path is undefined";
$remote = '.' unless defined $remote;
# my $cb = delete $opts{callback};
my $umask = delete $opts{umask};
my $perm = delete $opts{perm};
my $copy_perm = delete $opts{exists $opts{copy_perm} ? 'copy_perm' : 'copy_perms'};
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
}
return undef;
} );
return $count;
}
sub mget {
@_ >= 2 or croak 'Usage: $sftp->mget($remote, $localdir, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $remote, $localdir, %opts) = @_;
defined $remote or croak "remote pattern is undefined";
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{$_} }
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
}
}
$count++ unless $sftp->{_error};
$sftp->_call_on_error($on_error, $e);
}
$count;
}
sub fsync {
@_ == 2 or croak 'Usage: $sftp->fsync($fh)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $fh) = @_;
$sftp->flush($fh, "out");
$sftp->_check_extension('fsync@openssh.com' => 1,
SFTP_ERR_REMOTE_FSYNC_FAILED,
"fsync failed, not implemented")
or return undef;
my $id = $sftp->_queue_new_msg(SSH2_FXP_EXTENDED,
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
if ($sftp->_check_status_ok($id,
SFTP_ERR_REMOTE_FSYNC_FAILED,
"Couldn't fsync remote file")) {
return 1;
}
return undef;
}
sub statvfs {
@_ == 2 or croak 'Usage: $sftp->statvfs($path_or_fh)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $pofh) = @_;
my ($extension, $arg) = ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle'))
? ('fstatvfs@openssh.com', $sftp->_rid($pofh) )
: ('statvfs@openssh.com' , $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) );
$sftp->_check_extension($extension => 2,
SFTP_ERR_REMOTE_STATVFS_FAILED,
"statvfs failed, not implemented")
or return undef;
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
my $password = "foo#2014";
$password =~ s/#/\\#/g if $running_in_hp_ux;
my $ssh = Net::OpenSSH->new($host, user => $user,
password => $password);
I don't have access to an HP-UX machine, and so far nobody using it
has been able to explain this behaviour. Patches welcome!
=item - Taint mode and data coming through SFTP
When the module finds it is being used from a script started in taint
mode, on every method call it checks all the arguments passed and dies
if any of them is tainted. Also, any data coming through the SFTP
connection is marked as tainted.
That generates an internal conflict for those methods that under the
hood query the remote server multiple times, using data from responses
to previous queries (tainted) to build new ones (die!).
I don't think a generic solution could be applied to this issue while
honoring the taint-mode spirit (and erring on the safe side), so my
plan is to fix that in a case by case manner.
So, please report any issue you find with taint mode!
=back
Also, the following features should be considered experimental:
- support for Tectia server
- numbered feature
- autodie mode
local/lib/perl5/Net/SFTP/Foreign/Attributes.pm view on Meta::CPAN
$self->set_size($size);
$self->set_amtime($atime, $mtime);
return $self;
}
return undef;
}
sub new_from_buffer {
my ($class, $buf) = @_;
my $self = $class->new;
my $flags = $self->{flags} = $buf->get_int32_untaint;
if ($flags & SSH2_FILEXFER_ATTR_SIZE) {
$self->{size} = $buf->get_int64_untaint;
}
if ($flags & SSH2_FILEXFER_ATTR_UIDGID) {
$self->{uid} = $buf->get_int32_untaint;
$self->{gid} = $buf->get_int32_untaint;
}
if ($flags & SSH2_FILEXFER_ATTR_PERMISSIONS) {
$self->{perm} = $buf->get_int32_untaint;
}
if ($flags & SSH2_FILEXFER_ATTR_ACMODTIME) {
$self->{atime} = $buf->get_int32_untaint;
$self->{mtime} = $buf->get_int32_untaint;
}
if ($flags & SSH2_FILEXFER_ATTR_EXTENDED) {
my $n = $buf->get_int32;
$n >= 0 and $n <= 10000 or return undef;
my @pairs = map $buf->get_str, 1..2*$n;
$self->{extended} = \@pairs;
}
$self;
local/lib/perl5/Net/SFTP/Foreign/Backend/Unix.pm view on Meta::CPAN
$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
if (${^TAINT} and Scalar::Util::tainted($ENV{PATH})) {
_tcroak('Insecure $ENV{PATH}')
}
if ($stderr_discard) {
$stderr_fh = $backend->_open_dev_null($sftp) or return;
}
if (defined $pass) {
# user has requested to use a password or a passphrase for
# authentication we use IO::Pty to handle that
local/lib/perl5/Net/SFTP/Foreign/Buffer.pm view on Meta::CPAN
sub get_int16 {
length ${$_[0]} >=2 or return undef;
unpack(n => substr(${$_[0]}, 0, 2, ''));
}
sub get_int32 {
length ${$_[0]} >=4 or return undef;
unpack(N => substr(${$_[0]}, 0, 4, ''));
}
sub get_int32_untaint {
my ($v) = substr(${$_[0]}, 0, 4, '') =~ /(.*)/s;
get_int32(\$v);
}
sub get_int64_quads {
length ${$_[0]} >= 8 or return undef;
unpack Q => substr(${$_[0]}, 0, 8, '')
}
sub get_int64_no_quads {
local/lib/perl5/Net/SFTP/Foreign/Buffer.pm view on Meta::CPAN
$result <<= 32;
$result += $small;
}
return $result;
}
return $small;
}
*get_int64 = (HAS_QUADS ? \&get_int64_quads : \&get_int64_no_quads);
sub get_int64_untaint {
my ($v) = substr(${$_[0]}, 0, 8, '') =~ /(.*)/s;
get_int64(\$v);
}
sub get_str {
my $self = shift;
length $$self >=4 or return undef;
my $len = unpack(N => substr($$self, 0, 4, ''));
length $$self >=$len or return undef;
substr($$self, 0, $len, '');
local/lib/perl5/Net/SFTP/Foreign/Common.pm view on Meta::CPAN
our $VERSION = '1.76_02';
use strict;
use warnings;
use Carp;
BEGIN {
# Some versions of Scalar::Util are crippled
require Scalar::Util;
eval { Scalar::Util->import(qw(dualvar tainted)); 1 }
or do {
*tainted = sub { croak "The version of Scalar::Util installed on your system "
. "does not provide 'tainted'" };
*dualvar = sub { $_[0] };
};
}
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",
SSH2_FX_EOF, "End of file",
SSH2_FX_NO_SUCH_FILE, "No such file or directory",
local/lib/perl5/Net/SFTP/Foreign/Common.pm view on Meta::CPAN
our $debug;
sub _set_status {
my $sftp = shift;
my $code = shift;
if ($code) {
my $str;
if (@_) {
$str = join ': ', @_;
($str) = $str =~ /(.*)/
if (${^TAINT} && tainted $str);
}
unless (defined $str and length $str) {
$str = $status_str{$code} || "Unknown status ($code)";
}
$debug and $debug & 64 and _debug("_set_status code: $code, str: $str");
return $sftp->{_status} = dualvar($code, $str);
}
else {
return $sftp->{_status} = 0;
}
local/lib/perl5/Net/SFTP/Foreign/Common.pm view on Meta::CPAN
sub status { shift->{_status} }
sub _set_error {
my $sftp = shift;
my $code = shift;
if ($code) {
my $str;
if (@_) {
$str = join ': ', @_;
($str) = $str =~ /(.*)/
if (${^TAINT} && tainted $str);
}
else {
$str = $code ? "Unknown error $code" : "OK";
}
$debug and $debug & 64 and _debug("_set_err code: $code, str: $str");
my $error = $sftp->{_error} = dualvar $code, $str;
# FIXME: use a better approach to determine when some error is fatal
croak $error if $sftp->{_autodie};
}
local/lib/perl5/Net/SFTP/Foreign/Common.pm view on Meta::CPAN
continue {
$self->_call_on_error($on_error, $try)
}
return wantarray ? @res : $res;
}
sub glob {
@_ >= 2 or croak 'Usage: $sftp->glob($pattern, %opts)';
${^TAINT} and &_catch_tainted_args;
my ($sftp, $glob, %opts) = @_;
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};
my $realpath = delete $opts{realpath};
local/lib/perl5/Net/SFTP/Foreign/Helpers.pm view on Meta::CPAN
package Net::SFTP::Foreign::Helpers;
our $VERSION = '1.74_06';
use strict;
use warnings;
use Carp qw(croak carp);
our @CARP_NOT = qw(Net::SFTP::Foreign);
use Scalar::Util qw(tainted);
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw( _sort_entries
_gen_wanted
_ensure_list
_catch_tainted_args
_debug
_gen_converter
_hexdump
$debug
);
our @EXPORT_OK = qw( _is_lnk
_is_dir
_is_reg
_do_nothing
_glob_to_regex
_file_part
_umask_save_and_set
_tcroak
_untaint );
our $debug;
BEGIN {
eval "use Time::HiRes 'time'"
if ($debug and $debug & 256)
}
sub _debug {
local ($\, $!);
local/lib/perl5/Net/SFTP/Foreign/Helpers.pm view on Meta::CPAN
if (${^TAINT} > 0) {
push @_, " while running with -T switch";
goto &croak;
}
if (${^TAINT} < 0) {
push @_, " while running with -t switch";
goto &carp;
}
}
sub _catch_tainted_args {
my $i;
for (@_) {
next unless $i++;
if (tainted($_)) {
my (undef, undef, undef, $subn) = caller 1;
my $msg = ( $subn =~ /::([a-z]\w*)$/
? "Insecure argument '$_' on '$1' method call"
: "Insecure argument '$_' on method call" );
_tcroak($msg);
}
elsif (ref($_)) {
for (grep tainted($_),
do { local ($@, $SIG{__DIE__}); eval { values %$_ }}) {
my (undef, undef, undef, $subn) = caller 1;
my $msg = ( $subn =~ /::([a-z]\w*)$/
? "Insecure argument on '$1' method call"
: "Insecure argument on method call" );
_tcroak($msg);
}
}
}
}
local/lib/perl5/Net/SFTP/Foreign/Helpers.pm view on Meta::CPAN
sub _is_lnk { (S_IFMT & shift) == S_IFLNK }
sub _is_dir { (S_IFMT & shift) == S_IFDIR }
sub _is_reg { (S_IFMT & shift) == S_IFREG }
sub _file_part {
my $path = shift;
$path =~ m{([^/]*)$} or croak "unable to get file part from path '$path'";
$1;
}
sub _untaint {
if (${^TAINT}) {
for (@_) {
defined or next;
($_) = /(.*)/s
}
}
}
sub _umask_save_and_set {
my $umask = shift;
( run in 0.427 second using v1.01-cache-2.11-cpan-d6f9594c0a5 )