App-SimpleBackuper
view release on metacpan or search on metacpan
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");
}
## SSH2_FXP_CLOSE (4), SSH2_FXP_FSETSTAT (10)
# these return true on success, undef on failure
sub fsetstat {
_deprecated "fsetstat is deprecated and will be removed on the upcoming 2.xx series, "
. "setstat method accepts now both file handlers and paths";
goto &setstat;
}
sub _gen_setstat_shortcut {
my ($name, $rid_type, $attrs_flag, @arg_types) = @_;
my $nargs = 2 + @arg_types;
my $usage = ("\$sftp->$name("
. CORE::join(', ', '$path_or_fh', map "arg$_", 1..@arg_types)
. ')');
my $rid_method = ($rid_type eq 'file' ? '_rfid' :
$rid_type eq 'dir' ? '_rdid' :
$rid_type eq 'any' ? '_rid' :
croak "bad rid type $rid_type");
my $sub = sub {
@_ == $nargs or croak $usage;
my $sftp = shift;
my $pofh = shift;
my $id = $sftp->_queue_new_msg( ( (ref $pofh and UNIVERSAL::isa($pofh, 'Net::SFTP::Foreign::FileHandle') )
? ( SSH2_FXP_FSETSTAT, str => $sftp->$rid_method($pofh) )
: ( SSH2_FXP_SETSTAT, str => $sftp->_fs_encode($sftp->_rel2abs($pofh)) ) ),
int32 => $attrs_flag,
map { $arg_types[$_] => $_[$_] } 0..$#arg_types );
$sftp->_check_status_ok($id,
SFTP_ERR_REMOTE_SETSTAT_FAILED,
"Couldn't setstat remote file ($name)");
};
no strict 'refs';
*$name = $sub;
}
_gen_setstat_shortcut(truncate => 'file', SSH2_FILEXFER_ATTR_SIZE, 'int64');
_gen_setstat_shortcut(chown => 'any' , SSH2_FILEXFER_ATTR_UIDGID, 'int32', 'int32');
_gen_setstat_shortcut(chmod => 'any' , SSH2_FILEXFER_ATTR_PERMISSIONS, 'int32');
_gen_setstat_shortcut(utime => 'any' , SSH2_FILEXFER_ATTR_ACMODTIME, 'int32', 'int32');
sub _close {
@_ == 2 or croak 'Usage: $sftp->close($fh, $attrs)';
my $sftp = shift;
my $id = $sftp->_queue_rid_request(SSH2_FXP_CLOSE, @_);
defined $id or return undef;
my $ok = $sftp->_check_status_ok($id,
SFTP_ERR_REMOTE_CLOSE_FAILED,
"Couldn't close remote file");
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;
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
if (CORE::open $fh, '+<', $local) {
binmode $fh;
CORE::seek($fh, 0, 2);
$askoff = CORE::tell $fh;
if ($askoff < 0) {
# something is going really wrong here, fall
# back to non-resuming mode...
$askoff = 0;
undef $fh;
}
else {
if ($size >=0 and $askoff > $size) {
$sftp->_set_error(SFTP_ERR_LOCAL_BIGGER_THAN_REMOTE,
"Couldn't resume transfer, local file is bigger than remote");
return undef;
}
$size == $askoff and return 1;
}
}
}
# we open the remote file so late in order to skip it when
# resuming an already completed transfer:
$rfh = $sftp->open($remote, SSH2_FXF_READ);
defined $rfh or return undef;
unless (defined $fh) {
if ($local_is_fh) {
$fh = $local;
local ($@, $SIG{__DIE__}, $SIG{__WARN__});
eval { $lstart = CORE::tell($fh) };
$lstart = 0 unless ($lstart and $lstart > 0);
}
else {
my $flags = Fcntl::O_CREAT|Fcntl::O_WRONLY;
$flags |= Fcntl::O_APPEND if $append;
$flags |= Fcntl::O_EXCL if ($numbered or (!$overwrite and !$append));
unlink $local if $overwrite;
my $open_perm = (defined $perm ? $perm : 0666);
my $save = _umask_save_and_set($umask);
$sftp->_mkpath_local($local, $open_perm|0700, 1) if $mkpath;
while (1) {
sysopen ($fh, $local, $flags, $open_perm) and last;
unless ($numbered and -e $local) {
$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
"Can't open $local", $!);
return undef;
}
_inc_numbered($local);
}
$$numbered = $local if ref $numbered;
binmode $fh;
$lstart = sysseek($fh, 0, 2) if $append;
}
}
if (defined $perm) {
my $error;
do {
local ($@, $SIG{__DIE__}, $SIG{__WARN__});
unless (eval { CORE::chmod($perm, $local) > 0 }) {
$error = ($@ ? $@ : $!);
}
};
if ($error and !$best_effort) {
unlink $local unless $resume or $append;
$sftp->_set_error(SFTP_ERR_LOCAL_CHMOD_FAILED,
"Can't chmod $local", $error);
return undef
}
}
}
my $converter = _gen_converter $conversion;
my $rfid = $sftp->_rfid($rfh);
defined $rfid or die "internal error: rfid not defined";
my @msgid;
my @askoff;
my $loff = $askoff;
my $adjustment = 0;
local $\;
my $slow_start = ($size == -1 ? $queue_size - 1 : 0);
my $safe_block_size = $sftp->{_min_block_size} >= $block_size;
do {
# Disable autodie here in order to do not leave unhandled
# responses queued on the connection in case of failure.
local $sftp->{_autodie};
# Again, once this point is reached, all code paths should end
# through the CLEANUP block.
while (1) {
# request a new block if queue is not full
while (!@msgid or ( ($size == -1 or $size + $block_size > $askoff) and
@msgid < $queue_size - $slow_start and
$safe_block_size ) ) {
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;
}
$slow_start-- if $slow_start;
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) {
$sftp->_set_error if $sftp->{_status} == SSH2_FX_EOF;
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" );
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
Sends a C<SSH_FXP_OPENDIR> command to open the remote directory
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).
On failure returns C<undef>.
=item $sftp-E<gt>closedir($handle)
closes the remote directory handle C<$handle>.
Directory handles are closed from their C<DESTROY> method when not
done explicitly.
Return true on success, undef on failure.
=item $sftp-E<gt>readdir($handle)
returns the next entry from the remote directory C<$handle> (or all
the remaining entries when called in list context).
The return values are a hash with three keys: C<filename>, C<longname> and
C<a>. The C<a> value contains a L<Net::SFTP::Foreign::Attributes>
object describing the entry.
Returns undef on error or when no more entries exist on the directory.
=item $sftp-E<gt>stat($path_or_fh)
performs a C<stat> on the remote file and returns a
L<Net::SFTP::Foreign::Attributes> object with the result values. Both
paths and open remote file handles can be passed to this method.
Returns undef on failure.
=item $sftp-E<gt>fstat($handle)
this method is deprecated.
=item $sftp-E<gt>lstat($path)
this method is similar to C<stat> method but stats a symbolic link
instead of the file the symbolic links points to.
=item $sftp-E<gt>setstat($path_or_fh, $attrs)
sets file attributes on the remote file. Accepts both paths and open
remote file handles.
Returns true on success and undef on failure.
=item $sftp-E<gt>fsetstat($handle, $attrs)
this method is deprecated.
=item $sftp-E<gt>truncate($path_or_fh, $size)
=item $sftp-E<gt>chown($path_or_fh, $uid, $gid)
=item $sftp-E<gt>chmod($path_or_fh, $perm)
=item $sftp-E<gt>utime($path_or_fh, $atime, $mtime)
Shortcuts around C<setstat> method.
=item $sftp-E<gt>remove($path)
Sends a C<SSH_FXP_REMOVE> command to remove the remote file
C<$path>. Returns a true value on success and undef on failure.
=item $sftp-E<gt>mkdir($path, $attrs)
Sends a C<SSH_FXP_MKDIR> command to create a remote directory C<$path>
whose attributes are initialized to C<$attrs> (a
L<Net::SFTP::Foreign::Attributes> object).
Returns a true value on success and undef on failure.
The C<$attrs> argument is optional.
=item $sftp-E<gt>mkpath($path, $attrs, $parent)
This method is similar to C<mkdir> but also creates any non-existent
parent directories recursively.
When the optional argument C<$parent> has a true value, just the
parent directory of the given path (and its ancestors as required) is
created.
For instance:
$sftp->mkpath("/tmp/work", undef, 1);
my $fh = $sftp->open("/tmp/work/data.txt",
SSH2_FXF_WRITE|SSH2_FXF_CREAT);
=item $sftp-E<gt>rmdir($path)
Sends a C<SSH_FXP_RMDIR> command to remove a remote directory
C<$path>. Returns a true value on success and undef on failure.
=item $sftp-E<gt>realpath($path)
Sends a C<SSH_FXP_REALPATH> command to canonicalise C<$path>
to an absolute path. This can be useful for turning paths
containing C<'..'> into absolute paths.
Returns the absolute path on success, C<undef> on failure.
When the given path points to an nonexistent location, what one
gets back is server dependent. Some servers return a failure message
and others a canonical version of the path.
=item $sftp-E<gt>rename($old, $new, %opts)
Sends a C<SSH_FXP_RENAME> command to rename C<$old> to C<$new>.
Returns a true value on success and undef on failure.
Accepted options are:
=over 4
( run in 0.654 second using v1.01-cache-2.11-cpan-39bf76dae61 )