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