App-SimpleBackuper
view release on metacpan or search on metacpan
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
return undef;
}
}
$umask = (defined $perm ? 0 : umask) unless defined $umask;
if ($copy_perm) {
if (defined $rperm) {
$perm = $rperm;
}
elsif ($best_effort) {
undef $copy_perm
}
else {
$sftp->_ok_or_autodie and $sftp->_set_error(SFTP_ERR_REMOTE_STAT_FAILED,
"Not enough information on stat, mode not included");
return undef
}
}
$perm &= ~$umask if defined $perm;
$sftp->_clear_error_and_status;
if ($resume and $resume eq 'auto') {
undef $resume;
if (defined $mtime) {
if (my @lstat = CORE::stat $local) {
$resume = ($mtime <= $lstat[9]);
}
}
}
my ($atomic_numbered, $atomic_local, $atomic_cleanup);
my ($rfh, $fh);
my $askoff = 0;
my $lstart = 0;
if ($dont_save) {
$rfh = $sftp->open($remote, SSH2_FXF_READ);
defined $rfh or return undef;
}
else {
unless ($local_is_fh or $overwrite or $append or $resume or $numbered) {
if (-e $local) {
$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,
"local file $local already exists");
return undef
}
}
if ($atomic) {
$atomic_local = $local;
$local .= sprintf("(%d).tmp", rand(10000));
$atomic_numbered = $numbered;
$numbered = 1;
$debug and $debug & 128 and _debug("temporal local file name: $local");
}
if ($resume) {
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;
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
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];
}
# $remote = $sftp->_rel2abs($remote);
my $cb = delete $opts{callback};
my $umask = delete $opts{umask};
my $perm = delete $opts{perm};
my $copy_perm = delete $opts{copy_perm};
$copy_perm = delete $opts{copy_perms} unless defined $copy_perm;
my $copy_time = delete $opts{copy_time};
my $overwrite = delete $opts{overwrite};
my $resume = delete $opts{resume};
my $append = delete $opts{append};
my $block_size = delete $opts{block_size} || $sftp->{_block_size};
my $queue_size = delete $opts{queue_size} || $sftp->{_queue_size};
my $conversion = delete $opts{conversion};
my $late_set_perm = delete $opts{late_set_perm};
my $numbered = delete $opts{numbered};
my $atomic = delete $opts{atomic};
my $cleanup = delete $opts{cleanup};
my $best_effort = delete $opts{best_effort};
my $sparse = delete $opts{sparse};
my $mkpath = delete $opts{mkpath};
croak "'perm' and 'umask' options can not be used simultaneously"
if (defined $perm and defined $umask);
croak "'perm' and 'copy_perm' options can not be used simultaneously"
if (defined $perm and $copy_perm);
croak "'resume' and 'append' options can not be used simultaneously"
if ($resume and $append);
croak "'resume' and 'overwrite' options can not be used simultaneously"
if ($resume and $overwrite);
croak "'numbered' can not be used with 'overwrite', 'resume' or 'append'"
if ($numbered and ($overwrite or $resume or $append));
croak "'atomic' can not be used with 'resume' or 'append'"
if ($atomic and ($resume or $append));
%opts and _croak_bad_options(keys %opts);
$overwrite = 1 unless (defined $overwrite or $numbered);
$copy_perm = 1 unless (defined $perm or defined $copy_perm or $local_is_fh);
$copy_time = 1 unless (defined $copy_time or $local_is_fh);
$late_set_perm = $sftp->{_late_set_perm} unless defined $late_set_perm;
$cleanup = ($atomic || $numbered) unless defined $cleanup;
$mkpath = 1 unless defined $mkpath;
my $neg_umask;
if (defined $perm) {
$neg_umask = $perm;
}
else {
$umask = umask unless defined $umask;
$neg_umask = 0777 & ~$umask;
}
my ($fh, $lmode, $lsize, $latime, $lmtime);
if ($local_is_fh) {
$fh = $local;
# we don't set binmode for the passed file handle on purpose
}
else {
unless (CORE::open $fh, '<', $local) {
$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,
"Unable to open local file '$local'", $!);
return undef;
}
binmode $fh;
}
{
# as $fh can come from the outside, it may be a tied object
# lacking support for some methods, so we call them wrapped
# inside eval blocks
local ($@, $SIG{__DIE__}, $SIG{__WARN__});
if ((undef, undef, $lmode, undef, undef,
undef, undef, $lsize, $latime, $lmtime) =
eval {
no warnings; # Calling stat on a tied handler
# generates a warning because the op is
# not supported by the tie API.
CORE::stat $fh;
}
) {
$debug and $debug & 16384 and _debug "local file size is " . (defined $lsize ? $lsize : '<undef>');
# $fh can point at some place inside the file, not just at the
# begining
if ($local_is_fh and defined $lsize) {
my $tell = eval { CORE::tell $fh };
$lsize -= $tell if $tell and $tell > 0;
}
}
elsif ($copy_perm or $copy_time) {
$sftp->_set_error(SFTP_ERR_LOCAL_STAT_FAILED,
"Couldn't stat local file '$local'", $!);
return undef;
}
elsif ($resume and $resume eq 'auto') {
$debug and $debug & 16384 and _debug "not resuming because stat'ing the local file failed";
undef $resume
}
}
$perm = $lmode & $neg_umask if $copy_perm;
my $attrs = Net::SFTP::Foreign::Attributes->new;
$attrs->set_perm($perm) if defined $perm;
my $rfh;
my $writeoff = 0;
my $converter = _gen_converter $conversion;
my $converted_input = '';
my $rattrs;
if ($resume or $append) {
$rattrs = do {
local $sftp->{_autodie};
$sftp->stat($remote);
};
if ($rattrs) {
if ($resume and $resume eq 'auto' and $rattrs->mtime <= $lmtime) {
$debug and $debug & 16384 and
_debug "not resuming because local file is newer, r: ".$rattrs->mtime." l: $lmtime";
undef $resume;
}
else {
$writeoff = $rattrs->size;
$debug and $debug & 16384 and _debug "resuming from $writeoff";
local/lib/perl5/Net/SFTP/Foreign.pm view on Meta::CPAN
the transfer:
sub callback {
my($sftp, $data, $offset, $size) = @_;
if (want_to_abort_transfer()) {
$sftp->abort("You wanted to abort the transfer");
}
}
The callback will be called one last time with an empty data argument
to indicate the end of the file transfer.
The size argument can change between different calls as data is
transferred (for instance, when on-the-fly data conversion is being
performed or when the size of the file can not be retrieved with the
C<stat> SFTP command before the data transfer starts).
=item block_size =E<gt> $bytes
size of the blocks the file is being split on for transfer.
Incrementing this value can improve performance but most servers limit
the maximum size.
=item queue_size =E<gt> $size
read and write requests are pipelined in order to maximize transfer
throughput. This option allows one to set the maximum number of
requests that can be concurrently waiting for a server response.
=back
=item $sftp-E<gt>get_content($remote)
Returns the content of the remote file.
=item $sftp-E<gt>get_symlink($remote, $local, %opts)
copies a symlink from the remote server to the local file system
The accepted options are C<overwrite> and C<numbered>. They have the
same effect as for the C<get> method.
=item $sftp-E<gt>put($local, $remote, %opts)
Uploads a file C<$local> from the local host to the remote host saving
it as C<$remote>. By default file attributes are also copied. For
instance:
$sftp->put("test.txt", "test.txt")
or die "put failed: " . $sftp->error;
A file handle can also be passed in the C<$local> argument. In that
case, data is read from there and stored in the remote file. UTF8 data
is not supported unless a custom converter callback is used to
transform it to bytes. The method will croak if it encounters any data
in perl internal UTF8 format. Note also that the handle is not closed
when the transmission finish.
Example:
binmode STDIN;
$sftp->put(\*STDIN, "stdin.dat") or die "put failed";
close STDIN;
This method accepts several options:
=over 4
=item copy_time =E<gt> $bool
determines if access and modification time attributes have to be
copied from remote file. Default is to copy them.
=item copy_perm =E<gt> $bool
determines if permission attributes have to be copied from remote
file. Default is to copy them after applying the local process umask.
=item umask =E<gt> $umask
allows one to select the umask to apply when setting the permissions
of the copied file. Default is to use the umask for the current
process.
=item perm =E<gt> $perm
sets the permission mask of the file to be $perm, umask and local
permissions are ignored.
=item overwrite =E<gt> 0
by default C<put> will overwrite any pre-existent file with the same
name at the remote side. Setting this flag to zero will make the
method fail in that case.
=item numbered =E<gt> 1
when set, a sequence number is added to the remote file name in order
to avoid overwriting pre-existent files. Off by default.
=item append =E<gt> 1
appends the local file at the end of the remote file instead of
overwriting it. If the remote file does not exist a new one is
created. Off by default.
=item resume =E<gt> 1 | 'auto'
resumes an interrupted transfer.
If the C<auto> value is given, the transfer will be resumed only when
the remote file is newer than the local one.
=item sparse =E<gt> 1
Blocks that are all zeros are skipped possibly creating an sparse file
on the remote host.
=item mkpath =E<gt> 0
By default the method creates any non-existent parent directory for
( run in 1.465 second using v1.01-cache-2.11-cpan-39bf76dae61 )