SCP.pm

   1 package Net::SCP;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA @EXPORT_OK $scp);
   5 use Exporter;
   6 use File::Basename;
   7 use String::ShellQuote;
   8 use IO::Handle;
   9 use Net::SSH qw(sshopen3);
  10
  11 @ISA = qw(Exporter);
  12 @EXPORT_OK = qw( scp iscp );
  13 $VERSION = '0.01';
  14
  15 $scp = "scp";
  16
  17 =head1 NAME
  18
  19 Net::SCP - Perl extension for secure copy protocol
  20
  21 =head1 SYNOPSIS
  22
  23   #procedural interface
  24   use Net::SCP qw(scp iscp);
  25   scp($source, $destination);
  26   iscp($source, $destination); #shows command, asks for confirmation, and
  27                                #allows user to type a password on tty
  28
  29   #Net::FTP-style
  30   $scp = Net::SCP->new("hostname");
  31   $scp->login("user");
  32   $scp->cwd("/dir");
  33   $scp->size("file");
  34   $scp->get("file");
  35   $scp->quit;
  36
  37 =head1 DESCRIPTION
  38
  39 Simple wrappers around ssh and scp commands.
  40
  41 =head1 SUBROUTINES
  42
  43 =over 4
  44
  45 =item scp SOURCE, DESTINATION
  46
  47 Calls scp in batch mode, with the B<-B> B<-p> B<-q> and B<-r> options.
  48
  49 =cut
  50
  51 sub scp {
  52   my($src, $dest) = @_;
  53   my $flags = '-Bpq';
  54   $flags .= 'r' unless &_islocal($src) && ! -d $src;
  55   my @cmd = ( $scp, $flags, $src, $dest );
  56   system(@cmd);
  57 }
  58
  59 =item iscp SOURCE, DESTINATION
  60
  61 Prints the scp command to be execute, waits for the user to confirm, and
  62 (optionally) executes scp, with the B<-p> and B<-r> flags.
  63
  64 =cut
  65
  66 sub iscp {
  67   my($src, $dest) = @_;
  68   my $flags = '-p';
  69   $flags .= 'r' unless &_islocal($src) && ! -d $src;
  70   my @cmd = ( $scp, $flags, $src, $dest );
  71   print join(' ', @cmd), "\n";
  72   if ( &_yesno ) {
  73     system(@cmd);
  74   }
  75 }
  76
  77 sub _yesno {
  78   print "Proceed [y/N]:";
  79   my $x = scalar(<STDIN>);
  80   $x =~ /^y/i;
  81 }
  82
  83 sub _islocal {
  84   shift !~ /^[^:]+:/
  85 }
  86
  87 =back
  88
  89 =head1 METHODS
  90
  91 =over 4
  92
  93 =item new HOSTNAME
  94
  95 This is the constructor for a new Net::SCP object.  Additional parameters
  96 are ignored.
  97
  98 =cut
  99
 100 sub new {
 101   my $proto = shift;
 102   my $class = ref($proto) || $proto;
 103   my $self = {
 104                'host' => shift,
 105                'user' => '',
 106                'cwd'  => '',
 107              };
 108   bless($self, $class);
 109 }
 110
 111 =item login [USER]
 112
 113 Compatibility method.  Optionally sets the user.
 114
 115 =cut
 116
 117 sub login {
 118   my($self, $user) = @_;
 119   $self->{'user'} = $user;
 120 }
 121
 122 =item cwd CWD
 123
 124 Sets the cwd (used for a subsequent get or put request without a full pathname).
 125
 126 =cut
 127
 128 sub cwd {
 129   my($self, $cwd) = @_;
 130   $self->{'cwd'} = $cwd || '/';
 131 }
 132
 133 =item get REMOTE_FILE [, LOCAL_FILE]
 134
 135 Uses scp to transfer REMOTE_FILE from the remote host.  If a local filename is
 136 omitted, uses the basename of the remote file.
 137
 138 =cut
 139
 140 sub get {
 141   my($self, $remote, $local) = @_;
 142   $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
 143   $local ||= basename($remote);
 144   my $source = $self->{'host'}. ":$remote";
 145   $source = $self->{'user'}. '@'. $source if $self->{'user'};
 146   scp($source,$local);
 147 }
 148
 149 =item size FILE
 150
 151 Returns the size in bytes for the given file as stored on the remote server.
 152
 153 (Implementation note: An ssh connection is established to the remote machine
 154 and wc is used to determine the file size.  No distinction is currently made
 155 between nonexistant and zero-length files.)
 156
 157 =cut
 158
 159 sub size {
 160   my($self, $file) = @_;
 161   $file = $self->{'cwd'}. "/$file" if $self->{'cwd'} && $file !~ /^\//;
 162   my $host = $self->{'host'};
 163   $host = $self->{'user'}. '@'. $host if $self->{'user'};
 164   my($reader, $writer, $error ) =
 165     ( new IO::Handle, new IO::Handle, new IO::Handle );
 166   $writer->autoflush(1);#  $error->autoflush(1);
 167   #sshopen2($host, $reader, $writer, 'wc', '-c ', shell_quote($file) );
 168   sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) );
 169   chomp( my $size = <$reader> || 0 );
 170   if ( $size =~ /^\s+(\d+)/ ) {
 171     $1;
 172   } else {
 173     warn "unparsable output from remote wc";
 174     0;
 175   }
 176 }
 177
 178 =item put LOCAL_FILE [, REMOTE_FILE]
 179
 180 Uses scp to trasnfer LOCAL_FILE to the remote host.  If a remote filename is
 181 omitted, uses the basename of the local file.
 182
 183 =cut
 184
 185 sub put {
 186   my($self, $local, $remote) = @_;
 187   $remote ||= basename($local);
 188   $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
 189   my $dest = $self->{'host'}. ":$remote";
 190   $dest = $self->{'user'}. '@'. $dest if $self->{'user'};
 191   warn "scp $local $dest\n";
 192   scp($local, $dest);
 193 }
 194
 195 =item binary
 196
 197 Compatibility method: does nothing; returns true.
 198
 199 =cut
 200
 201 sub binary { 1; }
 202
 203 =back
 204
 205 =head1 AUTHOR
 206
 207 Ivan Kohler <ivan-netscp@420.am>
 208
 209 =head1 BUGS
 210
 211 Not OO.
 212
 213 In order to work around some problems with commercial SSH2, if the source file
 214 is on the local system, and is not a directory, the B<-r> flag is omitted.
 215
 216 It's probably better just to use SSH1 or OpenSSH <http://www.openssh.com/>
 217
 218 The Net::FTP-style OO stuff is kinda lame.  And incomplete.
 219
 220 =head1 SEE ALSO
 221
 222 scp(1), ssh(1)
 223
 224 =cut
 225
 226 1;
 227
 228