File Coverage

blib/lib/Net/SCP/Expect.pm

Criterion	Covered	Total	%
statement	47	194	24.2
branch	9	114	7.8
condition	26	81	32.1
subroutine	11	24	45.8
pod	8	8	100.0
total	101	421	23.9

##################################################################
# Net::SCP::Expect
#
# Wrapper for scp, with the ability to send passwords via Expect.
#
# See POD for more details.
##################################################################
package Net::SCP::Expect;
use strict;
use Expect;
use File::Basename;
use Carp;
use Cwd;
use Net::IPv6Addr;

BEGIN{
   use vars qw/$VERSION/;
   $VERSION = '0.16';
}

# Options added as needed
sub new{
   my($class,%arg) = @_;

   my $self = {
      _host          => $arg{host},
      _user          => $arg{user} || $ENV{'USER'},
      _password      => $arg{password},
      _cipher        => $arg{cipher},
      _port          => $arg{port},
      _error_handler => $arg{error_handler},
      _preserve      => $arg{preserve} || 0,
      _recursive     => $arg{recursive} || 0,
      _verbose       => $arg{verbose} || 0,
      _auto_yes      => $arg{auto_yes} || 0,
      _terminator    => $arg{terminator} || "\n",
      _timeout       => $arg{timeout} || 10,
      _timeout_auto  => $arg{timeout_auto} || 1,
      _timeout_err   => $arg{timeout_err} || undef,
      _no_check      => $arg{no_check} || 0,
      _protocol      => $arg{protocol} || undef,
      _identity_file => $arg{identity_file} || undef,
      _option        => $arg{option} || undef,
      _subsystem     => $arg{subsystem} || undef,
      _scp_path      => $arg{scp_path} || undef,
      _auto_quote    => $arg{auto_quote} || 1,
      _compress      => $arg{compress} || 0,
      _force_ipv4    => $arg{force_ipv4} || 0,
      _force_ipv6    => $arg{force_ipv6} || 0,
   };

   bless($self,$class);
}

sub _get{
   my($self,$attr) = @_;

   return $self->{"_$attr"};
}

sub _set{
   my($self,$attr,$val) = @_;
   croak("No attribute supplied to 'set()' method") unless defined $attr;
   $self->{"_$attr"} = $val;
}

sub auto_yes{
   my($self,$val) = @_;
   croak("No value passed to 'auto_yes()' method") unless defined $val;
   $self->_set('auto_yes',$val);
}

sub error_handler{
   my($self,$sub) = @_;
   croak("No sub supplied to 'error_handler()' method") unless defined $sub;
   $self->_set('error_handler',$sub)
}

sub login{
   my($self,$user,$password) = @_;

   croak("No user supplied to 'login()' method") unless defined $user;
   croak("No password supplied to 'login()' method") if @_ > 2 && !defined $password;

   $self->_set('user',$user);
   $self->_set('password',$password);
}

sub password{
   my($self,$password) = @_;
   croak("No password supplied to 'password()' method");

   $self->_set('password',$password) unless $password;
}

sub host{
   my($self,$host) = @_;
   croak("No host supplied to 'host()' method") unless $host;

   # If host is an IPv6 address, strip any enclosing brackets if used
   $host = substr($host, 1, length($host)-2) if $host && $host =~ /^\[/ && $host =~ /\]$/;

   $self->_set('host',$host);
}


sub user{
   my($self,$user) = @_;
   croak("No user supplied to 'user()' method") unless $user;
   $self->_set('user',$user);
}

