Open-ILS/src/perlmods/lib/OpenILS/Utils/RemoteAccount.pm

   1 package OpenILS::Utils::RemoteAccount;
   2
   3 # use OpenSRF::Utils::SettingsClient;
   4 use OpenSRF::Utils::Logger qw/:logger/;
   5
   6 use Data::Dumper;
   7 use IO::Pty;
   8 use Net::FTP;
   9 use Net::SSH2;
  10 use Net::SFTP::Foreign;
  11 use File::Temp;
  12 use File::Basename;
  13 use File::Spec;
  14 use Text::Glob qw( match_glob glob_to_regex );
  15 # use Error;
  16
  17 $Data::Dumper::Indent = 0;
  18
  19 use strict;
  20 use warnings;
  21
  22 use Carp;
  23
  24 our $AUTOLOAD;
  25
  26 our %keyfiles = ();
  27
  28 my %fields = (
  29     account_object  => undef,
  30     remote_host     => undef,
  31     remote_user     => undef,
  32     remote_password => undef,
  33     remote_account  => undef,
  34     remote_file     => undef,
  35     remote_path     => undef,   # not really doing anything with this... yet.
  36     ssh_privatekey  => undef,
  37     ssh_publickey   => undef,
  38     type            => undef,
  39     port            => undef,
  40     content         => undef,
  41     local_file      => undef,
  42     tempfile        => undef,
  43     error           => undef,
  44     single_ext      => undef,
  45     specific        => 0,
  46     debug           => 0,
  47 );
  48
  49
  50 =head1 NAME
  51
  52 OpenILS::Utils::RemoteAccount - Encapsulate FTP, SFTP and SSH file transactions for Evergreen
  53
  54 =head1 DESCRIPTION
  55
  56 The Remote Account module attempts to transfer a file to/from a remote server.
  57 Net::FTP, Net::SSH2 or Net::SFTP::Foreign is used.
  58
  59 =head1 PARAMETERS
  60
  61 All information is expected to be supplied by the caller via parameters:
  62    ~ remote_host (required)
  63    ~ remote_user
  64    ~ remote_password
  65    ~ remote_account
  66    ~ ssh_privatekey
  67    ~ ssh_publickey
  68    ~ type (FTP, SFTP or SCP -- default FTP)
  69    ~ port
  70    ~ debug
  71
  72 Note: none of the parameters are actually required, except remote_host.
  73 That is because remote_user, remote_password and remote_account can all be
  74 extrapolated from other sources, as the Net::FTP docs describe:
  75
  76     If no arguments are given then Net::FTP uses the Net::Netrc package
  77         to lookup the login information for the connected host.
  78
  79     If no information is found then a login of anonymous is used.
  80
  81     If no password is given and the login is anonymous then anonymous@
  82         will be used for password.
  83
  84 Note that specifying a password will require you to specify a user.
  85 Similarly, specifying an account requires both user and password.
  86 That is, there are no assumed defaults when the latter arguments are used.
  87
  88 =head2 SSH KEYS:
  89
  90 The use of ssh keys is preferred.  Explicit specification of connection type will prevent
  91 multiple attempts to the same server.  Therefore, using the type parameter is also recommended.
  92
  93 If the type is not explicit, we attempt to use SSH keys where they are specified or otherwise found
  94 in the runtime environment.  If only one key is specified, we attempt to derive
  95 the corresponding filename based on the ssh-keygen defaults.  If either key is
  96 specified, but both are not found (and readable) then the result is failure.  If
  97 no key or type is specified, but keys are found, the key-based connections will be attempted,
  98 but failure will be non-fatal.
  99
 100 =cut
 101
 102 sub plausible_dirs {
 103     # returns plausible locations of a .ssh subdir where SSH keys might be stashed
 104     # NOTE: these would need to be properly genericized w/ Makefile vars
 105     # in order to support Debian packaging and multiple EG's on one box.
 106     # Until that happens, we just rely on $HOME
 107
 108     my @bases = (
 109        # '/openils/conf',     # __EG_CONFIG_DIR__
 110     );
 111     ($ENV{HOME}) and unshift @bases, $ENV{HOME};
 112
 113     return grep {-d $_} map {"$_/.ssh"} @bases;
 114 }
 115
 116 sub local_keyfiles {
 117     # populates %keyfiles hash
 118     # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY
 119     my $self  = shift;
 120     my $force = (@_ ? shift : 0);
 121     return %keyfiles if (%keyfiles and not $force);   # caching
 122     $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : ''));
 123     %keyfiles = ();  # reset to empty
 124     my @dirs = plausible_dirs();
 125     $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs));
 126     foreach my $dir (@dirs) {
 127         foreach my $key (qw/rsa dsa/) {
 128             my $private = "$dir/id_$key";
 129             my $public  = "$dir/id_$key.pub";
 130             unless (-r $private) {
 131                 $logger->debug("Key '$private' cannot be read: $!");
 132                 next;
 133             }
 134             unless (-r $public) {
 135                 $logger->debug("Key '$public' cannot be read: $!");
 136                 next;
 137             }
 138             $keyfiles{$private} = $public;
 139         }
 140     }
 141     return %keyfiles;
 142 }
 143
 144 sub param_keys {
 145     my $self = shift;
 146     my %keys = ();
 147     if ($self->ssh_publickey and not $self->ssh_privatekey) {
 148         my $private = $self->ssh_publickey;
 149         unless ($private and $private =~ s/\.pub$// and -r $self->ssh_privatekey) {        # try to guess missing private key name
 150             $logger->error("No ssh_privatekey specified or found to pair with " . $self->ssh_publickey);
 151             return;
 152         }
 153         $self->ssh_privatekey($private);
 154     }
 155     if ($self->ssh_privatekey and not $self->ssh_publickey) {
 156         my $pub = $self->ssh_privatekey . '.pub'; # guess missing public key name
 157         unless (-r $pub) {
 158             $logger->error("No ssh_publickey specified or found to pair with " . $self->ssh_privatekey);
 159             return;
 160         }
 161         $self->ssh_publickey($pub);
 162     }
 163
 164     # so now, we have either both ssh_p*keys params or neither
 165     foreach (qw/ssh_publickey ssh_privatekey/) {
 166         unless (-r $self->{$_}) {
 167             $logger->error("$_ '" . $self->{$_} . "' cannot be read: $!");
 168             return;                 # quit w/ error if we fail on any user-specified key
 169         }
 170     }
 171     $keys{$self->ssh_privatekey} = $self->ssh_publickey;
 172     return %keys;
 173 }
 174
 175 sub new_tempfile {
 176     my $self = shift;
 177     my $text = shift || $self->content || '';
 178     my $tmp  = File::Temp->new();      # magical self-destructing tempfile
 179     # print $tmp "THIS IS TEXT\n";
 180     print $tmp $text  or  $logger->error($self->_error("could not write to tempfile '$tmp'"));
 181     close $tmp;
 182     $self->tempfile($tmp);             # save the object
 183     $self->local_file($tmp->filename);  # save the filename
 184     $logger->info(_pkg("using tempfile $tmp"));
 185     return $self->local_file;           # return the filename
 186 }
 187
 188 sub outbound_file {
 189     my $self   = shift;
 190     my $params = shift;
 191
 192     unless (defined $self->content or $self->local_file) {   # content can be emptystring
 193         $logger->error($self->_error("No content or local_file specified -- nothing to send"));
 194         return;
 195     }
 196
 197     # tricky subtlety: we want to use the most recently specified options
 198     #   with priority order: filename, content, old filename, old content.
 199     #
 200     # The $params->{x} will already match $self->x after the secondary init,
 201     # so the checks using $params below are for whether the value was specified NOW (e.g. via put()) or not.
 202     #
 203     # if we got a new local_file value, we use it
 204     # else if the content is new to this call, build a new tempfile w/ it,
 205     # else use existing local_file,
 206     # else build new tempfile w/ content already specified via new()
 207
 208     return $params->{local_file} || (
 209         (defined $params->{content})          ?
 210          $self->new_tempfile($self->content)  :     # $self->content is same value as $params->{content}
 211         ($self->local_file || $self->new_tempfile($self->content))
 212     );
 213 }
 214
 215 sub key_check {
 216     my $self   = shift;
 217     my $params = shift;
 218
 219     return if ($params->{type} and $params->{type} eq 'FTP');   # Forget it, user specified regular FTP
 220     return if (   $self->type  and    $self->type  eq 'FTP');   # Forget it, user specified regular FTP
 221
 222     if ($self->ssh_publickey || $self->ssh_privatekey) {
 223         $self->specific(1);
 224         return $self->param_keys();  # we got one or both params, but they didn't pan out
 225     }
 226     return local_keyfiles();     # optional "force" arg could be used here to empty cache
 227 }
 228
 229
 230 # TOP LEVEL methods
 231
 232 sub get {
 233     my $self   = shift;
 234     my $params = shift;
 235     if (! ref $params) {
 236         $params = {remote_file => $params} ;
 237     }
 238
 239     $self->init($params);   # secondary init
 240
 241     $self->{get_args} = [$self->remote_file];      # same for scp_put and FTP put
 242     push @{$self->{get_args}}, $self->local_file if defined $self->local_file;
 243
 244     # $self->content($content);
 245
 246     if ($self->type eq "FTP") {
 247         return $self->get_ftp(@{$self->{get_args}});
 248     } elsif ($self->type eq "SFTP") {
 249         return $self->get_sftp(@{$self->{get_args}});
 250     } else {
 251         my %keys = $self->key_check($params);
 252         return $self->get_ssh2(\%keys, @{$self->{get_args}});
 253     }
 254 }
 255
 256 sub put {
 257     my $self   = shift;
 258     my $params = shift;
 259     if (! ref $params) {
 260         $params = {local_file => $params} ;
 261     }
 262
 263     $self->init($params);   # secondary init
 264
 265     my $local_file = $self->outbound_file($params) or return;
 266
 267     $self->{put_args} = [$local_file];      # same for scp_put and FTP put
 268     if (defined $self->remote_path and not defined $self->remote_file) {
 269         my $rpath = $self->remote_path;
 270         my $fname = basename($local_file);
 271         if ($rpath =~ /^(.*)\*+(.*)$/) {    # if the path has an asterisk in it, like './incoming/*.tst'
 272             my $head = $1;
 273             my $tail = $2;
 274             if ($tail =~ /\//) {
 275                 $logger->warn($self->_error("remote path '$rpath' has dir slashes AFTER an asterisk.  Cannot determine target dir"));
 276                 return;
 277             }
 278             if ($self->single_ext) {
 279                 $tail =~ /\./ and $fname =~ s/\./_/g;    # if dot in tail, replace dots in fname (w/ _)
 280             }
 281             $self->remote_file($head . $fname . $tail);
 282         } else {
 283             $self->remote_file($rpath . '/' . $fname);   # if we know just the dir
 284         }
 285     }
 286
 287     if (defined $self->remote_file) {
 288         push @{$self->{put_args}}, $self->remote_file;   # user can specify remote_file name, optionally
 289     }
 290
 291     if ($self->type eq "FTP") {
 292         return $self->put_ftp(@{$self->{put_args}});
 293     } elsif ($self->type eq "SFTP") {
 294         return $self->put_sftp(@{$self->{put_args}});
 295     } else {
 296         my %keys = $self->key_check($params);
 297         $self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file;
 298     }
 299 }
 300
 301 sub ls {
 302     my $self   = shift;
 303     my $params = shift;
 304     my @targets = @_;
 305     if (! ref $params) {
 306         unshift @targets, ($params || '.');   # If it was just a string, it's the first target, else default pwd
 307         delete $self->{remote_file}; # overriding any target in the object previously.
 308         $params = {};                # make params a normal hashref again
 309     } else {
 310         if ($params->{remote_file} and @_) {
 311             $logger->warn($self->_error("Ignoring ls parameter remote_file for subsequent args"));
 312             delete $params->{remote_file};
 313         }
 314         $self->init($params);   # secondary init
 315         $self->remote_file and (! @targets) and push @targets, $self->remote_file;  # if remote_file is there, and there's nothing else, use it
 316         delete $self->{remote_file};
 317     }
 318
 319     $self->{ls_args} = \@targets;
 320
 321     if ($self->type eq "FTP") {
 322         return $self->ls_ftp(@targets);
 323     } elsif ($self->type eq "SFTP") {
 324         return $self->ls_sftp(@targets);
 325     } else {
 326         my %keys = $self->key_check($params);
 327         # $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys");
 328         return $self->ls_ssh2(\%keys, @targets);
 329     }
 330 }
 331
 332 sub delete {
 333     my $self   = shift;
 334     my $params = shift;
 335
 336     $params = {remote_file => $params} unless ref $params;
 337     $self->init($params); # secondary init
 338
 339     my $file = $params->{remote_file};
 340
 341     if (!$file) {
 342         $logger->warn("No file specified for deletion");
 343         return undef;
 344     }
 345
 346     $logger->info("Deleting remote file '$file'");
 347
 348     if ($self->type eq "FTP") {
 349         return $self->delete_ftp($file);
 350     } elsif ($self->type eq "SFTP") {
 351         return $self->delete_sftp($file);
 352     } else {
 353         my %keys = $self->key_check($params);
 354         return $self->delete_ssh2(\%keys, $file);
 355     }
 356 }
 357
 358
 359 # Checks if the filename part of a pathname has one or more glob characters
 360 # We split out the filename portion of the path
 361 # Detect glob or no glob.
 362 # returns: directory, regex for matching filenames
 363 sub glob_parse {
 364     my $self = shift;
 365     my $path = shift or return;
 366     my ($vol, $dir, $file) = File::Spec->splitpath($path); # we don't care about attempted globs in mid-filepath
 367     my $front = $vol ? File::Spec->catdir($vol, $dir) : $dir;
 368     $file =~ /\*/ and return ($front, glob_to_regex($file));
 369     $file =~ /\?/ and return ($front, glob_to_regex($file));
 370     $logger->debug("No glob detected in '$path'");
 371     return;
 372 }
 373
 374
 375 # Internal Mechanics
 376
 377 sub _sftp {
 378     my $self = shift;
 379     $self->{sftp} and return $self->{sftp};     # caching
 380     my $sftp = Net::SFTP::Foreign->new($self->remote_host, user => $self->remote_user, password => $self->remote_password,
 381                                        more => [-o => "StrictHostKeyChecking=no"]);
 382     $sftp->error and $logger->error("SFTP connect FAILED: " . $sftp->error);
 383     return $self->{sftp} = $sftp;
 384 }
 385
 386 sub put_sftp {
 387     my $self = shift;
 388     my $filename = $self->_sftp->put(@{$self->{put_args}});
 389     if ($self->_sftp->error or not $filename) {
 390         $logger->error(
 391             $self->_error(
 392                 "SFTP put to", $self->remote_host, "failed with error: $self->_sftp->error"
 393             )
 394         );
 395         return;
 396     }
 397
 398     $self->remote_file($filename);
 399     $logger->info(
 400         _pkg(
 401             "successfully sent", $self->remote_host, $self->local_file, "-->",
 402             $filename
 403         )
 404     );
 405     return $filename;
 406 }
 407
 408 sub get_sftp {
 409     my $self = shift;
 410     my $remote_filename = $self->{get_args}->[0];
 411     my $filename = $self->{get_args}->[1];
 412     my $success = $self->_sftp->get(@{$self->{get_args}});
 413     if ($self->_sftp->error or not $success) {
 414         $logger->error(
 415             $self->_error(
 416                 "get from", $self->remote_host, "failed with error: $self->_sftp->error"
 417             )
 418         );
 419         return;
 420     }
 421
 422     $self->local_file($filename);
 423     $logger->info(
 424         _pkg(
 425             "successfully retrieved $filename <--", $self->remote_host . '/' .
 426             $self->remote_file
 427         )
 428     );
 429     return $self->local_file;
 430
 431 }
 432
 433 #$sftp->ls($path) or die 'could not ls: ' . $sftp->error;
 434 sub ls_sftp {   # returns full path like: dir/path/file.ext
 435     my $self = shift;
 436     my @list;
 437
 438     foreach (@_) {
 439         my ($dirpath, $regex) = $self->glob_parse($_);
 440         my $dirtarget = $dirpath || $_;
 441         $dirtarget =~ s/\/+$//;
 442         my @part = @{$self->_sftp->ls($dirtarget, names_only=>1, no_wanted => qr/^\.+$/)};
 443         if ($self->_sftp->error) {
 444             $logger->error(
 445                 $self->_error(
 446                     "ls from",  $self->remote_host, "failed with error: " . $self->_sftp->error
 447                 )
 448             );
 449             next;
 450         }
 451         if ($dirtarget and $dirtarget ne '.' and $dirtarget ne './') {
 452             foreach my $file (@part) {   # we ensure full(er) path
 453                 $file =~ /^$dirtarget\// and next;
 454                 $logger->debug("ls_sftp: prepending $dirtarget/ to $file");
 455                 $file = File::Spec->catdir($dirtarget, $file);
 456             }
 457         }
 458         if ($regex) {
 459             my $count = scalar(@part);
 460             # @part = grep {my @a = split('/',$_); scalar(@a) ? /$regex/ : ($a[-1] =~ /$regex/)} @part;
 461             my @bulk = @part;
 462             @part = grep {
 463                         my ($vol, $dir, $file) = File::Spec->splitpath($_);
 464                         $file =~ /$regex/
 465                     } @part;
 466             $logger->info("FTP ls: Glob regex($regex) matches " . scalar(@part) . " of $count files");
 467         } #  else {$logger->info("FTP ls: No Glob regex in '$_'.  Just a regular ls");}
 468         push @list, @part;
 469     }
 470     return @list;
 471 }
 472
 473 sub delete_sftp {
 474 #$sftp->remove($putfile) or die "could not remove $putfile: " . $sftp->error;
 475   return;
 476 }
 477
 478 sub _ssh2 {
 479     my $self = shift;
 480     $self->{ssh2} and return $self->{ssh2};     # caching
 481     my $keys = shift;
 482
 483     my $ssh2 = Net::SSH2->new();
 484     unless($ssh2->connect($self->remote_host)) {
 485         $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error)));
 486         return;     # we cannot connect
 487     }
 488
 489     my $success  = 0;
 490     my @privates = keys %$keys;
 491     my $count    = scalar @privates;
 492
 493     if ($count) {
 494         foreach (@privates) {
 495             if ($self->auth_ssh2($ssh2,$self->auth_ssh2_args($_,$keys->{$_}))) {
 496                 $success++;
 497                 last;
 498             }
 499         }
 500         unless ($success) {
 501             $logger->error(
 502                 $self->error(
 503                     "All ($count) keypair(s) FAILED for " . $self->remote_host
 504                 )
 505             );
 506             return;
 507         }
 508     } else {
 509         $logger->error(
 510             $self->error("Login FAILED for " . $self->remote_host)
 511         ) unless $self->auth_ssh2($ssh2, $self->auth_ssh2_args);
 512     }
 513     return $self->{ssh2} = $ssh2;
 514 }
 515
 516 sub auth_ssh2 {
 517     my $self = shift;
 518     my $ssh2 = shift;
 519     my %auth_args = @_;
 520     $ssh2 or return;
 521
 522     my $host = $auth_args{hostname}   || 'UNKNOWN';
 523     my $key  = $auth_args{privatekey} || 'UNKNOWN';
 524     my $msg  = "ssh2->auth by keypair for $host using $key";
 525     if ($ssh2->auth(%auth_args)) {
 526         $logger->info("Successful $msg");
 527          return 1;
 528     }
 529
 530     if ($self->specific) {
 531         $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
 532     } else {
 533         $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
 534     }
 535     return;
 536 }
 537
 538 sub auth_ssh2_args {
 539     my $self = shift;
 540     my %auth_args = (
 541         privatekey => shift,
 542         publickey  => shift,
 543         rank => [qw/ publickey hostbased password /],
 544     );
 545     $self->remote_user     and $auth_args{username} = $self->remote_user    ;
 546     $self->remote_password and $auth_args{password} = $self->remote_password;
 547     $self->remote_host     and $auth_args{hostname} = $self->remote_host    ;
 548     return %auth_args;
 549 }
 550
 551 sub put_ssh2 {
 552     my $self = shift;
 553     my $keys = shift;    # could have many keypairs here
 554     unless (@_) {
 555         $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
 556         return;
 557     }
 558
 559     $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
 560     my $ssh2 = $self->_ssh2($keys) or return;
 561     my $res;
 562     if ($res = $ssh2->scp_put( @_ )) {
 563         $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
 564         return $res;
 565     }
 566     $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
 567     return;
 568 }
 569
 570 sub get_ssh2 {
 571     my $self = shift;
 572     my $keys = shift;    # could have many keypairs here
 573     unless (@_) {
 574         $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
 575         return;
 576     }
 577
 578     $logger->info("*** get args: " . Dumper(\@_));
 579     $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys");
 580     my $ssh2 = $self->_ssh2($keys) or return;
 581     my $res;
 582     if ($res = $ssh2->scp_get( @_ )) {
 583         $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
 584         return $res;
 585     }
 586     $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
 587     return;
 588 }
 589
 590 sub ls_ssh2 {
 591     my $self = shift;
 592     my @list = $self->ls_ssh2_full(@_);
 593     @list and return sort map {$_->{slash_path}} @list;
 594 #   @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
 595 }
 596
 597 sub ls_ssh2_full {
 598     my $self = shift;
 599     my $keys = shift;    # could have many keypairs here
 600     my @targets = grep {defined} @_;
 601
 602     $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
 603     my $ssh2 = $self->_ssh2($keys) or return;
 604     my $sftp = $ssh2->sftp         or return;
 605
 606     my @list = ();
 607     foreach my $target (@targets) {
 608         my ($dir, $file);
 609         my ($dirpath, $regex) = $self->glob_parse($target);
 610         $dir = $sftp->opendir($dirpath || $target);     # Try to open it like a directory
 611         unless ($dir) {
 612             $file = $sftp->stat($target);   # Otherwise, check it like a file
 613             if ($file) {
 614                 $file->{slash_path} = $self->_slash_path($target, $file->{name});     # it was a file, not a dir.  That's OK.
 615                 push @list, $file;
 616             } else {
 617                 $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
 618             }
 619             next;
 620         }
 621         my @pool = ();
 622         while ($file = $dir->read()) {
 623             $file->{slash_path} = $self->_slash_path($target, $file->{name});
 624             push @pool, $file;
 625         }
 626         if ($regex) {
 627             my $count = scalar(@pool);
 628             @pool = grep {$_->{name} =~ /$regex/} @pool;
 629             $logger->info("SSH ls: Glob regex($regex) matches " . scalar(@pool) . " of $count files");
 630         } # else { $logger->info("SSH ls: No Glob regex in '$target'.  Just a regular ls"); }
 631         push @list, @pool;
 632     }
 633     return @list;
 634
 635 }
 636
 637 sub delete_ssh2 {
 638     my $self = shift;
 639     my $keys = shift;
 640     my $file = shift;
 641     my $sftp = $self->_ssh2($keys)->sftp;
 642     return $sftp->unlink($file);
 643 }
 644
 645 sub _slash_path {
 646     my $self = shift;
 647     my $dir  = shift || '.';
 648     my $file = shift || '';
 649     my ($dirpath, $regex) = $self->glob_parse($dir);
 650     $dir = $dirpath if $dirpath;
 651     return $dir . ($dir =~ /\/$/ ? '' : '/') . $file;
 652 }
 653
 654 sub _ftp {
 655     my $self = shift;
 656     my %options = ();
 657     $self->{ftp} and return $self->{ftp};   # caching
 658     foreach (qw/debug port/) {
 659         $options{ucfirst($_)} = $self->{$_} if $self->{$_};
 660     }
 661
 662     my $ftp = new Net::FTP($self->remote_host, %options);
 663     unless ($ftp) {
 664         $logger->error(
 665             $self->_error(
 666                 "new Net::FTP('" . $self->remote_host . ", ...) FAILED: $@"
 667             )
 668         );
 669         return;
 670     }
 671
 672     my @login_args = ();
 673     foreach (qw/remote_user remote_password remote_account/) {
 674         $self->{$_} or last;
 675         push @login_args, $self->{$_};
 676     }
 677     my $login_ok = 0;
 678     eval { $login_ok = $ftp->login(@login_args) };
 679     if ($@ or !$login_ok) {
 680         $logger->error(
 681             $self->_error(
 682                 "failed login to", $self->remote_host, "w/ args(" .
 683                 join(',', @login_args) . ") : $@"
 684             )
 685         ); # XXX later, maybe keep passwords out of the logs?
 686         return;
 687     }
 688     return $self->{ftp} = $ftp;
 689 }
 690
 691 sub put_ftp {
 692     my $self = shift;
 693     my $filename;
 694
 695     eval { $filename = $self->_ftp->put(@{$self->{put_args}}) };
 696     if ($@ or not $filename) {
 697         $logger->error(
 698             $self->_error(
 699                 "put to", $self->remote_host, "failed with error: $@"
 700             )
 701         );
 702         return;
 703     }
 704
 705     $self->remote_file($filename);
 706     $logger->info(
 707         _pkg(
 708             "successfully sent", $self->remote_host, $self->local_file, '-->',
 709             $filename
 710         )
 711     );
 712     return $filename;
 713 }
 714
 715 sub get_ftp {
 716     my $self = shift;
 717     my $filename;
 718
 719     my $remote_filename = $self->{get_args}->[0];
 720     eval { $filename = $self->_ftp->get(@{$self->{get_args}}) };
 721     if ($@ or not $filename) {
 722         $logger->error(
 723             $self->_error(
 724                 "get from", $self->remote_host, "failed with error: $@"
 725             )
 726         );
 727         return;
 728     }
 729     if (!defined(${$filename->sref})) {
 730         # the underlying scalar is still undef, so Net::FTP must have
 731         # successfully retrieved an empty file... which we should skip
 732         $logger->error(
 733             $self->_error(
 734                 "get $remote_filename from", $self->remote_host, ": remote file is zero-length"
 735             )
 736         );
 737         return;
 738     }
 739
 740     $self->local_file($filename);
 741     $logger->info(
 742         _pkg(
 743             "successfully retrieved $filename <--", $self->remote_host . '/' .
 744             $self->remote_file
 745         )
 746     );
 747     return $self->local_file;
 748 }
 749
 750 sub ls_ftp {   # returns full path like: dir/path/file.ext
 751     my $self = shift;
 752     my @list;
 753
 754     foreach (@_) {
 755         my @part;
 756         my ($dirpath, $regex) = $self->glob_parse($_);
 757         my $dirtarget = $dirpath || $_;
 758         $dirtarget =~ s/\/+$//;
 759         eval { @part = $self->_ftp->ls($dirtarget) };      # this ls returns relative/path/filenames.  defer filename glob filtering for below.
 760         if ($@) {
 761             $logger->error(
 762                 $self->_error(
 763                     "ls from",  $self->remote_host, "failed with error: $@"
 764                 )
 765             );
 766             next;
 767         }
 768         if ($dirtarget and $dirtarget ne '.' and $dirtarget ne './' and
 769             $self->_ftp->dir($dirtarget)) {
 770             foreach my $file (@part) {   # we ensure full(er) path
 771                 $file =~ /^$dirtarget\// and next;
 772                 $logger->debug("ls_ftp: prepending $dirtarget/ to $file");
 773                 $file = File::Spec->catdir($dirtarget, $file);
 774             }
 775         }
 776         if ($regex) {
 777             my $count = scalar(@part);
 778             # @part = grep {my @a = split('/',$_); scalar(@a) ? /$regex/ : ($a[-1] =~ /$regex/)} @part;
 779             my @bulk = @part;
 780             @part = grep {
 781                         my ($vol, $dir, $file) = File::Spec->splitpath($_);
 782                         $file =~ /$regex/
 783                     } @part;
 784             $logger->info("FTP ls: Glob regex($regex) matches " . scalar(@part) . " of $count files");
 785         } #  else {$logger->info("FTP ls: No Glob regex in '$_'.  Just a regular ls");}
 786         push @list, @part;
 787     }
 788     return @list;
 789 }
 790
 791 sub delete_ftp {
 792     my $self = shift;
 793     my $file = shift;
 794     return $self->_ftp->delete($file);
 795 }
 796
 797 sub _pkg {      # Not OO
 798     return __PACKAGE__ . ' : ' unless @_;
 799     return __PACKAGE__ . ' : ' . join(' ', @_);
 800 }
 801
 802 sub _error {
 803     my $self = shift;
 804     return _pkg($self->error(join(' ',@_)));
 805 }
 806
 807 sub init {
 808     my $self   = shift;
 809     my $params = shift;
 810     my @required = @_;  # qw(remote_host) ;     # nothing required now
 811
 812     if ($params->{account_object}) {    # if we got passed an object, we initialize off that first
 813         $self->{remote_host    } = $params->{account_object}->host;
 814         $self->{remote_user    } = $params->{account_object}->username;
 815         $self->{remote_password} = $params->{account_object}->password;
 816         $self->{remote_account } = $params->{account_object}->account;
 817         $self->{remote_path    } = $params->{account_object}->path;     # not really the same as remote_file, maybe expand on this later
 818     }
 819
 820     foreach (keys %{$self->{_permitted}}) {
 821         $self->{$_} = $params->{$_} if defined $params->{$_};   # possibly override settings from object
 822     }
 823
 824     foreach (@required) {
 825         unless ($self->{$_}) {
 826             $logger->error("Required parameter $_ not specified");
 827             return;
 828         }
 829     }
 830     return $self;
 831 }
 832
 833 sub new {
 834     my ($class, %args) = @_;
 835     my $self = { _permitted => \%fields, %fields };
 836
 837     bless $self, $class;
 838
 839     $self->init(\%args); # or croak "Initialization error caused by bad args";
 840     return $self;
 841 }
 842
 843 sub DESTROY {
 844     # in order to create, we must first ...
 845     my $self  = shift;
 846     # let the other end know we're done.
 847     $self->{ssh2} and $self->{ssh2}->disconnect();
 848     $self->{sftp} and $self->{sftp}->disconnect();
 849     $self->{ftp} and $self->{ftp}->quit();
 850 }
 851
 852 sub AUTOLOAD {
 853     my $self  = shift;
 854     my $class = ref($self) or croak "AUTOLOAD error: $self is not an object";
 855     my $name  = $AUTOLOAD;
 856
 857     $name =~ s/.*://;   #   strip leading package stuff
 858
 859     unless (exists $self->{_permitted}->{$name}) {
 860         croak "AUTOLOAD error: Cannot access '$name' field of class '$class'";
 861     }
 862
 863     if (@_) {
 864         return $self->{$name} = shift;
 865     } else {
 866         return $self->{$name};
 867     }
 868 }
 869
 870 1;
 871