1 package OpenILS::Utils::RemoteAccount;
3 # use OpenSRF::Utils::SettingsClient;
4 use OpenSRF::Utils::Logger qw/:logger/;
8 use Net::SSH2; # because uFTP doesn't handle SSH keys (yet?)
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 Net::uFTP is used, encapsulating the available options of SCP, FTP and SFTP.
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 The latter three are optionally passed to the Net::uFTP constructor.
72 Note: none of the parameters are actually required, except remote_host.
73 That is because remote_user, remote_password and remote_account can all be
74 extrapolated from other sources, as the Net::FTP docs describe:
76 If no arguments are given then Net::FTP uses the Net::Netrc package
77 to lookup the login information for the connected host.
79 If no information is found then a login of anonymous is used.
81 If no password is given and the login is anonymous then anonymous@
82 will be used for password.
84 Note that specifying a password will require you to specify a user.
85 Similarly, specifying an account requires both user and password.
86 That is, there are no assumed defaults when the latter arguments are used.
90 The use of ssh keys is preferred. Explicit speicification of connection type will prevent
91 multiple attempts to the same server. Therefore, using the type parameter is also recommended.
93 If the type is not explicit, we attempt to use SSH keys where they are specified or otherwise found
94 in the runtime environment. If only one key is specified, we attempt to derive
95 the corresponding filename based on the ssh-keygen defaults. If either key is
96 specified, but both are not found (and readable) then the result is failure. If
97 no key or type is specified, but keys are found, the key-based connections will be attempted,
98 but failure will be non-fatal.
103 # returns plausible locations of a .ssh subdir where SSH keys might be stashed
104 # NOTE: these would need to be properly genericized w/ Makefule vars
105 # in order to support Debian packaging and multiple EG's on one box.
106 # Until that happens, we just rely on $HOME
109 # '/openils/conf', # __EG_CONFIG_DIR__
111 ($ENV{HOME}) and unshift @bases, $ENV{HOME};
113 return grep {-d $_} map {"$_/.ssh"} @bases;
117 # populates %keyfiles hash
118 # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY
120 my $force = (@_ ? shift : 0);
121 return %keyfiles if (%keyfiles and not $force); # caching
122 $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : ''));
123 %keyfiles = (); # reset to empty
124 my @dirs = plausible_dirs();
125 $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs));
126 foreach my $dir (@dirs) {
127 foreach my $key (qw/rsa dsa/) {
128 my $private = "$dir/id_$key";
129 my $public = "$dir/id_$key.pub";
130 unless (-r $private) {
131 $logger->debug("Key '$private' cannot be read: $!");
134 unless (-r $public) {
135 $logger->debug("Key '$public' cannot be read: $!");
138 $keyfiles{$private} = $public;
147 if ($self->ssh_publickey and not $self->ssh_privatekey) {
148 my $private = $self->ssh_publickey;
149 unless ($private and $private =~ s/\.pub$// and -r $self->ssh_privatekey) { # try to guess missing private key name
150 $logger->error("No ssh_privatekey specified or found to pair with " . $self->ssh_publickey);
153 $self->ssh_privatekey($private);
155 if ($self->ssh_privatekey and not $self->ssh_publickey) {
156 my $pub = $self->ssh_privatekey . '.pub'; # guess missing public key name
158 $logger->error("No ssh_publickey specified or found to pair with " . $self->ssh_privatekey);
161 $self->ssh_publickey($pub);
164 # so now, we have either both ssh_p*keys params or neither
165 foreach (qw/ssh_publickey ssh_privatekey/) {
166 unless (-r $self->{$_}) {
167 $logger->error("$_ '" . $self->{$_} . "' cannot be read: $!");
168 return; # quit w/ error if we fail on any user-specified key
171 $keys{$self->ssh_privatekey} = $self->ssh_publickey;
177 my $text = shift || $self->content || '';
178 my $tmp = File::Temp->new(); # magical self-destructing tempfile
179 # print $tmp "THIS IS TEXT\n";
180 print $tmp $text or $logger->error($self->_error("could not write to tempfile '$tmp'"));
182 $self->tempfile($tmp); # save the object
183 $self->local_file($tmp->filename); # save the filename
184 $logger->info(_pkg("using tempfile $tmp"));
185 return $self->local_file; # return the filename
192 unless (defined $self->content or $self->local_file) { # content can be emptystring
193 $logger->error($self->_error("No content or local_file specified -- nothing to send"));
197 # tricky subtlety: we want to use the most recently specified options
198 # with priority order: filename, content, old filename, old content.
200 # The $params->{x} will already match $self->x after the secondary init,
201 # so the checks using $params below are for whether the value was specified NOW (e.g. via put()) or not.
203 # if we got a new local_file value, we use it
204 # else if the content is new to this call, build a new tempfile w/ it,
205 # else use existing local_file,
206 # else build new tempfile w/ content already specified via new()
208 return $params->{local_file} || (
209 (defined $params->{content}) ?
210 $self->new_tempfile($self->content) : # $self->content is same value as $params->{content}
211 ($self->local_file || $self->new_tempfile($self->content))
219 return if ($params->{type} and $params->{type} eq 'FTP'); # Forget it, user specified regular FTP
220 return if ( $self->type and $self->type eq 'FTP'); # Forget it, user specified regular FTP
222 if ($self->ssh_publickey || $self->ssh_privatekey) {
224 return $self->param_keys(); # we got one or both params, but they didn't pan out
226 return local_keyfiles(); # optional "force" arg could be used here to empty cache
231 # TODO: delete for both uFTP and SSH2
232 # TODO: handle IO::Scalar and IO::File for uFTP
238 $params = {remote_file => $params} ;
241 $self->init($params); # secondary init
243 $self->{get_args} = [$self->remote_file]; # same for scp_put and uFTP put
244 push @{$self->{get_args}}, $self->local_file if defined $self->local_file;
246 # $self->content($content);
248 my %keys = $self->key_check($params);
250 my $try = $self->get_ssh2(\%keys, @{$self->{get_args}});
251 return $try if $try; # if we had keys and they worked, we're done
254 # Otherwise, try w/ non-key uFTP methods
255 return $self->get_uftp(@{$self->{get_args}});
262 $params = {local_file => $params} ;
265 $self->init($params); # secondary init
267 my $local_file = $self->outbound_file($params) or return;
269 $self->{put_args} = [$local_file]; # same for scp_put and uFTP put
270 if (defined $self->remote_path and not defined $self->remote_file) {
271 my $rpath = $self->remote_path;
272 my $fname = basename($local_file);
273 if ($rpath =~ /^(.*)\*+(.*)$/) { # if the path has an asterisk in it, like './incoming/*.tst'
277 $logger->warn($self->_error("remote path '$rpath' has dir slashes AFTER an asterisk. Cannot determine target dir"));
280 if ($self->single_ext) {
281 $tail =~ /\./ and $fname =~ s/\./_/g; # if dot in tail, replace dots in fname (w/ _)
283 $self->remote_file($head . $fname . $tail);
285 $self->remote_file($rpath . '/' . $fname); # if we know just the dir
289 if (defined $self->remote_file) {
290 push @{$self->{put_args}}, $self->remote_file; # user can specify remote_file name, optionally
293 my %keys = $self->key_check($params);
295 $self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file;
296 # if we had keys and they worked, we're done
299 # Otherwise, try w/ non-key uFTP methods
300 return $self->put_uftp(@{$self->{put_args}});
308 unshift @targets, ($params || '.'); # If it was just a string, it's the first target, else default pwd
309 delete $self->{remote_file}; # overriding any target in the object previously.
310 $params = {}; # make params a normal hashref again
312 if ($params->{remote_file} and @_) {
313 $logger->warn($self->_error("Ignoring ls parameter remote_file for subsequent args"));
314 delete $params->{remote_file};
316 $self->init($params); # secondary init
317 $self->remote_file and (! @targets) and push @targets, $self->remote_file; # if remote_file is there, and there's nothing else, use it
318 delete $self->{remote_file};
321 $self->{ls_args} = \@targets;
323 my %keys = $self->key_check($params);
325 # $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys");
326 my @try = $self->ls_ssh2(\%keys, @targets);
327 return @try if @try; # if we had keys and they worked, we're done
330 # Otherwise, try w/ non-key uFTP methods
331 return $self->ls_uftp(@targets);
334 # Checks if the filename part of a pathname has one or more glob characters
335 # We split out the filename portion of the path
336 # Detect glob or no glob.
337 # returns: directory, regex for matching filenames
340 my $path = shift or return;
341 my ($vol, $dir, $file) = File::Spec->splitpath($path); # we don't care about attempted globs in mid-filepath
342 my $front = $vol ? File::Spec->catdir($vol, $dir) : $dir;
343 $file =~ /\*/ and return ($front, glob_to_regex($file));
344 $file =~ /\?/ and return ($front, glob_to_regex($file));
345 $logger->debug("No glob detected in '$path'");
354 $self->{ssh2} and return $self->{ssh2}; # caching
357 my $ssh2 = Net::SSH2->new();
358 unless($ssh2->connect($self->remote_host)) {
359 $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error)));
360 return; # we cannot connect
364 my @privates = keys %$keys;
365 my $count = scalar @privates;
366 foreach (@privates) {
367 if ($self->auth_ssh2($ssh2, $self->auth_ssh2_args($_, $keys->{$_}))) {
373 $logger->error($self->error("All ($count) keypair(s) FAILED for " . $self->remote_host));
376 return $self->{ssh2} = $ssh2;
385 my $host = $auth_args{hostname} || 'UNKNOWN';
386 my $key = $auth_args{privatekey} || 'UNKNOWN';
387 my $msg = "ssh2->auth by keypair for $host using $key";
388 if ($ssh2->auth(%auth_args)) {
389 $logger->info("Successful $msg");
393 if ($self->specific) {
394 $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
396 $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
406 rank => [qw/ publickey hostbased password /],
408 $self->remote_user and $auth_args{username} = $self->remote_user ;
409 $self->remote_password and $auth_args{password} = $self->remote_password;
410 $self->remote_host and $auth_args{hostname} = $self->remote_host ;
416 my $keys = shift; # could have many keypairs here
418 $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
422 $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
423 my $ssh2 = $self->_ssh2($keys) or return;
425 if ($res = $ssh2->scp_put( @_ )) {
426 $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
429 $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
435 my $keys = shift; # could have many keypairs here
437 $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
441 $logger->info("*** get args: " . Dumper(\@_));
442 $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys");
443 my $ssh2 = $self->_ssh2($keys) or return;
445 if ($res = $ssh2->scp_get( @_ )) {
446 $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
449 $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
455 my @list = $self->ls_ssh2_full(@_);
456 @list and return sort map {$_->{slash_path}} @list;
457 # @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
462 my $keys = shift; # could have many keypairs here
463 my @targets = grep {defined} @_;
465 $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
466 my $ssh2 = $self->_ssh2($keys) or return;
467 my $sftp = $ssh2->sftp or return;
470 foreach my $target (@targets) {
472 my ($dirpath, $regex) = $self->glob_parse($target);
473 $dir = $sftp->opendir($dirpath || $target); # Try to open it like a directory
475 $file = $sftp->stat($target); # Otherwise, check it like a file
477 $file->{slash_path} = $self->_slash_path($target, $file->{name}); # it was a file, not a dir. That's OK.
480 $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
485 while ($file = $dir->read()) {
486 $file->{slash_path} = $self->_slash_path($target, $file->{name});
490 my $count = scalar(@pool);
491 @pool = grep {$_->{name} =~ /$regex/} @pool;
492 $logger->info("SSH ls: Glob regex($regex) matches " . scalar(@pool) . " of $count files");
493 } # else { $logger->info("SSH ls: No Glob regex in '$target'. Just a regular ls"); }
502 my $dir = shift || '.';
503 my $file = shift || '';
504 my ($dirpath, $regex) = $self->glob_parse($dir);
505 $dir = $dirpath if $dirpath;
506 return $dir . ($dir =~ /\/$/ ? '' : '/') . $file;
512 $self->{uftp} and return $self->{uftp}; # caching
513 foreach (qw/debug type port/) {
514 $options{$_} = $self->{$_} if $self->{$_};
517 my $ftp = Net::uFTP->new($self->remote_host, %options);
519 $logger->error($self->_error('Net::uFTP->new("' . $self->remote_host . ", ...) FAILED: $@"));
524 foreach (qw/remote_user remote_password remote_account/) {
526 push @login_args, $self->{$_};
529 eval { $login_ok = $ftp->login(@login_args) };
530 if ($@ or !$login_ok) {
531 $logger->error($self->_error("failed login to", $self->remote_host, "w/ args(" . join(',', @login_args) . ") : $@"));
534 return $self->{uftp} = $ftp;
539 my $ftp = $self->_uftp or return;
541 eval { $filename = $ftp->put(@{$self->{put_args}}) };
542 if ($@ or ! $filename) {
543 $logger->error($self->_error("put to", $self->remote_host, "failed with error: $@"));
546 $self->remote_file($filename);
547 $logger->info(_pkg("successfully sent", $self->remote_host, $self->local_file, '-->', $filename));
553 my $ftp = $self->_uftp or return;
555 eval { $filename = $ftp->get(@{$self->{get_args}}) };
556 if ($@ or ! $filename) {
557 $logger->error($self->_error("get from", $self->remote_host, "failed with error: $@"));
560 $self->local_file($filename);
561 $logger->info(_pkg("successfully retrieved $filename <--", $self->remote_host . '/' . $self->remote_file));
562 return $self->local_file;
565 sub ls_uftp { # returns full path like: dir/path/file.ext
567 my $ftp = $self->_uftp or return;
571 my ($dirpath, $regex) = $self->glob_parse($_);
572 my $dirtarget = $dirpath || $_;
573 $dirtarget =~ s/\/+$//;
574 eval { @part = $ftp->ls($dirtarget) }; # this ls returns relative/path/filenames. defer filename glob filtering for below.
576 $logger->error($self->_error("ls from", $self->remote_host, "failed with error: $@"));
579 if ($dirtarget and $dirtarget ne '.' and $dirtarget ne './' and $ftp->is_dir($dirtarget)) {
580 foreach my $file (@part) { # we ensure full(er) path
581 $file =~ /^$dirtarget\// and next;
582 $logger->debug("ls_uftp: prepending $dirtarget/ to $file");
583 $file = File::Spec->catdir($dirtarget, $file);
587 my $count = scalar(@part);
588 # @part = grep {my @a = split('/',$_); scalar(@a) ? /$regex/ : ($a[-1] =~ /$regex/)} @part;
591 my ($vol, $dir, $file) = File::Spec->splitpath($_);
594 $logger->info("FTP ls: Glob regex($regex) matches " . scalar(@part) . " of $count files");
595 } # else {$logger->info("FTP ls: No Glob regex in '$_'. Just a regular ls");}
603 my $ftp = $self->_uftp or return;
604 return $ftp->delete(shift);
608 return __PACKAGE__ . ' : ' unless @_;
609 return __PACKAGE__ . ' : ' . join(' ', @_);
614 return _pkg($self->error(join(' ',@_)));
620 my @required = @_; # qw(remote_host) ; # nothing required now
622 if ($params->{account_object}) { # if we got passed an object, we initialize off that first
623 $self->{remote_host } = $params->{account_object}->host;
624 $self->{remote_user } = $params->{account_object}->username;
625 $self->{remote_password} = $params->{account_object}->password;
626 $self->{remote_account } = $params->{account_object}->account;
627 $self->{remote_path } = $params->{account_object}->path; # not really the same as remote_file, maybe expand on this later
630 foreach (keys %{$self->{_permitted}}) {
631 $self->{$_} = $params->{$_} if defined $params->{$_}; # possibly override settings from object
634 foreach (@required) {
635 unless ($self->{$_}) {
636 $logger->error("Required parameter $_ not specified");
644 my ($class, %args) = @_;
645 my $self = { _permitted => \%fields, %fields };
649 $self->init(\%args); # or croak "Initialization error caused by bad args";
654 # in order to create, we must first ...
656 $self->{ssh2} and $self->{ssh2}->disconnect(); # let the other end know we're done.
657 $self->{uftp} and $self->{uftp}->quit(); # let the other end know we're done.
662 my $class = ref($self) or croak "AUTOLOAD error: $self is not an object";
663 my $name = $AUTOLOAD;
665 $name =~ s/.*://; # strip leading package stuff
667 unless (exists $self->{_permitted}->{$name}) {
668 croak "AUTOLOAD error: Cannot access '$name' field of class '$class'";
672 return $self->{$name} = shift;
674 return $self->{$name};