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