X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=SCP.pm;h=4bc087291a6d8628789dec0ff24dfaec53c73e9e;hb=6ad7096aae37b5c2e1ca5d265f5f79e4b2d736e1;hp=bbceed3f8ca7d27eb8d238909cd9068d850bc992;hpb=f43e25ef4731f835f859f16bcf08b833637eaeb4;p=Net-SCP.git diff --git a/SCP.pm b/SCP.pm index bbceed3..4bc0872 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.03'; $scp = "scp"; @@ -26,6 +28,16 @@ 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->get("filename") or die $scp->{errstr}; + $scp->put("filename") or die $scp->{errstr}; + #tmtowtdi + $scp = new Net::SCP; + $scp->scp($source, $destination); + #Net::FTP-style $scp = Net::SCP->new("hostname"); $scp->login("user"); @@ -44,33 +56,67 @@ 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 ) { + my $errstr = join('', <$error>); + #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->{'interact'} = 1; + $self->scp(@_); + } else { + scp(@_, 1); } } @@ -90,21 +136,33 @@ 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 + 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 : '' ), + 'interactive' => 0, + 'cwd' => '', + }; + } bless($self, $class); } @@ -116,7 +174,7 @@ Compatibility method. Optionally sets the user. sub login { my($self, $user) = @_; - $self->{'user'} = $user; + $self->{'user'} = $user if $user; } =item cwd CWD @@ -149,10 +207,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 +225,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 +270,16 @@ sub binary { 1; } =back -=head1 AUTHOR +=head1 AUTHORS + +Ivan Kohler +Anthony Deaver -Ivan Kohler +Thanks to Jon Gunnip for fixing a bug with size(). =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.