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