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     my $login_ok = 0;
 502     eval { $login_ok = $ftp->login(@login_args) };
 503     if ($@ or !$login_ok) {
 504         $logger->error($self->_error("failed login to", $self->remote_host,  "w/ args(" . join(',', @login_args) . ") : $@"));
 505         return;
 506     }
 507     return $self->{uftp} = $ftp;
 508 }
 509
 510 sub put_uftp {
 511     my $self = shift;
 512     my $ftp = $self->_uftp or return;
 513     my $filename;
 514     eval { $filename = $ftp->put(@{$self->{put_args}}) };
 515     if ($@ or ! $filename) {
 516         $logger->error($self->_error("put to", $self->remote_host, "failed with error: $@"));
 517         return;
 518     }
 519     $self->remote_file($filename);
 520     $logger->info(_pkg("successfully sent", $self->remote_host, $self->local_file, '-->', $filename));
 521     return $filename;
 522 }
 523
 524 sub get_uftp {
 525     my $self = shift;
 526     my $ftp = $self->_uftp or return;
 527     my $filename;
 528     eval { $filename = $ftp->get(@{$self->{get_args}}) };
 529     if ($@ or ! $filename) {
 530         $logger->error($self->_error("get from", $self->remote_host, "failed with error: $@"));
 531         return;
 532     }
 533     $self->local_file($filename);
 534     $logger->info(_pkg("successfully retrieved $filename <--", $self->remote_host . '/' . $self->remote_file));
 535     return $self->local_file;
 536 }
 537
 538 sub ls_uftp {
 539     my $self = shift;
 540     my $ftp = $self->_uftp or return;
 541     my @list;
 542     foreach (@_) {
 543         my @part;
 544         my ($dirpath, $regex) = $self->glob_parse($_);
 545         eval { @part = $ftp->ls($dirpath || $_) };
 546         if ($@) {
 547             $logger->error($self->_error("ls from",  $self->remote_host, "failed with error: $@"));
 548             next;
 549         }
 550         if ($regex) {
 551             my $count = scalar(@part);
 552             @part = grep {/$regex/} @part;
 553             $logger->info("Glob regex($regex) matches " . scalar(@part) . " of $count files");
 554         }
 555         push @list, @part;
 556     }
 557     return @list;
 558 }
 559
 560 sub delete_uftp {
 561     my $self = shift;
 562     my $ftp = $self->_uftp or return;
 563     return $ftp->delete(shift);
 564 }
 565
 566 sub _pkg {      # Not OO
 567     return __PACKAGE__ . ' : ' unless @_;
 568     return __PACKAGE__ . ' : ' . join(' ', @_);
 569 }
 570
 571 sub _error {
 572     my $self = shift;
 573     return _pkg($self->error(join(' ',@_)));
 574 }
 575
 576 sub init {
 577     my $self   = shift;
 578     my $params = shift;
 579     my @required = @_;  # qw(remote_host) ;     # nothing required now
 580
 581     if ($params->{account_object}) {    # if we got passed an object, we initialize off that first
 582         $self->{remote_host    } = $params->{account_object}->host;
 583         $self->{remote_user    } = $params->{account_object}->username;
 584         $self->{remote_password} = $params->{account_object}->password;
 585         $self->{remote_account } = $params->{account_object}->account;
 586         $self->{remote_path    } = $params->{account_object}->path;     # not really the same as remote_file, maybe expand on this later
 587     }
 588
 589     foreach (keys %{$self->{_permitted}}) {
 590         $self->{$_} = $params->{$_} if defined $params->{$_};   # possibly override settings from object
 591     }
 592
 593     foreach (@required) {
 594         unless ($self->{$_}) {
 595             $logger->error("Required parameter $_ not specified");
 596             return;
 597         }
 598     }
 599     return $self;
 600 }
 601
 602 sub new {
 603     my ($class, %args) = @_;
 604     my $self = { _permitted => \%fields, %fields };
 605
 606         bless $self, $class;
 607
 608     $self->init(\%args); # or croak "Initialization error caused by bad args";
 609     return $self;
 610 }
 611
 612 sub DESTROY {
 613         # in order to create, we must first ...
 614         my $self  = shift;
 615     $self->{ssh2} and $self->{ssh2}->disconnect();  # let the other end know we're done.
 616     $self->{uftp} and $self->{uftp}->quit();  # let the other end know we're done.
 617 }
 618
 619 sub AUTOLOAD {
 620         my $self  = shift;
 621         my $class = ref($self) or croak "AUTOLOAD error: $self is not an object";
 622         my $name  = $AUTOLOAD;
 623
 624         $name =~ s/.*://;   #   strip leading package stuff
 625
 626         unless (exists $self->{_permitted}->{$name}) {
 627                 croak "Cannot access '$name' field of class '$class'";
 628         }
 629
 630         if (@_) {
 631                 return $self->{$name} = shift;
 632         } else {
 633                 return $self->{$name};
 634         }
 635 }
 636
 637 1;
 638