mkdir patch from Ofer

[Net-SCP.git] / SCP.pm

diff --git a/SCP.pm b/SCP.pm
index f0fd8ea..2b19b7e 100644 (file)
--- a/SCP.pm
+++ b/SCP.pm
@@ -1,7 +1,7 @@
 package Net::SCP;
 
 use strict;
-use vars qw($VERSION @ISA @EXPORT_OK $scp);
+use vars qw($VERSION @ISA @EXPORT_OK $scp $DEBUG);
 use Exporter;
 use Carp;
 use File::Basename;
@@ -12,10 +12,12 @@ use IPC::Open3;
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw( scp iscp );
-$VERSION = '0.02';
+$VERSION = '0.08';
 
 $scp = "scp";
 
+$DEBUG = 0;
+
 =head1 NAME
 
 Net::SCP - Perl extension for secure copy protocol
@@ -32,13 +34,11 @@ Net::SCP - Perl extension for secure copy protocol
   $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};
+  #tmtowtdi
+  $scp = new Net::SCP;
+  $scp->scp($source, $destination);
 
   #Net::FTP-style
   $scp = Net::SCP->new("hostname");
@@ -74,9 +74,10 @@ sub scp {
   my($src, $dest, $interact) = @_;
   my $flags = '-p';
   $flags .= 'r' unless &_islocal($src) && ! -d $src;
-  my @cmd = ( $scp, $flags, $src, $dest );
+  my @cmd;
   if ( ( defined($interact) && $interact )
        || ( defined($self->{interact}) && $self->{interact} ) ) {
+    @cmd = ( $scp, $flags, $src, $dest );
     print join(' ', @cmd), "\n";
     unless ( &_yesno ) {
       $self->{errstr} = "User declined";
@@ -84,6 +85,7 @@ sub scp {
     }
   } else {
     $flags .= 'qB';
+    @cmd = ( $scp, $flags, $src, $dest );
   }
   my($reader, $writer, $error ) =
     ( new IO::Handle, new IO::Handle, new IO::Handle );
@@ -91,7 +93,8 @@ sub scp {
   my $pid = open3($writer, $reader, $error, @cmd );
   waitpid $pid, 0;
   if ( $? >> 8 ) {
-    chomp(my $errstr = <$error>);
+    my $errstr = join('', <$error>);
+    #chomp(my $errstr = <$error>);
     $self->{errstr} = $errstr;
     0;
   } else {
@@ -114,7 +117,7 @@ Returns false and sets the B<errstr> attribute if there is an error.
 sub iscp {
   if ( ref($_[0]) ) {
     my $self = shift;
-    $self->set( 'interact' => 1 );
+    $self->{'interact'} = 1;
     $self->scp(@_);
   } else {
     scp(@_, 1);
@@ -145,7 +148,6 @@ hashref of named params, with the following keys:
 
     host - hostname
     user - username
-    verbose - bool
     interactive - bool
     cwd - current working directory on remote server
 
@@ -161,7 +163,6 @@ sub new {
     $self = {
               'host'        => shift,
               'user'        => ( scalar(@_) ? shift : '' ),
-              'verbose'     => 0,
               'interactive' => 0,
               'cwd'         => '',
             };
@@ -177,7 +178,7 @@ Compatibility method.  Optionally sets the user.
 
 sub login {
   my($self, $user) = @_;
-  $self->{'user'} = $user;
+  $self->{'user'} = $user if $user;
 }
 
 =item cwd CWD
@@ -204,7 +205,37 @@ sub get {
   $local ||= basename($remote);
   my $source = $self->{'host'}. ":$remote";
   $source = $self->{'user'}. '@'. $source if $self->{'user'};
-  scp($source,$local);
+  $self->scp($source,$local);
+}
+
+=item mkdir DIRECTORY
+
+Makes a directory on the remote server.  Returns false and sets the B<errstr>
+attribute on errors.
+
+(Implementation note: An ssh connection is established to the remote machine
+and '/bin/mkdir B<-p>' is used to create the directory.)
+
+=cut
+
+sub mkdir {
+  my($self, $directory) = @_;
+  $directory = $self->{'cwd'}. "/$directory"
+    if $self->{'cwd'} && $directory !~ /^\//;
+  my $host = $self->{'host'};
+  $host = $self->{'user'}. '@'. $host if $self->{'user'};
+  my($reader, $writer, $error ) =
+    ( new IO::Handle, new IO::Handle, new IO::Handle );
+  $writer->autoflush(1);
+  my $pid = sshopen3( $host, $writer, $reader, $error,
+                      '/bin/mkdir', '-p ', shell_quote($directory) );
+  waitpid $pid, 0;
+  if ( $? >> 8 ) {
+    chomp(my $errstr = <$error> || '');
+    $self->{errstr} = $errstr || "mkdir exited with status ". ($?>>8);
+    return 0;
+  }
+  1;
 }
 
 =item size FILE
@@ -226,7 +257,7 @@ sub size {
   $host = $self->{'user'}. '@'. $host if $self->{'user'};
   my($reader, $writer, $error ) =
     ( new IO::Handle, new IO::Handle, new IO::Handle );
-  $writer->autoflush(1);#  $error->autoflush(1);
+  $writer->autoflush(1);
   #sshopen2($host, $reader, $writer, 'wc', '-c ', shell_quote($file) );
   my $pid =
     sshopen3($host, $writer, $reader, $error, 'wc', '-c ', shell_quote($file) );
@@ -259,8 +290,8 @@ sub put {
   $remote = $self->{'cwd'}. "/$remote" if $self->{'cwd'} && $remote !~ /^\//;
   my $dest = $self->{'host'}. ":$remote";
   $dest = $self->{'user'}. '@'. $dest if $self->{'user'};
-  warn "scp $local $dest\n";
-  scp($local, $dest);
+  warn "scp $local $dest\n" if $DEBUG;
+  $self->scp($local, $dest);
 }
 
 =item binary
@@ -273,13 +304,37 @@ sub binary { 1; }
 
 =back
 
+=head1 FREQUENTLY ASKED QUESTIONS
+
+Q: How do you supply a password to connect with ssh within a perl script
+using the Net::SSH module?
+
+A: You don't.  Use RSA or DSA keys.  See the ssh-keygen(1) manpage.
+
+Q: My script is "leaking" ssh processes.
+
+A: See L<perlfaq8/"How do I avoid zombies on a Unix system">, L<IPC::Open2>,
+L<IPC::Open3> and L<perlfunc/waitpid>.
+
 =head1 AUTHORS
 
 Ivan Kohler <ivan-netscp_pod@420.am>
-Anthony Deaver <bishop@projectmagnus.org>
+
+Major updates Anthony Deaver <bishop@projectmagnus.org>
 
 Thanks to Jon Gunnip <jon@soundbite.com> for fixing a bug with size().
 
+Patch for the mkdir method by Anthony Awtrey <tony@awtrey.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2000 Ivan Kohler.
+Copyright (c) 2000 Silicon Interactive Software Design.
+Copyright (c) 2000 Freeside Internet Services, LLC
+All rights reserved.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
 =head1 BUGS
 
 Still has no-OO cruft.