From d2320ef628c4b6261c7e0dbdaf6103ae7ec518a3 Mon Sep 17 00:00:00 2001 From: ivan Date: Sun, 26 Nov 2000 06:16:19 +0000 Subject: [PATCH] patch from Anthony Deaver and some rewrites --- SCP.pm | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 101 insertions(+), 29 deletions(-) diff --git a/SCP.pm b/SCP.pm index cb2e589..6a25ccd 100644 --- a/SCP.pm +++ b/SCP.pm @@ -3,14 +3,16 @@ package Net::SCP; use strict; use vars qw($VERSION @ISA @EXPORT_OK $scp); use Exporter; +use Carp; use File::Basename; use String::ShellQuote; use IO::Handle; use Net::SSH qw(sshopen3); +use IPC::Open3; @ISA = qw(Exporter); @EXPORT_OK = qw( scp iscp ); -$VERSION = '0.01'; +$VERSION = '0.02'; $scp = "scp"; @@ -26,6 +28,18 @@ Net::SCP - Perl extension for secure copy protocol iscp($source, $destination); #shows command, asks for confirmation, and #allows user to type a password on tty + #OO interface + $scp = Net::SCP->new( "hostname", "username" ); + #with named params + $scp = Net::SCP->new( { "host"=>$hostname, "user"=>$username } ); + $scp->set( + cwd => "/dir", + verbose => "yes", + interact => "yes" + ); + $scp->get("filename") or die $scp->{errstr}; + $scp->put("filename") or die $scp->{errstr}; + #Net::FTP-style $scp = Net::SCP->new("hostname"); $scp->login("user"); @@ -44,33 +58,66 @@ Simple wrappers around ssh and scp commands. =item scp SOURCE, DESTINATION +Can be called either as a subroutine or a method; however, the subroutine +interface is depriciated. + Calls scp in batch mode, with the B<-B> B<-p> B<-q> and B<-r> options. +Returns false upon error, with a text error message accessable in +$scp->{errstr}. + +Returns false and sets the B attribute if there is an error. =cut sub scp { - my($src, $dest) = @_; - my $flags = '-Bpq'; + my $self = ref($_[0]) ? shift : {}; + my($src, $dest, $interact) = @_; + my $flags = '-p'; $flags .= 'r' unless &_islocal($src) && ! -d $src; my @cmd = ( $scp, $flags, $src, $dest ); - system(@cmd); + if ( ( defined($interact) && $interact ) + || ( defined($self->{interact}) && $self->{interact} ) ) { + print join(' ', @cmd), "\n"; + unless ( &_yesno ) { + $self->{errstr} = "User declined"; + return 0; + } + } else { + $flags .= 'qB'; + } + my($reader, $writer, $error ) = + ( new IO::Handle, new IO::Handle, new IO::Handle ); + $writer->autoflush(1);# $error->autoflush(1); + my $pid = open3($writer, $reader, $error, @cmd ); + waitpid $pid, 0; + if ( $? >> 8 ) { + chomp(my $errstr = <$error>); + $self->{errstr} = $errstr; + 0; + } else { + 1; + } } =item iscp SOURCE, DESTINATION +Can be called either as a subroutine or a method; however, the subroutine +interface is depriciated. + Prints the scp command to be execute, waits for the user to confirm, and (optionally) executes scp, with the B<-p> and B<-r> flags. +Returns false and sets the B attribute if there is an error. + =cut sub iscp { - my($src, $dest) = @_; - my $flags = '-p'; - $flags .= 'r' unless &_islocal($src) && ! -d $src; - my @cmd = ( $scp, $flags, $src, $dest ); - print join(' ', @cmd), "\n"; - if ( &_yesno ) { - system(@cmd); + if ( ref($_[0]) ) { + my $self = shift; + $self->set( 'interact' => 1 ); + $self->scp(@_); + } else { + scp(@_, 1); } } @@ -90,21 +137,35 @@ sub _islocal { =over 4 -=item new HOSTNAME +=item new HOSTNAME [ USER ] | HASHREF -This is the constructor for a new Net::SCP object. Additional parameters -are ignored. +This is the constructor for a new Net::SCP object. You must specify a +hostname, and may optionally provide a user. Alternatively, you may pass a +hashref of named params, with the following keys: + + host - hostname + user - username + verbose - bool + interactive - bool + cwd - current working directory on remote server =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; - my $self = { - 'host' => shift, - 'user' => '', - 'cwd' => '', - }; + my $self; + if ( ref($_[0]) ) { + $self = shift; + } else { + $self = { + 'host' => shift, + 'user' => ( scalar(@_) ? shift : '' ), + 'verbose' => 0, + 'interactive' => 0, + 'cwd' => '', + }; + } bless($self, $class); } @@ -149,10 +210,12 @@ sub get { =item size FILE Returns the size in bytes for the given file as stored on the remote server. +Returns 0 on error, and sets the B attribute. In the case of an actual +zero-length file on the remote server, the special value '0e0' is returned, +which evaluates to zero when used as a number, but is true. (Implementation note: An ssh connection is established to the remote machine -and wc is used to determine the file size. No distinction is currently made -between nonexistant and zero-length files.) +and wc is used to determine the file size.) =cut @@ -165,13 +228,21 @@ sub size { ( new IO::Handle, new IO::Handle, new IO::Handle ); $writer->autoflush(1);# $error->autoflush(1); #sshopen2($host, $reader, $writer, 'wc', '-c ', shell_quote($file) ); - sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) ); - chomp( my $size = <$reader> || 0 ); - if ( $size =~ /^\s+(\d+)/ ) { - $1; - } else { - warn "unparsable output from remote wc"; + my $pid = + sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) ); + waitpid $pid, 0; + if ( $? >> 8 ) { + chomp(my $errstr = <$error>); + $self->{errstr} = $errstr || "wc exited with status ". $?>>8; 0; + } else { + chomp( my $size = <$reader> || 0 ); + if ( $size =~ /^\s+(\d+)/ ) { + $1 ? $1 : '0e0'; + } else { + $self->{errstr} = "unparsable output from remote wc: $size"; + 0; + } } } @@ -202,13 +273,14 @@ sub binary { 1; } =back -=head1 AUTHOR +=head1 AUTHORS Ivan Kohler +Anthony Deaver =head1 BUGS -Not OO. +Still has no-OO cruft. In order to work around some problems with commercial SSH2, if the source file is on the local system, and is not a directory, the B<-r> flag is omitted. -- 2.11.0