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
234 $params = {remote_file => $params} ;
237 $self->init($params); # secondary init
239 $self->{get_args} = [$self->remote_file]; # same for scp_put and FTP put
240 push @{$self->{get_args}}, $self->local_file if defined $self->local_file;
242 # $self->content($content);
244 if ($self->type eq "FTP") {
245 return $self->get_ftp(@{$self->{get_args}});
247 my %keys = $self->key_check($params);
248 return $self->get_ssh2(\%keys, @{$self->{get_args}});
256 $params = {local_file => $params} ;
259 $self->init($params); # secondary init
261 my $local_file = $self->outbound_file($params) or return;
263 $self->{put_args} = [$local_file]; # same for scp_put and FTP put
264 if (defined $self->remote_path and not defined $self->remote_file) {
265 my $rpath = $self->remote_path;
266 my $fname = basename($local_file);
267 if ($rpath =~ /^(.*)\*+(.*)$/) { # if the path has an asterisk in it, like './incoming/*.tst'
271 $logger->warn($self->_error("remote path '$rpath' has dir slashes AFTER an asterisk. Cannot determine target dir"));
274 if ($self->single_ext) {
275 $tail =~ /\./ and $fname =~ s/\./_/g; # if dot in tail, replace dots in fname (w/ _)
277 $self->remote_file($head . $fname . $tail);
279 $self->remote_file($rpath . '/' . $fname); # if we know just the dir
283 if (defined $self->remote_file) {
284 push @{$self->{put_args}}, $self->remote_file; # user can specify remote_file name, optionally
287 if ($self->type eq "FTP") {
288 return $self->put_ftp(@{$self->{put_args}});
290 my %keys = $self->key_check($params);
291 $self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file;
300 unshift @targets, ($params || '.'); # If it was just a string, it's the first target, else default pwd
301 delete $self->{remote_file}; # overriding any target in the object previously.
302 $params = {}; # make params a normal hashref again
304 if ($params->{remote_file} and @_) {
305 $logger->warn($self->_error("Ignoring ls parameter remote_file for subsequent args"));
306 delete $params->{remote_file};
308 $self->init($params); # secondary init
309 $self->remote_file and (! @targets) and push @targets, $self->remote_file; # if remote_file is there, and there's nothing else, use it
310 delete $self->{remote_file};
313 $self->{ls_args} = \@targets;
315 if ($self->type eq "FTP") {
316 return $self->ls_ftp(@targets);
318 my %keys = $self->key_check($params);
319 # $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys");
320 return $self->ls_ssh2(\%keys, @targets);
328 $params = {remote_file => $params} unless ref $params;
329 $self->init($params); # secondary init
331 my $file = $params->{remote_file};
334 $logger->warn("No file specified for deletion");
338 $logger->info("Deleting remote file '$file'");
340 if ($self->type eq "FTP") {
341 return $self->delete_ftp($file);
343 my %keys = $self->key_check($params);
344 return $self->delete_ssh2(\%keys, $file);
349 # Checks if the filename part of a pathname has one or more glob characters
350 # We split out the filename portion of the path
351 # Detect glob or no glob.
352 # returns: directory, regex for matching filenames
355 my $path = shift or return;
356 my ($vol, $dir, $file) = File::Spec->splitpath($path); # we don't care about attempted globs in mid-filepath
357 my $front = $vol ? File::Spec->catdir($vol, $dir) : $dir;
358 $file =~ /\*/ and return ($front, glob_to_regex($file));
359 $file =~ /\?/ and return ($front, glob_to_regex($file));
360 $logger->debug("No glob detected in '$path'");
369 $self->{ssh2} and return $self->{ssh2}; # caching
372 my $ssh2 = Net::SSH2->new();
373 unless($ssh2->connect($self->remote_host)) {
374 $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error)));
375 return; # we cannot connect
379 my @privates = keys %$keys;
380 my $count = scalar @privates;
383 foreach (@privates) {
384 if ($self->auth_ssh2($ssh2,$self->auth_ssh2_args($_,$keys->{$_}))) {
392 "All ($count) keypair(s) FAILED for " . $self->remote_host
399 $self->error("Login FAILED for " . $self->remote_host)
400 ) unless $self->auth_ssh2($ssh2, $self->auth_ssh2_args);
402 return $self->{ssh2} = $ssh2;
411 my $host = $auth_args{hostname} || 'UNKNOWN';
412 my $key = $auth_args{privatekey} || 'UNKNOWN';
413 my $msg = "ssh2->auth by keypair for $host using $key";
414 if ($ssh2->auth(%auth_args)) {
415 $logger->info("Successful $msg");
419 if ($self->specific) {
420 $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
422 $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
432 rank => [qw/ publickey hostbased password /],
434 $self->remote_user and $auth_args{username} = $self->remote_user ;
435 $self->remote_password and $auth_args{password} = $self->remote_password;
436 $self->remote_host and $auth_args{hostname} = $self->remote_host ;
442 my $keys = shift; # could have many keypairs here
444 $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
448 $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
449 my $ssh2 = $self->_ssh2($keys) or return;
451 if ($res = $ssh2->scp_put( @_ )) {
452 $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
455 $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
461 my $keys = shift; # could have many keypairs here
463 $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
467 $logger->info("*** get args: " . Dumper(\@_));
468 $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys");
469 my $ssh2 = $self->_ssh2($keys) or return;
471 if ($res = $ssh2->scp_get( @_ )) {
472 $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
475 $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
481 my @list = $self->ls_ssh2_full(@_);
482 @list and return sort map {$_->{slash_path}} @list;
483 # @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
488 my $keys = shift; # could have many keypairs here
489 my @targets = grep {defined} @_;
491 $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
492 my $ssh2 = $self->_ssh2($keys) or return;
493 my $sftp = $ssh2->sftp or return;
496 foreach my $target (@targets) {
498 my ($dirpath, $regex) = $self->glob_parse($target);
499 $dir = $sftp->opendir($dirpath || $target); # Try to open it like a directory
501 $file = $sftp->stat($target); # Otherwise, check it like a file
503 $file->{slash_path} = $self->_slash_path($target, $file->{name}); # it was a file, not a dir. That's OK.
506 $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
511 while ($file = $dir->read()) {
512 $file->{slash_path} = $self->_slash_path($target, $file->{name});
516 my $count = scalar(@pool);
517 @pool = grep {$_->{name} =~ /$regex/} @pool;
518 $logger->info("SSH ls: Glob regex($regex) matches " . scalar(@pool) . " of $count files");
519 } # else { $logger->info("SSH ls: No Glob regex in '$target'. Just a regular ls"); }
530 my $sftp = $self->_ssh2($keys)->sftp;
531 return $sftp->unlink($file);
536 my $dir = shift || '.';
537 my $file = shift || '';
538 my ($dirpath, $regex) = $self->glob_parse($dir);
539 $dir = $dirpath if $dirpath;
540 return $dir . ($dir =~ /\/$/ ? '' : '/') . $file;
546 $self->{ftp} and return $self->{ftp}; # caching
547 foreach (qw/debug port/) {
548 $options{ucfirst($_)} = $self->{$_} if $self->{$_};
551 my $ftp = new Net::FTP($self->remote_host, %options);
555 "new Net::FTP('" . $self->remote_host . ", ...) FAILED: $@"
562 foreach (qw/remote_user remote_password remote_account/) {
564 push @login_args, $self->{$_};
567 eval { $login_ok = $ftp->login(@login_args) };
568 if ($@ or !$login_ok) {
571 "failed login to", $self->remote_host, "w/ args(" .
572 join(',', @login_args) . ") : $@"
574 ); # XXX later, maybe keep passwords out of the logs?
577 return $self->{ftp} = $ftp;
584 eval { $filename = $self->_ftp->put(@{$self->{put_args}}) };
585 if ($@ or not $filename) {
588 "put to", $self->remote_host, "failed with error: $@"
594 $self->remote_file($filename);
597 "successfully sent", $self->remote_host, $self->local_file, '-->',
608 eval { $filename = $self->_ftp->get(@{$self->{get_args}}) };
609 if ($@ or not $filename) {
612 "get from", $self->remote_host, "failed with error: $@"
618 $self->local_file($filename);
621 "successfully retrieved $filename <--", $self->remote_host . '/' .
625 return $self->local_file;
628 sub ls_ftp { # returns full path like: dir/path/file.ext
634 my ($dirpath, $regex) = $self->glob_parse($_);
635 my $dirtarget = $dirpath || $_;
636 $dirtarget =~ s/\/+$//;
637 eval { @part = $self->_ftp->ls($dirtarget) }; # this ls returns relative/path/filenames. defer filename glob filtering for below.
641 "ls from", $self->remote_host, "failed with error: $@"
646 if ($dirtarget and $dirtarget ne '.' and $dirtarget ne './' and
647 $self->_ftp->dir($dirtarget)) {
648 foreach my $file (@part) { # we ensure full(er) path
649 $file =~ /^$dirtarget\// and next;
650 $logger->debug("ls_ftp: prepending $dirtarget/ to $file");
651 $file = File::Spec->catdir($dirtarget, $file);
655 my $count = scalar(@part);
656 # @part = grep {my @a = split('/',$_); scalar(@a) ? /$regex/ : ($a[-1] =~ /$regex/)} @part;
659 my ($vol, $dir, $file) = File::Spec->splitpath($_);
662 $logger->info("FTP ls: Glob regex($regex) matches " . scalar(@part) . " of $count files");
663 } # else {$logger->info("FTP ls: No Glob regex in '$_'. Just a regular ls");}
672 return $self->_ftp->delete($file);
676 return __PACKAGE__ . ' : ' unless @_;
677 return __PACKAGE__ . ' : ' . join(' ', @_);
682 return _pkg($self->error(join(' ',@_)));
688 my @required = @_; # qw(remote_host) ; # nothing required now
690 if ($params->{account_object}) { # if we got passed an object, we initialize off that first
691 $self->{remote_host } = $params->{account_object}->host;
692 $self->{remote_user } = $params->{account_object}->username;
693 $self->{remote_password} = $params->{account_object}->password;
694 $self->{remote_account } = $params->{account_object}->account;
695 $self->{remote_path } = $params->{account_object}->path; # not really the same as remote_file, maybe expand on this later
698 foreach (keys %{$self->{_permitted}}) {
699 $self->{$_} = $params->{$_} if defined $params->{$_}; # possibly override settings from object
702 foreach (@required) {
703 unless ($self->{$_}) {
704 $logger->error("Required parameter $_ not specified");
712 my ($class, %args) = @_;
713 my $self = { _permitted => \%fields, %fields };
717 $self->init(\%args); # or croak "Initialization error caused by bad args";
722 # in order to create, we must first ...
724 $self->{ssh2} and $self->{ssh2}->disconnect(); # let the other end know we're done.
725 $self->{ftp} and $self->{ftp}->quit(); # let the other end know we're done.
730 my $class = ref($self) or croak "AUTOLOAD error: $self is not an object";
731 my $name = $AUTOLOAD;
733 $name =~ s/.*://; # strip leading package stuff
735 unless (exists $self->{_permitted}->{$name}) {
736 croak "AUTOLOAD error: Cannot access '$name' field of class '$class'";
740 return $self->{$name} = shift;
742 return $self->{$name};