use Data::Dumper;
use IO::Pty;
use Net::FTP;
-use Net::OpenSSH;
+use Net::SSH2;
use Net::SFTP::Foreign;
use File::Temp;
use File::Basename;
=head1 DESCRIPTION
The Remote Account module attempts to transfer a file to/from a remote server.
-Net::FTP, Net::OpenSSH or Net::SFTP::Foreign is used.
+Net::FTP, Net::SSH2 or Net::SFTP::Foreign is used.
=head1 PARAMETERS
if ($self->type eq "FTP") {
return $self->get_ftp(@{$self->{get_args}});
+ } elsif ($self->type eq "SFTP") {
+ return $self->get_sftp(@{$self->{get_args}});
} else {
my %keys = $self->key_check($params);
return $self->get_ssh2(\%keys, @{$self->{get_args}});
if ($self->type eq "FTP") {
return $self->put_ftp(@{$self->{put_args}});
+ } elsif ($self->type eq "SFTP") {
+ return $self->put_sftp(@{$self->{put_args}});
} else {
my %keys = $self->key_check($params);
$self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file;
if ($self->type eq "FTP") {
return $self->ls_ftp(@targets);
+ } elsif ($self->type eq "SFTP") {
+ return $self->ls_sftp(@targets);
} else {
my %keys = $self->key_check($params);
# $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys");
if ($self->type eq "FTP") {
return $self->delete_ftp($file);
+ } elsif {
+ return $self->delete_sftp($file);
} else {
my %keys = $self->key_check($params);
return $self->delete_ssh2(\%keys, $file);
# Internal Mechanics
sub _sftp {
+ my $self = shift;
+ $self->{sftp} and return $self->{sftp}; # caching
+ my $sftp = Net::SFTP::Foreign->new($self->remote_host, user => $self->remote_user, password => $self->remote_password);
+ $sftp->error and $logger->error("SFTP connect FAILED: " . $sftp->error);
+ return $self->{sftp} = $sftp
+}
+
+sub put_sftp {
+ my $self = shift;
+ my $filename = $self->_sftp->put(@{$self->{put_args}});
+ if ($self->_sftp->error or not $filename) {
+ $logger->error(
+ $self->_error(
+ "SFTP put to", $self->remote_host, "failed with error: $self->_sftp->error"
+ )
+ );
+ return;
+ }
+
+ $self->remote_file($filename);
+ $logger->info(
+ _pkg(
+ "successfully sent", $self->remote_host, $self->local_file, "-->",
+ $filename
+ )
+ );
+ return $filename;
+}
+
+sub get_sftp {
+ my $self = shift;
+ my $remote_filename = $self->{get_args}->[0];
+ my $filename = $self->_sftp->get(@{$self->{get_args}});
+ if ($self->_sftp->error or not $filename) {
+ $logger->error(
+ $self->_error(
+ "get from", $self->remote_host, "failed with error: $self->_sftp->error"
+ )
+ );
+ return;
+ }
+ if (!defined(${$filename->sref})) {
+ # the underlying scalar is still undef, so Net::SFTP::Foreign must have
+ # successfully retrieved an empty file... which we should skip
+ $logger->error(
+ $self->_error(
+ "get $remote_filename from", $self->remote_host, ": remote file is zero-length"
+ )
+ );
+ return;
+ }
+
+ $self->local_file($filename);
+ $logger->info(
+ _pkg(
+ "successfully retrieved $filename <--", $self->remote_host . '/' .
+ $self->remote_file
+ )
+ );
+ return $self->local_file;
+
+}
+
+#$sftp->ls($path) or die 'could not ls: ' . $sftp->error;
+sub ls_sftp { # returns full path like: dir/path/file.ext
+ my $self = shift;
+ my @list;
+
+ foreach (@_) {
+ my @part;
+ my ($dirpath, $regex) = $self->glob_parse($_);
+ my $dirtarget = $dirpath || $_;
+ $dirtarget =~ s/\/+$//;
+ eval { @part = $self->_ftp->ls($dirtarget) }; # this ls returns relative/path/filenames. defer filename glob filtering for below.
+ if ($@) {
+ $logger->error(
+ $self->_error(
+ "ls from", $self->remote_host, "failed with error: $@"
+ )
+ );
+ next;
+ }
+ if ($dirtarget and $dirtarget ne '.' and $dirtarget ne './' and
+ $self->_ftp->dir($dirtarget)) {
+ foreach my $file (@part) { # we ensure full(er) path
+ $file =~ /^$dirtarget\// and next;
+ $logger->debug("ls_ftp: prepending $dirtarget/ to $file");
+ $file = File::Spec->catdir($dirtarget, $file);
+ }
+ }
+ if ($regex) {
+ my $count = scalar(@part);
+ # @part = grep {my @a = split('/',$_); scalar(@a) ? /$regex/ : ($a[-1] =~ /$regex/)} @part;
+ my @bulk = @part;
+ @part = grep {
+ my ($vol, $dir, $file) = File::Spec->splitpath($_);
+ $file =~ /$regex/
+ } @part;
+ $logger->info("FTP ls: Glob regex($regex) matches " . scalar(@part) . " of $count files");
+ } # else {$logger->info("FTP ls: No Glob regex in '$_'. Just a regular ls");}
+ push @list, @part;
+ }
+ return @list;
+}
+}
+
+sub delete_sftp {
+#$sftp->remove($putfile) or die "could not remove $putfile: " . $sftp->error;
+
+}
+
+sub _ssh2 {
+ my $self = shift;
+ $self->{ssh2} and return $self->{ssh2}; # caching
+ my $keys = shift;
+
+ my $ssh2 = Net::SSH2->new();
+ unless($ssh2->connect($self->remote_host)) {
+ $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error)));
+ return; # we cannot connect
+ }
+
+ my $success = 0;
+ my @privates = keys %$keys;
+ my $count = scalar @privates;
+
+ if ($count) {
+ foreach (@privates) {
+ if ($self->auth_ssh2($ssh2,$self->auth_ssh2_args($_,$keys->{$_}))) {
+ $success++;
+ last;
+ }
+ }
+ unless ($success) {
+ $logger->error(
+ $self->error(
+ "All ($count) keypair(s) FAILED for " . $self->remote_host
+ )
+ );
+ return;
+ }
+ } else {
+ $logger->error(
+ $self->error("Login FAILED for " . $self->remote_host)
+ ) unless $self->auth_ssh2($ssh2, $self->auth_ssh2_args);
+ }
+ return $self->{ssh2} = $ssh2;
+}
+
+sub auth_ssh2 {
+ my $self = shift;
+ my $ssh2 = shift;
+ my %auth_args = @_;
+ $ssh2 or return;
+
+ my $host = $auth_args{hostname} || 'UNKNOWN';
+ my $key = $auth_args{privatekey} || 'UNKNOWN';
+ my $msg = "ssh2->auth by keypair for $host using $key";
+ if ($ssh2->auth(%auth_args)) {
+ $logger->info("Successful $msg");
+ return 1;
+ }
+ if ($self->specific) {
+ $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
+ } else {
+ $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
+ }
+ return;
}
-sub _openssh {
-
-}
-
-#sub _ssh2 {
-# my $self = shift;
-# $self->{ssh2} and return $self->{ssh2}; # caching
-# my $keys = shift;
-#
-# my $ssh2 = Net::SSH2->new();
-# unless($ssh2->connect($self->remote_host)) {
-# $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error)));
-# return; # we cannot connect
-# }
-#
-# my $success = 0;
-# my @privates = keys %$keys;
-# my $count = scalar @privates;
-#
-# if ($count) {
-# foreach (@privates) {
-# if ($self->auth_ssh2($ssh2,$self->auth_ssh2_args($_,$keys->{$_}))) {
-# $success++;
-# last;
-# }
-# }
-# unless ($success) {
-# $logger->error(
-# $self->error(
-# "All ($count) keypair(s) FAILED for " . $self->remote_host
-# )
-# );
-# return;
-# }
-# } else {
-# $logger->error(
-# $self->error("Login FAILED for " . $self->remote_host)
-# ) unless $self->auth_ssh2($ssh2, $self->auth_ssh2_args);
-# }
-# return $self->{ssh2} = $ssh2;
-#}
-#
-#sub auth_ssh2 {
-# my $self = shift;
-# my $ssh2 = shift;
-# my %auth_args = @_;
-# $ssh2 or return;
-#
-# my $host = $auth_args{hostname} || 'UNKNOWN';
-# my $key = $auth_args{privatekey} || 'UNKNOWN';
-# my $msg = "ssh2->auth by keypair for $host using $key";
-# if ($ssh2->auth(%auth_args)) {
-# $logger->info("Successful $msg");
-# return 1;
-# }
-#
-# if ($self->specific) {
-# $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
-# } else {
-# $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
-# }
-# return;
-#}
-
-sub auth_openssh_args {
+sub auth_ssh2_args {
my $self = shift;
my %auth_args = (
privatekey => shift,
return %auth_args;
}
-#sub put_ssh2 {
-# my $self = shift;
-# my $keys = shift; # could have many keypairs here
-# unless (@_) {
-# $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
-# return;
-# }
-#
-# $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
-# my $ssh2 = $self->_ssh2($keys) or return;
-# my $res;
-# if ($res = $ssh2->scp_put( @_ )) {
-# $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
-# return $res;
-# }
-# $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
-# return;
-#}
-#
-#sub get_ssh2 {
-# my $self = shift;
-# my $keys = shift; # could have many keypairs here
-# unless (@_) {
-# $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
-# return;
-# }
-#
-# $logger->info("*** get args: " . Dumper(\@_));
-# $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys");
-# my $ssh2 = $self->_ssh2($keys) or return;
-# my $res;
-# if ($res = $ssh2->scp_get( @_ )) {
-# $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
-# return $res;
-# }
-# $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
-# return;
-#}
-#
-#sub ls_ssh2 {
-# my $self = shift;
-# my @list = $self->ls_ssh2_full(@_);
-# @list and return sort map {$_->{slash_path}} @list;
-## @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
-#}
-#
-#sub ls_ssh2_full {
-# my $self = shift;
-# my $keys = shift; # could have many keypairs here
-# my @targets = grep {defined} @_;
-#
-# $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
-# my $ssh2 = $self->_ssh2($keys) or return;
-# my $sftp = $ssh2->sftp or return;
-#
-# my @list = ();
-# foreach my $target (@targets) {
-# my ($dir, $file);
-# my ($dirpath, $regex) = $self->glob_parse($target);
-# $dir = $sftp->opendir($dirpath || $target); # Try to open it like a directory
-# unless ($dir) {
-# $file = $sftp->stat($target); # Otherwise, check it like a file
-# if ($file) {
-# $file->{slash_path} = $self->_slash_path($target, $file->{name}); # it was a file, not a dir. That's OK.
-# push @list, $file;
-# } else {
-# $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
-# }
-# next;
-# }
-# my @pool = ();
-# while ($file = $dir->read()) {
-# $file->{slash_path} = $self->_slash_path($target, $file->{name});
-# push @pool, $file;
-# }
-# if ($regex) {
-# my $count = scalar(@pool);
-# @pool = grep {$_->{name} =~ /$regex/} @pool;
-# $logger->info("SSH ls: Glob regex($regex) matches " . scalar(@pool) . " of $count files");
-# } # else { $logger->info("SSH ls: No Glob regex in '$target'. Just a regular ls"); }
-# push @list, @pool;
-# }
-# return @list;
-#
-#}
-#
-#sub delete_ssh2 {
-# my $self = shift;
-# my $keys = shift;
-# my $file = shift;
-# my $sftp = $self->_ssh2($keys)->sftp;
-# return $sftp->unlink($file);
-#}
+sub put_ssh2 {
+ my $self = shift;
+ my $keys = shift; # could have many keypairs here
+ unless (@_) {
+ $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
+ return;
+ }
+
+ $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
+ my $ssh2 = $self->_ssh2($keys) or return;
+ my $res;
+ if ($res = $ssh2->scp_put( @_ )) {
+ $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
+ return $res;
+ }
+ $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
+ return;
+}
+
+sub get_ssh2 {
+ my $self = shift;
+ my $keys = shift; # could have many keypairs here
+ unless (@_) {
+ $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
+ return;
+ }
+
+ $logger->info("*** get args: " . Dumper(\@_));
+ $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys");
+ my $ssh2 = $self->_ssh2($keys) or return;
+ my $res;
+ if ($res = $ssh2->scp_get( @_ )) {
+ $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
+ return $res;
+ }
+ $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
+ return;
+}
+
+sub ls_ssh2 {
+ my $self = shift;
+ my @list = $self->ls_ssh2_full(@_);
+ @list and return sort map {$_->{slash_path}} @list;
+# @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
+}
+
+sub ls_ssh2_full {
+ my $self = shift;
+ my $keys = shift; # could have many keypairs here
+ my @targets = grep {defined} @_;
+
+ $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
+ my $ssh2 = $self->_ssh2($keys) or return;
+ my $sftp = $ssh2->sftp or return;
+
+ my @list = ();
+ foreach my $target (@targets) {
+ my ($dir, $file);
+ my ($dirpath, $regex) = $self->glob_parse($target);
+ $dir = $sftp->opendir($dirpath || $target); # Try to open it like a directory
+ unless ($dir) {
+ $file = $sftp->stat($target); # Otherwise, check it like a file
+ if ($file) {
+ $file->{slash_path} = $self->_slash_path($target, $file->{name}); # it was a file, not a dir. That's OK.
+ push @list, $file;
+ } else {
+ $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
+ }
+ next;
+ }
+ my @pool = ();
+ while ($file = $dir->read()) {
+ $file->{slash_path} = $self->_slash_path($target, $file->{name});
+ push @pool, $file;
+ }
+ if ($regex) {
+ my $count = scalar(@pool);
+ @pool = grep {$_->{name} =~ /$regex/} @pool;
+ $logger->info("SSH ls: Glob regex($regex) matches " . scalar(@pool) . " of $count files");
+ } # else { $logger->info("SSH ls: No Glob regex in '$target'. Just a regular ls"); }
+ push @list, @pool;
+ }
+ return @list;
+
+}
+
+sub delete_ssh2 {
+ my $self = shift;
+ my $keys = shift;
+ my $file = shift;
+ my $sftp = $self->_ssh2($keys)->sftp;
+ return $sftp->unlink($file);
+}
sub _slash_path {
my $self = shift;
projects / working / Evergreen.git / commitdiff