1 package OpenILS::Utils::RemoteAccount;
3 # use OpenSRF::Utils::SettingsClient;
4 use OpenSRF::Utils::Logger qw/:logger/;
12 use Text::Glob qw( match_glob glob_to_regex );
15 $Data::Dumper::Indent = 0;
27 account_object => undef,
30 remote_password => undef,
31 remote_account => undef,
33 remote_path => undef, # not really doing anything with this... yet.
34 ssh_privatekey => undef,
35 ssh_publickey => undef,
50 OpenILS::Utils::RemoteAccount - Encapsulate FTP, SFTP and SSH file transactions for Evergreen
54 The Remote Account module attempts to transfer a file to/from a remote server.
55 Either Net::FTP or Net::SSH2 is used.
59 All information is expected to be supplied by the caller via parameters:
60 ~ remote_host (required)
66 ~ type (FTP, SFTP or SCP -- default FTP)
70 Note: none of the parameters are actually required, except remote_host.
71 That is because remote_user, remote_password and remote_account can all be
72 extrapolated from other sources, as the Net::FTP docs describe:
74 If no arguments are given then Net::FTP uses the Net::Netrc package
75 to lookup the login information for the connected host.
77 If no information is found then a login of anonymous is used.
79 If no password is given and the login is anonymous then anonymous@
80 will be used for password.
82 Note that specifying a password will require you to specify a user.
83 Similarly, specifying an account requires both user and password.
84 That is, there are no assumed defaults when the latter arguments are used.
88 The use of ssh keys is preferred. Explicit specification of connection type will prevent
89 multiple attempts to the same server. Therefore, using the type parameter is also recommended.
91 If the type is not explicit, we attempt to use SSH keys where they are specified or otherwise found
92 in the runtime environment. If only one key is specified, we attempt to derive
93 the corresponding filename based on the ssh-keygen defaults. If either key is
94 specified, but both are not found (and readable) then the result is failure. If
95 no key or type is specified, but keys are found, the key-based connections will be attempted,
96 but failure will be non-fatal.
101 # returns plausible locations of a .ssh subdir where SSH keys might be stashed
102 # NOTE: these would need to be properly genericized w/ Makefile vars
103 # in order to support Debian packaging and multiple EG's on one box.
104 # Until that happens, we just rely on $HOME
107 # '/openils/conf', # __EG_CONFIG_DIR__
109 ($ENV{HOME}) and unshift @bases, $ENV{HOME};
111 return grep {-d $_} map {"$_/.ssh"} @bases;
115 # populates %keyfiles hash
116 # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY
118 my $force = (@_ ? shift : 0);
119 return %keyfiles if (%keyfiles and not $force); # caching
120 $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : ''));
121 %keyfiles = (); # reset to empty
122 my @dirs = plausible_dirs();
123 $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs));
124 foreach my $dir (@dirs) {
125 foreach my $key (qw/rsa dsa/) {
126 my $private = "$dir/id_$key";
127 my $public = "$dir/id_$key.pub";
128 unless (-r $private) {
129 $logger->debug("Key '$private' cannot be read: $!");
132 unless (-r $public) {
133 $logger->debug("Key '$public' cannot be read: $!");
136 $keyfiles{$private} = $public;
145 if ($self->ssh_publickey and not $self->ssh_privatekey) {
146 my $private = $self->ssh_publickey;
147 unless ($private and $private =~ s/\.pub$// and -r $self->ssh_privatekey) { # try to guess missing private key name
148 $logger->error("No ssh_privatekey specified or found to pair with " . $self->ssh_publickey);
151 $self->ssh_privatekey($private);
153 if ($self->ssh_privatekey and not $self->ssh_publickey) {
154 my $pub = $self->ssh_privatekey . '.pub'; # guess missing public key name
156 $logger->error("No ssh_publickey specified or found to pair with " . $self->ssh_privatekey);
159 $self->ssh_publickey($pub);
162 # so now, we have either both ssh_p*keys params or neither
163 foreach (qw/ssh_publickey ssh_privatekey/) {
164 unless (-r $self->{$_}) {
165 $logger->error("$_ '" . $self->{$_} . "' cannot be read: $!");
166 return; # quit w/ error if we fail on any user-specified key
169 $keys{$self->ssh_privatekey} = $self->ssh_publickey;
175 my $text = shift || $self->content || '';
176 my $tmp = File::Temp->new(); # magical self-destructing tempfile
177 # print $tmp "THIS IS TEXT\n";
178 print $tmp $text or $logger->error($self->_error("could not write to tempfile '$tmp'"));
180 $self->tempfile($tmp); # save the object
181 $self->local_file($tmp->filename); # save the filename
182 $logger->info(_pkg("using tempfile $tmp"));
183 return $self->local_file; # return the filename
190 unless (defined $self->content or $self->local_file) { # content can be emptystring
191 $logger->error($self->_error("No content or local_file specified -- nothing to send"));
195 # tricky subtlety: we want to use the most recently specified options
196 # with priority order: filename, content, old filename, old content.
198 # The $params->{x} will already match $self->x after the secondary init,
199 # so the checks using $params below are for whether the value was specified NOW (e.g. via put()) or not.
201 # if we got a new local_file value, we use it
202 # else if the content is new to this call, build a new tempfile w/ it,
203 # else use existing local_file,
204 # else build new tempfile w/ content already specified via new()
206 return $params->{local_file} || (
207 (defined $params->{content}) ?
208 $self->new_tempfile($self->content) : # $self->content is same value as $params->{content}
209 ($self->local_file || $self->new_tempfile($self->content))
217 return if ($params->{type} and $params->{type} eq 'FTP'); # Forget it, user specified regular FTP
218 return if ( $self->type and $self->type eq 'FTP'); # Forget it, user specified regular FTP
220 if ($self->ssh_publickey || $self->ssh_privatekey) {
222 return $self->param_keys(); # we got one or both params, but they didn't pan out
224 return local_keyfiles(); # optional "force" arg could be used here to empty cache
229 # TODO: delete for both FTP and SSH2
235 $params = {remote_file => $params} ;
238 $self->init($params); # secondary init
240 $self->{get_args} = [$self->remote_file]; # same for scp_put and FTP put
241 push @{$self->{get_args}}, $self->local_file if defined $self->local_file;
243 # $self->content($content);
245 if ($self->type eq "FTP") {
246 return $self->get_ftp(@{$self->{get_args}});
248 my %keys = $self->key_check($params);
249 return $self->get_ssh2(\%keys, @{$self->{get_args}});
257 $params = {local_file => $params} ;
260 $self->init($params); # secondary init
262 my $local_file = $self->outbound_file($params) or return;
264 $self->{put_args} = [$local_file]; # same for scp_put and FTP put
265 if (defined $self->remote_path and not defined $self->remote_file) {
266 my $rpath = $self->remote_path;
267 my $fname = basename($local_file);
268 if ($rpath =~ /^(.*)\*+(.*)$/) { # if the path has an asterisk in it, like './incoming/*.tst'
272 $logger->warn($self->_error("remote path '$rpath' has dir slashes AFTER an asterisk. Cannot determine target dir"));
275 if ($self->single_ext) {
276 $tail =~ /\./ and $fname =~ s/\./_/g; # if dot in tail, replace dots in fname (w/ _)
278 $self->remote_file($head . $fname . $tail);
280 $self->remote_file($rpath . '/' . $fname); # if we know just the dir
284 if (defined $self->remote_file) {
285 push @{$self->{put_args}}, $self->remote_file; # user can specify remote_file name, optionally
288 if ($self->type eq "FTP") {
289 return $self->put_ftp(@{$self->{put_args}});
291 my %keys = $self->key_check($params);
292 $self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file;
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
305 if ($params->{remote_file} and @_) {
306 $logger->warn($self->_error("Ignoring ls parameter remote_file for subsequent args"));
307 delete $params->{remote_file};
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};
314 $self->{ls_args} = \@targets;
316 if ($self->type eq "FTP") {
317 return $self->ls_ftp(@targets);
319 my %keys = $self->key_check($params);
320 # $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys");
321 return $self->ls_ssh2(\%keys, @targets);
325 # Checks if the filename part of a pathname has one or more glob characters
326 # We split out the filename portion of the path
327 # Detect glob or no glob.
328 # returns: directory, regex for matching filenames
331 my $path = shift or return;
332 my ($vol, $dir, $file) = File::Spec->splitpath($path); # we don't care about attempted globs in mid-filepath
333 my $front = $vol ? File::Spec->catdir($vol, $dir) : $dir;
334 $file =~ /\*/ and return ($front, glob_to_regex($file));
335 $file =~ /\?/ and return ($front, glob_to_regex($file));
336 $logger->debug("No glob detected in '$path'");
345 $self->{ssh2} and return $self->{ssh2}; # caching
348 my $ssh2 = Net::SSH2->new();
349 unless($ssh2->connect($self->remote_host)) {
350 $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error)));
351 return; # we cannot connect
355 my @privates = keys %$keys;
356 my $count = scalar @privates;
359 foreach (@privates) {
360 if ($self->auth_ssh2($ssh2,$self->auth_ssh2_args($_,$keys->{$_}))) {
368 "All ($count) keypair(s) FAILED for " . $self->remote_host
375 $self->error("Login FAILED for " . $self->remote_host)
376 ) unless $self->auth_ssh2($ssh2, $self->auth_ssh2_args);
378 return $self->{ssh2} = $ssh2;
387 my $host = $auth_args{hostname} || 'UNKNOWN';
388 my $key = $auth_args{privatekey} || 'UNKNOWN';
389 my $msg = "ssh2->auth by keypair for $host using $key";
390 if ($ssh2->auth(%auth_args)) {
391 $logger->info("Successful $msg");
395 if ($self->specific) {
396 $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
398 $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
408 rank => [qw/ publickey hostbased password /],
410 $self->remote_user and $auth_args{username} = $self->remote_user ;
411 $self->remote_password and $auth_args{password} = $self->remote_password;
412 $self->remote_host and $auth_args{hostname} = $self->remote_host ;
418 my $keys = shift; # could have many keypairs here
420 $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
424 $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
425 my $ssh2 = $self->_ssh2($keys) or return;
427 if ($res = $ssh2->scp_put( @_ )) {
428 $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
431 $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
437 my $keys = shift; # could have many keypairs here
439 $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
443 $logger->info("*** get args: " . Dumper(\@_));
444 $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys");
445 my $ssh2 = $self->_ssh2($keys) or return;
447 if ($res = $ssh2->scp_get( @_ )) {
448 $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
451 $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
457 my @list = $self->ls_ssh2_full(@_);
458 @list and return sort map {$_->{slash_path}} @list;
459 # @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
464 my $keys = shift; # could have many keypairs here
465 my @targets = grep {defined} @_;
467 $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
468 my $ssh2 = $self->_ssh2($keys) or return;
469 my $sftp = $ssh2->sftp or return;
472 foreach my $target (@targets) {
474 my ($dirpath, $regex) = $self->glob_parse($target);
475 $dir = $sftp->opendir($dirpath || $target); # Try to open it like a directory
477 $file = $sftp->stat($target); # Otherwise, check it like a file
479 $file->{slash_path} = $self->_slash_path($target, $file->{name}); # it was a file, not a dir. That's OK.
482 $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
487 while ($file = $dir->read()) {
488 $file->{slash_path} = $self->_slash_path($target, $file->{name});
492 my $count = scalar(@pool);
493 @pool = grep {$_->{name} =~ /$regex/} @pool;
494 $logger->info("SSH ls: Glob regex($regex) matches " . scalar(@pool) . " of $count files");
495 } # else { $logger->info("SSH ls: No Glob regex in '$target'. Just a regular ls"); }
504 my $dir = shift || '.';
505 my $file = shift || '';
506 my ($dirpath, $regex) = $self->glob_parse($dir);
507 $dir = $dirpath if $dirpath;
508 return $dir . ($dir =~ /\/$/ ? '' : '/') . $file;
514 $self->{ftp} and return $self->{ftp}; # caching
515 foreach (qw/debug port/) {
516 $options{ucfirst($_)} = $self->{$_} if $self->{$_};
519 my $ftp = new Net::FTP($self->remote_host, %options);
523 "new Net::FTP('" . $self->remote_host . ", ...) FAILED: $@"
530 foreach (qw/remote_user remote_password remote_account/) {
532 push @login_args, $self->{$_};
535 eval { $login_ok = $ftp->login(@login_args) };
536 if ($@ or !$login_ok) {
539 "failed login to", $self->remote_host, "w/ args(" .
540 join(',', @login_args) . ") : $@"
542 ); # XXX later, maybe keep passwords out of the logs?
545 return $self->{ftp} = $ftp;
552 eval { $filename = $self->_ftp->put(@{$self->{put_args}}) };
553 if ($@ or not $filename) {
556 "put to", $self->remote_host, "failed with error: $@"
562 $self->remote_file($filename);
565 "successfully sent", $self->remote_host, $self->local_file, '-->',
576 eval { $filename = $self->_ftp->get(@{$self->{get_args}}) };
577 if ($@ or not $filename) {
580 "get from", $self->remote_host, "failed with error: $@"
586 $self->local_file($filename);
589 "successfully retrieved $filename <--", $self->remote_host . '/' .
593 return $self->local_file;
596 sub ls_ftp { # returns full path like: dir/path/file.ext
602 my ($dirpath, $regex) = $self->glob_parse($_);
603 my $dirtarget = $dirpath || $_;
604 $dirtarget =~ s/\/+$//;
605 eval { @part = $self->_ftp->ls($dirtarget) }; # this ls returns relative/path/filenames. defer filename glob filtering for below.
609 "ls from", $self->remote_host, "failed with error: $@"
614 if ($dirtarget and $dirtarget ne '.' and $dirtarget ne './' and
615 $self->_ftp->dir($dirtarget)) {
616 foreach my $file (@part) { # we ensure full(er) path
617 $file =~ /^$dirtarget\// and next;
618 $logger->debug("ls_ftp: prepending $dirtarget/ to $file");
619 $file = File::Spec->catdir($dirtarget, $file);
623 my $count = scalar(@part);
624 # @part = grep {my @a = split('/',$_); scalar(@a) ? /$regex/ : ($a[-1] =~ /$regex/)} @part;
627 my ($vol, $dir, $file) = File::Spec->splitpath($_);
630 $logger->info("FTP ls: Glob regex($regex) matches " . scalar(@part) . " of $count files");
631 } # else {$logger->info("FTP ls: No Glob regex in '$_'. Just a regular ls");}
637 sub delete_ftp { # XXX not yet used
638 $_[0]->_ftp->delete($_[1]);
642 return __PACKAGE__ . ' : ' unless @_;
643 return __PACKAGE__ . ' : ' . join(' ', @_);
648 return _pkg($self->error(join(' ',@_)));
654 my @required = @_; # qw(remote_host) ; # nothing required now
656 if ($params->{account_object}) { # if we got passed an object, we initialize off that first
657 $self->{remote_host } = $params->{account_object}->host;
658 $self->{remote_user } = $params->{account_object}->username;
659 $self->{remote_password} = $params->{account_object}->password;
660 $self->{remote_account } = $params->{account_object}->account;
661 $self->{remote_path } = $params->{account_object}->path; # not really the same as remote_file, maybe expand on this later
664 foreach (keys %{$self->{_permitted}}) {
665 $self->{$_} = $params->{$_} if defined $params->{$_}; # possibly override settings from object
668 foreach (@required) {
669 unless ($self->{$_}) {
670 $logger->error("Required parameter $_ not specified");
678 my ($class, %args) = @_;
679 my $self = { _permitted => \%fields, %fields };
683 $self->init(\%args); # or croak "Initialization error caused by bad args";
688 # in order to create, we must first ...
690 $self->{ssh2} and $self->{ssh2}->disconnect(); # let the other end know we're done.
691 $self->{ftp} and $self->{ftp}->quit(); # let the other end know we're done.
696 my $class = ref($self) or croak "AUTOLOAD error: $self is not an object";
697 my $name = $AUTOLOAD;
699 $name =~ s/.*://; # strip leading package stuff
701 unless (exists $self->{_permitted}->{$name}) {
702 croak "AUTOLOAD error: Cannot access '$name' field of class '$class'";
706 return $self->{$name} = shift;
708 return $self->{$name};