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