SCP.pm

   1 package Net::SCP;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA @EXPORT_OK $scp);
   5 use Exporter;
   6 use Carp;
   7 use File::Basename;
   8 use String::ShellQuote;
   9 use IO::Handle;
  10 use Net::SSH qw(sshopen3);
  11 use IPC::Open3;
  12
  13 @ISA = qw(Exporter);
  14 @EXPORT_OK = qw( scp iscp );
  15 $VERSION = '0.02';
  16
  17 $scp = "scp";
  18
  19 =head1 NAME
  20
  21 Net::SCP - Perl extension for secure copy protocol
  22
  23 =head1 SYNOPSIS
  24
  25   #procedural interface
  26   use Net::SCP qw(scp iscp);
  27   scp($source, $destination);
  28   iscp($source, $destination); #shows command, asks for confirmation, and
  29                                #allows user to type a password on tty
  30
  31   #OO interface
  32   $scp = Net::SCP->new( "hostname", "username" );
  33   #with named params
  34   $scp = Net::SCP->new( { "host"=>$hostname, "user"=>$username } );
  35   $scp->set(
  36     cwd      => "/dir",
  37     verbose  => "yes",
  38     interact => "yes"
  39   );
  40   $scp->get("filename") or die $scp->{errstr};
  41   $scp->put("filename") or die $scp->{errstr};
  42
  43   #Net::FTP-style
  44   $scp = Net::SCP->new("hostname");
  45   $scp->login("user");
  46   $scp->cwd("/dir");
  47   $scp->size("file");
  48   $scp->get("file");
  49   $scp->quit;
  50
  51 =head1 DESCRIPTION
  52
  53 Simple wrappers around ssh and scp commands.
  54
  55 =head1 SUBROUTINES
  56
  57 =over 4
  58
  59 =item scp SOURCE, DESTINATION
  60
  61 Can be called either as a subroutine or a method; however, the subroutine
  62 interface is depriciated.
  63
  64 Calls scp in batch mode, with the B<-B> B<-p> B<-q> and B<-r> options.
  65 Returns false upon error, with a text error message accessable in
  66 $scp->{errstr}.
  67
  68 Returns false and sets the B<errstr> attribute if there is an error.
  69
  70 =cut
  71
  72 sub scp {
  73   my $self = ref($_[0]) ? shift : {};
  74   my($src, $dest, $interact) = @_;
  75   my $flags = '-p';
  76   $flags .= 'r' unless &_islocal($src) && ! -d $src;
  77   my @cmd = ( $scp, $flags, $src, $dest );
  78   if ( ( defined($interact) && $interact )
  79        || ( defined($self->{interact}) && $self->{interact} ) ) {
  80     print join(' ', @cmd), "\n";
  81     unless ( &_yesno ) {
  82       $self->{errstr} = "User declined";
  83       return 0;
  84     }
  85   } else {
  86     $flags .= 'qB';
  87   }
  88   my($reader, $writer, $error ) =
  89     ( new IO::Handle, new IO::Handle, new IO::Handle );
  90   $writer->autoflush(1);#  $error->autoflush(1);
  91   my $pid = open3($writer, $reader, $error, @cmd );
  92   waitpid $pid, 0;
  93   if ( $? >> 8 ) {
  94     chomp(my $errstr = <$error>);
  95     $self->{errstr} = $errstr;
  96     0;
  97   } else {
  98     1;
  99   }
 100 }
 101
 102 =item iscp SOURCE, DESTINATION
 103
 104 Can be called either as a subroutine or a method; however, the subroutine
 105 interface is depriciated.
 106
 107 Prints the scp command to be execute, waits for the user to confirm, and
 108 (optionally) executes scp, with the B<-p> and B<-r> flags.
 109
 110 Returns false and sets the B<errstr> attribute if there is an error.
 111
 112 =cut
 113
 114 sub iscp {
 115   if ( ref($_[0]) ) {
 116     my $self = shift;
 117     $self->set( 'interact' => 1 );
 118     $self->scp(@_);
 119   } else {
 120     scp(@_, 1);
 121   }
 122 }
 123
 124 sub _yesno {
 125   print "Proceed [y/N]:";
 126   my $x = scalar(<STDIN>);
 127   $x =~ /^y/i;
 128 }
 129
 130 sub _islocal {
 131   shift !~ /^[^:]+:/
 132 }
 133
 134 =back
 135
 136 =head1 METHODS
 137
 138 =over 4
 139
 140 =item new HOSTNAME [ USER ] | HASHREF
 141
 142 This is the constructor for a new Net::SCP object.  You must specify a
 143 hostname, and may optionally provide a user.  Alternatively, you may pass a
 144 hashref of named params, with the following keys:
 145
 146     host - hostname
 147     user - username
 148     verbose - bool
 149     interactive - bool
 150     cwd - current working directory on remote server
 151
 152 =cut
 153
 154 sub new {
 155   my $proto = shift;
 156   my $class = ref($proto) || $proto;
 157   my $self;
 158   if ( ref($_[0]) ) {
 159     $self = shift;
 160   } else {
 161     $self = {
 162               'host'        => shift,
 163               'user'        => ( scalar(@_) ? shift : '' ),
 164               'verbose'     => 0,
 165               'interactive' => 0,
 166               'cwd'         => '',
 167             };
 168   }
 169   bless($self, $class);
 170 }
 171
 172 =item login [USER]
 173
 174 Compatibility method.  Optionally sets the user.
 175
 176 =cut
 177
 178 sub login {
 179   my($self, $user) = @_;
 180   $self->{'user'} = $user;
 181 }
 182
 183 =item cwd CWD
 184
 185 Sets the cwd (used for a subsequent get or put request without a full pathname).
 186
 187 =cut
 188
 189 sub cwd {
 190   my($self, $cwd) = @_;
 191   $self->{'cwd'} = $cwd || '/';
 192 }
 193
 194 =item get REMOTE_FILE [, LOCAL_FILE]
 195
 196 Uses scp to transfer REMOTE_FILE from the remote host.  If a local filename is
 197 omitted, uses the basename of the remote file.
 198
 199 =cut
 200
 201 sub get {
 202   my($self, $remote, $local) = @_;
 203   $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
 204   $local ||= basename($remote);
 205   my $source = $self->{'host'}. ":$remote";
 206   $source = $self->{'user'}. '@'. $source if $self->{'user'};
 207   scp($source,$local);
 208 }
 209
 210 =item size FILE
 211
 212 Returns the size in bytes for the given file as stored on the remote server.
 213 Returns 0 on error, and sets the B<errstr> attribute.  In the case of an actual
 214 zero-length file on the remote server, the special value '0e0' is returned,
 215 which evaluates to zero when used as a number, but is true.
 216
 217 (Implementation note: An ssh connection is established to the remote machine
 218 and wc is used to determine the file size.)
 219
 220 =cut
 221
 222 sub size {
 223   my($self, $file) = @_;
 224   $file = $self->{'cwd'}. "/$file" if $self->{'cwd'} && $file !~ /^\//;
 225   my $host = $self->{'host'};
 226   $host = $self->{'user'}. '@'. $host if $self->{'user'};
 227   my($reader, $writer, $error ) =
 228     ( new IO::Handle, new IO::Handle, new IO::Handle );
 229   $writer->autoflush(1);#  $error->autoflush(1);
 230   #sshopen2($host, $reader, $writer, 'wc', '-c ', shell_quote($file) );
 231   my $pid =
 232     sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) );
 233   waitpid $pid, 0;
 234   if ( $? >> 8 ) {
 235     chomp(my $errstr = <$error>);
 236     $self->{errstr} = $errstr || "wc exited with status ". $?>>8;
 237     0;
 238   } else {
 239     chomp( my $size = <$reader> || 0 );
 240     if ( $size =~ /^\s+(\d+)/ ) {
 241       $1 ? $1 : '0e0';
 242     } else {
 243       $self->{errstr} = "unparsable output from remote wc: $size";
 244       0;
 245     }
 246   }
 247 }
 248
 249 =item put LOCAL_FILE [, REMOTE_FILE]
 250
 251 Uses scp to trasnfer LOCAL_FILE to the remote host.  If a remote filename is
 252 omitted, uses the basename of the local file.
 253
 254 =cut
 255
 256 sub put {
 257   my($self, $local, $remote) = @_;
 258   $remote ||= basename($local);
 259   $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
 260   my $dest = $self->{'host'}. ":$remote";
 261   $dest = $self->{'user'}. '@'. $dest if $self->{'user'};
 262   warn "scp $local $dest\n";
 263   scp($local, $dest);
 264 }
 265
 266 =item binary
 267
 268 Compatibility method: does nothing; returns true.
 269
 270 =cut
 271
 272 sub binary { 1; }
 273
 274 =back
 275
 276 =head1 AUTHORS
 277
 278 Ivan Kohler <ivan-netscp_pod@420.am>
 279 Anthony Deaver <bishop@projectmagnus.org>
 280
 281 =head1 BUGS
 282
 283 Still has no-OO cruft.
 284
 285 In order to work around some problems with commercial SSH2, if the source file
 286 is on the local system, and is not a directory, the B<-r> flag is omitted.
 287
 288 It's probably better just to use SSH1 or OpenSSH <http://www.openssh.com/>
 289
 290 The Net::FTP-style OO stuff is kinda lame.  And incomplete.
 291
 292 =head1 SEE ALSO
 293
 294 scp(1), ssh(1)
 295
 296 =cut
 297
 298 1;
 299
 300