#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# If the hostname is not included as part of the source, it is assumed to
# be part of the destination.
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub scp{
   my($self,$from,$to) = @_;

   my $login        = $self->_get('user');
   my $password     = $self->_get('password');
   my $timeout      = $self->_get('timeout');
   my $timeout_auto = $self->_get('timeout_auto');
   my $timeout_err  = $self->_get('timeout_err');
   my $cipher       = $self->_get('cipher');
   my $port         = $self->_get('port');
   my $recursive    = $self->_get('recursive');
   my $verbose      = $self->_get('verbose');
   my $preserve     = $self->_get('preserve');
   my $handler      = $self->_get('error_handler');
   my $auto_yes     = $self->_get('auto_yes');
   my $no_check     = $self->_get('no_check');
   my $terminator   = $self->_get('terminator');
   my $protocol     = $self->_get('protocol');
   my $identity_file = $self->_get('identity_file');
   my $option        = $self->_get('option');
   my $subsystem     = $self->_get('subsystem');
   my $scp_path      = $self->_get('scp_path');
   my $auto_quote    = $self->_get('auto_quote');
   my $compress      = $self->_get('compress');
   my $force_ipv4    = $self->_get('force_ipv4');
   my $force_ipv6    = $self->_get('force_ipv6');

   ##################################################################
   # If the second argument is not provided, the remote file will be
   # given the same (base) name as the local file (or vice-versa).
   ##################################################################
   unless($to){
      $to = basename($from);
   }

   my($host,$dest);

   # Parse the to/from string. If the $from contains a ':', assume it is a Remote to Local transfer
   if($from =~ /:/){
      ($login,$host,$dest) = $self->_parse_scp_string($from);
      $from = $login . '@' . $self->_format_host_string($host) . ':';
      $from .= "$dest" if $dest;
   }
   else{ # Local to Remote transfer
      ($login,$host,$dest) = $self->_parse_scp_string($to);
      $to = $login . '@' . $self->_format_host_string($host) . ':';
      $to .= "$dest" if $dest;
   }

   croak("No login. Can't scp") unless $login;
   croak("No password or identity file. Can't scp") unless $password || $identity_file;
   croak("No host specified. Can't scp") unless $host;

   # Define argument auto-quote
   my $qt = $auto_quote ? '\'' : '';

   # Gather flags.
   my $flags;

   $flags .= "-c $qt$cipher$qt " if $cipher;
   $flags .= "-P $qt$port$qt " if $port;
   $flags .= "-r " if $recursive;
   $flags .= "-v " if $verbose;
   $flags .= "-p " if $preserve;
   $flags .= "-$qt$protocol$qt " if $protocol;
   $flags .= "-q ";  # Always pass this option (no progress meter)
   $flags .= "-s $qt$subsystem$qt " if $subsystem;
   $flags .= "-o $qt$option$qt " if $option;
   $flags .= "-i $qt$identity_file$qt " if $identity_file;
   $flags .= "-C " if $compress;
   $flags .= "-4 " if $force_ipv4;
   $flags .= "-6 " if $force_ipv6;

   my $scp = Expect->new;
   #if($verbose){ $scp->raw_pty(1) }
   #$scp->debug(1);

   # Use scp specified by the user, if possible
   $scp_path = defined $scp_path ? "$qt$scp_path$qt" : "scp ";

   # Escape quotes
   if ($auto_quote) {
      $from =~ s/'/'"'"'/go;
      $to =~ s/'/'"'"'/go;
   }

   my $scp_string = "$scp_path $flags $qt$from$qt $qt$to$qt";
   $scp = Expect->spawn($scp_string);

   unless ($scp) {
      if($handler){ $handler->($!); return; }
      else { croak("Couldn't start program: $!"); }
   }

   $scp->log_stdout(0);

   if($auto_yes){
      while($scp->expect($timeout_auto,-re=>'[Yy]es\/[Nn]o')){
         $scp->send("yes\n");
      }
   }

   if ($password) {
      unless($scp->expect($timeout,-re=>'[Pp]assword.*?:|[Pp]assphrase.*?:')){
         my $err = $scp->before() || $scp->match();
         if($err){
            if($handler){ $handler->($err); return; }
            else { croak("Problem performing scp: $err"); }
         }
         $err = "scp timed out while trying to connect to $host";
         if($handler){ $handler->($err); return; }
         else{ croak($err) };
      }

      if($verbose){ print $scp->before() }

      $password .= $terminator if $terminator;

      $scp->send($password);
   }

   ################################################################
   # Check to see if we sent the correct password, or if we got
   # some other bizarre error.  Anything passed back to the
   # terminal at this point means that something went wrong.
   #
   # The exception to this is verbose output, which can mistakenly
   # be picked up by Expect.
   ################################################################
   my $error;
   my $eof = 0;
   unless($no_check || $verbose){

      $error = ($scp->expect($timeout_err,
         [qr/[Pp]ass.*/ => sub{
               my $error = $scp->before() || $scp->match();
               if($handler){
                  $handler->($error);
                  return;
               }
               else{
                  croak("Error: Bad password [$error]");
               }
            }
         ],
         [qr/\w+.*/ => sub{
               my $error = $scp->match() || $scp->before();
               if($handler){
                  $handler->($error);
                  return;
               }
               else{
                  croak("Error: last line returned was: $error");
               }
            }
         ],
         ['eof' => sub{ $eof = 1 } ],
      ))[1];
   }
   else{
      $error = ($scp->expect($timeout_err, ['eof' => sub { $eof = 1 }]))[1];
   }

   if($verbose){ print $scp->after(),"\n" }

   # Ignore error if it was due to scp auto-exiting successfully (which may trigger false positives on some platforms)
   if ($error && !($eof && $error =~ m/^(2|3)/o)) {
      if ($handler) {
         $handler->($error);
         return;
      }
      else {
         croak("scp processing error occured: $error");
      }
   }

   # Insure we check exit state of process
   $scp->hard_close();

   if ($scp->exitstatus > 0) {   #ignore -1, in case there's a waitpid portability issue
      if ($handler) {
         $handler->($scp->exitstatus);
         return;
      }
      else {
         croak("scp exited with non-success state: " . $scp->exitstatus);
      }
   }

   return 1;
}

# Break the from/to line into its various parts
sub _parse_scp_string{
   my($self,$string) = @_;
   my @parts;
   my($user,$host,$dest);

   @parts = split(/@/,$string,2);
   if(scalar(@parts) == 2){
      $user = shift(@parts);
   }
   else{
      $user = $self->_get("user");
   }

   my $temp = join('',@parts);
   @parts = split(/:/,$temp);
   if (@parts) {
      if (@parts > 1) {
         $host = join('',@parts[0,1..scalar(@parts)-2]);
         $dest = $parts[-1];
      } else {
         $host = $parts[0];
      }
   }

   # scp('file','file') syntax, where local to remote is assumed
   unless($dest){
      $dest = $host;
      $host = $self->_get("host");
   }

   $host ||= $self->_get("host");

   # If host is an IPv6 address, strip any enclosing brackets if used
   $host = substr($host, 1, length($host)-2) if $host && $host =~ /^\[/ && $host =~ /\]$/;

   return ($user,$host,$dest);
}

sub _format_host_string{
   my ($self,$host) = @_;

   # If host is an IPv6 address, verify it is correctly formatted for scp
   if ($host) {
      $host = substr($host, 1, length($host)-2) if $host =~ /^\[/ && $host =~ /\]$/;
      local $@;
      $host = "[$host]" if eval { Net::IPv6Addr::ipv6_parse($host) };
   }

   return $host;
}
1;
__END__