commit 4c98d6c14b1d7a0a8dc7fec3968cb054def153ad Author: Paul Kolano Date: Tue Oct 8 18:17:22 2019 -0700 BASSHFS 1.0 diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..a3322aa --- /dev/null +++ b/COPYING @@ -0,0 +1,272 @@ + NASA OPEN SOURCE AGREEMENT VERSION 1.3 + +THIS OPEN SOURCE AGREEMENT ("AGREEMENT") DEFINES THE RIGHTS OF +USE, REPRODUCTION, DISTRIBUTION, MODIFICATION AND +REDISTRIBUTION OF CERTAIN COMPUTER SOFTWARE ORIGINALLY +RELEASED BY THE UNITED STATES GOVERNMENT AS REPRESENTED BY +THE GOVERNMENT AGENCY LISTED BELOW ("GOVERNMENT AGENCY"). +THE UNITED STATES GOVERNMENT, AS REPRESENTED BY GOVERNMENT +AGENCY, IS AN INTENDED THIRD-PARTY BENEFICIARY OF ALL +SUBSEQUENT DISTRIBUTIONS OR REDISTRIBUTIONS OF THE SUBJECT +SOFTWARE. ANYONE WHO USES, REPRODUCES, DISTRIBUTES, MODIFIES +OR REDISTRIBUTES THE SUBJECT SOFTWARE, AS DEFINED HEREIN, OR +ANY PART THEREOF, IS, BY THAT ACTION, ACCEPTING IN FULL THE +RESPONSIBILITIES AND OBLIGATIONS CONTAINED IN THIS AGREEMENT. + +Government Agency: NASA Ames Research Center +Government Agency Original Software Designation: NASA Ames Research Center +Government Agency Original Software Title: BASSHFS: Bash-Accessible SSH File System +User Registration Requested. Please e-mail Government Agency Point of Contact +Government Agency Point of Contact for Original Software: Paul Kolano + + 1. DEFINITIONS + + A. "Contributor" means Government Agency, as the developer of the + Original Software, and any entity that makes a Modification. + B. "Covered Patents" mean patent claims licensable by a Contributor that + are necessarily infringed by the use or sale of its Modification alone or + when combined with the Subject Software. + C. "Display" means the showing of a copy of the Subject Software, + either directly or by means of an image, or any other device. + D. "Distribution" means conveyance or transfer of the Subject Software, + regardless of means, to another. + E. "Larger Work" means computer software that combines Subject + Software, or portions thereof, with software separate from the Subject + Software that is not governed by the terms of this Agreement. + F. "Modification" means any alteration of, including addition to or + deletion from, the substance or structure of either the Original + Software or Subject Software, and includes derivative works, as that + term is defined in the Copyright Statute, 17 USC 101. However, the + act of including Subject Software as part of a Larger Work does not in + and of itself constitute a Modification. + G. "Original Software" means the computer software first released under + this Agreement by Government Agency with Government Agency + designation NASA Ames Research Center and entitled + BASSHFS: Bash-Accessible SSH File System, including source code, + object code and accompanying documentation, if any. + H. "Recipient" means anyone who acquires the Subject Software under + this Agreement, including all Contributors. + I. "Redistribution" means Distribution of the Subject Software after a + Modification has been made. + J. "Reproduction" means the making of a counterpart, image or copy of + the Subject Software. + K. "Sale" means the exchange of the Subject Software for money or + equivalent value. + L. "Subject Software" means the Original Software, Modifications, or + any respective parts thereof. + M. "Use" means the application or employment of the Subject Software + for any purpose. + +2. GRANT OF RIGHTS + + A. Under Non-Patent Rights: Subject to the terms and conditions of this + Agreement, each Contributor, with respect to its own contribution to + the Subject Software, hereby grants to each Recipient a non-exclusive, + world-wide, royalty-free license to engage in the following activities + pertaining to the Subject Software: + + 1. Use + 2. Distribution + 3. Reproduction + 4. Modification + 5. Redistribution + 6. Display + + B. Under Patent Rights: Subject to the terms and conditions of this + Agreement, each Contributor, with respect to its own contribution to + the Subject Software, hereby grants to each Recipient under Covered + Patents a non-exclusive, world-wide, royalty-free license to engage in + the following activities pertaining to the Subject Software: + + 1. Use + 2. Distribution + 3. Reproduction + 4. Sale + 5. Offer for Sale + + C. The rights granted under Paragraph B. also apply to the combination of + a Contributor's Modification and the Subject Software if, at the time + the Modification is added by the Contributor, the addition of such + Modification causes the combination to be covered by the Covered + Patents. It does not apply to any other combinations that include a + Modification. + + D. The rights granted in Paragraphs A. and B. allow the Recipient to + sublicense those same rights. Such sublicense must be under the same + terms and conditions of this Agreement. + +3. OBLIGATIONS OF RECIPIENT + + A. Distribution or Redistribution of the Subject Software must be made + under this Agreement except for additions covered under paragraph + 3H. + + 1. Whenever a Recipient distributes or redistributes the Subject + Software, a copy of this Agreement must be included with each + copy of the Subject Software; and + 2. If Recipient distributes or redistributes the Subject Software in + any form other than source code, Recipient must also make the + source code freely available, and must provide with each copy of + the Subject Software information on how to obtain the source + code in a reasonable manner on or through a medium + customarily used for software exchange. + + B. Each Recipient must ensure that the following copyright notice + appears prominently in the Subject Software: + + BASSHFS: BashAccessible SSH File System + Copyright (C) 2019 United States Government as represented by the + Administrator of the National Aeronautics and Space Administration. + All Rights Reserved. + + BASSHFS: Bash-Accessible SSH File System contains 3rd party code. + Copyright notices for 3rd party code below. The license can be found + at https://dev.perl.org/licenses/artistic.html. + + Perl module Net::SFTP::Foreign + Copyright (c) 2005-2019 Salvador Fandino (sfandino@yahoo.com). + Copyright (c) 2001 Benjamin Trott, Copyright (c) 2003 David Rolsky. + _glob_to_regex method based on code (c) 2002 Richard Clamp. + + C. Each Contributor must characterize its alteration of the Subject + Software as a Modification and must identify itself as the originator of + its Modification in a manner that reasonably allows subsequent + Recipients to identify the originator of the Modification. In fulfillment + of these requirements, Contributor must include a file (e.g., a change + log file) that describes the alterations made and the date of the + alterations, identifies Contributor as originator of the alterations, and + consents to characterization of the alterations as a Modification, for + example, by including a statement that the Modification is derived, + directly or indirectly, from Original Software provided by Government + Agency. Once consent is granted, it may not thereafter be revoked. + + D. A Contributor may add its own copyright notice to the Subject + Software. Once a copyright notice has been added to the Subject + Software, a Recipient may not remove it without the express + permission of the Contributor who added the notice. + + E. A Recipient may not make any representation in the Subject Software + or in any promotional, advertising or other material that may be + construed as an endorsement by Government Agency or by any prior + Recipient of any product or service provided by Recipient, or that may + seek to obtain commercial advantage by the fact of Government + Agency's or a prior Recipient's participation in this Agreement. + + F. In an effort to track usage and maintain accurate records of the Subject + Software, each Recipient, upon receipt of the Subject Software, is + requested to provide Government Agency, by e-mail to the + Government Agency Point of Contact listed in clause 5.F., the + following information: name and email. Recipient's name and + personal information shall be used for statistical purposes only. Once a + Recipient makes a Modification available, it is requested that the + Recipient inform Government Agency, by e-mail to the Government + Agency Point of Contact listed in clause 5.F., how to access the + Modification. + + G. Each Contributor represents that that its Modification is believed to be + Contributor's original creation and does not violate any existing + agreements, regulations, statutes or rules, and further that Contributor + has sufficient rights to grant the rights conveyed by this Agreement. + + H. A Recipient may choose to offer, and to charge a fee for, warranty, + support, indemnity and/or liability obligations to one or more other + Recipients of the Subject Software. A Recipient may do so, however, + only on its own behalf and not on behalf of Government Agency or + any other Recipient. Such a Recipient must make it absolutely clear + that any such warranty, support, indemnity and/or liability obligation + is offered by that Recipient alone. Further, such Recipient agrees to + indemnify Government Agency and every other Recipient for any + liability incurred by them as a result of warranty, support, indemnity + and/or liability offered by such Recipient. + + I. A Recipient may create a Larger Work by combining Subject Software + with separate software not governed by the terms of this agreement + and distribute the Larger Work as a single product. In such case, the + Recipient must make sure Subject Software, or portions thereof, + included in the Larger Work is subject to this Agreement. + + J. Notwithstanding any provisions contained herein, Recipient is hereby + put on notice that export of any goods or technical data from the + United States may require some form of export license from the U.S. + Government. Failure to obtain necessary export licenses may result in + criminal liability under U.S. laws. Government Agency neither + represents that a license shall not be required nor that, if required, it + shall be issued. Nothing granted herein provides any such export + license. + +4. DISCLAIMER OF WARRANTIES AND LIABILITIES; WAIVER AND + INDEMNIFICATION + + A. No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" + WITHOUT ANY WARRANTY OF ANY KIND, EITHER + EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT + NOT LIMITED TO, ANY WARRANTY THAT THE SUBJECT + SOFTWARE WILL CONFORM TO SPECIFICATIONS, ANY + IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS + FOR A PARTICULAR PURPOSE, OR FREEDOM FROM + INFRINGEMENT, ANY WARRANTY THAT THE SUBJECT + SOFTWARE WILL BE ERROR FREE, OR ANY WARRANTY + THAT DOCUMENTATION, IF PROVIDED, WILL CONFORM TO + THE SUBJECT SOFTWARE. THIS AGREEMENT DOES NOT, IN + ANY MANNER, CONSTITUTE AN ENDORSEMENT BY + GOVERNMENT AGENCY OR ANY PRIOR RECIPIENT OF ANY + RESULTS, RESULTING DESIGNS, HARDWARE, SOFTWARE + PRODUCTS OR ANY OTHER APPLICATIONS RESULTING + FROM USE OF THE SUBJECT SOFTWARE. FURTHER, + GOVERNMENT AGENCY DISCLAIMS ALL WARRANTIES AND + LIABILITIES REGARDING THIRD-PARTY SOFTWARE, IF + PRESENT IN THE ORIGINAL SOFTWARE, AND DISTRIBUTES + IT "AS IS." + + B. Waiver and Indemnity: RECIPIENT AGREES TO WAIVE ANY + AND ALL CLAIMS AGAINST THE UNITED STATES + GOVERNMENT, ITS CONTRACTORS AND + SUBCONTRACTORS, AS WELL AS ANY PRIOR RECIPIENT. IF + RECIPIENT'S USE OF THE SUBJECT SOFTWARE RESULTS IN + ANY LIABILITIES, DEMANDS, DAMAGES, EXPENSES OR + LOSSES ARISING FROM SUCH USE, INCLUDING ANY + DAMAGES FROM PRODUCTS BASED ON, OR RESULTING + FROM, RECIPIENT'S USE OF THE SUBJECT SOFTWARE, + RECIPIENT SHALL INDEMNIFY AND HOLD HARMLESS THE + UNITED STATES GOVERNMENT, ITS CONTRACTORS AND + SUBCONTRACTORS, AS WELL AS ANY PRIOR RECIPIENT, TO + THE EXTENT PERMITTED BY LAW. RECIPIENT'S SOLE + REMEDY FOR ANY SUCH MATTER SHALL BE THE + IMMEDIATE, UNILATERAL TERMINATION OF THIS + AGREEMENT. + +5. GENERAL TERMS + + A. Termination: This Agreement and the rights granted hereunder will + terminate automatically if a Recipient fails to comply with these terms + and conditions, and fails to cure such noncompliance within thirty (30) + days of becoming aware of such noncompliance. Upon termination, a + Recipient agrees to immediately cease use and distribution of the + Subject Software. All sublicenses to the Subject Software properly + granted by the breaching Recipient shall survive any such termination + of this Agreement. + + B. Severability: If any provision of this Agreement is invalid or + unenforceable under applicable law, it shall not affect the validity or + enforceability of the remainder of the terms of this Agreement. + + C. Applicable Law: This Agreement shall be subject to United States + federal law only for all purposes, including, but not limited to, + determining the validity of this Agreement, the meaning of its + provisions and the rights, obligations and remedies of the parties. + + D. Entire Understanding: This Agreement constitutes the entire + understanding and agreement of the parties relating to release of the + Subject Software and may not be superseded, modified or amended + except by further written agreement duly executed by the parties. + + E. Binding Authority: By accepting and using the Subject Software + under this Agreement, a Recipient affirms its authority to bind the + Recipient to all terms and conditions of this Agreement and that that + Recipient hereby agrees to all terms and conditions herein. + + F. Point of Contact: Any Recipient contact with Government Agency is + to be directed to the designated representative as follows: + Paul Kolano + Paul.Kolano@nasa.gov + diff --git a/README.md b/README.md new file mode 100644 index 0000000..99fb463 --- /dev/null +++ b/README.md @@ -0,0 +1,36 @@ +Bash-Accessible SSH File System (BASSHFS) +========================================= + +Working with remote systems over SSH is common in HPC environments +where the size of data sets makes them nontrivial to relocate. To run +arbitrary commands on that data, a full SSH session is required. There +are cases, however, when the user may wish to perform simpler operations +such as checking file existence and size, viewing differences between +configuration files, creating directories, etc. that can be achieved +with more limited access. Juggling multiple sessions to multiple hosts +may be inconvenient for such simple tasks. BASSHFS is a tool that +allows users to perform such tasks within a single terminal on a single +host by transparently carrying out remote operations as needed to +present remote files as if they are locally mounted when using the bash +shell. + +BASSHFS is similar to the existing SSHFS utility except it is does not +require FUSE kernel support. Instead, BASSHFS uses the aliasing and +function mechanisms of the bash shell to intercept program invocations +and remap those that are supported to its own versions. These internal +versions determine if files on the command line are local or remote. +Remote files are processed transparently using a persistent SSH +connection to the associated host(s). Output associated with the local +and remote files is then multiplexed together into the standard unified +format associated with the original command. To the user, it appears as +if all files reside on a local file system even though they may span +multiple files systems on multiple hosts. + +To install, copy "basshfs" to a directory in $PATH and "basshfs.1" to +a directory in $MANPATH. For usage details, see "basshfs.1" (in man +page format, viewable with "nroff -man"). + +Questions, comments, fixes, and/or enhancements welcome. + +--Paul Kolano + diff --git a/basshfs b/basshfs new file mode 100755 index 0000000..6ebc3e7 --- /dev/null +++ b/basshfs @@ -0,0 +1,1551 @@ +#!/usr/bin/perl +# +# Notices +# BASSHFS: Bash-Accessible SSH File System +# Copyright (C) 2019 United States Government as represented by the +# Administrator of the National Aeronautics and Space Administration. +# All Rights Reserved. +# +# BASSHFS: Bash-Accessible SSH File System contains 3rd party code. +# Copyright notices for 3rd party code below. The license can be found +# at https://dev.perl.org/licenses/artistic.html. +# +# Perl module Net::SFTP::Foreign +# Copyright (c) 2005-2019 Salvador Fandino (sfandino@yahoo.com). +# Copyright (c) 2001 Benjamin Trott, Copyright (c) 2003 David Rolsky. +# _glob_to_regex method based on code (c) 2002 Richard Clamp. +# +# Disclaimers +# +# No Warranty: THE SUBJECT SOFTWARE IS PROVIDED "AS IS" WITHOUT ANY +# WARRANTY OF ANY KIND, EITHER EXPRESSED, IMPLIED, OR STATUTORY, +# INCLUDING, BUT NOT LIMITED TO, ANY WARRANTY THAT THE SUBJECT SOFTWARE +# WILL CONFORM TO SPECIFICATIONS, ANY IMPLIED WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR FREEDOM FROM +# INFRINGEMENT, ANY WARRANTY THAT THE SUBJECT SOFTWARE WILL BE ERROR FREE, +# OR ANY WARRANTY THAT DOCUMENTATION, IF PROVIDED, WILL CONFORM TO THE +# SUBJECT SOFTWARE. THIS AGREEMENT DOES NOT, IN ANY MANNER, CONSTITUTE AN +# ENDORSEMENT BY GOVERNMENT AGENCY OR ANY PRIOR RECIPIENT OF ANY RESULTS, +# RESULTING DESIGNS, HARDWARE, SOFTWARE PRODUCTS OR ANY OTHER APPLICATIONS +# RESULTING FROM USE OF THE SUBJECT SOFTWARE. FURTHER, GOVERNMENT AGENCY +# DISCLAIMS ALL WARRANTIES AND LIABILITIES REGARDING THIRD?PARTY SOFTWARE, +# IF PRESENT IN THE ORIGINAL SOFTWARE, AND DISTRIBUTES IT "AS IS." +# +# Waiver and Indemnity: RECIPIENT AGREES TO WAIVE ANY AND ALL CLAIMS +# AGAINST THE UNITED STATES GOVERNMENT, ITS CONTRACTORS AND +# SUBCONTRACTORS, AS WELL AS ANY PRIOR RECIPIENT. IF RECIPIENT'S USE OF +# THE SUBJECT SOFTWARE RESULTS IN ANY LIABILITIES, DEMANDS, DAMAGES, +# EXPENSES OR LOSSES ARISING FROM SUCH USE, INCLUDING ANY DAMAGES FROM +# PRODUCTS BASED ON, OR RESULTING FROM, RECIPIENT'S USE OF THE SUBJECT +# SOFTWARE, RECIPIENT SHALL INDEMNIFY AND HOLD HARMLESS THE UNITED STATES +# GOVERNMENT, ITS CONTRACTORS AND SUBCONTRACTORS, AS WELL AS ANY PRIOR +# RECIPIENT, TO THE EXTENT PERMITTED BY LAW. RECIPIENT'S SOLE REMEDY FOR +# ANY SUCH MATTER SHALL BE THE IMMEDIATE, UNILATERAL TERMINATION OF THIS +# AGREEMENT. +# + +# This program is based on the tricks discussed in "Magic Aliases: +# A Layering Loophole in the Bourne Shell" by Simon Tatham available +# at https://www.chiark.greenend.org.uk/~sgtatham/aliases.html + +# need perl 5.8.5 as glob is broken in earlier versions +require 5.008_005; +use strict; +use Cwd qw(abs_path); +use Data::Dumper; +use Fcntl qw(:flock :mode); +use File::Basename; +use File::Find; +use File::Glob qw(:glob); +use File::Path; +use File::Spec; +require File::Spec::Link; +use File::Spec::Unix; +use File::Temp qw(tempdir tempfile); +use Getopt::Long qw(:config bundling no_auto_abbrev no_ignore_case require_order); +use IO::File; +use IO::Handle; +use IO::Socket::UNIX; +use List::Util qw(first min sum); +require Net::SFTP::Foreign; +use POSIX; +use Socket; + +use constant SFTP_APPEND => 0x04; +use constant SFTP_CREAT => 0x08; +use constant SFTP_READ => 0x01; +use constant SFTP_TRUNC => 0x10; +use constant SFTP_WRITE => 0x02; +use constant SFTP_EXCL => 0x20; + +our $VERSION = 1.0; + +$Data::Dumper::Indent = 0; +$Data::Dumper::Purity = 1; + +# do not die when receiving sigpipe +$SIG{PIPE} = 'IGNORE'; +# add some basic paths +$ENV{PATH} .= ($ENV{PATH} ? ":" : "") . + "/bin:/usr/bin:/usr/local/bin:/sbin:/usr/sbin:/usr/local/sbin"; +# disable graphical passphrase prompts +delete $ENV{SSH_ASKPASS}; +delete $ENV{DISPLAY}; + +######################### +#### default options #### +######################### +my %opts = ( + abs0 => abs_path($0), + base0 => basename($0), + encode => "latin1", + tmp_d => File::Spec->tmpdir, + sftp_d => "$ENV{HOME}/.basshfs", + ssh => "ssh", +); +$opts{sock} = $opts{sftp_d} . "/sock"; + +####################### +#### parse options #### +####################### +if (!GetOptions(\%opts, "c", "l", "ssh|s=s", "u", + "o=s" => sub { + my ($key, $val) = split(/=|\s+/, $_[1], 2); + $val = shift @ARGV if (!defined $val); + $opts{$_[0] . lc($key)} = " $val"; + }) || !$opts{c} && + ($opts{l} && scalar(@ARGV) != 0 || + $opts{u} && scalar(@ARGV) != 1 || + !$opts{l} && !$opts{u} && scalar(@ARGV) != 2)) { + # show help + print "Mount: eval `$opts{base0} [USER@]HOST:[DIR] MOUNTPOINT [OPTIONS]`\n"; + print "Unmount: eval `$opts{base0} -u MOUNTPOINT`\n"; + print "List: $opts{base0} -l\n"; + print "\n"; + print "Options:\n"; + print " -s=CMDLINE use CMDLINE instead of \"ssh\" to access remote host\n"; + print " -oCMD=OPTS invoke supported command CMD with options OPTS\n"; + exit; +} +$opts{ssh} = unescape($opts{ssh}); +if (-e $opts{sftp_d} && !-d $opts{sftp_d}) { + die "ERROR: $opts{sock_d} exists and is not a directory\n"; +} elsif (!$opts{l} && !$opts{u} && !$opts{c} && -e $ARGV[1]) { + die "ERROR: mount point \"$ARGV[1]\" must not exist\n"; +} + +my %mounts; +foreach my $m (split(/,/, $ENV{BASSHFS_MOUNTS})) { + if ($m =~ /(\S+)=(\S+)/) { + $mounts{$1} = $2; + } +} +if ($opts{l}) { + while (my ($m, $d) = each %mounts) { + print "$m on $d (basshfs)\n"; + } + exit; +} + +################################ +#### define aliases for vfs #### +################################ +if (!$opts{c}) { + $opts{abs0} .= " -c"; + my @ng_cmds = qw(cat cd chgrp chmod chown cmp cp df diff du file ln ls mkdir + mount mv pwd rm rmdir test touch); + my @cmds = qw(grep head less more tail tee wc); + #TODO: find, more/less without whole file, mkfifo?, tac?, tar? + #TODO: can't use noglob alias with piped input (set -f destroys input) + if ($opts{u}) { + my $env = $ENV{BASSHFS_MOUNTS}; + $env =~ s/,$ARGV[0]=[^,]+//; + print qq|export BASSHFS_MOUNTS=$env ; |; + # clean up only if no more mounts + if ($env !~ /=/) { + # terminate vfs socket process + qx($opts{abs0} exit); + print qq|unset -f basshfs_cd ; |; + print qq|unset -f basshfs_ng ; |; + print qq|unalias $_ ; | foreach (@cmds, @ng_cmds); + print q|export COMP_WORDBREAKS=${COMP_WORDBREAKS}: ; |; + print qq|complete -r $_ ; | foreach (@cmds, @ng_cmds); + } + } else { + #TODO: could do redirection by getting orig cmd, rewriting < to + # cat, rewriting > to tee, then rexec'ing (only if history 1 works) + my $ssh = escape($opts{ssh}); + print qq|basshfs_cd () { eval `$opts{abs0} -s $ssh cd "\$@"`; RC=\$?; set +f; return \$RC ; } ; |; + print qq|basshfs_ng () { $opts{abs0} -s $ssh "\$@"; RC=\$?; set +f; return \$RC ; } ; |; + # aliases where glob can be safely disabled with set -f + print qq|alias $_='set -f; basshfs_ng $_ $opts{"o$_"}' ; | foreach (@ng_cmds); + # aliases where glob cannot be disabled as set -f destroys stdin + print qq|alias $_='$opts{abs0} -s $ssh $_$opts{"o$_"}' ; | foreach (@cmds); + print qq|alias cd='set -f; basshfs_cd' ; |; + print qq|complete -o default -o filenames -o nospace -C '$opts{abs0} -s $ssh complete' $_ ; | + foreach (@cmds, @ng_cmds); + print qq|export BASSHFS_MOUNTS=\${BASSHFS_MOUNTS},$ARGV[1]=$ARGV[0] ; |; + } + exit; +} + +############################### +#### execute local command #### +############################### +my $agent_sock; +if (scalar(@ARGV) > 0) { + my $cmd = shift @ARGV; + my $i; + for ($i = 0; $i < scalar(@ARGV); $i++) { + last if ($ARGV[$i] !~ /^--?\w+(=.*)?$/ && + ($i != 0 || $cmd !~ /(?:^|\W)(?:chgrp|chown|chmod|grep)$/)); + } + my $argv_mount = 0; + for (; $i < scalar(@ARGV); $i++) { + $ARGV[$i] =~ s/^~/$ENV{HOME}/; + if ($cmd ne 'complete' && $ARGV[$i] !~ /^\//) { + $ARGV[$i] = $ENV{PWD} . "/" . $ARGV[$i]; + 1 while ($ARGV[$i] =~ s/(?:^|\/?(?:[^\/]*\/))\.\.//); + } + $ARGV[$i] = "/" if (!$ARGV[$i]); + if ($cmd !~ /^(?:mv|rm|rmdir)$/) { + $ARGV[$i] = File::Spec::Link->resolve_all($ARGV[$i]); + } + $ARGV[$i] =~ s/\/\//\//g; + if ($cmd eq 'complete' && $i == 1) { + my $path = $ARGV[$i]; + $path = $ENV{PWD} . "/". $path if ($path !~ /^\//); + 1 while ($path =~ s/(?:^|\/?(?:[^\/]*\/))\.\.//); + $argv_mount ||= map_mount($path); + $ARGV[1] = $path; + my $match; + foreach my $m (keys %mounts) { + if ($m =~ /^$path[^\/]*$/) { + print $m, "/\n"; + $match = 1; + } + } + if ($match) { + # must complete manually or else only mount will be shown + system("bash", "-c", "compgen -o default -o filenames -o nospace $path"); + } + } elsif ($cmd ne 'complete' || $i != 0 && $i != 2) { + $argv_mount ||= map_mount($ARGV[$i]); + } + } + if ($cmd =~ /(?:^|\W)pwd$/) { + print "$ENV{PWD}\n"; + exit; + } elsif (!$argv_mount && (!map_mount($ENV{PWD}) || + (scalar(@ARGV) == 0 || grep(!/^(?:\-|\.$)/, @ARGV) == 0) || + $cmd =~ /(?:^|\W)complete$/ && $ARGV[1] =~ /^\// || + $cmd =~ /(?:^|\W)cd$/ && $ARGV[0] =~ /^\//)) { + if ($cmd eq 'exit') { + # do nothing for now + } elsif ($cmd eq 'mount') { + if (scalar(@ARGV) == 0) { + system("mount"); + while (my ($m, $d) = each %mounts) { + print "$m on $d (basshfs)\n"; + } + } else { + system("mount", @ARGV); + } + exit; + } elsif ($cmd =~ /(?:^|\W)(?:ls|du)$/ && map_mount($ENV{PWD}) && + (scalar(@ARGV) == 0 || grep(!/^(?:\-|\.$)/, @ARGV) == 0)) { + # add implicit current directory to remote ls/du + push(@ARGV, $ENV{PWD}); + } elsif ($cmd =~ /(?:^|\W)df$/ && + (scalar(@ARGV) == 0 || grep(!/^(?:\-|\.$)/, @ARGV) == 0)) { + } else { + exit if ($cmd =~ /(?:^|\W)complete$/); + unshift(@ARGV, $cmd); + unshift(@ARGV, qw(echo builtin)) if ($cmd =~ /(?:^|\W)cd$/); + @ARGV = map {glob($_)} @ARGV; + exit WEXITSTATUS(system(@ARGV)); + } + } elsif ($cmd =~ /(?:^|\W)complete$/) { + @ARGV = ($ARGV[1]); + } + # add previously shifted command back into argument list + unshift(@ARGV, $cmd); +} + +########################## +#### clean up on exit #### +########################## +END {exit_clean()}; +use sigtrap qw(handler exit_clean normal-signals); + +########################### +#### connect to daemon #### +########################### +my $server = IO::Socket::UNIX->new( + Peer => $opts{sock}, +); + +############################ +#### start sftp for vfs #### +############################ +if (!defined $server) { + mkdir $opts{sftp_d}; + mkdir "$opts{sftp_d}/empty"; + unlink $opts{sock}; + + if (fork) { + my $t0 = time; + sleep 1 while ($t0 + 5 > time && ! -S $opts{sock}); + $server = IO::Socket::UNIX->new( + Peer => $opts{sock}, + ); + # prevent cleanup + $opts{sftp_d} = undef; + } else { + close STDIN; + close STDOUT; + close STDERR; + setsid; + open(STDIN, "/dev/null"); + open(STDERR, ">/dev/null"); + + $server = IO::Socket::UNIX->new( + Listen => 10, + Local => $opts{sock}, + Proto => 'tcp', + ); + + while (my $client = $server->accept) { + $_ = <$client>; + if (!$_) { + close $client; + next; + } + my $pwd; + my $emounts; + eval; + $ENV{PWD} = $pwd; + foreach my $m (split(/,/, $emounts)) { + if ($m =~ /(\S+)=(\S+)/) { + $mounts{$1} = $2; + } + } + my %copts; + for (my $i = 1; $i < scalar(@ARGV); $i++) { + if ($ARGV[$i] =~ /^--(\w+)$/) { + $copts{$1} = 1; + } elsif ($ARGV[$i] =~ /^--(\w+)=(.*)$/) { + $copts{$1} = $2; + } elsif ($ARGV[$i] =~ /^-(\d+)$/) { + $copts{$1} = 1; + } elsif ($ARGV[$i] =~ /^-(\w+)$/) { + $copts{$_} = 1 foreach (split(//, $1)); + } elsif (!defined $copts{-arg1} && $ARGV[0] =~ + /(?:^|\W)(?:chgrp|chown|chmod|grep)$/) { + # first non-option argument + $copts{-arg1} = $ARGV[$i]; + } else { + my ($host, $path) = hostpath(map_mount($ARGV[$i], 1)); + if ($host eq 'localhost') { + # rewrite arg for /localhost/path case + $ARGV[$i] = $path; + if ($path !~ /^\//) { + # relative path + ($host, $path) = hostpath($pwd); + $path .= "/" . $ARGV[$i] if ($host ne 'localhost'); + } + } + if ($host ne 'localhost') { + $path = File::Spec::Unix->canonpath($path); +# 1 while ($path =~ s/(?:^|\/?(?:[^\/]*\/))\.\.//); + $path = "/" if (!$path); + # original argument + $copts{-arg} = splice(@ARGV, $i--, 1); + if ($path =~ /[*?[]/ && + $ARGV[0] !~ /(?:^|\W)(?:ls|complete)$/) { + my @glob = sftp($host)->glob($path, names_only => 1); + next if (scalar(@glob) == 0); + $path = shift @glob; + @glob = map {unmap_mount(hostpath($host, $_))} @glob; + splice(@ARGV, $i + 1, 0, @glob); + } + push(@{$copts{-argv}}, hostpath($host, $path)); + if ($ARGV[0] =~ /(?:^|\W)(cd|chgrp|chmod|chown|complete|df|du|head|ls|mkdir|rm|rmdir|tail|test|touch)$/) { +#TODO: this should probably be done differently (i.e. should rename +# all paths, then execute subs on all args at once) + $copts{-argsleft} = scalar(@ARGV) - $i - 1; + my $sub = \&{"v$1"}; + &{$sub}($client, $host, $path, \%copts); + last if ($1 eq 'cd'); + } elsif ($ARGV[0] !~ /(?:^|\W)(?:cp|ln|mv|tee)$/) { + #### commands that use tmp files for remote files #### + my $tmp = sftp_tmp() . "-" . basename($path); + if ($ARGV[0] =~ /(?:^|\W)file$/) { + #### commands that use first n bytes of files #### + open(FILE, '>', $tmp); + my $fh = sftp($host)->open($path); + print FILE sftp($host)->read($fh, 4096); + close $fh; + close FILE; + } else { + #### commands that use entire files #### + if ($tmp ne $copts{-arg}) { + my $ref = {}; + transport('get', $host, $path, $tmp, $ref); + transport('end', $host); + #TODO: do something with error + } + } + splice(@ARGV, ++$i, 0, $tmp); + $copts{-argc}++; + } + } else { + $copts{-argc}++; + push(@{$copts{-argv}}, glob($ARGV[$i])); + } + } + } + + if ($ARGV[0] =~ /(?:^|\W)(cp|ln|mv|tee)$/) { + #### commands that process all arguments at once #### + my $sub = \&{"v$1"}; + &{$sub}($client, \%copts); + } + if (!defined $copts{-argv} && $ARGV[0] =~ /(?:^|\W)df$/) { + #### commands that process remotely even when local + vdf($client, 'localhost', undef, \%copts); + foreach my $m (keys %mounts) { + vdf($client, hostpath($mounts{$m}), \%copts); + } + } + if ($copts{-argc} || $copts{-arg1} && $ARGV[0] =~ /(?:^|\W)grep$/) { + #### commands that execute locally on local files #### + if ($ARGV[0] =~ /(?:^|\W)ls$/) { + # add directory to ls output + sftp_echo($client, ""); + sftp_echo($client, $ARGV[-1] . ":") + if ($copts{-argc} == 1 && -d $ARGV[-1]); + } + @ARGV = map {glob($_)} @ARGV; + sftp_cmd($client, @ARGV); + } + close $client; + last if ($ARGV[0] eq 'exit'); + } + exit; + } +} + +############################# +#### execute vfs command #### +############################# +print $server scalar(Data::Dumper->Dump( + [\@ARGV, $ENV{PWD}, $ENV{SSH_AUTH_SOCK}, $ENV{BASSHFS_MOUNTS}], + [qw(*ARGV pwd agent_sock emounts)])) . "\n"; +my $rc = 0; +if ($ARGV[0] =~ /(?:^|\W)tee$/) { + while () { + print; + print $server $_; + } +} else { + while (my $line = <$server>) { + eval $line; + $rc |= WEXITSTATUS(system(@ARGV)); + unlink grep(/basshfs-/, @ARGV); + } +} +exit $rc; + +#################### +#### exit_clean #### +#################### +# clean up directories and exit +sub exit_clean { + my $rc = $?; + if ($opts{sftp_d} =~ /basshfs-.{8}$/) { + # rmtree complains about current directory without chdir + chdir "/"; + # remove temporary directory and all contents + rmtree($opts{sftp_d}); + } + exit $rc; +} + +############## +#### fqdn #### +############## +# return fully qualified version of given host name +sub fqdn { + my $host = shift; + return $host if ($host eq '127.0.0.1'); + my @uhost = split(/@/, $host); + if ($uhost[-1] =~ /^\d+\.\d+\.\d+\.\d+$/) { + my $name = gethostbyaddr(inet_aton($uhost[-1]), AF_INET); + $uhost[-1] = $name if ($name); + } else { + my @cols = gethostbyname($uhost[-1]); + $uhost[-1] = $cols[0] if ($cols[0]); + } + return join('@', @uhost); +} + +################## +#### hostpath #### +################## +# return parsed host/path in list context or true if remote path in scalar +sub hostpath { + my $path = $_[-1]; + my $host = scalar(@_) > 1 ? $_[0] : 'localhost'; + if (scalar(@_) > 1) { + # multiple arguments + # return host-path for non-localhost and original path otherwise + return $path if ($host eq 'localhost'); + return $host . ":" . $path; + } elsif ($path =~ /^([\w@.-]+):(.*)$/s) { + my ($h, $p) = ($1, $2); + # leave user name as part of host + if ($h ne 'file' && $p !~ /^\/\//) { + # single host-path argument in scp format + ($host, $path) = ($h, $p); + # remove leading ~/ since it is implied + $path =~ s/^~\/+//; + # resolve home dir for relative paths + if (wantarray && $path !~ /^\//) { + $path = sftp($host)->cwd . "/" . $path; + } + } + } + # for list context, return (host, path) + # for scalar context, return true if non-localhost host-path + return wantarray ? ($host, $path) : ($host ne 'localhost' ? 1 : 0); +} + +################### +#### map_mount #### +################### +sub map_mount { + my $path = shift; + my $orig = shift; + if ($path !~ /^\//) { + $path = $ENV{PWD} . "/" . $path; + } + foreach my $m (keys %mounts) { + my $d = $mounts{$m}; + if ($path =~ /^$m(\/.*)?/) { + return $d . $1; + } + } + return $orig ? $path : undef; +} + +##################### +#### unmap_mount #### +##################### +sub unmap_mount { + my $path = shift; + foreach my $m (keys %mounts) { + my $d = $mounts{$m}; + if ($path =~ /^$d(\/.*)?/) { + return $m . $1; + } + } + return $path; +} + +############## +#### sftp #### +############## +# return new/cached sftp connection to given host +sub sftp { + my $host = shift; + my $no_cwd = shift; + + if ($opts{"sftp_$host"}) { + # use cwd to check for dead connection + $opts{"sftp_$host"}->cwd if (!$no_cwd); + # return cached connection to host if still connected + return $opts{"sftp_$host"} if ($opts{"sftp_$host"}->{_connected}); + } + # use global agent socket for authentication + $ENV{SSH_AUTH_SOCK} = $agent_sock; + # create and cache new connection to host + $opts{"sftp_$host"} = Net::SFTP::Foreign->new( + autoflush => 1, + fs_encoding => $opts{encode}, + open2_cmd => "$opts{ssh} -s $host sftp", + ); + my $fqdn = fqdn($host); + # cache under fully qualified host name as well + $opts{"sftp_$fqdn"} = $opts{"sftp_$host"} if ($fqdn ne $host); + return $opts{"sftp_$host"}; +} + +################## +#### sftp_cmd #### +################## +# execute given command via given socket +sub sftp_cmd { + my $ref = shift; + print $ref scalar(Data::Dumper->Dump([[@_]], [qw(*ARGV)])) . "\n"; +} + +################### +#### sftp_echo #### +################### +# print given message via given socket or set text in given hash +sub sftp_echo { + my $ref = shift; + return if (!defined $ref || !defined $_[0]); + print $ref scalar(Data::Dumper->Dump([["echo", @_]], [qw(*ARGV)])) . "\n"; +} + +#################### +#### sftp_error #### +#################### +# print given error message via given socket or set error text in given hash +sub sftp_error { + my $ref = shift; + return if (!defined $ref || !defined $_[0]); + # use echo to print message + print $ref scalar(Data::Dumper->Dump([["echo", @_]], [qw(*ARGV)])) . "\n"; + # use false to set non-zero exit code + print $ref scalar(Data::Dumper->Dump([["false"]], [qw(*ARGV)])) . "\n"; +} + +################# +#### sftp_ls #### +################# +# return formatted ls string of given remote file +sub sftp_ls { + #TODO: size is negative in some cases (perhaps showing 64-bit results + # on 32-bit system? + my ($name, $attrs) = ($_[0]->{filename}, $_[0]->{a}); + $name = basename($name) if ($_[1]); + return $name if (!$_[2]); + $name = "$name -> $_[0]->{link}" if ($_[0]->{link}); + my $user = getpwuid($attrs->uid); + $user = $attrs->uid if (!$user); + my $group = getgrgid($attrs->gid); + $group = $attrs->gid if (!$group); + return sprintf("%10s %4d %7s %7s %9d %12s %s", + sftp_ls_mode($attrs->perm), 1, $user, $group, $attrs->size, + strftime("%b %d %Y", localtime $attrs->mtime), $name); +} + +###################### +#### sftp_ls_mode #### +###################### +# return formatted ls permission string corresponding to given mode +sub sftp_ls_mode { + my $mode = shift; + my @perms = qw(--- --x -w- -wx r-- r-x rw- rwx); + my @ftype = qw(. p c ? d ? b ? - ? l ? s ? ? ?); + $ftype[0] = ''; + my $setids = ($mode & 07000) >> 9; + my @permstrs = @perms[ + ($mode & 0700) >> 6, ($mode & 0070) >> 3, $mode & 0007]; + my $ftype = $ftype[($mode & 0170000) >> 12]; + + if ($setids) { + $permstrs[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e if ($setids & 01); + $permstrs[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e if ($setids & 04); + $permstrs[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e if ($setids & 02); + } + + return join('', $ftype, @permstrs); +} + +################## +#### sftp_tmp #### +################## +# return new temporary file name (with handle in array context) +sub sftp_tmp { + my %dir; + # create in vfs socket directory if it exists + $dir{DIR} = defined $opts{sftp_d} ? $opts{sftp_d} : $opts{tmp_d}; + my ($tmpfh, $tmp) = tempfile("basshfs-XXXXXXXX", %dir); + if (wantarray) { + # in array context, return both file handle and file name + return ($tmpfh, $tmp); + } else { + close $tmpfh; + # in scalar context, return just file name + return $tmp; + } +} + +################ +#### escape #### +################ +# return uri-escaped version of given string +sub escape { + my $text = shift; + $text =~ s/([^A-Za-z0-9\-\._~\/])/sprintf("%%%02X", ord($1))/eg + if (defined $text); + return $text; +} + +################## +#### unescape #### +################## +# return uri-unescaped version of given string +sub unescape { + my $text = shift; + $text =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if (defined $text); + return $text; +} + +################### +#### transport #### +################### +my %tcmds; +sub transport { + my ($op, $host, $src, $dst, $err) = @_; + $tcmds{$host} = [] if ($host && !defined $tcmds{$host}); + if ($op eq 'end' && !defined $host) { + my @hosts = keys %tcmds; + # localhost must be first to create directories + transport($op, 'localhost') if (grep(/^localhost$/, @hosts)); + foreach $host (@hosts) { + transport($op, $host) if ($host ne 'localhost'); + } + return; + } elsif ($op eq 'end') { + transport_default($host, @{$_}) foreach (@{$tcmds{$host}}); + } else { + push(@{$tcmds{$host}}, [$op, $src, $dst, $err]); + return; + } + delete $tcmds{$host}; +} + +########################### +#### transport_default #### +########################### +sub transport_default { + my ($host, $op, $src, $dst, $err) = @_; + if ($host eq 'localhost') { + if ($op =~ /^(?:get|put)$/) { + copy($src, $dst) or sftp_error($err, "$!"); + } elsif ($op eq 'mkdir') { + # ignore if directory exists + -d $src or mkdir $src or sftp_error($err, "$!"); + } elsif ($op eq 'rm') { + unlink $src or sftp_error($err, "$!"); + } elsif ($op eq 'rrm') { + sftp_error($err, rmtree($src)); + } + } else { + if ($op eq 'get') { + sftp($host)->get($src, $dst) or + sftp_error($err, "" . sftp($host, 1)->error); + } elsif ($op eq 'mkdir') { + vmkdir($err, $host, $src, {-overwrite => 1}); + } elsif ($op eq 'put') { + sftp($host)->put($src, $dst) or + sftp_error($err, "" . sftp($host, 1)->error); + } elsif ($op eq 'rget') { + sftp($host)->rget($src, $dst) or + sftp_error($err, "" . sftp($host, 1)->error); + } elsif ($op eq 'rm') { + sftp($host)->remove($src) or + sftp_error($err, "" . sftp($host, 1)->error); + } elsif ($op eq 'rput') { + sftp($host)->rput($src, $dst) or + sftp_error($err, "" . sftp($host, 1)->error); + } elsif ($op eq 'rrm') { + sftp($host)->rremove($src) or + sftp_error($err, "" . sftp($host, 1)->error); + } + } +} + +############# +#### vcd #### +############# +sub vcd { + my ($ref, $host, $path, $copts) = @_; + my $attrs = sftp($host)->stat($path); + #TODO: pushd/popd?, set OLDPWD? + $path =~ s/\/*$//; + if (!$attrs) { + sftp_echo($ref, "echo " . hostpath($host, $path) . + ": No such file or directory"); + } elsif (!S_ISDIR($attrs->perm)) { + sftp_echo($ref, "echo " . hostpath($host, $path) . + ": Not a directory"); + } else { + sftp_echo($ref, "builtin cd $opts{sftp_d}/empty; export PWD=" . + unmap_mount(hostpath($host, $path))); + } +} + +################ +#### vchgrp #### +################ +sub vchgrp { + return vchown(@_, 1); +} + +################ +#### vchmod #### +################ +sub vchmod { + my ($ref, $host, $path, $copts) = @_; + #TODO: handle options/links/etc., ago+rwx syntax + my $attrs = Net::SFTP::Foreign::Attributes->new; + $attrs->set_perm(oct $copts->{-arg1}); + if (!sftp($host)->setstat($path, $attrs)) { + sftp_error($ref, sftp($host, 1)->error); + } +} + +################ +#### vchown #### +################ +sub vchown { + my ($ref, $host, $path, $copts, $chgrp) = @_; + #TODO: handle options/links/etc. + if (!defined $copts->{-user} && !defined $copts->{-group}) { + my ($user, $group); + if ($chgrp) { + $group = $copts->{-arg1}; + } else { + if ($copts->{-arg1} =~ /(\w+)?:(\w+)/) { + ($user, $group) = ($1, $2); + } else { + $user = $copts->{-arg1}; + } + } + if (defined $group) { + if ($group !~ /^\d+$/) { + # find remote group name in remote /etc/group + my $fh = sftp($host)->open("/etc/group"); + while (<$fh>) { + if (/^\Q$group\E:[^:]*:(\d+)/) { + $copts->{-group} = $1; + last; + } + } + close $fh; + sftp_error($ref, "Invalid argument") + if (!defined $copts->{-group}); + } else { + $copts->{-group} = $group; + } + } + if (defined $user) { + if ($user !~ /^\d+$/) { + # find remote user name in remote /etc/group + my $fh = sftp($host)->open("/etc/passwd"); + while (<$fh>) { + if (/^\Q$user\E:[^:]*:(\d+)/) { + $copts->{-user} = $1; + last; + } + } + close $fh; + sftp_error($ref, "Invalid argument") + if (!defined $copts->{-user}); + } else { + $copts->{-user} = $user; + } + } + } + my $attrs = sftp($host)->stat($path); + if (!$attrs) { + sftp_error($ref, "No such file or directory"); + } else { + my ($user, $group) = ($attrs->uid, $attrs->gid); + $user = $copts->{-user} if (defined $copts->{-user}); + $group = $copts->{-group} if (defined $copts->{-group}); + $attrs->set_ugid($user, $group); + sftp_error($ref, "Operation not permitted") + if (!sftp($host)->setstat($path, $attrs)); + } +} + +################### +#### vcomplete #### +################### +sub vcomplete { + my ($ref, $host, $path, $copts) = @_; + my ($tmp_fh, $tmp) = sftp_tmp(); + $path .= "/" if ($copts->{-arg} =~ /\/$/); + my @link; + my @glob = sftp($host)->glob("$path*", follow_links => 1, + on_error => sub {push(@link, $_[1])}); + push(@glob, @link); + foreach (@glob) { + print $tmp_fh $copts->{-arg}; + print $tmp_fh unmap_mount(substr($_->{filename}, length $path)); + print $tmp_fh "/" if (S_ISDIR($_->{a}->perm)); + print $tmp_fh "\n"; + } + close $tmp_fh; + sftp_cmd($ref, "sort", $tmp); +} + +############# +#### vcp #### +############# +sub vcp { + vmv(@_, 1); +} + +############# +#### vdf #### +############# +sub vdf { + my ($ref, $host, $path, $copts) = @_; + if ($host eq 'localhost') { + return if ($^O eq 'MSWin32'); + # collect disk space + eval { + local $SIG{__WARN__} = sub {die}; + # use 15s alarm in case df stalls + local $SIG{ALRM} = sub {die}; + alarm 15; + # use open3 to avoid executing a shell command based on the name + # of a file being copied (which may contain metacharacters, etc.) + my $opts = "-Pk"; + $opts .= "i" if $copts->{i}; + if (defined $path) { + open(TMP, '-|', 'df', $opts, $path); + } else { + open(TMP, '-|', 'df', $opts); + } + alarm 0; + }; + if (!$@) { + if (defined $copts->{-argv} && scalar(@{$copts->{-argv}}) != 1); + while (my $line = ) { + $line =~ s/\s*\r?\n$//; + sftp_echo($ref, $line); + } + } + close TMP; + } else { + my $df = sftp($host)->statvfs($path); + my ($fs, $mount) = ("?", $path); + foreach my $m (keys %mounts) { + my $d = $mounts{$m}; + if (hostpath($host, $path) =~ /^$d(\/.*)?/) { + ($fs, $mount) = ($d, $m); + last; + } + } + my ($tmp_fh, $tmp) = sftp_tmp(); + if (defined $df && $copts->{i}) { + if (defined $copts->{-argv} && scalar(@{$copts->{-argv}}) == 1) { + print $tmp_fh "Filesystem Inodes IUsed IFree IUse% Mounted_on\n"; + } + print $tmp_fh "$fs $df->{files} " . ($df->{files} - $df->{ffree}) . + " $df->{ffree} " . int(100 * ($df->{files} - $df->{ffree}) / + $df->{files}) . "% $mount\n"; + } elsif (defined $df) { + if (defined $copts->{-argv} && scalar(@{$copts->{-argv}}) == 1) { + print $tmp_fh "Filesystem 1K-blocks Used Available Use% Mounted_on\n"; + } + my $s = $df->{bsize} / 1024.0; + print $tmp_fh "$fs " . int($s * $df->{blocks}) . " " . + int($s * ($df->{blocks} - $df->{bfree})) . " " . + int($s * $df->{bfree}) . " " . + int(100 * ($df->{blocks} - $df->{bfree}) / + $df->{blocks}) . "% $mount\n"; + } else { + sftp_error($ref, "Statvfs is not supported by the target sftp server"); + return; + } + close $tmp_fh; + sftp_cmd($ref, "column", "-t", $tmp); + } +} + +############# +#### vdu #### +############# +sub vdu { + my ($ref, $host, $path, $copts) = @_; + my ($dcurr, $dmin, $dprev) = (0, $path =~ tr/\///, 0); + my @dirs = ($path); + my @sizes = (0); + my %follow; + $follow{follow_links} = 1 if ($copts->{L}); + sftp($host)->find($path, + %follow, + ordered => 1, + wanted => sub { + my $name = $_[1]->{filename}; + my $perm = $_[1]->{a}->perm; + my $size = $_[1]->{a}->size; + if (!$copts->{b}) { + $size = int(($size + 1023) / 1024); + if (S_ISDIR($perm)) { + $size = 4 * int($size / 4); + } else { + $size = 4 * int(($size + 3) / 4); + } + } + $dcurr = ($name =~ tr/\///) - $dmin; + if (!$copts->{s}) { + for (my $i = $dprev - 1; $i >= $dcurr; $i--) { + sftp_echo($ref, "$sizes[$i]\t" . + unmap_mount(hostpath($host, $dirs[$i]))); + } + } + if (S_ISDIR($perm)) { + $dirs[$dcurr] = $name; + $sizes[$dcurr] = 0; + } elsif ($copts->{a}) { + sftp_echo($ref, "$size\t" . + unmap_mount(hostpath($host, $name))); + } + $sizes[$_] += $size for (0..$dcurr); + $dprev = $dcurr; + return undef; + }); + sftp_echo($ref, "$sizes[0]\t" . + unmap_mount(hostpath($host, $dirs[0]))); +} + +############### +#### vhead #### +############### +sub vhead { + my ($ref, $host, $path, $copts) = @_; + my $n = (grep(/^\d+$/, keys %{$copts}))[0]; + $n = 10 if (!defined $n); + my $fh = sftp($host)->open($path); + if ($fh) { + my ($tmp_fh, $tmp) = sftp_tmp(); + while (<$fh>) { + last if ($n-- <= 0); + print $tmp_fh $_; + } + close $tmp_fh; + close $fh; + sftp_cmd($ref, "cat", $tmp); + } else { + sftp_error($ref, sftp($host, 1)->error); + } +} + +############# +#### vln #### +############# +sub vln { + my ($ref, $copts) = @_; + #TODO: handle opts, -f, etc. + # do not run original spliced command + $copts->{-argc} = 0; + my $dpath0 = pop @{$copts->{-argv}}; + (my $dhost, $dpath0) = hostpath($dpath0); + if ($dhost ne 'localhost') { + my $attrs = sftp($dhost)->stat($dpath0); + foreach my $spath0 (@{$copts->{-argv}}) { + my $dpath = $dpath0; + $dpath .= "/" . basename($spath0) + if ($attrs && S_ISDIR($attrs->perm)); + my ($shost, $spath) = hostpath($spath0); + if ($shost ne 'localhost') { + # link remote to remote + if ($shost eq $dhost) { + sftp($dhost)->symlink($dpath, $spath); + } else { + sftp($dhost)->symlink($dpath, $spath0); + } + } else { + # link remote to local + sftp_error($ref, "Cannot link remote file to local file"); + } + } + } else { + # link local to remote + foreach my $spath (@{$copts->{-argv}}) { + next if (!hostpath($spath)); + my $dpath = $dpath0; + $dpath .= "/" . basename($spath) if (-d $dpath0); + symlink($spath, $dpath); + } + } +} + +############# +#### vls #### +############# +sub vls { + my ($ref, $host, $path, $copts) = @_; + my @glob; + if ($copts->{d}) { + @glob = sftp($host)->glob($path); + } else { + my @link; + @glob = sftp($host)->glob($path, follow_links => 1, + on_error => sub {push(@link, $_[1])}); + push(@glob, @link); + } + my $rpath = hostpath($host, $path); + my $globc = scalar(@glob); + if (!$globc) { + sftp_error($ref, "$rpath: No such file or directory"); + } elsif ($copts->{-vargc}) { + #TODO: this is wrong when path is a file and not dir + # probably need to do ls all at once like cp/mv + sftp_echo($ref, ""); + sftp_echo($ref, "$rpath:"); + } elsif ($copts->{-argc} || $copts->{-argsleft} > 0) { + #TODO: this is wrong when path is a file and not dir + # probably need to do ls all at once like cp/mv + sftp_echo($ref, "$rpath:"); + } + $copts->{-vargc}++; + my $cmd = (!$copts->{l} && !$copts->{1} ? "column" : "cat"); + my $tmp = sftp_tmp(); + if ($globc) { + open(TMP, '|-', "sort -k 9 -o $tmp"); + foreach (@glob) { + next if (!$copts->{d} && S_ISDIR($_->{a}->perm)); + $_->{link} = sftp($host)->readlink($_->{filename}) + if ($copts->{l} && S_ISLNK($_->{a}->perm)); + print TMP sftp_ls($_, 0, $copts->{l}) . "\n"; + } + close TMP; + sftp_cmd($ref, $cmd, $tmp); + $tmp = sftp_tmp(); + } + open(TMP, '|-', "sort -k 9 -o $tmp"); + if ($globc && !$copts->{d}) { + @glob = sftp($host)->glob("$path/*"); + #TODO: empty directories do not show up + my $dir; + for (my $j = 0; $j < scalar(@glob); $j++) { + my $tdir = dirname($glob[$j]->{filename}); + if ($tdir ne $dir) { + $dir = $tdir; + if ($j > 0) { + close TMP; + sftp_cmd($ref, $cmd, $tmp); + $tmp = sftp_tmp(); + open(TMP, '|-', "sort -k 9 -o $tmp"); + } + if ($globc > 1) { + #TODO: this is wrong when path is a file and not dir + # probably need to do ls all at once like cp/mv + sftp_echo($ref, ""); + sftp_echo($ref, "$dir:"); + } + } + if ($copts->{l} && S_ISLNK($glob[$j]->{a}->perm)) { + $glob[$j]->{link} = sftp($host)->readlink($glob[$j]->{filename}); + } + print TMP sftp_ls($glob[$j], 1, $copts->{l}) . "\n"; + } + } + close TMP; + sftp_cmd($ref, $cmd, $tmp); +} + +################ +#### vmkdir #### +################ +sub vmkdir { + my ($ref, $host, $path) = @_; + my $attrs = sftp($host)->stat($path); + if ($attrs && !S_ISDIR($attrs->perm)) { + sftp_error($ref, "File exists"); + } elsif (!$attrs && !sftp($host)->mkdir($path)) { + sftp_error($ref, "Permission denied"); + } +} + +############# +#### vmv #### +############# +sub vmv { + my ($ref, $copts, $cp) = @_; + if (scalar(@{$copts->{-argv}}) == 1) { + sftp_error($ref, "usage: " . ($cp ? "cp" : "mv") . " src ... dst"); + next; + } + my %shosts; + my $dpath0 = pop @{$copts->{-argv}}; + (my $dhost, $dpath0) = hostpath($dpath0); + if ($dhost ne 'localhost') { + # do not run original spliced command + $copts->{-argc} = 0; + my $dattrs = sftp($dhost)->stat($dpath0); + foreach my $spath (@{$copts->{-argv}}) { + my $dpath = $dpath0; + $dpath .= "/" . basename($spath) + if ($dattrs && S_ISDIR($dattrs->perm)); + (my $shost, $spath) = hostpath($spath); + if ($shost ne 'localhost') { + # copy remote to remote + if ($shost eq $dhost) { + #TODO: check is src/dst host are the same + #so rename instead + } else { + $shosts{$shost} = 1; + } + my $tmp = sftp_tmp(); + my $sattrs = sftp($shost)->stat($spath); + #TODO: need a check about copying multiple files to a file, etc. + if (!$sattrs) { + sftp_error($ref, "$spath: No such file or directory"); + next; + } elsif (S_ISDIR($sattrs->perm)) { + if (!$copts->{r} && !$copts->{R} && $cp) { + sftp_error($ref, "$spath is a directory"); + next; + } else { + transport('rget', $shost, $spath, $tmp, {}); + transport('rput', $dhost, $tmp, $dpath, {}); + #TODO: do error checking before rm + transport('rrm', $shost, $spath, undef, {}) if (!$cp); + transport('rrm', 'localhost', $tmp, undef, {}); + } + } elsif (S_ISREG($sattrs->perm) || S_ISLNK($sattrs->perm)) { + transport('get', $shost, $spath, $tmp, {}); + transport('put', $dhost, $tmp, $dpath, {}); + #TODO: do error checking before rm + transport('rm', $shost, $spath, undef, {}) if (!$cp); + transport('rm', 'localhost', $tmp, undef, {}); + } else { + sftp_error($ref, "$spath: Not a regular file"); + next; + } + #TODO: warn on non-{dir|reg|lnk} + } else { + # copy local to remote + if (! -e $spath) { + sftp_error($ref, "$spath: No such file or directory"); + next; + } elsif (-d $spath) { + if (!$copts->{r} && !$copts->{R} && $cp) { + sftp_error($ref, "$spath is a directory"); + next; + } else { + transport('rput', $dhost, $spath, $dpath, {}); + #TODO: do error checking before rm + transport('rrm', 'localhost', $spath, undef, {}) + if (!$cp); + } + } elsif (-f $spath || -l $spath) { + transport('put', $dhost, $spath, $dpath, {}); + transport('rm', 'localhost', $spath, undef, {}) if (!$cp); + } else { + sftp_error($ref, "$spath: Not a regular file"); + next; + } + } + } + #TODO: warn if only one arg for general case? + } else { + # original spliced command needs at least two args + $copts->{-argc} = 0 if ($copts->{-argc} == 1); + foreach my $spath (@{$copts->{-argv}}) { + my $dpath = $dpath0; + $dpath .= "/" . basename($spath) if (-d $dpath0); + (my $shost, $spath) = hostpath($spath); + if ($shost ne 'localhost') { + # copy remote to local + $shosts{$shost} = 1; + my $sattrs = sftp($shost)->stat($spath); + if (!$sattrs) { + sftp_error($ref, "$spath: No such file or directory"); + next; + } elsif (S_ISDIR($sattrs->perm)) { + if (!$copts->{r} && !$copts->{R} && $cp) { + sftp_error($ref, "$spath is a directory"); + next; + } else { + transport('rget', $shost, $spath, $dpath, {}); + #TODO: do error checking before rm + transport('rrm', $shost, $spath, undef, {}) if (!$cp); + } + } elsif (S_ISREG($sattrs->perm) || S_ISLNK($sattrs->perm)) { + transport('get', $shost, $spath, $dpath, {}); + #TODO: do error checking before rm + transport('rm', $shost, $spath, undef, {}) if (!$cp); + } else { + sftp_error($ref, "$spath: Not a regular file"); + next; + } + } else { + # copy local to local + if (! -e $spath) { + sftp_error($ref, "$spath: No such file or directory"); + next; + } elsif (-d $spath) { + if (!$copts->{r} && !$copts->{R} && $cp) { + sftp_error($ref, "$spath is a directory"); + next; + } else { + transport('rput', 'localhost', $spath, $dpath, {}); + #TODO: do error checking before rm + transport('rrm', 'localhost', $spath, undef, {}) + if (!$cp); + } + } elsif (-f $spath || -l $spath) { + transport('put', 'localhost', $spath, $dpath, {}); + transport('rm', 'localhost', $spath, undef, {}) + if (!$cp); + } else { + sftp_error($ref, "$spath: Not a regular file"); + next; + } + } + } + } + transport('end', 'localhost'); + transport('end', $_) foreach (keys %shosts); + transport('end', $dhost); + transport('end', 'localhost', 1); +} + +############# +#### vrm #### +############# +sub vrm { + my ($ref, $host, $path, $copts) = @_; + if ($copts->{r}) { + sftp_error($ref, sftp($host, 1)->error) + if (!sftp($host)->rremove($path)); + } else { + sftp_error($ref, sftp($host, 1)->error) + if (!sftp($host)->remove($path)); + } +} + +################ +#### vrmdir #### +################ +sub vrmdir { + my ($ref, $host, $path, $copts) = @_; + #TODO: directory does not exist + sftp_error($ref, "Directory not empty or permission denied") + if (!sftp($host)->rmdir($path)); +} + +############### +#### vtail #### +############### +sub vtail { + my ($ref, $host, $path, $copts) = @_; + my $n = (grep(/^\d+$/, keys %{$copts}))[0]; + $n = 10 if (!defined $n); + my $fh = sftp($host)->open($path); + if ($fh) { + my $attrs = sftp($host)->stat($path); + my ($seek, $block, $nl, $i, $line) = ($attrs->size, $n * 80, 0, 1); + do { + $seek -= $block * $i++; + $seek = 0 if ($seek < 0); + seek($fh, $seek, 0); + read($fh, $line, $block); + $nl++ while ($line =~ /\n/gs); + my $index = 0; + while ($nl > $n) { + $index = index($line, "\n", $index) + 1; + $nl--; + } + $seek += $index; + } while ($seek > 0 && $nl < $n); + my ($tmp_fh, $tmp) = sftp_tmp(); + seek($fh, $seek, 0); + print $tmp_fh $_ while (<$fh>); + close $tmp_fh; + close $fh; + sftp_cmd($ref, "cat", $tmp); + } else { + sftp_error($ref, sftp($host, 1)->error); + } +} + +############## +#### vtee #### +############## +sub vtee { + my ($ref, $copts) = @_; + # do not run original spliced command + $copts->{-argc} = 0; + my @fhs; + my $append = ($copts->{a} ? ">" : ""); + my $flags = SFTP_WRITE | SFTP_CREAT; + $flags |= SFTP_TRUNC if (!$copts->{a}); + foreach (@{$copts->{-argv}}) { + my $fh; + my ($host, $path) = hostpath($_); + if ($host ne 'localhost') { + $fh = sftp($host)->open($path, $flags); + seek($fh, 0, 2) if ($copts->{a}); + } else { + open($fh, "$append>", $_); + } + push(@fhs, $fh); + } +#TODO: tee hangs to remote file if input from another vfs command + while (my $line = <$ref>) { + print $_ $line foreach (@fhs); + } + close $_ foreach (@fhs); +} + +############### +#### vtest #### +############### +sub vtest { + my ($ref, $host, $path, $copts) = @_; + my $true = 0; + my $attrs = sftp($host)->stat($path); + # can't implement -x, -G, or -O w/o effective uid/gid + if ($attrs && ( + $copts->{b} && S_ISBLK($attrs->perm) || + $copts->{c} && S_ISCHR($attrs->perm) || + $copts->{d} && S_ISDIR($attrs->perm) || + $copts->{e} || + $copts->{f} && S_ISREG($attrs->perm) || + $copts->{g} && (S_ISGID & $attrs->perm) || + $copts->{h} && S_ISLNK($attrs->perm) || + $copts->{k} && (S_ISVTX & $attrs->perm) || + $copts->{p} && S_ISFIFO($attrs->perm) && !S_ISSOCK($attrs->perm) || + $copts->{s} && $attrs->size > 0 || + $copts->{u} && (S_ISUID & $attrs->perm) || +#TODO: this (maybe others) wrong because stat will never return a symlink + $copts->{L} && S_ISLNK($attrs->perm) || + $copts->{S} && S_ISSOCK($attrs->perm))) { + $true = 1; + } elsif ($attrs && $copts->{r}) { + my $fh = sftp($host)->open($path); + if ($fh) { + close $fh; + $true = 1; + } + } elsif ($attrs && $copts->{w}) { + my $fh = sftp($host)->open($path, SFTP_WRITE); + if ($fh) { + close $fh; + $true = 1; + } + } + sftp_cmd($ref, $true ? "true" : "false"); +} + +################ +#### vtouch #### +################ +sub vtouch { + my ($ref, $host, $path, $copts) = @_; + my $attrs = sftp($host)->stat($path); + if (!$attrs) { + my $fh = sftp($host)->open($path, SFTP_CREAT | SFTP_WRITE); + if (!$fh) { + sftp_error($ref, "Permission denied"); + } else { + close $fh; + } + } else { + my $time = time; + my $atime = ($copts->{a} || !$copts->{m} ? $time : $attrs->atime); + my $mtime = ($copts->{m} || !$copts->{a} ? $time : $attrs->mtime); + $attrs->set_amtime($atime, $mtime); + sftp_error($ref, "Permission denied") + if (!sftp($host)->setstat($path, $attrs)); + } +} + +# This chunk of stuff was generated by App::FatPacker. To find the original +# file's code, look for the end of this BEGIN block or the string 'FATPACK' +BEGIN { +my %fatpacked; + +$fatpacked{"File/Spec/Link.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_SPEC_LINK'; + package File::Spec::Link;use strict;use warnings;use File::Spec ();use base q(File::Spec);our$VERSION=0.073;sub canonpath {my($spec,$path)=@_;return$spec->SUPER::canonpath($path)if$path;require Carp;Carp::cluck("canonpath: ",defined$path ? "empty path" : "path undefined");return$path}sub catdir {my$spec=shift;return @_ ? $spec->SUPER::catdir(@_): $spec->curdir}sub linked {my$self=shift -> new(@_);return unless$self -> follow;return$self -> path}sub resolve {my$self=shift -> new(@_);return unless$self -> resolved;return$self -> path}sub resolve_all {my$self=shift -> new(@_);return $_[0]if ($_[0]=~ /^(?:file:|[a-z]+:\/\/)/);return unless$self -> resolvedir;return$self -> path .(($_[0]=~ /\/$/)? "/" : "")}sub relative_to_file {my($spec,$path)=splice @_,0,2;my$self=$spec -> new(@_);return unless$self -> relative($path);return$self -> path}sub chopfile {my$self=shift -> new(@_);return$self -> path if length($self -> chop);return}sub full_resolve {my($spec,$file)=@_;my$path=$spec->resolve_path($file);return defined$path ? $path : $spec->resolve_all($file)}sub resolve_path {my($spec,$file)=@_;my$path=do {local$SIG{__WARN__}=sub {if ($_[0]=~ /^opendir\b/ and $_[0]=~ /\bNot\s+a\s+directory\b/ and $Cwd::VERSION < 2.18 and not -d $file){warn <file_name_is_absolute($file)? $path : $spec->abs2rel($path)}sub splitlast {my$self=shift -> new(@_);my$last_path=$self -> chop;return ($self -> path,$last_path)}sub new {my$self=bless {},shift;$self -> split(shift)if @_;return$self}sub path {my$self=shift;return$self -> catpath($self->vol,$self->dir,q{})}sub canonical {my$self=shift;return$self -> canonpath($self -> path)}sub vol {my$vol=shift->{vol};return defined$vol ? $vol : q{}}sub dir {my$self=shift;return$self -> catdir($self -> dirs)}sub dirs {my$dirs=shift->{dirs};return$dirs ? @{$dirs}: ()}sub add {my($self,$file)=@_;if($file eq $self -> curdir){}elsif($file eq $self -> updir){$self -> pop}else {$self -> push($file)}return}sub pop {my$self=shift;my@dirs=$self -> dirs;if(not @dirs or $dirs[-1]eq $self -> updir){push @{$self->{dirs}},$self -> updir}elsif(length$dirs[-1]and $dirs[-1]ne $self -> curdir){CORE::pop @{$self->{dirs}}}else {require Carp;Carp::cluck("Can't go up from ",length$dirs[-1]? $dirs[-1]: "empty dir")}return}sub push {my$self=shift;my$file=shift;CORE::push @{$self->{dirs}},$file if length$file;return}sub split {my($self,$path)=@_;my($vol,$dir,$file)=$self->splitpath($path,1);$self->{vol}=$vol;$self->{dirs}=[$self->splitdir($dir)];$self->push($file);return}sub chop {my$self=shift;my$dirs=$self->{dirs};my$file='';while(@$dirs){last if @$dirs==1 and not length$dirs->[0];last if length($file=CORE::pop @$dirs)}return$file}sub follow {my$self=shift;my$path=$self -> path;my$link=readlink$self->path;return$self->relative($link)if defined$link;require Carp;Carp::confess("Can't readlink ",$self->path," : ",(-l $self->path ? "but it is" : "not")," a link")}sub relative {my($self,$path)=@_;unless($self->file_name_is_absolute($path)){return unless length($self->chop);$path=$self->catdir($self->path,$path)}$self->split($path);return 1}sub resolved {my$self=shift;my$seen=@_ ? shift : {};while(-l $self->path){return if$seen->{$self->canonical}++;return unless$self->follow}return 1}sub resolvedir {my$self=shift;my$seen=@_ ? shift : {};my@path;while(1){return unless$self->resolved($seen);my$last=$self->chop;last unless length$last;unshift@path,$last}$self->add($_)for@path;return 1}1; + Cwd::abs_path() only works on directories, not: $file + Use Cwd v2.18 or later + WARN +FILE_SPEC_LINK + +$fatpacked{"Net/SFTP/Foreign.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN'; + package Net::SFTP::Foreign;our$VERSION='1.81';use strict;use warnings;use warnings::register;use Carp qw(carp croak);use Symbol ();use Errno ();use Fcntl;use File::Spec ();BEGIN {if ($] >= 5.008){require Encode}else {require bytes;bytes->import();*Encode::encode=sub {$_[1]};*Encode::decode=sub {$_[1]};*utf8::downgrade=sub {1}}}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;BEGIN {$windows=$^O =~ /Win(?:32|64)/;if ($^O =~ /solaris/i){$dirty_cleanup=1 unless defined$dirty_cleanup}}my$thread_generation=1;sub CLONE {$thread_generation++}sub _deprecated {if (warnings::enabled('deprecated')and warnings::enabled(__PACKAGE__)){Carp::carp(join('',@_))}}sub _next_msg_id {shift->{_msg_id}++}use constant _empty_attributes=>Net::SFTP::Foreign::Attributes->new;sub _queue_new_msg {my$sftp=shift;my$code=shift;my$id=$sftp->_next_msg_id;my$msg=Net::SFTP::Foreign::Buffer->new(int8=>$code,int32=>$id,@_);$sftp->_queue_msg($msg);return$id}sub _queue_msg {my ($sftp,$buf)=@_;my$bytes=$buf->bytes;my$len=length$bytes;if ($debug and $debug & 1){$sftp->{_queued}++;_debug(sprintf("queueing msg len: %i, code:%i, id:%i ... [$sftp->{_queued}]",$len,unpack(CN=>$bytes)));$debug & 16 and _hexdump(pack('N',length($bytes)).$bytes)}$sftp->{_bout}.= pack('N',length($bytes));$sftp->{_bout}.= $bytes}sub _do_io {$_[0]->{_backend}->_do_io(@_)}sub _conn_lost {my ($sftp,$status,$err,@str)=@_;$debug and $debug & 32 and _debug("_conn_lost");$sftp->{_status}or $sftp->_set_status(defined$status ? $status : SSH2_FX_CONNECTION_LOST);$sftp->{_error}or $sftp->_set_error((defined$err ? $err : SFTP_ERR_CONNECTION_BROKEN),(@str ? @str : "Connection to remote server is broken"));undef$sftp->{_connected}}sub _conn_failed {my$sftp=shift;$sftp->_conn_lost(SSH2_FX_NO_CONNECTION,SFTP_ERR_CONNECTION_BROKEN,@_)unless$sftp->{_error}}sub _get_msg {my$sftp=shift;$debug and $debug & 1 and _debug("waiting for message... [$sftp->{_queued}]");unless ($sftp->_do_io($sftp->{_timeout})){$sftp->_conn_lost(undef,undef,"Connection to remote server stalled");return undef}my$bin=\$sftp->{_bin};my$len=unpack N=>substr($$bin,0,4,'');my$msg=Net::SFTP::Foreign::Buffer->make(substr($$bin,0,$len,''));if ($debug and $debug & 1){$sftp->{_queued}--;my ($code,$id,$status)=unpack(CNN=>$$msg);$id='-' if$code==SSH2_FXP_VERSION;$status='-' unless$code==SSH2_FXP_STATUS;_debug(sprintf("got it!, len:%i, code:%i, id:%s, status: %s",$len,$code,$id,$status));$debug & 8 and _hexdump($$msg)}return$msg}sub _croak_bad_options {if (@_){my$s=(@_ > 1 ? 's' : '');croak "Invalid option$s '" .CORE::join("', '",@_)."' or bad combination of options"}}sub _fs_encode {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,_error=>0,_status=>0 };bless$sftp,$class;if ($debug){_debug "This is Net::SFTP::Foreign $Net::SFTP::Foreign::VERSION";_debug "Loaded from $INC{'Net/SFTP/Foreign.pm'}";_debug "Running on Perl $^V for $^O";_debug "debug set to $debug";_debug "~0 is " .~0}$sftp->_clear_error_and_status;my$backend=delete$opts{backend};unless (ref$backend){$backend=($windows ? 'Windows' : 'Unix')unless (defined$backend);$backend =~ /^\w+$/ or croak "Bad backend name $backend";my$backend_class="Net::SFTP::Foreign::Backend::$backend";eval "require $backend_class; 1" or croak "Unable to load backend $backend: $@";$backend=$backend_class->_new($sftp,\%opts)}$sftp->{_backend}=$backend;if ($debug){my$class=ref($backend)|| $backend;no strict 'refs';my$version=${$class .'::VERSION'}|| 0;_debug "Using backend $class $version"}my%defs=$backend->_defaults;$sftp->{_autodie}=delete$opts{autodie};$sftp->{_block_size}=delete$opts{block_size}|| $defs{block_size}|| 32*1024;$sftp->{_min_block_size}=delete$opts{min_block_size}|| $defs{min_block_size}|| 512;$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->{_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 $]"}else {$sftp->{_fs_encoding}='utf8'}$sftp->autodisconnect(delete$opts{autodisconnect});$backend->_init_transport($sftp,\%opts);%opts and _croak_bad_options(keys%opts);$sftp->_init unless$sftp->{_error};$backend->_after_init($sftp);$sftp}sub autodisconnect {my ($sftp,$ad)=@_;if (not defined$ad or $ad==2){$debug and $debug & 4 and _debug "setting disconnecting pid to $$ and thread to $thread_generation";$sftp->{_disconnect_by_pid}=$$;$sftp->{_disconnect_by_thread}=$thread_generation}else {delete$sftp->{_disconnect_by_thread};if ($ad==0){$sftp->{_disconnect_by_pid}=-1}elsif ($ad==1){delete$sftp->{_disconnect_by_pid}}else {croak "bad value '$ad' for autodisconnect"}}1}sub disconnect {my$sftp=shift;my$pid=delete$sftp->{pid};$debug and $debug & 4 and _debug("$sftp->disconnect called (ssh pid: ".($pid||'').")");local$sftp->{_autodie};$sftp->_conn_lost;if (defined$pid){close$sftp->{ssh_out}if (defined$sftp->{ssh_out}and not $sftp->{_ssh_out_is_not_dupped});close$sftp->{ssh_in}if defined$sftp->{ssh_in};if ($windows){kill KILL=>$pid and waitpid($pid,0);$debug and $debug & 4 and _debug "process $pid reaped"}else {my$dirty=(defined$sftp->{_dirty_cleanup}? $sftp->{_dirty_cleanup}: $dirty_cleanup);if ($dirty or not defined$dirty){$debug and $debug & 4 and _debug("starting dirty cleanup of process $pid");for my$sig (($dirty ? (): 0),qw(TERM TERM KILL KILL)){$debug and $debug & 4 and _debug("killing process $pid with signal $sig");$sig and kill$sig,$pid;local ($@,$SIG{__DIE__},$SIG{__WARN__});my$wpr;eval {local$SIG{ALRM}=sub {die "timeout\n"};alarm 8;$wpr=waitpid($pid,0);alarm 0};$debug and $debug & 4 and _debug("waitpid returned " .(defined$wpr ? $wpr : ''));if ($wpr){last if$wpr > 0 or $!==Errno::ECHILD()}}}else {while (1){last if waitpid($pid,0)> 0;if ($!!=Errno::EINTR){warn "internal error: unexpected error in waitpid($pid): $!" if $!!=Errno::ECHILD;last}}}$debug and $debug & 4 and _debug "process $pid reaped"}}close$sftp->{_pty}if defined$sftp->{_pty};1}sub DESTROY {local ($?,$!,$@);my$sftp=shift;my$dbpid=$sftp->{_disconnect_by_pid};my$dbthread=$sftp->{_disconnect_by_thread};$debug and $debug & 4 and _debug("$sftp->DESTROY called (current pid: $$, disconnect_by_pid: " .($dbpid || '')."), current thread generation: $thread_generation, disconnect_by_thread: " .($dbthread || '').")");if (!defined$dbpid or ($dbpid==$$ and $dbthread==$thread_generation)){$sftp->disconnect}else {$debug and $debug & 4 and _debug "skipping disconnection because pid and/or thread generation don't match"}}sub _init {my$sftp=shift;$sftp->_queue_msg(Net::SFTP::Foreign::Buffer->new(int8=>SSH2_FXP_INIT,int32=>SSH2_FILEXFER_VERSION));if (my$msg=$sftp->_get_msg){my$type=$msg->get_int8;if ($type==SSH2_FXP_VERSION){my$version=$msg->get_int32;$sftp->{server_version}=$version;$sftp->{server_extensions}={};while (length $$msg){my$key=$msg->get_str;my$value=$msg->get_str;$sftp->{server_extensions}{$key}=$value;if ($key eq 'vendor-id'){my$vid=Net::SFTP::Foreign::Buffer->make("$value");$sftp->{_ext__vendor_id}=[Encode::decode(utf8=>$vid->get_str),Encode::decode(utf8=>$vid->get_str),Encode::decode(utf8=>$vid->get_str),$vid->get_int64 ]}elsif ($key eq 'supported2'){my$s2=Net::SFTP::Foreign::Buffer->make("$value");$sftp->{_ext__supported2}=[$s2->get_int32,$s2->get_int32,$s2->get_int32,$s2->get_int32,$s2->get_int32,$s2->get_int16,$s2->get_int16,[map Encode::decode(utf8=>$_),$s2->get_str_list],[map Encode::decode(utf8=>$_),$s2->get_str_list]]}}return$version}$sftp->_conn_lost(SSH2_FX_BAD_MESSAGE,SFTP_ERR_REMOTE_BAD_MESSAGE,"bad packet type, expecting SSH2_FXP_VERSION, got $type")}elsif ($sftp->{_status}==SSH2_FX_CONNECTION_LOST and $sftp->{_password_authentication}and $sftp->{_password_sent}){$sftp->_set_error(SFTP_ERR_PASSWORD_AUTHENTICATION_FAILED,"Password authentication failed or connection lost")}return undef}sub server_extensions {%{shift->{server_extensions}}}sub _check_extension {my ($sftp,$name,$version,$error,$errstr)=@_;my$ext=$sftp->{server_extensions}{$name};return 1 if (defined$ext and $ext==$version);$sftp->_set_status(SSH2_FX_OP_UNSUPPORTED);$sftp->_set_error($error,"$errstr: extended operation not supported by server");return undef}sub _get_msg_and_check {my ($sftp,$etype,$eid,$err,$errstr)=@_;my$msg=$sftp->_get_msg;if ($msg){my$type=$msg->get_int8;my$id=$msg->get_int32;$sftp->_clear_error_and_status;if ($id!=$eid){$sftp->_conn_lost(SSH2_FX_BAD_MESSAGE,SFTP_ERR_REMOTE_BAD_MESSAGE,$errstr,"bad packet sequence, expected $eid, got $id");return undef}if ($type!=$etype){if ($type==SSH2_FXP_STATUS){my$code=$msg->get_int32;my$str=Encode::decode(utf8=>$msg->get_str);my$status=$sftp->_set_status($code,(defined$str ? $str : ()));$sftp->_set_error($err,$errstr,$status)}else {$sftp->_conn_lost(SSH2_FX_BAD_MESSAGE,SFTP_ERR_REMOTE_BAD_MESSAGE,$errstr,"bad packet type, expected $etype packet, got $type")}return undef}}$msg}sub _get_handle {my ($sftp,$eid,$error,$errstr)=@_;if (my$msg=$sftp->_get_msg_and_check(SSH2_FXP_HANDLE,$eid,$error,$errstr)){return$msg->get_str}return undef}sub _rid {my ($sftp,$rfh)=@_;my$rid=$rfh->_rid;unless (defined$rid){$sftp->_set_error(SFTP_ERR_REMOTE_ACCESING_CLOSED_FILE,"Couldn't access a file that has been previosly closed")}$rid}sub _rfid {$_[1]->_check_is_file;&_rid}sub _rdid {$_[1]->_check_is_dir;&_rid}sub _queue_rid_request {my ($sftp,$code,$fh,$attrs)=@_;my$rid=$sftp->_rid($fh);return undef unless defined$rid;$sftp->_queue_new_msg($code,str=>$rid,(defined$attrs ? (attr=>$attrs): ()))}sub _queue_rfid_request {$_[2]->_check_is_file;&_queue_rid_request}sub _queue_rdid_request {$_[2]->_check_is_dir;&_queue_rid_request}sub _queue_str_request {my($sftp,$code,$str,$attrs)=@_;$sftp->_queue_new_msg($code,str=>$str,(defined$attrs ? (attr=>$attrs): ()))}sub _check_status_ok {my ($sftp,$eid,$error,$errstr)=@_;if (defined$eid){if (my$msg=$sftp->_get_msg_and_check(SSH2_FXP_STATUS,$eid,$error,$errstr)){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)}return$sftp->{cwd}=$cwd}else {delete$sftp->{cwd};return$sftp->cwd if defined wantarray}}sub cwd {@_==1 or croak 'Usage: $sftp->cwd()';my$sftp=shift;return defined$sftp->{cwd}? $sftp->{cwd}: $sftp->realpath('')}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,SFTP_ERR_REMOTE_OPEN_FAILED,"Couldn't open remote file '$path'");if ($debug and $debug & 2){if (defined$rid){_debug("new remote file '$path' open, rid:");_hexdump($rid)}else {_debug("open failed: $sftp->{_status}")}}defined$rid or return undef;my$fh=Net::SFTP::Foreign::FileHandle->_new_from_rid($sftp,$rid);$fh->_flag(append=>1)if ($flags & SSH2_FXF_APPEND);$fh}sub _open_mkpath {my ($sftp,$filename,$mkpath,$flags,$attrs)=@_;$flags=($flags || 0)| SSH2_FXF_WRITE|SSH2_FXF_CREAT;my$fh=do {local$sftp->{_autodie};$sftp->open($filename,$flags,$attrs)};unless ($fh){if ($mkpath and $sftp->status==SSH2_FX_NO_SUCH_FILE){my$da=$attrs->clone;$da->set_perm(($da->perm || 0)| 0700);$sftp->mkpath($filename,$da,1)or return;$fh=$sftp->open($filename,$flags,$attrs)}else {$sftp->_ok_or_autodie}}$fh}sub opendir {@_==2 or croak 'Usage: $sftp->opendir($path)';${^TAINT} and &_catch_tainted_args;my$sftp=shift;my$path=shift;$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){_debug("new remote dir '$path' open, rid:");_hexdump($rid)}defined$rid or return undef;Net::SFTP::Foreign::DirHandle->_new_from_rid($sftp,$rid,0)}sub sftpread {(@_ >= 3 and @_ <= 4)or croak 'Usage: $sftp->sftpread($fh, $offset [, $size])';my ($sftp,$rfh,$offset,$size)=@_;unless ($size){return '' if defined$size;$size=$sftp->{_block_size}}my$rfid=$sftp->_rfid($rfh);defined$rfid or return undef;my$id=$sftp->_queue_new_msg(SSH2_FXP_READ,str=>$rfid,int64=>$offset,int32=>$size);if (my$msg=$sftp->_get_msg_and_check(SSH2_FXP_DATA,$id,SFTP_ERR_REMOTE_READ_FAILED,"Couldn't read from remote file")){return$msg->get_str}return undef}sub sftpwrite {@_==4 or croak 'Usage: $sftp->sftpwrite($fh, $offset, $data)';my ($sftp,$rfh,$offset)=@_;my$rfid=$sftp->_rfid($rfh);defined$rfid or return undef;utf8::downgrade($_[3],1)or croak "wide characters found in data";my$id=$sftp->_queue_new_msg(SSH2_FXP_WRITE,str=>$rfid,int64=>$offset,str=>$_[3]);if ($sftp->_check_status_ok($id,SFTP_ERR_REMOTE_WRITE_FAILED,"Couldn't write to remote file")){return 1}return undef}sub seek {(@_ >= 3 and @_ <= 4)or croak 'Usage: $sftp->seek($fh, $pos [, $whence])';my ($sftp,$rfh,$pos,$whence)=@_;$sftp->flush($rfh)or return undef;if (!$whence){$rfh->_pos($pos)}elsif ($whence==1){$rfh->_inc_pos($pos)}elsif ($whence==2){my$a=$sftp->stat($rfh)or return undef;$rfh->_pos($pos + $a->size)}else {croak "invalid value for whence argument ('$whence')"}1}sub tell {@_==2 or croak 'Usage: $sftp->tell($fh)';my ($sftp,$rfh)=@_;return$rfh->_pos + length ${$rfh->_bout}}sub eof {@_==2 or croak 'Usage: $sftp->eof($fh)';my ($sftp,$rfh)=@_;$sftp->_fill_read_cache($rfh,1);return length(${$rfh->_bin})==0}sub _write {my ($sftp,$rfh,$off,$cb)=@_;$sftp->_clear_error_and_status;my$rfid=$sftp->_rfid($rfh);defined$rfid or return undef;my$qsize=$sftp->{_queue_size};my@msgid;my@written;my$written=0;my$end;while (!$end or @msgid){while (!$end and @msgid < $qsize){my$data=$cb->();if (defined$data and length$data){my$id=$sftp->_queue_new_msg(SSH2_FXP_WRITE,str=>$rfid,int64=>$off + $written,str=>$data);push@written,$written;$written += length$data;push@msgid,$id}else {$end=1}}my$eid=shift@msgid;my$last=shift@written;unless ($sftp->_check_status_ok($eid,SFTP_ERR_REMOTE_WRITE_FAILED,"Couldn't write to remote file")){$sftp->_get_msg for@msgid;return$last}}return$written}sub write {@_==3 or croak 'Usage: $sftp->write($fh, $data)';my ($sftp,$rfh)=@_;$sftp->flush($rfh,'in')or return undef;utf8::downgrade($_[2],1)or croak "wide characters found in data";my$datalen=length $_[2];my$bout=$rfh->_bout;$$bout .= $_[2];my$len=length $$bout;$sftp->flush($rfh,'out')if ($len >= $sftp->{_write_delay}or ($len and $sftp->{_autoflush}));return$datalen}sub flush {(@_ >= 2 and @_ <= 3)or croak 'Usage: $sftp->flush($fh [, $direction])';my ($sftp,$rfh,$dir)=@_;$dir ||='';defined$sftp->_rfid($rfh)or return;if ($dir ne 'out'){${$rfh->_bin}=''}if ($dir ne 'in'){my$bout=$rfh->_bout;my$len=length $$bout;if ($len){my$start;my$append=$rfh->_flag('append');if ($append){my$attr=$sftp->stat($rfh)or return undef;$start=$attr->size}else {$start=$rfh->_pos;${$rfh->_bin}=''}my$off=0;my$written=$sftp->_write($rfh,$start,sub {my$data=substr($$bout,$off,$sftp->{_block_size});$off += length$data;$data});$rfh->_inc_pos($written)unless$append;substr($$bout,0,$written,'');$written==$len or return undef}}1}sub _fill_read_cache {my ($sftp,$rfh,$len)=@_;$sftp->_clear_error_and_status;$sftp->flush($rfh,'out')or return undef;my$rfid=$sftp->_rfid($rfh);defined$rfid or return undef;my$bin=$rfh->_bin;if (defined$len){return 1 if ($len < length $$bin);my$read_ahead=$sftp->{_read_ahead};$len=length($$bin)+ $read_ahead if$len - length($$bin)< $read_ahead}my$pos=$rfh->_pos;my$qsize=$sftp->{_queue_size};my$bsize=$sftp->{_block_size};my@msgid;my$askoff=length $$bin;my$eof;while (!defined$len or length $$bin < $len){while ((!defined$len or $askoff < $len)and @msgid < $qsize){my$id=$sftp->_queue_new_msg(SSH2_FXP_READ,str=>$rfid,int64=>$pos + $askoff,int32=>$bsize);push@msgid,$id;$askoff += $bsize}my$eid=shift@msgid;my$msg=$sftp->_get_msg_and_check(SSH2_FXP_DATA,$eid,SFTP_ERR_REMOTE_READ_FAILED,"Couldn't read from remote file")or last;my$data=$msg->get_str;$$bin .= $data;if (length$data < $bsize){unless (defined$len){$eof=$sftp->_queue_new_msg(SSH2_FXP_READ,str=>$rfid,int64=>$pos + length $$bin,int32=>1)}last}}$sftp->_get_msg for@msgid;if ($eof){$sftp->_get_msg_and_check(SSH2_FXP_DATA,$eof,SFTP_ERR_REMOTE_BLOCK_TOO_SMALL,"received block was too small")}if ($sftp->{_status}==SSH2_FX_EOF and length $$bin){$sftp->_clear_error_and_status}return$sftp->{_error}? undef : length $$bin}sub read {@_==3 or croak 'Usage: $sftp->read($fh, $len)';my ($sftp,$rfh,$len)=@_;if ($sftp->_fill_read_cache($rfh,$len)){my$bin=$rfh->_bin;my$data=substr($$bin,0,$len,'');$rfh->_inc_pos(length$data);return$data}return undef}sub _readline {my ($sftp,$rfh,$sep)=@_;$sep="\n" if @_ < 3;my$sl=length$sep;my$bin=$rfh->_bin;my$last=0;while(1){my$ix=index $$bin,$sep,$last + 1 - $sl ;if ($ix >= 0){$ix += $sl;$rfh->_inc_pos($ix);return substr($$bin,0,$ix,'')}$last=length $$bin;$sftp->_fill_read_cache($rfh,length($$bin)+ 1);unless (length $$bin > $last){$sftp->{_error}and return undef;my$line=$$bin;$rfh->_inc_pos(length$line);$$bin='';return$line}}}sub readline {(@_ >= 2 and @_ <= 3)or croak 'Usage: $sftp->readline($fh [, $sep])';my ($sftp,$rfh,$sep)=@_;$sep="\n" if @_ < 3;if (!defined$sep or $sep eq ''){$sftp->_fill_read_cache($rfh);$sftp->{_error}and return undef;my$bin=$rfh->_bin;my$line=$$bin;$rfh->_inc_pos(length$line);$$bin='';return$line}if (wantarray){my@lines;while (defined (my$line=$sftp->_readline($rfh,$sep))){push@lines,$line}return@lines}return$sftp->_readline($rfh,$sep)}sub getc {@_==2 or croak 'Usage: $sftp->getc($fh)';my ($sftp,$rfh)=@_;$sftp->_fill_read_cache($rfh,1);my$bin=$rfh->_bin;if (length$bin){$rfh->_inc_pos(1);return substr $$bin,0,1,''}return undef}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}return undef}sub fstat {_deprecated "fstat is deprecated and will be removed on the upcoming 2.xx series, " ."stat method accepts now both file handlers and paths";goto&stat}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}_gen_remove_method(remove=>SSH2_FXP_REMOVE,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");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")}sub join {my$sftp=shift;my$a='.';while (@_){my$b=shift;if (defined$b){$b =~ s|^(?:\./+)+||;if (length$b and $b ne '.'){if ($b !~ m|^/| and $a ne '.'){$a=($a =~ m|/$| ? "$a$b" : "$a/$b")}else {$a=$b}$a =~ s|(?:/+\.)+/?$|/|;$a =~ s|(?<=[^/])/+$||;$a='.' unless length$a}}}$a}sub _rel2abs {my ($sftp,$path)=@_;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;$path =~ s{^(/*)}{};my$start=$1;$path =~ s{/+$}{};my@path;while (1){if ($first){$first=0}else {$path =~ s{/*[^/]*$}{}}my$p="$start$path";$debug and $debug & 8192 and _debug "checking $p";if ($sftp->test_d($p)){$debug and $debug & 8192 and _debug "$p is a dir";last}unless (length$path){$sftp->_set_error(SFTP_ERR_REMOTE_MKDIR_FAILED,"Unable to make path, bad root");return undef}unshift@path,$p}for my$p (@path){$debug and $debug & 8192 and _debug "mkdir $p";if ($p =~ m{^(?:.*/)?\.{1,2}$} or $p =~ m{/$}){$debug and $debug & 8192 and _debug "$p is a symbolic dir, skipping";unless ($sftp->test_d($p)){$debug and $debug & 8192 and _debug "symbolic dir $p can not be checked";$sftp->{_error}or $sftp->_set_error(SFTP_ERR_REMOTE_MKDIR_FAILED,"Unable to make path, bad name");return undef}}else {$sftp->mkdir($p,$attrs)or return undef}}1}sub _mkpath_local {my ($sftp,$path,$perm,$parent)=@_;my@parts=File::Spec->splitdir($path);my@tail;if ($debug and $debug & 32768){my$target=File::Spec->join(@parts);_debug "_mkpath_local('$target')"}if ($parent){pop@parts while@parts and not length$parts[-1];@parts or goto top_dir_reached;pop@parts}while (1){my$target=File::Spec->join(@parts);$target='' unless defined$target;if (-e $target){if (-d $target){while (@tail){$target=File::Spec->join($target,shift(@tail));$debug and $debug and 32768 and _debug "creating local directory $target";unless (CORE::mkdir$target,$perm){unless (do {local $!;-d $target}){$sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED,"mkdir '$target' failed",$!);return}}}return 1}else {$sftp->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT,"Local file '$target' is not a directory");return}}@parts or last;unshift@tail,pop@parts}top_dir_reached: $sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED,"mkpath failed, top dir reached");return}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")}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)=@_;$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);if (my$msg=$sftp->_get_msg_and_check(SSH2_FXP_NAME,$id,SFTP_ERR_REMOTE_READDIR_FAILED,"Couldn't read remote directory")){my$count=$msg->get_int32 or last;for (1..$count){push @$cache,{filename=>$sftp->_fs_decode($msg->get_str),longname=>$sftp->_fs_decode($msg->get_str),a=>$msg->get_attributes }}}else {$sftp->_set_error if$sftp->{_status}==SSH2_FX_EOF;last}}if (wantarray){my$old=$cache;$cache=[];return @$old}shift @$cache}sub _readdir {my ($sftp,$rdh);if (wantarray){my$line=$sftp->readdir($rdh);if (defined$line){return$line->{filename}}}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);$sftp->_set_error($error,"Couldn't get $name for remote '$path', no names on reply")}return undef}}*realpath=_gen_getpath_method(SSH2_FXP_REALPATH,SFTP_ERR_REMOTE_REALPATH_FAILED,"realpath");*readlink=_gen_getpath_method(SSH2_FXP_READLINK,SFTP_ERR_REMOTE_READLINK_FAILED,"link target");sub _rename {my ($sftp,$old,$new)=@_;$old=$sftp->_rel2abs($old);$new=$sftp->_rel2abs($new);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){$sftp->atomic_rename($old,$new)and return 1;$sftp->{_status}!=SSH2_FX_OP_UNSUPPORTED and return undef}for (1){local$sftp->{_autodie};if (!$sftp->_rename($old,$new)and $sftp->{_status}==SSH2_FX_FAILURE){if ($numbered and $sftp->test_e($new)){_inc_numbered($new);redo}elsif ($overwrite){my$rp_old=$sftp->realpath($old);my$rp_new=$sftp->realpath($new);if (defined$rp_old and defined$rp_new and $rp_old eq $rp_new){$sftp->_clear_error_and_status}elsif ($sftp->remove($new)){$overwrite=0;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);my$id=$sftp->_queue_new_msg(SSH2_FXP_EXTENDED,str=>'posix-rename@openssh.com',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 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);my$id=$sftp->_queue_new_msg(SSH2_FXP_EXTENDED,str=>'hardlink@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 {my$method=shift;sub {my$sftp=shift;local ($sftp->{_error},$sftp->{_status})if$sftp->{_error};$sftp->$method(@_)}}*_close_save_status=_gen_save_status_method('close');*_closedir_save_status=_gen_save_status_method('closedir');*_remove_save_status=_gen_save_status_method('remove');sub _inc_numbered {$_[0]=~ s{^(.*)\((\d+)\)((?:\.[^\.]*)?)$}{"$1(" . ($2+1) . ")$3"}e or $_[0]=~ s{((?:\.[^\.]*)?)$}{(1)$1};$debug and $debug & 128 and _debug("numbering to: $_[0]")}sub abort {my$sftp=shift;$sftp->_set_error(SFTP_ERR_ABORTED,($@ ? $_[0]: "Aborted"))}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'));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'};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$dont_save=delete$opts{dont_save};my$conversion=delete$opts{conversion};my$numbered=delete$opts{numbered};my$cleanup=delete$opts{cleanup};my$atomic=delete$opts{atomic};my$best_effort=delete$opts{best_effort};my$mkpath=delete$opts{mkpath};croak "'perm' and 'copy_perm' options can not be used simultaneously" if (defined$perm and defined$copy_perm);croak "'resume' and 'append' options can not be used simultaneously" if ($resume and $append);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));if ($local_is_fh){my$append='option can not be used when target is a file handle';$resume and croak "'resume' $append";$overwrite and croak "'overwrite' $append";$numbered and croak "'numbered' $append";$dont_save and croak "'dont_save' $append";$atomic and croak "'croak' $append"}%opts and _croak_bad_options(keys%opts);if ($resume and $conversion){carp "resume option is useless when data conversion has also been requested";undef$resume}$overwrite=1 unless (defined$overwrite or $local_is_fh 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);$mkpath=1 unless defined$mkpath;$cleanup=($atomic || $numbered)unless defined$cleanup;my$a=do {local$sftp->{_autodie};$sftp->stat($remote)};my ($rperm,$size,$atime,$mtime)=($a ? ($a->perm,$a->size,$a->atime,$a->mtime): ());$size=-1 unless defined$size;if ($copy_time and not defined$atime){if ($best_effort){undef$copy_time}else {$sftp->_ok_or_autodie and $sftp->_set_error(SFTP_ERR_REMOTE_STAT_FAILED,"Not enough information on stat, amtime not included");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){$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}}}$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,1)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 {local$sftp->{_autodie};while (1){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");last}$loff += $len;unless ($safe_block_size){if ($len > $sftp->{_min_block_size}){$sftp->{min_block_size}=$len;if ($len < $block_size){$block_size=$len;$askoff=$loff}}$safe_block_size=1}my$adjustment_before=$adjustment;$adjustment += $converter->($data)if$converter;if (length($data)and defined$cb){local $\;$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);goto CLEANUP if$sftp->{_error};if ($converter){my$data='';my$adjustment_before=$adjustment;$adjustment += $converter->($data);if (length($data)and defined$cb){local $\;$cb->($sftp,$data,$askoff + $adjustment_before,$size + $adjustment);goto CLEANUP 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",$!);goto CLEANUP}}}if (defined$cb){my$data='';do {local $\;$cb->($sftp,$data,$askoff + $adjustment,$size + $adjustment)};return undef 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",$!);goto CLEANUP}}}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}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){if (!$overwrite){while (1){if (link$local,$atomic_local){unlink$local;last}my$err=$!;unless (-e $atomic_local){if (sysopen my$lock,$atomic_local,Fcntl::O_CREAT|Fcntl::O_EXCL|Fcntl::O_WRONLY,0600){$atomic_cleanup=1;goto OVERWRITE}$err=$!;unless (-e $atomic_local){$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,"Can't open $local",$err);goto CLEANUP}}unless ($numbered){$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,"local file $atomic_local already exists");goto CLEANUP}_inc_numbered($atomic_local)}}else {OVERWRITE: unless (CORE::rename$local,$atomic_local){$sftp->_set_error(SFTP_ERR_LOCAL_RENAME_FAILED,"Unable to rename temporal file to its final position '$atomic_local'",$!);goto CLEANUP}}$$atomic_numbered=$local if ref$atomic_numbered}}CLEANUP: if ($cleanup and $sftp->{_error}){unlink$local;unlink$atomic_local if$atomic_cleanup}};$sftp->_ok_or_autodie}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]}$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}else {unless (CORE::open$fh,'<',$local){$sftp->_set_error(SFTP_ERR_LOCAL_OPEN_FAILED,"Unable to open local file '$local'",$!);return undef}binmode$fh}{local ($@,$SIG{__DIE__},$SIG{__WARN__});if ((undef,undef,$lmode,undef,undef,undef,undef,$lsize,$latime,$lmtime)=eval {no warnings;CORE::stat$fh}){$debug and $debug & 16384 and _debug "local file size is " .(defined$lsize ? $lsize : '');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"}}else {if ($append){$sftp->{_status}==SSH2_FX_NO_SUCH_FILE or $sftp->_ok_or_autodie or return undef;undef$append}$sftp->_clear_error_and_status}}my ($atomic_numbered,$atomic_remote);if ($writeoff){if ($resume){$debug and $debug & 16384 and _debug "resuming file transfer from $writeoff";if ($converter){my$off=0;my$eof_t;while (1){my$len=length$converted_input;my$delta=$writeoff - $off;if ($delta <= $len){$debug and $debug & 16384 and _debug "discarding $delta converted bytes";substr$converted_input,0,$delta,'';last}else {$off += $len;if ($eof_t){$sftp->_set_error(SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL,"Couldn't resume transfer, remote file is bigger than local");return undef}my$read=CORE::read($fh,$converted_input,$block_size * 4);unless (defined$read){$sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,"Couldn't read from local file '$local' to the resume point $writeoff",$!);return undef}$lsize += $converter->($converted_input)if defined$lsize;utf8::downgrade($converted_input,1)or croak "converter introduced wide characters in data";$read or $eof_t=1}}}elsif ($local_is_fh){my$off=$writeoff;while ($off){my$read=CORE::read($fh,my($buf),($off < 16384 ? $off : 16384));if ($read){$debug and $debug & 16384 and _debug "discarding $read bytes";$off -= $read}else {$sftp->_set_error(defined$read ? (SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL,"Couldn't resume transfer, remote file is bigger than local"): (SFTP_ERR_LOCAL_READ_ERROR,"Couldn't read from local file handler '$local' to the resume point $writeoff",$!))}}}else {if (defined$lsize and $writeoff > $lsize){$sftp->_set_error(SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL,"Couldn't resume transfer, remote file is bigger than local");return undef}unless (CORE::seek($fh,$writeoff,0)){$sftp->_set_error(SFTP_ERR_LOCAL_SEEK_FAILED,"seek operation on local file failed: $!");return undef}}if (defined$lsize and $writeoff==$lsize){if (defined$perm and $rattrs->perm!=$perm){return$sftp->_best_effort($best_effort,setstat=>$remote,$attrs)}return 1}}$rfh=$sftp->open($remote,SSH2_FXF_WRITE)or return undef}else {if ($atomic){if (!($numbered or $overwrite)and $sftp->test_e($remote)){$sftp->_set_status(SSH2_FX_FAILURE);$sftp->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS,"Remote file '$remote' already exists");return undef}$atomic_remote=$remote;$remote .= sprintf("(%d).tmp",rand(10000));$atomic_numbered=$numbered;$numbered=1;$debug and $debug & 128 and _debug("temporal remote file name: $remote")}local$sftp->{_autodie};if ($numbered){while (1){$rfh=$sftp->_open_mkpath($remote,$mkpath,SSH2_FXF_WRITE | SSH2_FXF_CREAT | SSH2_FXF_EXCL,$attrs);last if ($rfh or $sftp->{_status}!=SSH2_FX_FAILURE or !$sftp->test_e($remote));_inc_numbered($remote)}$$numbered=$remote if$rfh and ref$numbered}else {for my$rep (0,1){$rfh=$sftp->_open_mkpath($remote,$mkpath,SSH2_FXF_WRITE | SSH2_FXF_CREAT | ($overwrite ? SSH2_FXF_TRUNC : SSH2_FXF_EXCL),$attrs);last if$rfh or $rep or!$overwrite or $sftp->{_status}!=SSH2_FX_PERMISSION_DENIED;$debug and $debug & 2 and _debug("retrying open after removing remote file");local ($sftp->{_status},$sftp->{_error});$sftp->remove($remote)}}}$sftp->_ok_or_autodie or return undef;my$last_block_was_zeros;do {local$sftp->{autodie};if (defined$perm and!$late_set_perm){$sftp->_best_effort($best_effort,setstat=>$rfh,$attrs)or goto CLEANUP}my$rfid=$sftp->_rfid($rfh);defined$rfid or die "internal error: rfid is undef";$lsize += $writeoff if ($append or not defined$lsize);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){$sftp->_set_error(SFTP_ERR_LOCAL_READ_ERROR,"Couldn't read from local file '$local'",$!);last OK}$eof_t=1}$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=1}}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){if ($sparse and $data =~ /^\x{00}*$/s){$last_block_was_zeros=1;$debug and $debug & 16384 and _debug "skipping zeros block at offset $writeoff, length $len"}else {$debug and $debug & 16384 and _debug "writing block at offset $writeoff, length $len";my$id=$sftp->_queue_new_msg(SSH2_FXP_WRITE,str=>$rfid,int64=>$writeoff,str=>$data);push@msgid,$id;$last_block_was_zeros=0}$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}}CORE::close$fh unless$local_is_fh;$sftp->_get_msg for (@msgid);$sftp->truncate($rfh,$writeoff)if$last_block_was_zeros and not $sftp->{_error};$sftp->_close_save_status($rfh);goto CLEANUP if$sftp->{_error};if ($copy_time or ($late_set_perm and defined$perm)){$attrs->set_perm unless$late_set_perm and defined$perm;$attrs->set_amtime($latime,$lmtime)if$copy_time;$sftp->_best_effort($best_effort,setstat=>$remote,$attrs)or goto CLEANUP}if ($atomic){$sftp->rename($remote,$atomic_remote,overwrite=>$overwrite,numbered=>$atomic_numbered)or goto CLEANUP}CLEANUP: 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,%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};my$queue_size=delete$opts{queue_size};my$cheap=($names_only and!$realpath);my ($cheap_wanted,$wanted);if ($cheap and ref$opts{wanted}eq 'RegExp' and not defined$opts{no_wanted}){$cheap_wanted=delete$opts{wanted}}else {$wanted=(delete$opts{_wanted}|| _gen_wanted(delete$opts{wanted},delete$opts{no_wanted}));undef$cheap if defined$wanted}%opts and _croak_bad_options(keys%opts);my$delayed_wanted=($atomic_readdir and $wanted);$queue_size=1 if ($follow_links or $realpath or ($wanted and not $delayed_wanted));my$max_queue_size=$queue_size || $sftp->{_queue_size};$queue_size ||=2;$dir='.' unless defined$dir;$dir=$sftp->_rel2abs($dir);my$rdh=$sftp->opendir($dir);return unless defined$rdh;my$rdid=$sftp->_rdid($rdh);defined$rdid or return undef;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=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}? $_->{realpath}: $_->{filename}}@dir if$names_only}if ($ordered){if ($names_only){@dir=sort@dir}else {_sort_entries \@dir}}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);my$count=0;my@dirs;$sftp->find($dirs,on_error=>$on_error,atomic_readdir=>1,wanted=>sub {my$e=$_[1];my$fn=$e->{filename};if (_is_dir($e->{a}->perm)){push@dirs,$e}else {if (!$wanted or $wanted->($sftp,$e)){if ($sftp->remove($fn)){$count++}else {$sftp->_call_on_error($on_error,$e)}}}});_sort_entries(\@dirs);while (@dirs){my$e=pop@dirs;if (!$wanted or $wanted->($sftp,$e)){if ($sftp->rmdir($e->{filename})){$count++}else {$sftp->_call_on_error($on_error,$e)}}}return$count}sub get_symlink {@_ >= 3 or croak 'Usage: $sftp->get_symlink($remote, $local, %opts)';my ($sftp,$remote,$local,%opts)=@_;my$overwrite=delete$opts{overwrite};my$numbered=delete$opts{numbered};croak "'overwrite' and 'numbered' can not be used together" if ($overwrite and $numbered);%opts and _croak_bad_options(keys%opts);$overwrite=1 unless (defined$overwrite or $numbered);my$a=$sftp->lstat($remote)or return undef;unless (_is_lnk($a->perm)){$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,"Remote object '$remote' is not a symlink");return undef}my$link=$sftp->readlink($remote)or return undef;if ($numbered){_inc_numbered($local)while -e $local}elsif (-e $local){if ($overwrite){unlink$local}else {$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,"local file $local already exists");return undef}}unless (eval {CORE::symlink$link,$local}){$sftp->_set_error(SFTP_ERR_LOCAL_SYMLINK_FAILED,"creation of symlink '$local' failed",$!);return undef}$$numbered=$local if ref$numbered;1}sub put_symlink {@_ >= 3 or croak 'Usage: $sftp->put_symlink($local, $remote, %opts)';my ($sftp,$local,$remote,%opts)=@_;my$overwrite=delete$opts{overwrite};my$numbered=delete$opts{numbered};croak "'overwrite' and 'numbered' can not be used together" if ($overwrite and $numbered);%opts and _croak_bad_options(keys%opts);$overwrite=1 unless (defined$overwrite or $numbered);my$perm=(CORE::lstat$local)[2];unless (defined$perm){$sftp->_set_error(SFTP_ERR_LOCAL_STAT_FAILED,"Couldn't stat local file '$local'",$!);return undef}unless (_is_lnk($perm)){$sftp->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT,"Local file $local is not a symlink");return undef}my$target=readlink$local;unless (defined$target){$sftp->_set_error(SFTP_ERR_LOCAL_READLINK_FAILED,"Couldn't read link '$local'",$!);return undef}while (1){local$sftp->{_autodie};$sftp->symlink($remote,$target);if ($sftp->{_error}and $sftp->{_status}==SSH2_FX_FAILURE){if ($numbered and $sftp->test_e($remote)){_inc_numbered($remote);redo}elsif ($overwrite and $sftp->_remove_save_status($remote)){$overwrite=0;redo}}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$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};my$on_error=delete$opts{on_error};local$sftp->{_autodie}if$on_error;my$ignore_links=delete$opts{ignore_links};my$mkpath=delete$opts{mkpath};my$wanted=_gen_wanted(delete$opts{wanted},delete$opts{no_wanted});my%get_opts=(map {$_=>delete$opts{$_}}qw(block_size queue_size overwrite conversion resume numbered atomic best_effort));if ($get_opts{resume}and $get_opts{conversion}){carp "resume option is useless when data conversion has also been requested";delete$get_opts{resume}}my%get_symlink_opts=(map {$_=>$get_opts{$_}}qw(overwrite numbered));%opts and _croak_bad_options(keys%opts);$remote=$sftp->join($remote,'./');my$qremote=quotemeta$remote;my$reremote=qr/^$qremote(.*)$/i;my$save=_umask_save_and_set$umask;$copy_perm=1 unless defined$copy_perm;$copy_time=1 unless defined$copy_time;$mkpath=1 unless defined$mkpath;my$count=0;$sftp->find([$remote],descend=>sub {my$e=$_[1];if (!$wanted or $wanted->($sftp,$e)){my$fn=$e->{filename};if ($fn =~ $reremote){my$lpath=File::Spec->catdir($local,$1);($lpath)=$lpath =~ /(.*)/ if ${^TAINT};if (-d $lpath){$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,"directory '$lpath' already exists");$sftp->_call_on_error($on_error,$e);return 1}else {my$perm=($copy_perm ? $e->{a}->perm & 0777 : 0777);if (CORE::mkdir($lpath,$perm)or ($mkpath and $sftp->_mkpath_local($lpath,$perm))){$count++;return 1}$sftp->_set_error(SFTP_ERR_LOCAL_MKDIR_FAILED,"mkdir '$lpath' failed",$!)}}else {$sftp->_set_error(SFTP_ERR_REMOTE_BAD_PATH,"bad remote path '$fn'")}$sftp->_call_on_error($on_error,$e)}return undef},wanted=>sub {my$e=$_[1];unless (_is_dir($e->{a}->perm)){if (!$wanted or $wanted->($sftp,$e)){my$fn=$e->{filename};if ($fn =~ $reremote){my$lpath=File::Spec->catfile($local,$1);($lpath)=$lpath =~ /(.*)/ if ${^TAINT};if (_is_lnk($e->{a}->perm)and!$ignore_links){if ($sftp->get_symlink($fn,$lpath,%get_symlink_opts)){$count++;return undef}}elsif (_is_reg($e->{a}->perm)){if ($newer_only and -e $lpath and (CORE::stat _)[9]>= $e->{a}->mtime){$sftp->_set_error(SFTP_ERR_LOCAL_ALREADY_EXISTS,"newer local file '$lpath' already exists")}else {if ($sftp->get($fn,$lpath,copy_perm=>$copy_perm,copy_time=>$copy_time,%get_opts)){$count++;return undef}}}else {$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,($ignore_links ? "remote file '$fn' is not regular file or directory" : "remote file '$fn' is not regular file, directory or link"))}}else {$sftp->_set_error(SFTP_ERR_REMOTE_BAD_PATH,"bad remote path '$fn'")}$sftp->_call_on_error($on_error,$e)}}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$umask=delete$opts{umask};my$perm=delete$opts{perm};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};my$on_error=delete$opts{on_error};local$sftp->{_autodie}if$on_error;my$ignore_links=delete$opts{ignore_links};my$mkpath=delete$opts{mkpath};my$wanted=_gen_wanted(delete$opts{wanted},delete$opts{no_wanted});my%put_opts=(map {$_=>delete$opts{$_}}qw(block_size queue_size overwrite conversion resume numbered late_set_perm atomic best_effort sparse));my%put_symlink_opts=(map {$_=>$put_opts{$_}}qw(overwrite numbered));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);%opts and _croak_bad_options(keys%opts);require Net::SFTP::Foreign::Local;my$lfs=Net::SFTP::Foreign::Local->new;$local=$lfs->join($local,'./');my$relocal;if ($local =~ m|^\./?$|){$relocal=qr/^(.*)$/}else {my$qlocal=quotemeta$local;$relocal=qr/^$qlocal(.*)$/i}$copy_perm=1 unless defined$copy_perm;$copy_time=1 unless defined$copy_time;$mkpath=1 unless defined$mkpath;my$mask;if (defined$perm){$mask=$perm & 0777}else {$umask=umask unless defined$umask;$mask=0777 & ~$umask}if ($on_error){my$on_error1=$on_error;$on_error=sub {my$lfs=shift;$sftp->_copy_error($lfs);$sftp->_call_on_error($on_error1,@_)}}my$count=0;$lfs->find([$local],descend=>sub {my$e=$_[1];if (!$wanted or $wanted->($lfs,$e)){my$fn=$e->{filename};$debug and $debug & 32768 and _debug "rput handling $fn";if ($fn =~ $relocal){my$rpath=$sftp->join($remote,File::Spec->splitdir($1));$debug and $debug & 32768 and _debug "rpath: $rpath";my$a=Net::SFTP::Foreign::Attributes->new;if (defined$perm){$a->set_perm($mask | 0300)}elsif ($copy_perm){$a->set_perm($e->{a}->perm & $mask)}if ($sftp->mkdir($rpath,$a)){$count++;return 1}if ($mkpath and $sftp->status==SSH2_FX_NO_SUCH_FILE){$sftp->_clear_error_and_status;if ($sftp->mkpath($rpath,$a)){$count++;return 1}}$lfs->_copy_error($sftp);if ($sftp->test_d($rpath)){$lfs->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS,"Remote directory '$rpath' already exists");$lfs->_call_on_error($on_error,$e);return 1}}else {$lfs->_set_error(SFTP_ERR_LOCAL_BAD_PATH,"Bad local path '$fn'")}$lfs->_call_on_error($on_error,$e)}return undef},wanted=>sub {my$e=$_[1];unless (_is_dir($e->{a}->perm)){if (!$wanted or $wanted->($lfs,$e)){my$fn=$e->{filename};$debug and $debug & 32768 and _debug "rput handling $fn";if ($fn =~ $relocal){my (undef,$d,$f)=File::Spec->splitpath($1);my$rpath=$sftp->join($remote,File::Spec->splitdir($d),$f);if (_is_lnk($e->{a}->perm)and!$ignore_links){if ($sftp->put_symlink($fn,$rpath,%put_symlink_opts)){$count++;return undef}$lfs->_copy_error($sftp)}elsif (_is_reg($e->{a}->perm)){my$ra;if ($newer_only and $ra=$sftp->stat($rpath)and $ra->mtime >= $e->{a}->mtime){$lfs->_set_error(SFTP_ERR_REMOTE_ALREADY_EXISTS,"Newer remote file '$rpath' already exists")}else {if ($sftp->put($fn,$rpath,(defined($perm)? (perm=>$perm): $copy_perm ? (perm=>$e->{a}->perm & $mask): (copy_perm=>0,umask=>$umask)),copy_time=>$copy_time,%put_opts)){$count++;return undef}$lfs->_copy_error($sftp)}}else {$lfs->_set_error(SFTP_ERR_LOCAL_BAD_OBJECT,($ignore_links ? "Local file '$fn' is not regular file or directory" : "Local file '$fn' is not regular file, directory or link"))}}else {$lfs->_set_error(SFTP_ERR_LOCAL_BAD_PATH,"Bad local path '$fn'")}$lfs->_call_on_error($on_error,$e)}}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{$_}}qw(on_error follow_links ignore_case wanted no_wanted strict_leading_dot));my%get_symlink_opts=(map {$_=>$opts{$_}}qw(overwrite numbered));my%get_opts=(map {$_=>delete$opts{$_}}qw(umask perm copy_perm copy_time block_size queue_size overwrite conversion resume numbered atomic best_effort mkpath));%opts and _croak_bad_options(keys%opts);my@remote=map$sftp->glob($_,%glob_opts),_ensure_list$remote;my$count=0;require File::Spec;for my$e (@remote){my$perm=$e->{a}->perm;if (_is_dir($perm)){$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,"Remote object '$e->{filename}' is a directory")}else {my$fn=$e->{filename};my ($local)=$fn =~ m{([^\\/]*)$};$local=File::Spec->catfile($localdir,$local)if defined$localdir;if (_is_lnk($perm)){next if$ignore_links;$sftp->get_symlink($fn,$local,%get_symlink_opts)}else {$sftp->get($fn,$local,%get_opts)}}$count++ unless$sftp->{_error};$sftp->_call_on_error($on_error,$e)}$count}sub mput {@_ >= 2 or croak 'Usage: $sftp->mput($local, $remotedir, %opts)';my ($sftp,$local,$remotedir,%opts)=@_;defined$local or die "local 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{$_}}qw(on_error follow_links ignore_case wanted no_wanted strict_leading_dot));my%put_symlink_opts=(map {$_=>$opts{$_}}qw(overwrite numbered));my%put_opts=(map {$_=>delete$opts{$_}}qw(umask perm copy_perm copy_time block_size queue_size overwrite conversion resume numbered late_set_perm atomic best_effort sparse mkpath));%opts and _croak_bad_options(keys%opts);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){my$perm=$e->{a}->perm;if (_is_dir($perm)){$sftp->_set_error(SFTP_ERR_REMOTE_BAD_OBJECT,"Remote object '$e->{filename}' is a directory")}else {my$fn=$e->{filename};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)}else {$sftp->put($fn,$remote,%put_opts)}}$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,str=>'fsync@openssh.com',str=>$sftp->_rid($fh));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;my$id=$sftp->_queue_new_msg(SSH2_FXP_EXTENDED,str=>$extension,str=>$arg);if (my$msg=$sftp->_get_msg_and_check(SSH2_FXP_EXTENDED_REPLY,$id,SFTP_ERR_REMOTE_STATVFS_FAILED,"Couldn't stat remote file system")){my%statvfs=map {$_=>$msg->get_int64}qw(bsize frsize blocks bfree bavail files ffree favail fsid flag namemax);return \%statvfs}return undef}sub fstatvfs {_deprecated "fstatvfs is deprecated and will be removed on the upcoming 2.xx series, " ."statvfs method accepts now both file handlers and paths";goto&statvfs}package Net::SFTP::Foreign::Handle;use Tie::Handle;our@ISA=qw(Tie::Handle);our@CARP_NOT=qw(Net::SFTP::Foreign Tie::Handle);my$gen_accessor=sub {my$ix=shift;sub {my$st=*{shift()}{ARRAY};if (@_){$st->[$ix]=shift}else {$st->[$ix]}}};my$gen_proxy_method=sub {my$method=shift;sub {my$self=$_[0];$self->_check or return undef;my$sftp=$self->_sftp;if (wantarray){my@ret=$sftp->$method(@_);$sftp->_set_errno unless@ret;return@ret}else {my$ret=$sftp->$method(@_);$sftp->_set_errno unless defined$ret;return$ret}}};my$gen_not_supported=sub {sub {$!=Errno::ENOTSUP();undef}};sub TIEHANDLE {return shift}sub _new_from_rid {my$class=shift;my$sftp=shift;my$rid=shift;my$flags=shift || 0;my$self=Symbol::gensym;bless$self,$class;*$self=[$sftp,$rid,0,$flags,@_];tie *$self,$self;$self}sub _close {my$self=shift;@{*{$self}{ARRAY}}=()}sub _check {return 1 if defined(*{shift()}{ARRAY}[0]);$!=Errno::EBADF;undef}sub FILENO {my$self=shift;$self->_check or return undef;my$hrid=unpack 'H*'=>$self->_rid;"-1:sftp(0x$hrid)"}sub _sftp {*{shift()}{ARRAY}[0]}sub _rid {*{shift()}{ARRAY}[1]}* _pos=$gen_accessor->(2);sub _inc_pos {my ($self,$inc)=@_;*{shift()}{ARRAY}[2]+= $inc}my%flag_bit=(append=>0x1);sub _flag {my$st=*{shift()}{ARRAY};my$fn=shift;my$flag=$flag_bit{$fn};Carp::croak("unknown flag $fn")unless defined$flag;if (@_){if (shift){$st->[3]|=$flag}else {$st->[3]&=~$flag}}$st->[3]& $flag ? 1 : 0}sub _check_is_file {Carp::croak("expecting remote file handler, got directory handler")}sub _check_is_dir {Carp::croak("expecting remote directory handler, got file handler")}my$autoloaded;sub AUTOLOAD {my$self=shift;our$AUTOLOAD;if ($autoloaded){my$class=ref$self || $self;Carp::croak qq|Can't locate object method "$AUTOLOAD" via package "$class|}else {$autoloaded=1;require IO::File;require IO::Dir;my ($method)=$AUTOLOAD =~ /^.*::(.*)$/;$self->$method(@_)}}package Net::SFTP::Foreign::FileHandle;our@ISA=qw(Net::SFTP::Foreign::Handle IO::File);sub _new_from_rid {my$class=shift;my$sftp=shift;my$rid=shift;my$flags=shift;my$self=$class->SUPER::_new_from_rid($sftp,$rid,$flags,'','')}sub _check_is_file {}sub _bin {\(*{shift()}{ARRAY}[4])}sub _bout {\(*{shift()}{ARRAY}[5])}sub WRITE {my ($self,undef,$length,$offset)=@_;$self->_check or return undef;$offset=0 unless defined$offset;$offset=length $_[1]+ $offset if$offset < 0;$length=length $_[1]unless defined$length;my$sftp=$self->_sftp;my$ret=$sftp->write($self,substr($_[1],$offset,$length));$sftp->_set_errno unless defined$ret;$ret}sub READ {my ($self,undef,$len,$offset)=@_;$self->_check or return undef;$_[1]='' unless defined $_[1];$offset ||=0;if ($offset > length $_[1]){$_[1].= "\0" x ($offset - length $_[1])}if ($len==0){substr($_[1],$offset)='';return 0}my$sftp=$self->_sftp;$sftp->_fill_read_cache($self,$len);my$bin=$self->_bin;if (length $$bin){my$data=substr($$bin,0,$len,'');$self->_inc_pos($len);substr($_[1],$offset)=$data;return length$data}return 0 if$sftp->{_status}==$sftp->SSH2_FX_EOF;$sftp->_set_errno;undef}sub EOF {my$self=$_[0];$self->_check or return undef;my$sftp=$self->_sftp;my$ret=$sftp->eof($self);$sftp->_set_errno unless defined$ret;$ret}*GETC=$gen_proxy_method->('getc');*TELL=$gen_proxy_method->('tell');*SEEK=$gen_proxy_method->('seek');*CLOSE=$gen_proxy_method->('close');my$readline=$gen_proxy_method->('readline');sub READLINE {$readline->($_[0],$/)}sub OPEN {shift->CLOSE;undef}sub DESTROY {local ($@,$!,$?);my$self=shift;my$sftp=$self->_sftp;$debug and $debug & 4 and Net::SFTP::Foreign::_debug("$self->DESTROY called (sftp: ".($sftp||'').")");if ($self->_check and $sftp){local$sftp->{_autodie};$sftp->_close_save_status($self)}}package Net::SFTP::Foreign::DirHandle;our@ISA=qw(Net::SFTP::Foreign::Handle IO::Dir);sub _new_from_rid {my$class=shift;my$sftp=shift;my$rid=shift;my$flags=shift;my$self=$class->SUPER::_new_from_rid($sftp,$rid,$flags,[])}sub _check_is_dir {}sub _cache {*{shift()}{ARRAY}[4]}*CLOSEDIR=$gen_proxy_method->('closedir');*READDIR=$gen_proxy_method->('_readdir');sub OPENDIR {shift->CLOSEDIR;undef}*REWINDDIR=$gen_not_supported->();*TELLDIR=$gen_not_supported->();*SEEKDIR=$gen_not_supported->();sub DESTROY {local ($@,$!,$?);my$self=shift;my$sftp=$self->_sftp;$debug and $debug & 4 and Net::SFTP::Foreign::_debug("$self->DESTROY called (sftp: ".($sftp||'').")");if ($self->_check and $sftp){local$sftp->{_autodie};$sftp->_closedir_save_status($self)}}1; +NET_SFTP_FOREIGN + +$fatpacked{"Net/SFTP/Foreign/Attributes.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_ATTRIBUTES'; + package Net::SFTP::Foreign::Attributes;our$VERSION='1.68_05';use strict;use warnings;use Carp;use Net::SFTP::Foreign::Constants qw(:att);use Net::SFTP::Foreign::Buffer;sub new {my$class=shift;return bless {flags=>0},$class}sub new_from_stat {if (@_ > 1){my ($class,undef,undef,$mode,undef,$uid,$gid,undef,$size,$atime,$mtime)=@_;my$self=$class->new;$self->set_perm($mode);$self->set_ugid($uid,$gid);$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}sub skip_from_buffer {my ($class,$buf)=@_;my$flags=$buf->get_int32;if ($flags==(SSH2_FILEXFER_ATTR_SIZE | SSH2_FILEXFER_ATTR_UIDGID | SSH2_FILEXFER_ATTR_PERMISSIONS | SSH2_FILEXFER_ATTR_ACMODTIME)){$buf->skip_bytes(28)}else {my$len=0;$len += 8 if$flags & SSH2_FILEXFER_ATTR_SIZE;$len += 8 if$flags & SSH2_FILEXFER_ATTR_UIDGID;$len += 4 if$flags & SSH2_FILEXFER_ATTR_PERMISSIONS;$len += 8 if$flags & SSH2_FILEXFER_ATTR_ACMODTIME;$buf->skip_bytes($len);if ($flags & SSH2_FILEXFER_ATTR_EXTENDED){my$n=$buf->get_int32;$buf->skip_str,$buf->skip_str for (1..$n)}}}sub as_buffer {my$a=shift;my$buf=Net::SFTP::Foreign::Buffer->new(int32=>$a->{flags});if ($a->{flags}& SSH2_FILEXFER_ATTR_SIZE){$buf->put_int64(int$a->{size})}if ($a->{flags}& SSH2_FILEXFER_ATTR_UIDGID){$buf->put(int32=>$a->{uid},int32=>$a->{gid})}if ($a->{flags}& SSH2_FILEXFER_ATTR_PERMISSIONS){$buf->put_int32($a->{perm})}if ($a->{flags}& SSH2_FILEXFER_ATTR_ACMODTIME){$buf->put(int32=>$a->{atime},int32=>$a->{mtime})}if ($a->{flags}& SSH2_FILEXFER_ATTR_EXTENDED){my$pairs=$a->{extended};$buf->put_int32(int(@$pairs / 2));$buf->put_str($_)for @$pairs}$buf}sub flags {shift->{flags}}sub size {shift->{size}}sub set_size {my ($self,$size)=@_;if (defined$size){$self->{flags}|=SSH2_FILEXFER_ATTR_SIZE;$self->{size}=$size}else {$self->{flags}&=~SSH2_FILEXFER_ATTR_SIZE;delete$self->{size}}}sub uid {shift->{uid}}sub gid {shift->{gid}}sub set_ugid {my ($self,$uid,$gid)=@_;if (defined$uid and defined$gid){$self->{flags}|=SSH2_FILEXFER_ATTR_UIDGID;$self->{uid}=$uid;$self->{gid}=$gid}elsif (!defined$uid and!defined$gid){$self->{flags}&=~SSH2_FILEXFER_ATTR_UIDGID;delete$self->{uid};delete$self->{gid}}else {croak "wrong arguments for set_ugid"}}sub perm {shift->{perm}}sub set_perm {my ($self,$perm)=@_;if (defined$perm){$self->{flags}|=SSH2_FILEXFER_ATTR_PERMISSIONS;$self->{perm}=$perm}else {$self->{flags}&=~SSH2_FILEXFER_ATTR_PERMISSIONS;delete$self->{perm}}}sub atime {shift->{atime}}sub mtime {shift->{mtime}}sub set_amtime {my ($self,$atime,$mtime)=@_;if (defined$atime and defined$mtime){$self->{flags}|=SSH2_FILEXFER_ATTR_ACMODTIME;$self->{atime}=$atime;$self->{mtime}=$mtime}elsif (!defined$atime and!defined$mtime){$self->{flags}&=~SSH2_FILEXFER_ATTR_ACMODTIME;delete$self->{atime};delete$self->{mtime}}else {croak "wrong arguments for set_amtime"}}sub extended {@{shift->{extended}|| []}}sub set_extended {my$self=shift;@_ & 1 and croak "odd number of arguments passed to set_extended";if (@_){$self->{flags}|=SSH2_FILEXFER_ATTR_EXTENDED;$self->{extended}=[@_]}else {$self->{flags}&=~SSH2_FILEXFER_ATTR_EXTENDED;delete$self->{extended}}}sub append_extended {my$self=shift;@_ & 1 and croak "odd number of arguments passed to append_extended";my$pairs=$self->{extended};if (@$pairs){push @$pairs,@_}else {$self->set_extended(@_)}}sub clone {my$self=shift;my$clone={%$self };bless$clone,ref$self;$clone}1; +NET_SFTP_FOREIGN_ATTRIBUTES + +$fatpacked{"Net/SFTP/Foreign/Attributes/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_ATTRIBUTES_COMPAT'; + package Net::SFTP::Foreign::Attributes::Compat;our$VERSION='0.01';use strict;use warnings;use Net::SFTP::Foreign::Attributes;our@ISA=qw(Net::SFTP::Foreign::Attributes);my@fields=qw(flags size uid gid perm atime mtime);for my$f (@fields){no strict 'refs';*$f=sub {@_ > 1 ? $_[0]->{$f}=$_[1]: $_[0]->{$f}|| 0}}sub new {my ($class,%param)=@_;my$a=$class->SUPER::new();if (my$stat=$param{Stat}){$a->set_size($stat->[7]);$a->set_ugid($stat->[4],$stat->[5]);$a->set_perm($stat->[2]);$a->set_amtime($stat->[8],$stat->[9])}$a}1; +NET_SFTP_FOREIGN_ATTRIBUTES_COMPAT + +$fatpacked{"Net/SFTP/Foreign/Backend/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_BACKEND_UNIX'; + package Net::SFTP::Foreign::Backend::Unix;our$VERSION='1.76_03';use strict;use warnings;use Carp;our@CARP_NOT=qw(Net::SFTP::Foreign);use Fcntl qw(O_NONBLOCK F_SETFL F_GETFL);use POSIX ();use Net::SFTP::Foreign::Helpers qw(_tcroak _ensure_list _debug _hexdump $debug);use Net::SFTP::Foreign::Constants qw(SSH2_FX_BAD_MESSAGE SFTP_ERR_REMOTE_BAD_MESSAGE);sub _new {shift}sub _defaults {(queue_size=>32)}sub _init_transport_streams {my (undef,$sftp)=@_;for my$dir (qw(ssh_in ssh_out)){binmode$sftp->{$dir};my$flags=fcntl($sftp->{$dir},F_GETFL,0);fcntl($sftp->{$dir},F_SETFL,$flags | O_NONBLOCK)}}sub _open_dev_null {my$sftp=shift;my$dev_null;unless (open$dev_null,'>',"/dev/null"){$sftp->_conn_failed("Unable to redirect stderr to /dev/null");return}$dev_null}sub _fileno_dup_over {my ($good_fn,$fh)=@_;if (defined$fh){my@keep_open;my$fn=fileno$fh;for (1..5){$fn >= $good_fn and return$fn;$fn=POSIX::dup($fn);push@keep_open,$fn}POSIX::_exit(255)}undef}sub _open4 {my$backend=shift;my$sftp=shift;my ($dad_in,$dad_out,$child_in,$child_out);unless (pipe ($dad_in,$child_out)and pipe ($child_in,$dad_out)){$sftp->_conn_failed("Unable to created pipes: $!");return}my$pid=fork;unless ($pid){unless (defined$pid){$sftp->_conn_failed("Unable to fork new process: $!");return}close ($dad_in);close ($dad_out);shift;shift;my$child_err=shift;my$pty=shift;$pty->make_slave_controlling_terminal if defined$pty;my$child_err_fno=eval {no warnings;fileno($child_err ? $child_err : *STDERR)};my$child_err_safe;if (defined$child_err_fno and $child_err_fno >= 0){open$child_err_safe,">&=$child_err_fno" or POSIX::_exit(1)}else {open$child_err_safe,">/dev/null" or POSIX::_exit(1)}my$child_in_fno=_fileno_dup_over(0=>$child_in);my$child_out_fno=_fileno_dup_over(1=>$child_out);my$child_err_safe_fno=_fileno_dup_over(2=>$child_err_safe);unless (($child_in_fno==0 or POSIX::dup2($child_in_fno,0))and ($child_out_fno==1 or POSIX::dup2($child_out_fno,1))and ($child_err_safe_fno==2 or POSIX::dup2($child_err_safe_fno,2))){POSIX::_exit(1)}do {exec @_};POSIX::_exit(1)}close$child_in;close$child_out;$_[0]=$dad_in;$_[1]=$dad_out;$pid}sub _init_transport {my ($backend,$sftp,$opts)=@_;my$transport=delete$opts->{transport};if (defined$transport){if (ref$transport eq 'ARRAY'){@{$sftp}{qw(ssh_in ssh_out pid)}=@$transport}else {$sftp->{ssh_in}=$sftp->{ssh_out}=$transport;$sftp->{_ssh_out_is_not_dupped}=1}}else {my$user=delete$opts->{user};my$pass=delete$opts->{passphrase};my$ask_for_username_at_login;my$pass_is_passphrase;my$password_prompt;if (defined$pass){$pass_is_passphrase=1}else {$pass=delete$opts->{password};if (defined$pass){$sftp->{_password_authentication}=1;$password_prompt=$sftp->{_password_prompt}=delete$opts->{password_prompt};if (defined$password_prompt){unless (ref$password_prompt eq 'Regexp'){$password_prompt=quotemeta$password_prompt;$password_prompt=qr/$password_prompt\s*$/i}}$ask_for_username_at_login=$sftp->{_ask_for_username_at_login}=(delete($opts->{ask_for_username_at_login})|| delete($opts->{asks_for_username_at_login}));if ($ask_for_username_at_login){croak "ask_for_username_at_login set but user was not given" unless defined$user;croak "ask_for_username_at_login can not be used with a custom password prompt" if defined$password_prompt}}}delete$opts->{expect_log_user};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){@open2_cmd=_ensure_list($open2_cmd)}else {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=_ensure_list$ssh_cmd;unless (defined$ssh_cmd_interface){$ssh_cmd_interface=("@open2_cmd" =~ /\bplink\b/i ? 'plink' : "@open2_cmd" =~ /\bsshg3\b/i ? 'tectia' : 'ssh')}my$port=delete$opts->{port};my$ssh1=delete$opts->{ssh1};my$more=delete$opts->{more};defined$more and!ref($more)and $more =~ /^-\w\s+\S/ and warnings::warnif("Net::SFTP::Foreign","'more' argument looks like it should be split first");my@more=_ensure_list$more;my@preferred_authentications;if (defined$key_path){push@preferred_authentications,'publickey';push@open2_cmd,map {-i=>$_}_ensure_list$key_path}if ($ssh_cmd_interface eq 'plink'){push@open2_cmd,-P=>$port if defined$port;if (defined$pass and!$pass_is_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 (defined$pass and!$pass_is_passphrase){push@open2_cmd,-o=>'NumberOfPasswordPrompts=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;push@open2_cmd,($ssh1 ? "/usr/lib/sftp-server" : -s=>'sftp')}my$redirect_stderr_to_tty=(defined$pass 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;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){eval {require IO::Pty;1}or croak "password authentication not available, IO::Pty is not installed or failed to load: $@";local ($ENV{SSH_ASKPASS},$ENV{SSH_AUTH_SOCK})if$pass_is_passphrase;my$name=$pass_is_passphrase ? 'Passphrase' : 'Password';my$child;my$pty=IO::Pty->new;$redirect_stderr_to_tty and $stderr_fh=$pty->slave;$child=$backend->_open4($sftp,$sftp->{ssh_in},$sftp->{ssh_out},$stderr_fh,$pty,@open2_cmd);unless (defined$child){$sftp->_conn_failed("Bad ssh command",$!);return}$sftp->{pid}=$child;open my$pty_dup,'+>&',$pty;$sftp->{_pty}=$pty_dup;$debug and $debug & 65536 and _debug "starting password authentication";my$rv='';vec($rv,fileno($pty),1)=1;my$buffer='';my$at=0;my$password_sent;my$start_time=time;while(1){if (defined$sftp->{_timeout}){$debug and $debug & 65536 and _debug "checking timeout, max: $sftp->{_timeout}, ellapsed: " .(time - $start_time);if (time - $start_time > $sftp->{_timeout}){$sftp->_conn_failed("login procedure timed out");return}}if (waitpid($child,POSIX::WNOHANG())> 0){undef$sftp->{pid};my$err=$? >> 8;$sftp->_conn_failed("SSH slave exited unexpectedly with error code $err");return}$debug and $debug & 65536 and _debug "waiting for data from the pty to become available";my$rv1=$rv;select($rv1,undef,undef,1)> 0 or next;if (my$bytes=sysread($pty,$buffer,4096,length$buffer)){if ($debug and $debug & 65536){_debug "$bytes bytes readed from pty:";_hexdump substr($buffer,-$bytes)}if ($buffer =~ /^The authenticity of host/mi or $buffer =~ /^Warning: the \S+ host key for/mi){$sftp->_conn_failed("the authenticity of the target host can't be established, " ."the remote host public key is probably not present on the " ."'~/.ssh/known_hosts' file");return}if ($password_sent){$debug and $debug & 65536 and _debug "looking for password ok";last if substr($buffer,$at)=~ /\n$/}else {$debug and $debug & 65536 and _debug "looking for user/password prompt";my$re=(defined$password_prompt ? $password_prompt : qr/(user|name|login)?[:?]\s*$/i);$debug and $debug & 65536 and _debug "matching against $re";if (substr($buffer,$at)=~ $re){if ($ask_for_username_at_login and ($ask_for_username_at_login ne 'auto' or defined $1)){$debug and $debug & 65536 and _debug "sending username";print$pty "$user\n";undef$ask_for_username_at_login}else {$debug and $debug & 65536 and _debug "sending password";print$pty "$pass\n";$password_sent=1}$at=length$buffer}}}else {$debug and $debug & 65536 and _debug "no data available from pty, delaying until next read";sleep 1}}$debug and $debug & 65536 and _debug "password authentication done";$pty->close_slave()}else {$sftp->{pid}=$backend->_open4($sftp,$sftp->{ssh_in},$sftp->{ssh_out},$stderr_fh,undef,@open2_cmd);unless (defined$sftp->{pid}){$sftp->_conn_failed("Bad ssh command",$!);return}}}$backend->_init_transport_streams($sftp)}sub _after_init {my ($backend,$sftp)=@_;if ($sftp->{pid}and not $sftp->error){local ($@,$!);eval {setpgrp($sftp->{pid},0)}}}sub _do_io {my (undef,$sftp,$timeout)=@_;$debug and $debug & 32 and _debug(sprintf "_do_io connected: %s",$sftp->{_connected}|| 0);return undef unless$sftp->{_connected};my$fnoout=fileno$sftp->{ssh_out};my$fnoin=fileno$sftp->{ssh_in};my ($rv,$wv)=('','');vec($rv,$fnoin,1)=1;vec($wv,$fnoout,1)=1;my$bin=\$sftp->{_bin};my$bout=\$sftp->{_bout};local$SIG{PIPE}='IGNORE';my$len;while (1){my$lbin=length $$bin;if (defined$len){return 1 if$lbin >= $len}elsif ($lbin >= 4){$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}return 1 if$lbin >= $len}my$rv1=$rv;my$wv1=length($$bout)? $wv : '';$debug and $debug & 32 and _debug("_do_io select(-,-,-, ".(defined$timeout ? $timeout : 'undef').")");my$n=select($rv1,$wv1,undef,$timeout);if ($n > 0){if (vec($wv1,$fnoout,1)){my$written=syswrite($sftp->{ssh_out},$$bout,64 * 1024);if ($debug and $debug & 32){_debug (sprintf "_do_io write queue: %d, syswrite: %s, max: %d, \$!: %s",length $$bout,(defined$written ? $written : 'undef'),64 * 1024,$!);$debug & 2048 and $written and _hexdump(substr($$bout,0,$written))}if ($written){substr($$bout,0,$written,'')}elsif ($!!=Errno::EAGAIN()and $!!=Errno::EINTR()){$sftp->_conn_lost;return undef}}if (vec($rv1,$fnoin,1)){my$read=sysread($sftp->{ssh_in},$$bin,64 * 1024,length($$bin));if ($debug and $debug & 32){_debug (sprintf "_do_io read sysread: %s, total read: %d, \$!: %s",(defined$read ? $read : 'undef'),length $$bin,$!);$debug & 1024 and $read and _hexdump(substr($$bin,-$read))}if (!$read and $!!=Errno::EAGAIN()and $!!=Errno::EINTR()){$sftp->_conn_lost;return undef}}}else {$debug and $debug & 32 and _debug "_do_io select failed: $!";next if ($n < 0 and ($!==Errno::EINTR()or $!==Errno::EAGAIN()));return undef}}}1; +NET_SFTP_FOREIGN_BACKEND_UNIX + +$fatpacked{"Net/SFTP/Foreign/Backend/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_BACKEND_WINDOWS'; + package Net::SFTP::Foreign::Backend::Windows;our$VERSION='1.70_08';use strict;use warnings;use Carp;our@CARP_NOT=qw(Net::SFTP::Foreign);use IPC::Open3;use POSIX ();use Net::SFTP::Foreign::Helpers;use Net::SFTP::Foreign::Constants qw(SSH2_FX_BAD_MESSAGE SFTP_ERR_REMOTE_BAD_MESSAGE);require Net::SFTP::Foreign::Backend::Unix;our@ISA=qw(Net::SFTP::Foreign::Backend::Unix);sub _defaults {(queue_size=>16)}sub _init_transport_streams {my ($backend,$sftp)=@_;binmode$sftp->{ssh_in};binmode$sftp->{ssh_out}}sub _open_dev_null {my$sftp=shift;my$dev_null;unless (open$dev_null,'>','NUL:'){$sftp->_conn_failed("Unable to redirect stderr for slave SSH process to NUL: $!");return}$dev_null}sub _open4 {my$backend=shift;my$sftp=shift;defined $_[3]and croak "setting child PTY is not supported on Windows";my$fno=eval {defined $_[2]? fileno $_[2]: fileno*STDERR};unless (defined$fno and $fno >= 0){$sftp->_conn_failed("STDERR or stderr_fh is not a real file handle: " .(length $@ ? $@ : $!));return}local*SSHERR;unless (open(SSHERR,">>&=",$fno)){$sftp->_conn_failed("Unable to duplicate stderr redirection file handle: $!");return undef}goto NOTIE unless tied*STDERR;local*STDERR;unless (open STDERR,">&=2"){$sftp->_conn_failed("Unable to reattach STDERR to fd 2: $!");return}NOTIE: local ($@,$SIG{__DIE__},$SIG{__WARN__});my$ppid=$$;my$pid=eval {open3(@_[1,0],">&SSHERR",@_[4..$#_])};$ppid==$$ or POSIX::_exit(-1);$pid}sub _after_init {}sub _sysreadn {my ($sftp,$n)=@_;my$bin=\$sftp->{_bin};while (1){my$len=length $$bin;return 1 if$len >= $n;my$read=sysread($sftp->{ssh_in},$$bin,$n - $len,$len);unless ($read){$sftp->_conn_lost;return undef}}return$n}sub _do_io {my ($backend,$sftp,$timeout)=@_;return undef unless$sftp->{_connected};my$bin=\$sftp->{_bin};my$bout=\$sftp->{_bout};while (length $$bout){my$written=syswrite($sftp->{ssh_out},$$bout,20480);unless ($written){$sftp->_conn_lost;return undef}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}_sysreadn($sftp,$len)}1; +NET_SFTP_FOREIGN_BACKEND_WINDOWS + +$fatpacked{"Net/SFTP/Foreign/Buffer.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_BUFFER'; + package Net::SFTP::Foreign::Buffer;our$VERSION='1.68_05';use strict;use warnings;no warnings 'uninitialized';use Carp;use constant HAS_QUADS=>do {local $@;local$SIG{__DIE__};no warnings;eval q{ + pack(Q => 0x1122334455667788) eq "\x11\x22\x33\x44\x55\x66\x77\x88" + }};sub new {my$class=shift;my$data='';@_ and put(\$data,@_);bless \$data,$class}sub make {bless \$_[1],$_[0]}sub bytes {${$_[0]}}sub get_int8 {length ${$_[0]}>=1 or return undef;unpack(C=>substr(${$_[0]},0,1,''))}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 {length ${$_[0]}>= 8 or return undef;my ($big,$small)=unpack(NN=>substr(${$_[0]},0,8,''));if ($big){my$high=$big * 4294967296;my$result=$high + $small;unless ($result - $high==$small){require Math::BigInt;$result=Math::BigInt->new($big);$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,'')}sub get_str_list {my$self=shift;my@a;if (my$n=$self->get_int32){for (1..$n){my$str=$self->get_str;last unless defined$str;push@a,$str}}return@a}sub get_attributes {Net::SFTP::Foreign::Attributes->new_from_buffer($_[0])}sub skip_bytes {substr(${$_[0]},0,$_[1],'')}sub skip_str {my$self=shift;my$len=$self->get_int32;substr($$self,0,$len,'')}sub put_int8 {${$_[0]}.= pack(C=>$_[1])}sub put_int32 {${$_[0]}.= pack(N=>$_[1])}sub put_int64_quads {${$_[0]}.= pack(Q=>$_[1])}sub put_int64_no_quads {if ($_[1]>= 4294967296){my$high=int ($_[1]/ 4294967296);my$low=int ($_[1]- $high * 4294967296);${$_[0]}.= pack(NN=>$high,$low)}else {${$_[0]}.= pack(NN=>0,$_[1])}}*put_int64=(HAS_QUADS ? \&put_int64_quads : \&put_int64_no_quads);sub put_str {utf8::downgrade($_[1])or croak "UTF8 data reached the SFTP buffer";${$_[0]}.= pack(N=>length($_[1])).$_[1]}sub put_char {${$_[0]}.= $_[1]}sub _attrs_as_buffer {my$attrs=shift;my$ref=ref$attrs;Net::SFTP::Foreign::Attributes->isa($ref)or croak("Object of class Net::SFTP::Foreign::Attributes " ."expected, $ref found");$attrs->as_buffer}sub put_attributes {${$_[0]}.= ${_attrs_as_buffer $_[1]}}my%unpack=(int8=>\&get_int8,int32=>\&get_int32,int64=>\&get_int64,str=>\&get_str,attr=>\&get_attributtes);sub get {my$buf=shift;map {$unpack{$_}->($buf)}@_}my%pack=(int8=>sub {pack C=>$_[0]},int32=>sub {pack N=>$_[0]},int64=>sub {if (HAS_QUADS){return pack(Q=>$_[0])}else {if ($_[0]>= 4294967296){my$high=int ($_[0]/ 4294967296);my$low=int ($_[0]- $high * 4294967296);return pack(NN=>$high,$low)}else {return pack(NN=>0,$_[0])}}},str=>sub {pack(N=>length($_[0])),$_[0]},char=>sub {$_[0]},attr=>sub {${_attrs_as_buffer $_[0]}});sub put {my$buf=shift;@_ & 1 and croak "bad number of arguments for put (@_)";my@parts;while (@_){my$type=shift;my$value=shift;my$packer=$pack{$type}or Carp::confess("internal error: bad packing type '$type'");push@parts,$packer->($value)}$$buf.=join('',@parts)}1; +NET_SFTP_FOREIGN_BUFFER + +$fatpacked{"Net/SFTP/Foreign/Common.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_COMMON'; + package Net::SFTP::Foreign::Common;our$VERSION='1.76_02';use strict;use warnings;use Carp;BEGIN {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",SSH2_FX_PERMISSION_DENIED,"Permission denied",SSH2_FX_FAILURE,"Failure",SSH2_FX_BAD_MESSAGE,"Bad message",SSH2_FX_NO_CONNECTION,"No connection",SSH2_FX_CONNECTION_LOST,"Connection lost",SSH2_FX_OP_UNSUPPORTED,"Operation unsupported");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}}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;croak$error if$sftp->{_autodie}}elsif ($sftp->{_error}){if ($sftp->{_error}!=Net::SFTP::Foreign::Constants::SFTP_ERR_CONNECTION_BROKEN()){$sftp->{_error}=0}}return$sftp->{_error}}sub _clear_error_and_status {my$sftp=shift;$sftp->_set_error;$sftp->_set_status}sub _copy_error {my ($sftp,$other)=@_;unless ($sftp->{_error}and $sftp->{_error}==Net::SFTP::Foreign::Constants::SFTP_ERR_CONNECTION_BROKEN()){$sftp->{_error}=$other->{_error}}}sub error {shift->{_error}}sub die_on_error {my$sftp=shift;$sftp->{_error}and croak(@_ ? "@_: $sftp->{_error}" : $sftp->{_error})}sub _ok_or_autodie {my$sftp=shift;return 1 unless$sftp->{_error};$sftp->{_autodie}and croak$sftp->{_error};undef}sub _set_errno {my$sftp=shift;if ($sftp->{_error}){my$status=$sftp->{_status}+ 0;my$error=$sftp->{_error}+ 0;if ($status==SSH2_FX_EOF){return}elsif ($status==SSH2_FX_NO_SUCH_FILE){$!=Errno::ENOENT()}elsif ($status==SSH2_FX_PERMISSION_DENIED){$!=Errno::EACCES()}elsif ($status==SSH2_FX_BAD_MESSAGE){$!=Errno::EBADMSG()}elsif ($status==SSH2_FX_OP_UNSUPPORTED){$!=Errno::ENOTSUP()}elsif ($status){$!=Errno::EIO()}}}sub _best_effort {my$sftp=shift;my$best_effort=shift;my$method=shift;local ($sftp->{_error},$sftp->{_autodie})if$best_effort;$sftp->$method(@_);return (($best_effort or not $sftp->{_error})? 1 : undef)}sub _call_on_error {my ($sftp,$on_error,$entry)=@_;$on_error and $sftp->error and $on_error->($sftp,$entry);$sftp->_clear_error_and_status}sub find {@_ >= 1 or croak 'Usage: $sftp->find($remote_dirs, %opts)';my$self=shift;my%opts=@_ & 1 ? ('dirs',@_): @_;$self->_clear_error_and_status;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};my$atomic_readdir=delete$opts{atomic_readdir};my$wanted=_gen_wanted(delete$opts{wanted},delete$opts{no_wanted});my$descend=_gen_wanted(delete$opts{descend},delete$opts{no_descend});%opts and croak "invalid option(s) '".CORE::join("', '",keys%opts)."'";$dirs='.' unless defined$dirs;my$wantarray=wantarray;my (@res,$res);my%done;my%rpdone;my@dirs=_ensure_list$dirs;my@queue=map {{filename=>$_ }}($ordered ? sort@dirs : @dirs);my$task=sub {my$entry=shift;my$fn=$entry->{filename};for (1){my$follow=($follow_links and _is_lnk($entry->{a}->perm));if ($follow or $realpath){unless (defined$entry->{realpath}){my$rp=$entry->{realpath}=$self->realpath($fn);next unless (defined$rp and not $rpdone{$rp}++)}}if ($follow){my$a=$self->stat($fn);if (defined$a){$entry->{a}=$a;unshift@queue,$entry}next}if (!$wanted or $wanted->($self,$entry)){if ($wantarray){push@res,($names_only ? (exists$entry->{realpath}? $entry->{realpath}: $entry->{filename}): $entry)}else {$res++}}}continue {$self->_call_on_error($on_error,$entry)}};my$try;while (@queue){no warnings 'uninitialized';$try=shift@queue;my$fn=$try->{filename};my$a=$try->{a}||=$self->lstat($fn)or next;next if (_is_dir($a->perm)and $done{$fn}++);$task->($try);if (_is_dir($a->perm)){if (!$descend or $descend->($self,$try)){if ($ordered or $atomic_readdir){my$ls=$self->ls($fn,ordered=>$ordered,_wanted=>sub {my$child=$_[1]->{filename};if ($child !~ /^\.\.?$/){$_[1]->{filename}=$self->join($fn,$child);return 1}undef})or next;unshift@queue,@$ls}else {$self->ls($fn,_wanted=>sub {my$entry=$_[1];my$child=$entry->{filename};if ($child !~ /^\.\.?$/){$entry->{filename}=$self->join($fn,$child);if (_is_dir($entry->{a}->perm)){push@queue,$entry}else {$task->($entry)}}undef})or next}}}}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};my$ordered=delete$opts{ordered};my$wanted=_gen_wanted(delete$opts{wanted},delete$opts{no_wanted});my$strict_leading_dot=delete$opts{strict_leading_dot};$strict_leading_dot=1 unless defined$strict_leading_dot;%opts and _croak_bad_options(keys%opts);my$wantarray=wantarray;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;while (@parts and @res){my@parents=@res;@res=();my$part=shift@parts;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};if ($has_wildcards){$sftp->ls($pfn,ordered=>$ordered,_wanted=>sub {my$e=$_[1];if ($e->{filename}=~ $re){my$fn=$e->{filename}=$sftp->join($pfn,$e->{filename});if ((@parts or $follow_links)and _is_lnk($e->{a}->perm)){if (my$a=$sftp->stat($fn)){$e->{a}=$a}else {$on_error and $sftp->_call_on_error($on_error,$e);return undef}}if (@parts){push@res,$e if _is_dir($e->{a}->perm)}elsif (!$wanted or $wanted->($sftp,$e)){if ($wantarray){if ($realpath){my$rp=$e->{realpath}=$sftp->realpath($e->{filename});unless (defined$rp){$on_error and $sftp->_call_on_error($on_error,$e);return undef}}push@res,($names_only ? ($realpath ? $e->{realpath}: $e->{filename}): $e)}$res++}}return undef})or ($on_error and $sftp->_call_on_error($on_error,$parent))}else {my$fn=$sftp->join($pfn,$part);my$method=((@parts or $follow_links)? 'stat' : 'lstat');if (my$a=$sftp->$method($fn)){my$e={filename=>$fn,a=>$a };if (@parts){push@res,$e if _is_dir($a->{perm})}elsif (!$wanted or $wanted->($sftp,$e)){if ($wantarray){if ($realpath){my$rp=$fn=$e->{realpath}=$sftp->realpath($fn);unless (defined$rp){$on_error and $sftp->_call_on_error($on_error,$e);next}}push@res,($names_only ? $fn : $e)}$res++}}}}}return wantarray ? @res : $res}sub test_d {my ($sftp,$name)=@_;{local$sftp->{_autodie};my$a=$sftp->stat($name);return _is_dir($a->perm)if$a}if ($sftp->{_status}==SSH2_FX_NO_SUCH_FILE){$sftp->_clear_error_and_status;return undef}$sftp->_ok_or_autodie}sub test_e {my ($sftp,$name)=@_;{local$sftp->{_autodie};$sftp->stat($name)and return 1}if ($sftp->{_status}==SSH2_FX_NO_SUCH_FILE){$sftp->_clear_error_and_status;return undef}$sftp->_ok_or_autodie}1; +NET_SFTP_FOREIGN_COMMON + +$fatpacked{"Net/SFTP/Foreign/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_COMPAT'; + package Net::SFTP::Foreign::Compat;our$VERSION='1.70_05';use warnings;use strict;use Carp;require Net::SFTP::Foreign;require Net::SFTP::Foreign::Constants;require Net::SFTP::Foreign::Attributes::Compat;our@ISA=qw(Net::SFTP::Foreign);my$supplant;sub import {for my$arg (@_[1..$#_]){if ($arg eq ':supplant'){if (!$supplant){$supplant=1;@Net::SFTP::ISA=qw(Net::SFTP::Foreign::Compat);@Net::SFTP::Attributes::ISA=qw(Net::SFTP::Foreign::Attributes::Compat);@Net::SFTP::Constant::ISA=qw(Net::SFTP::Foreign::Constants);$INC{q(Net/SFTP.pm)}=$INC{q(Net/SFTP/Foreign/Compat.pm)};$INC{q(Net/SFTP/Attributes.pm)}=$INC{q(Net/SFTP/Foreign/Compat.pm)};$INC{q(Net/SFTP/Constants.pm)}=$INC{q(Net/SFTP/Foreign/Compat.pm)}}}else {croak "invalid import tag '$arg'"}}}our%DEFAULTS=(put=>[best_effort=>1],get=>[best_effort=>1],ls=>[],new=>[]);BEGIN {my@forbidden=qw(setcwd cwd open opendir sftpread sftpwrite seek tell eof write flush read getc lstat stat fstat remove rmdir mkdir setstat fsetstat close closedir readdir realpath readlink rename symlink abort get_content join glob rremove rget rput error die_on_error);for my$method (@forbidden){my$super="SUPER::$method";no strict 'refs';*{$method}=sub {unless (index((caller)[0],"Net::SFTP::Foreign")==0){croak "Method '$method' is not available from " .__PACKAGE__ .", use the real Net::SFTP::Foreign if you want it!"}shift->$super(@_)}}}sub new {my ($class,$host,%opts)=@_;my$warn;if (exists$opts{warn}){$warn=delete($opts{warn})|| sub {}}else {$warn=sub {warn(CORE::join '',@_,"\n")}}my$sftp=$class->SUPER::new($host,@{$DEFAULTS{new}},%opts);$sftp->{_compat_warn}=$warn;return$sftp}sub _warn {my$sftp=shift;if (my$w=$sftp->{_compat_warn}){$w->(@_)}}sub _warn_error {my$sftp=shift;if (my$e=$sftp->SUPER::error){$sftp->_warn($e)}}sub status {my$status=shift->SUPER::status;return wantarray ? ($status + 0,"$status"): $status + 0}sub get {croak '$Usage: $sftp->get($local, $remote, $cb)' if @_ < 2 or @_ > 4;my ($sftp,$remote,$local,$cb)=@_;my$save=defined(wantarray);my@content;my@cb;if (defined$cb or $save){@cb=(callback=>sub {my ($sftp,$data,$off,$size)=@_;$cb->($sftp,$data,$off,$size)if$cb;push@content,$data if$save})}$sftp->SUPER::get($remote,$local,@{$DEFAULTS{get}},dont_save=>!defined($local),@cb)or return undef;if ($save){return CORE::join('',@content)}}sub put {croak '$Usage: $sftp->put($local, $remote, $cb)' if @_ < 3 or @_ > 4;my ($sftp,$local,$remote,$cb)=@_;$sftp->SUPER::put($local,$remote,@{$DEFAULTS{put}},callback=>$cb);$sftp->_warn_error;!$sftp->SUPER::error}sub ls {croak '$Usage: $sftp->ls($path, $cb)' if @_ < 2 or @_ > 3;my ($sftp,$path,$cb)=@_;if ($cb){$sftp->SUPER::ls($path,@{$DEFAULTS{ls}},wanted=>sub {_rebless_attrs($_[1]->{a});$cb->($_[1]);0});return ()}else {if (my$ls=$sftp->SUPER::ls($path,@{$DEFAULTS{ls}})){_rebless_attrs($_->{a})for @$ls;return @$ls}return ()}}sub do_open {shift->SUPER::open(@_)}sub do_opendir {shift->SUPER::opendir(@_)}sub do_realpath {shift->SUPER::realpath(@_)}sub do_read {my$sftp=shift;my$read=$sftp->SUPER::sftpread(@_);$sftp->_warn_error;if (wantarray){return ($read,$sftp->status)}else {return$read}}sub _gen_do_and_status {my$method="SUPER::" .shift;return sub {my$sftp=shift;$sftp->$method(@_);$sftp->_warn_error;$sftp->status}}*do_write=_gen_do_and_status('sftpwrite');*do_close=_gen_do_and_status('close');*do_setstat=_gen_do_and_status('setstat');*do_fsetstat=_gen_do_and_status('setstat');*do_remove=_gen_do_and_status('remove');*do_rename=_gen_do_and_status('rename');*do_mkdir=_gen_do_and_status('mkdir');*do_rmdir=_gen_do_and_status('rmdir');sub _rebless_attrs {my$a=shift;if ($a){bless$a,($supplant ? "Net::SFTP::Attributes" : "Net::SFTP::Foreign::Attributes::Compat")}$a}sub _gen_do_stat {my$name=shift;my$method="SUPER::$name";return sub {croak '$Usage: $sftp->'.$name.'($local, $remote, $cb)' if @_!=2;my$sftp=shift;if (my$a=$sftp->$method(@_)){return _rebless_attrs($a)}else {$sftp->_warn_error;return undef}}}*do_lstat=_gen_do_stat('lstat');*do_fstat=_gen_do_stat('fstat');*do_stat=_gen_do_stat('stat');1; +NET_SFTP_FOREIGN_COMPAT + +$fatpacked{"Net/SFTP/Foreign/Constants.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_CONSTANTS'; + package Net::SFTP::Foreign::Constants;our$VERSION='1.63_05';use strict;use warnings;use Carp;require Exporter;our@ISA=qw(Exporter);our (@EXPORT_OK,%EXPORT_TAGS);BEGIN {my%constants=(SSH2_FXP_INIT=>1,SSH2_FXP_VERSION=>2,SSH2_FXP_OPEN=>3,SSH2_FXP_CLOSE=>4,SSH2_FXP_READ=>5,SSH2_FXP_WRITE=>6,SSH2_FXP_LSTAT=>7,SSH2_FXP_FSTAT=>8,SSH2_FXP_SETSTAT=>9,SSH2_FXP_FSETSTAT=>10,SSH2_FXP_OPENDIR=>11,SSH2_FXP_READDIR=>12,SSH2_FXP_REMOVE=>13,SSH2_FXP_MKDIR=>14,SSH2_FXP_RMDIR=>15,SSH2_FXP_REALPATH=>16,SSH2_FXP_STAT=>17,SSH2_FXP_RENAME=>18,SSH2_FXP_READLINK=>19,SSH2_FXP_SYMLINK=>20,SSH2_FXP_STATUS=>101,SSH2_FXP_HANDLE=>102,SSH2_FXP_DATA=>103,SSH2_FXP_NAME=>104,SSH2_FXP_ATTRS=>105,SSH2_FXP_EXTENDED=>200,SSH2_FXP_EXTENDED_REPLY=>201,SSH2_FXF_READ=>0x01,SSH2_FXF_WRITE=>0x02,SSH2_FXF_APPEND=>0x04,SSH2_FXF_CREAT=>0x08,SSH2_FXF_TRUNC=>0x10,SSH2_FXF_EXCL=>0x20,SSH2_FX_OK=>0,SSH2_FX_EOF=>1,SSH2_FX_NO_SUCH_FILE=>2,SSH2_FX_PERMISSION_DENIED=>3,SSH2_FX_FAILURE=>4,SSH2_FX_BAD_MESSAGE=>5,SSH2_FX_NO_CONNECTION=>6,SSH2_FX_CONNECTION_LOST=>7,SSH2_FX_OP_UNSUPPORTED=>8,SSH2_FILEXFER_ATTR_SIZE=>0x01,SSH2_FILEXFER_ATTR_UIDGID=>0x02,SSH2_FILEXFER_ATTR_PERMISSIONS=>0x04,SSH2_FILEXFER_ATTR_ACMODTIME=>0x08,SSH2_FILEXFER_ATTR_EXTENDED=>0x80000000,SSH2_FILEXFER_VERSION=>3,SSH2_FXE_STATVFS_ST_READONLY=>0x1,SSH2_FXE_STATVFS_ST_NOSUID=>0x2,SFTP_ERR_REMOTE_STAT_FAILED=>1,SFTP_ERR_REMOTE_OPEN_FAILED=>2,SFTP_ERR_LOCAL_ALREADY_EXISTS=>3,SFTP_ERR_LOCAL_OPEN_FAILED=>26,SFTP_ERR_REMOTE_READ_FAILED=>5,SFTP_ERR_REMOTE_BLOCK_TOO_SMALL=>6,SFTP_ERR_LOCAL_WRITE_FAILED=>7,SFTP_ERR_REMOTE_BAD_PERMISSIONS=>8,SFTP_ERR_LOCAL_CHMOD_FAILED=>9,SFTP_ERR_REMOTE_BAD_TIME=>10,SFTP_ERR_LOCAL_UTIME_FAILED=>11,SFTP_ERR_REMOTE_BAD_MESSAGE=>13,SFTP_ERR_REMOTE_REALPATH_FAILED=>14,SFTP_ERR_REMOTE_OPENDIR_FAILED=>15,SFTP_ERR_REMOTE_WRITE_FAILED=>16,SFTP_ERR_REMOTE_RENAME_FAILED=>17,SFTP_ERR_REMOTE_LSTAT_FAILED=>18,SFTP_ERR_REMOTE_FSTAT_FAILED=>19,SFTP_ERR_REMOTE_CLOSE_FAILED=>20,SFTP_ERR_REMOTE_REMOVE_FAILED=>21,SFTP_ERR_REMOTE_MKDIR_FAILED=>22,SFTP_ERR_REMOTE_RMDIR_FAILED=>23,SFTP_ERR_REMOTE_SETSTAT_FAILED=>24,SFTP_ERR_REMOTE_FSETSTAT_FAILED=>25,SFTP_ERR_LOCAL_STAT_FAILED=>27,SFTP_ERR_LOCAL_READ_ERROR=>28,SFTP_ERR_REMOTE_READDIR_FAILED=>29,SFTP_ERR_REMOTE_READLINK_FAILED=>30,SFTP_ERR_REMOTE_SYMLINK_FAILED=>31,SFTP_ERR_REMOTE_BAD_PATH=>32,SFTP_ERR_LOCAL_MKDIR_FAILED=>33,SFTP_ERR_LOCAL_SYMLINK_FAILED=>34,SFTP_ERR_REMOTE_BAD_OBJECT=>35,SFTP_ERR_REMOTE_ACCESING_CLOSED_FILE=>36,SFTP_ERR_CONNECTION_BROKEN=>37,SFTP_ERR_LOCAL_GENERIC_ERROR=>38,SFTP_ERR_LOCAL_READLINK_FAILED=>39,SFTP_ERR_LOCAL_BAD_PATH=>40,SFTP_ERR_LOCAL_BAD_OBJECT=>41,SFTP_ERR_REMOTE_ALREADY_EXISTS=>42,SFTP_ERR_ABORTED=>44,SFTP_ERR_REMOTE_BIGGER_THAN_LOCAL=>45,SFTP_ERR_LOCAL_BIGGER_THAN_REMOTE=>46,SFTP_ERR_LOCAL_SEEK_FAILED=>47,SFTP_ERR_REMOTE_STATVFS_FAILED=>48,SFTP_ERR_REMOTE_FSTATVFS_FAILED=>49,SFTP_ERR_PASSWORD_AUTHENTICATION_FAILED=>50,SFTP_ERR_REMOTE_HARDLINK_FAILED=>51,SFTP_ERR_LOCAL_RENAME_FAILED=>52,SFTP_ERR_REMOTE_FSYNC_FAILED=>53,);for my$key (keys%constants){no strict 'refs';my$value=$constants{$key};*{$key}=sub () {$value}}@EXPORT_OK=keys%constants;my%etagre=qw(fxp SSH2_FXP_ flags SSH2_FXF_ att SSH2_FILEXFER_ATTR status SSH2_FX_ error SFTP_ERR_ ext SSH2_FXE_);for my$key (keys%etagre){my$re=qr/^$etagre{$key}/;$EXPORT_TAGS{$key}=[grep $_=~$re,@EXPORT_OK]}}1; +NET_SFTP_FOREIGN_CONSTANTS + +$fatpacked{"Net/SFTP/Foreign/Helpers.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_HELPERS'; + 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;sub _debug {local ($\,$!);my$caller='';if ($debug & 8192){$caller=(caller 1)[3];$caller =~ s/[\w:]*:://;$caller .= ': '}if ($debug & 256){my$ts=sprintf("%010.5f",time);print STDERR "#$$ $ts $caller",@_,"\n"}else {print STDERR "# $caller",@_,"\n"}}sub _hexdump {local ($\,$!);no warnings qw(uninitialized);my$data=shift;while ($data =~ /(.{1,32})/smg){my$line=$1;my@c=((map {sprintf "%02x",$_}unpack('C*',$line)),((" ")x 32))[0..31];$line=~s/(.)/ my $c=$1; unpack("c",$c)>=32 ? $c : '.' /egms;local $\;print STDERR join(" ",@c,'|',$line),"\n"}}sub _do_nothing {}{my$has_sk;sub _has_sk {unless (defined$has_sk){local $@;local$SIG{__DIE__};eval {require Sort::Key};$has_sk=($@ eq '')}return$has_sk}}sub _sort_entries {my$e=shift;if (_has_sk){&Sort::Key::keysort_inplace(sub {$_->{filename}},$e)}else {@$e=sort {$a->{filename}cmp $b->{filename}}@$e}}sub _gen_wanted {my ($ow,$onw)=my ($w,$nw)=@_;if (ref$w eq 'Regexp'){$w=sub {$_[1]->{filename}=~ $ow}}if (ref$nw eq 'Regexp'){$nw=sub {$_[1]->{filename}!~ $onw}}elsif (defined$nw){$nw=sub {!&$onw}}if (defined$w and defined$nw){return sub {&$nw and &$w}}return$w || $nw}sub _ensure_list {my$l=shift;return ()unless defined$l;local $@;local$SIG{__DIE__};local$SIG{__WARN__};no warnings;(eval {@$l;1}? @$l : $l)}sub _glob_to_regex {my ($glob,$strict_leading_dot,$ignore_case)=@_;my ($regex,$in_curlies,$escaping);my$wildcards=0;my$first_byte=1;while ($glob =~ /\G(.)/g){my$char=$1;if ($char eq '\\'){$escaping=1}else {if ($first_byte){if ($strict_leading_dot){$regex .= '(?=[^\.])' unless$char eq '.'}$first_byte=0}if ($char eq '/'){$first_byte=1}if ($escaping){$regex .= quotemeta$char}else {$wildcards++;if ($char eq '*'){$regex .= ".*"}elsif ($char eq '?'){$regex .= '.'}elsif ($char eq '{'){$regex .= '(?:(?:';++$in_curlies}elsif ($char eq '}'){$regex .= "))";--$in_curlies;$in_curlies < 0 and croak "invalid glob pattern"}elsif ($char eq ',' && $in_curlies){$regex .= ")|(?:"}elsif ($char eq '['){if ($glob =~ /\G((?:\\.|[^\]])+)\]/g){$regex .= "[$1]"}else {croak "invalid glob pattern"}}else {$wildcards--;$regex .= quotemeta$char}}$escaping=0}}croak "invalid glob pattern" if$in_curlies;my$re=$ignore_case ? qr/^$regex$/i : qr/^$regex$/;wantarray ? ($re,($wildcards > 0 ? 1 : undef)): $re}sub _tcroak {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)}}}}sub _gen_dos2unix {my$unix2dos=shift;my$name=($unix2dos ? 'unix2dos' : 'dos2unix');my$previous;my$done;sub {$done and die "Internal error: bad calling sequence for $name transformation";my$adjustment=0;for (@_){if ($debug and $debug & 128){_debug ("before $name: previous: $previous, data follows...");_hexdump($_)}if (length){if ($previous){$adjustment++;$_="\x0d$_"}$adjustment -= $previous=s/\x0d\z//s;if ($unix2dos){$adjustment += s/(?($_[0]);length($_[0])- $before}}else {croak "unsupported conversion argument"}}elsif ($conversion eq 'dos2unix'){return _gen_dos2unix(0)}elsif ($conversion eq 'unix2dos'){return _gen_dos2unix(1)}else {croak "unknown conversion '$conversion'"}}sub _is_lnk {(0120000 & shift)==0120000}sub _is_dir {(0040000 & shift)==0040000}sub _is_reg {(0100000 & shift)==0100000}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;if (defined$umask){my$old=umask$umask;return bless \$old,'Net::SFTP::Foreign::Helpers::umask_saver'}()}sub Net::SFTP::Foreign::Helpers::umask_saver::DESTROY {umask ${$_[0]}}1; +NET_SFTP_FOREIGN_HELPERS + +$fatpacked{"Net/SFTP/Foreign/Local.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_SFTP_FOREIGN_LOCAL'; + package Net::SFTP::Foreign::Local;our$VERSION='1.57';use strict;use warnings;use Carp;use File::Spec;use Net::SFTP::Foreign::Attributes;use Net::SFTP::Foreign::Constants qw(:error);use Net::SFTP::Foreign::Helpers qw(_sort_entries _gen_wanted _do_nothing);require Net::SFTP::Foreign::Common;our@ISA=qw(Net::SFTP::Foreign::Common);sub new {my$class=shift;my$self={status=>0,error=>0 };bless$self,$class}sub realpath {$!=0;File::Spec->rel2abs($_[1])}sub stat {$!=0;my$a=Net::SFTP::Foreign::Attributes->new_from_stat(CORE::stat($_[1]));unless ($a){$_[0]->_set_error(SFTP_ERR_LOCAL_STAT_FAILED,"Couldn't stat local file '$_[1]'",$!)}$a}sub lstat {$!=0;my$a=Net::SFTP::Foreign::Attributes->new_from_stat(CORE::lstat($_[1]));unless ($a){$_[0]->_set_error(SFTP_ERR_LOCAL_STAT_FAILED,"Couldn't stat local file '$_[1]'",$!)}$a}sub readlink {$!=0;my$target=readlink $_[1];unless (defined$target){$_[0]->_set_error(SFTP_ERR_LOCAL_READLINK_FAILED,"Couldn't read link '$_[1]'",$!)}$target}sub join {shift;my$path=File::Spec->join(@_);$path=File::Spec->canonpath($path);$path}sub ls {my ($self,$dir,%opts)=@_;my$ordered=delete$opts{ordered};my$follow_links=delete$opts{follow_links};my$atomic_readdir=delete$opts{atomic_readdir};my$wanted=delete$opts{_wanted}|| _gen_wanted(delete$opts{wanted},delete$opts{no_wanted});%opts and croak "invalid option(s) '".CORE::join("', '",keys%opts)."'";$!=0;opendir(my$ldh,$dir)or return undef;my@dir;while (defined(my$part=readdir$ldh)){my$fn=File::Spec->join($dir,$part);my$a=$self->lstat($fn);if ($a and $follow_links and S_ISLNK($a->perm)){if (my$fa=$self->stat($fn)){$a=$fa}else {$!=0}}my$entry={filename=>$part,a=>$a };if ($atomic_readdir or!$wanted or $wanted->($self,$entry)){push@dir,$entry}}if ($atomic_readdir and $wanted){@dir=grep {$wanted->($self,$_)}@dir}_sort_entries(\@dir)if$ordered;return \@dir}1; +NET_SFTP_FOREIGN_LOCAL + +s/^ //mg for values %fatpacked; + +my $class = 'FatPacked::'.(0+\%fatpacked); +no strict 'refs'; +*{"${class}::files"} = sub { keys %{$_[0]} }; + +if ($] < 5.008) { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + return sub { + return 0 unless length $fat; + $fat =~ s/^([^\n]*\n?)//; + $_ = $1; + return 1; + }; + } + return; + }; +} + +else { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + open my $fh, '<', \$fat + or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; + return $fh; + } + return; + }; +} + +unshift @INC, bless \%fatpacked, $class; + } # END OF FATPACK CODE + diff --git a/basshfs.1 b/basshfs.1 new file mode 100644 index 0000000..b115a39 --- /dev/null +++ b/basshfs.1 @@ -0,0 +1,308 @@ +.TH "basshfs" "1" "06 Sep 2019" "" "" +./"################################################################ +.SH "NAME" +./"################################################################ +\fBbasshfs\fP \(em Bash-Accessible SSH File System +./"################################################################ +.SH "SYNOPSIS" +./"################################################################ +.nf +Mount: \fBeval `basshfs [USER@]HOST:[DIR] MOUNTPOINT [OPTIONS]`\fP +Unmount: \fBeval `basshfs -u MOUNTPOINT`\fP +List: \fBbasshfs -l\fP +.fi +.PP +Mount and unmount remote file systems as if they were local. +./"################################################################ +.SH "DESCRIPTION" +./"################################################################ +Working with remote systems over SSH is common in HPC environments +where the size of data sets makes them nontrivial to relocate. To run +arbitrary commands on that data, a full SSH session is required. There +are cases, however, when the user may wish to perform simpler operations +such as checking file existence and size, viewing differences between +configuration files, creating directories, etc. that can be achieved +with more limited access. Juggling multiple sessions to multiple hosts +may be inconvenient for such simple tasks. BASSHFS is a tool that +allows users to perform such tasks within a single terminal on a single +host by transparently carrying out remote operations as needed to +present remote files as if they are locally mounted when using the bash +shell. +.PP +BASSHFS is similar to the existing SSHFS utility except it is does not +require FUSE kernel support. Instead, BASSHFS uses the aliasing and +function mechanisms of the bash shell to intercept program invocations +and remap those that are supported to its own versions. These internal +versions determine if files on the command line are local or remote. +Remote files are processed transparently using a persistent SSH +connection to the associated host(s). Output associated with the local +and remote files is then multiplexed together into the standard unified +format associated with the original command. To the user, it appears as +if all files reside on a local file system even though they may span +multiple files systems on multiple hosts. +./"################################################################ +.SH "REQUIREMENTS" +./"################################################################ +BASSHFS functionality is only supported within the Bash shell and +requires SSH and Perl version 5.8.5 or above. It also requires the +standard Unix utilities cat, column, false, sort, and true and has been +tested successfully on Linux, OS X, and Windows under Cygwin. Note that +users of Windows under Cygwin may need to install the coreutils and +util-linux packages to obtain these utilities. +./"################################################################ +.SH "USAGE" +./"################################################################ +.IP "Mount file system" +Before a remote file system can be accessed, it must be "mounted" +locally. Note that this is not a true file system mount as with SSHFS, +but a virtual mount that is only known to certain commands within the +Bash shell currently running. The mount point must not correspond to +any existing file or directory. In order for the corresponding aliases +and functions to be imported into the existing Bash environment, the +command must be executed in an eval statement. +.PP +.RS +.RS +.nf +\fBeval `basshfs [USER@]HOST:[DIR] MOUNTPOINT [OPTIONS]`\fP +.fi +.RE +.RE +.IP +For example, to mount /home on host1 as /mnt/home1: +.PP +.RS +.RS +.nf +\fBeval `basshfs host1:/home1 /mnt/home1`\fP +.fi +.RE +.RE +.IP +By default, BASSHFS will access remote hosts using the bare "ssh" +command. If additional options are needed, the -s option may be used. +For example, if host1 can only be accessed by first hopping through +bastion1, the corresponding mount command would be: +.PP +.RS +.RS +.nf +\fBeval `basshfs -s "ssh bastion1 ssh" host1:/home1 /mnt/home1`\fP +.fi +.RE +.RE +.IP +For use within a non-interactive bash shell, the script must set the +expand_aliases option. For example: +.PP +.RS +.RS +.nf +#!/bin/bash +shopt -s expand_aliases +eval `basshfs host1:/home1 /mnt/home1` +.fi +.RE +.RE +.IP +The use of BASSHFS overrides previously defined aliases for supported +commands. For example, if "ls" was previously aliases to "ls +--color=always", once a file system is mounted, ls would no longer show +colorized output. If desired, default options for any supported command +can be specified using the -oCMD=OPTS option. For example, to set the +above option for ls, the following can be used: +.PP +.RS +.RS +.nf +\fBeval `basshfs -ols="--color=always" host1:/home1 /mnt/home1`\fP +.fi +.RE +.RE +.IP +Note that built-in commands support only a limited subset of the +available options found in their standard counterparts so options added +in this manner may only apply to local files and not to those that +reside on remote file systems. +.IP "Unmount file system" +To "unmount" a mounted file system and terminate any underlying +processes, the -u option is used. Similar to mount, in order for the +corresponding aliases and functions to be removed from the existing +Bash environment, the command must be executed in an eval statement. +.PP +.RS +.RS +.nf +\fBeval `basshfs -u MOUNTPOINT`\fP +.fi +.RE +.RE +.IP +For example, to unmount the previously mounted /mnt/home1: +.PP +.RS +.RS +.nf +\fBeval `basshfs -u /mnt/home1`\fP +.fi +.RE +.RE +.IP "List mounted file systems" +To see the list of mounted file systems, the -l option is used. Note +that it is not necessary to use an eval statement in this case. +.PP +.RS +.RS +.nf +\fBbasshfs -l\fP +.fi +.RE +.RE +./"################################################################ +.SH "COMMANDS" +./"################################################################ +Once a remote file system is mounted, a specific set of commands may +be run on locations within the mounted hierarchy as if the file system +were local. Tab completion is also supported normally. Currently +supported commands and their currently supported options are below. +Unsupported options will simply be ignored except where noted. +.IP "\fBcat\fP (no options)" +.IP "\fBcd\fP (no options)" +Note that when changing to remote directories, cd only changes +$PWD so to make changes visible, the working directory (i.e. \w in +bash) must be in your prompt. For example, the following prompt: +.PP +.RS +.RS +.nf +export PS1="\\h:\\w> " +.fi +.RE +.RE +.IP +would display the current host name followed by the current +working directory. +.IP "\fBchgrp\fP (no options)" +Groups may be specified either by number or by name. Names will be +resolved on the remote host. +.IP "\fBchmod\fP (no options)" +Modes must be specified numerically (e.g. 0700). Symbolic modes, such +as a+rX, are not currently supported. +.IP "\fBchown\fP (no options)" +Users and groups may be specified either by number or by name. Names +will be resolved on the remote host. +.IP "\fBcmp\fP (all options)" +.IP "\fBcp\fP [-r]" +Note that copies between two remote hosts transfer files to the local +host first since BASSHFS does not allow third party transfers. Thus, +very large file transfers between remote systems should be achieved +using an alternate approach. +.IP "\fBdf\fP [-i]" +Note that 1024-byte blocks are used. +.IP "\fBdiff\fP (all options)" +.IP "\fBdu\fP [-a] [-b] [-s]" +Note that 1024-byte blocks are used. +.IP "\fBfile\fP (all options)" +.IP "\fBgrep\fP (all options)" +.IP "\fBhead\fP [-number]" +Note that head does not support the form "-n number", thus, for +example, to display the first 5 lines of a file, use "-5" and not "-n +5". +.IP "\fBless\fP (all options)" +.IP "\fBln\fP [-s]" +Note that hard links are not supported. +.IP "\fBls\fP [-1] [-d] [-l]" +For efficiency purposes, ls behaves slightly differently for remote +commands than for local. In particular "ls -l" will not show links by +default and will show what is actually linked instead of the link +itself. Link details can be obtained using the "-d" option (e.g. ls -ld +*). +.IP +Also for efficiency, ls processes remote files before local files, so +output ordering may be changed when remote and local files are +interleaved on the ls command line. For example, "ls /foo /mnt/host1 +/bar" would show /mnt/host1 first, then /foo, then /bar. +.IP "\fBmkdir\fP (no options)" +.IP "\fBmore\fP (all options)" +.IP "\fBmount\fP (all options)" +.IP "\fBmv\fP (no options)" +.IP "\fBpwd\fP (no options)" +.IP "\fBrm\fP [-r]" +.IP "\fBrmdir\fP (no options)" +.IP "\fBtail\fP [-number]" +Note that tail does not support the form "-n number", thus, for +example, to display the last 5 lines of a file, use "-5" and not "-n 5". +.IP "\fBtee\fP [-a]" +.IP "\fBtest\fP [-b] [-c] [-d] [-e] [-f] [-g] [-h] [-k] [-L] [-p] [-r] [-s] [-S] [-u] [-w]" +Note that compound and string tests are not supported. Compound and +string tests can be achieved using multiple test commands separated by +shell compound operators. For example, +.PP +.RS +.RS +.nf +test -f /mnt/host1/foo -a "abc" != "123" +.fi +.RE +.RE +.IP +would become: +.PP +.RS +.RS +.nf +test -f /mnt/host1/foo && test "abc" != "123" +.fi +.RE +.RE +.IP "\fBtouch\fP (no options) +.IP "\fBwc\fP (all options) +./"################################################################ +.SH "CAVEATS" +./"################################################################ +In general, BASSHFS works for the most common usage scenarios with +some caveats. In particular: +.IP - +"Whole file" commands (i.e. commands that must process the entire +file), including cat, cmp, diff, grep, wc (and currently more/less due +to implementation) retrieve files first before processing for +efficiency. Thus, these commands should not be executed on very large +files. +.IP - +There is a conflict between commands that take piped input and the +custom globbing utilized by BASSHFS, thus these commands have portions +of globbing support disabled. These commands are grep, head, less, +more, tail, tee, and wc. In these cases, globbing will work for +absolute prefixes, but not relative. For example, "grep foo +/mnt/host1/tmp/*" will work, but "cd /mnt/host1/tmp; grep foo *" will +not. +.IP - +Redirection to/from remote files doesn't work. The same effect can be +achieved using cat and tee (e.g. "grep localhost a" would become "cat /mnt/host1/etc/hosts |grep localhost | tee -a +>/dev/null"). Redirection still works normally for local files. +.IP - +The first time a command is run involving a particular host, a SFTP +connection is created to that host. When running "ps", it may appear as +if a zombie client process is running. +.IP - +Commands may hang the first time after switching networks (e.g. with +a laptop). If this happens, hit Control-c and it will work the next +time. +.IP - +The ls command does not show BASSHFS mount points. +.IP - +The wc command shows the names of the local copies of the file +arguments instead of the original names. +.IP - +Various commands and completion may expand relative paths to absolute +paths. +./"################################################################ +.SH "AUTHOR" +./"################################################################ +BASSHFS was written by Paul Kolano. +./"################################################################ +.SH "SEE ALSO" +./"################################################################ +bash(1), sshfs(1) +