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 The Remote Account module attempts to transfer a file to/from a remote server.
51 Net::uFTP is used, encapsulating the available options of SCP, FTP and SFTP.
53 All information is expected to be gathered by the Event Definition through event parameters:
54 ~ remote_host (required)
60 ~ type (FTP, SFTP or SCP -- default FTP)
64 The latter three are optionally passed to the Net::uFTP constructor.
66 Note: none of the parameters are actually required, except remote_host.
67 That is because remote_user, remote_password and remote_account can all be
68 extrapolated from other sources, as the Net::FTP docs describe:
70 If no arguments are given then Net::FTP uses the Net::Netrc package
71 to lookup the login information for the connected host.
73 If no information is found then a login of anonymous is used.
75 If no password is given and the login is anonymous then anonymous@
76 will be used for password.
78 Note that specifying a password will require you to specify a user.
79 Similarly, specifying an account requires both user and password.
80 That is, there are no assumed defaults when the latter arguments are used.
84 The use of ssh keys is preferred.
86 We attempt to use SSH keys where they are specified or otherwise found
87 in the runtime environment. If only one key is specified, we attempt to derive
88 the corresponding filename based on the ssh-keygen defaults. If either key is
89 specified, but both are not found (and readable) then the result is failure. If
90 no key is specified, but keys are found, the key-based connections will be attempted,
91 but failure will be non-fatal.
96 # returns plausible locations of a .ssh subdir where SSH keys might be stashed
97 # NOTE: these would need to be properly genericized w/ Makefule vars
98 # in order to support Debian packaging and multiple EG's on one box.
99 # Until that happens, we just rely on $HOME
102 # '/openils/conf', # __EG_CONFIG_DIR__
104 ($ENV{HOME}) and unshift @bases, $ENV{HOME};
106 return grep {-d $_} map {"$_/.ssh"} @bases;
110 # populates %keyfiles hash
111 # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY
113 my $force = (@_ ? shift : 0);
114 return %keyfiles if (%keyfiles and not $force); # caching
115 $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : ''));
116 %keyfiles = (); # reset to empty
117 my @dirs = plausible_dirs();
118 $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs));
119 foreach my $dir (@dirs) {
120 foreach my $key (qw/rsa dsa/) {
121 my $private = "$dir/id_$key";
122 my $public = "$dir/id_$key.pub";
123 unless (-r $private) {
124 $logger->debug("Key '$private' cannot be read: $!");
127 unless (-r $public) {
128 $logger->debug("Key '$public' cannot be read: $!");
131 $keyfiles{$private} = $public;
140 if ($self->ssh_publickey and not $self->ssh_privatekey) {
141 my $private = $self->ssh_publickey;
142 unless ($private and $private =~ s/\.pub$// and -r $self->ssh_privatekey) { # try to guess missing private key name
143 $logger->error("No ssh_privatekey specified or found to pair with " . $self->ssh_publickey);
146 $self->ssh_privatekey($private);
148 if ($self->ssh_privatekey and not $self->ssh_publickey) {
149 my $pub = $self->ssh_privatekey . '.pub'; # guess missing public key name
151 $logger->error("No ssh_publickey specified or found to pair with " . $self->ssh_privatekey);
154 $self->ssh_publickey($pub);
157 # so now, we have either both ssh_p*keys params or neither
158 foreach (qw/ssh_publickey ssh_privatekey/) {
159 unless (-r $self->{$_}) {
160 $logger->error("$_ '" . $self->{$_} . "' cannot be read: $!");
161 return; # quit w/ error if we fail on any user-specified key
164 $keys{$self->ssh_privatekey} = $self->ssh_publickey;
170 my $text = shift || $self->content || '';
171 my $tmp = File::Temp->new(); # magical self-destructing tempfile
172 # print $tmp "THIS IS TEXT\n";
173 print $tmp $text or $logger->error($self->_error("could not write to tempfile '$tmp'"));
175 $self->tempfile($tmp); # save the object
176 $self->local_file($tmp->filename); # save the filename
177 $logger->info(_pkg("using tempfile $tmp"));
178 return $self->local_file; # return the filename
185 unless (defined $self->content or $self->local_file) { # content can be emptystring
186 $logger->error($self->_error("No content or local_file specified -- nothing to send"));
190 # tricky subtlety: we want to use the most recently specified options
191 # with priority order: filename, content, old filename, old content.
193 # The $params->{x} will already match $self->x after the secondary init,
194 # so the checks using $params below are for whether the value was specified NOW (e.g. via put()) or not.
196 # if we got a new local_file value, we use it
197 # else if the content is new to this call, build a new tempfile w/ it,
198 # else use existing local_file,
199 # else build new tempfile w/ content already specified via new()
201 return $params->{local_file} || (
202 (defined $params->{content}) ?
203 $self->new_tempfile($self->content) : # $self->content is same value as $params->{content}
204 ($self->local_file || $self->new_tempfile($self->content))
212 return if ($params->{type} and $params->{type} eq 'FTP'); # Forget it, user specified regular FTP
213 return if ( $self->type and $self->type eq 'FTP'); # Forget it, user specified regular FTP
215 if ($self->ssh_publickey || $self->ssh_privatekey) {
217 return $self->param_keys(); # we got one or both params, but they didn't pan out
219 return local_keyfiles(); # optional "force" arg could be used here to empty cache
224 # TODO: delete for both uFTP and SSH2
225 # TODO: handle IO::Scalar and IO::File for uFTP
231 $params = {remote_file => $params} ;
234 $self->init($params); # secondary init
236 $self->{get_args} = [$self->remote_file]; # same for scp_put and uFTP put
237 push @{$self->{get_args}}, $self->local_file if defined $self->local_file;
239 # $self->content($content);
241 my %keys = $self->key_check($params);
243 my $try = $self->get_ssh2(\%keys, @{$self->{get_args}});
244 return $try if $try; # if we had keys and they worked, we're done
247 # Otherwise, try w/ non-key uFTP methods
248 return $self->get_uftp(@{$self->{get_args}});
255 $params = {local_file => $params} ;
258 $self->init($params); # secondary init
260 my $local_file = $self->outbound_file($params) or return;
262 $self->{put_args} = [$local_file]; # same for scp_put and uFTP put
263 if (defined $self->remote_path and not defined $self->remote_file) {
264 my $rpath = $self->remote_path;
265 my $fname = basename($local_file);
266 if ($rpath =~ /^(.*)\*+(.*)$/) { # if the path has an asterisk in it, like './incoming/*.tst'
270 $logger->warn($self->_error("remote path '$rpath' has dir slashes AFTER an asterisk. Cannot determine target dir"));
273 if ($self->single_ext) {
274 $tail =~ /\./ and $fname =~ s/\./_/g; # if dot in tail, replace dots in fname (w/ _)
276 $self->remote_file($head . $fname . $tail);
278 $self->remote_file($rpath . '/' . $fname); # if we know just the dir
282 if (defined $self->remote_file) {
283 push @{$self->{put_args}}, $self->remote_file; # user can specify remote_file name, optionally
286 my %keys = $self->key_check($params);
288 $self->put_ssh2(\%keys, @{$self->{put_args}}) and return $self->remote_file;
289 # if we had keys and they worked, we're done
292 # Otherwise, try w/ non-key uFTP methods
293 return $self->put_uftp(@{$self->{put_args}});
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 my %keys = $self->key_check($params);
318 # $logger->info("*** calling ls_ssh2(keys, '" . join("', '", (scalar(@targets) ? map {defined $_ ? $_ : '' } @targets : ())) . "') with ssh keys");
319 my @try = $self->ls_ssh2(\%keys, @targets);
320 return @try if @try; # if we had keys and they worked, we're done
323 # Otherwise, try w/ non-key uFTP methods
324 return $self->ls_uftp(@targets);
327 # Checks if the filename part of a pathname has one or more glob characters
328 # We split out the filename portion of the path
329 # Detect glob or no glob.
330 # return: regex for matching filenames
333 my $path = shift or return;
334 my ($vol, $dir, $file) = File::Spec->splitpath($path); # we don't care about attempted globs in mid-filepath
335 $file =~ /\*/ and return (File::Spec->catdir($vol, $dir), glob_to_regex($file));
336 $file =~ /\?/ and return (File::Spec->catdir($vol, $dir), glob_to_regex($file));
337 $logger->debug("No glob detected in '$path'");
346 $self->{ssh2} and return $self->{ssh2}; # caching
349 my $ssh2 = Net::SSH2->new();
350 unless($ssh2->connect($self->remote_host)) {
351 $logger->warn($self->error("SSH2 connect FAILED: $! " . join(" ", $ssh2->error)));
352 return; # we cannot connect
356 my @privates = keys %$keys;
357 my $count = scalar @privates;
358 foreach (@privates) {
359 if ($self->auth_ssh2($ssh2, $self->auth_ssh2_args($_, $keys->{$_}))) {
365 $logger->error($self->error("All ($count) keypair(s) FAILED for " . $self->remote_host));
368 return $self->{ssh2} = $ssh2;
377 my $host = $auth_args{hostname} || 'UNKNOWN';
378 my $key = $auth_args{privatekey} || 'UNKNOWN';
379 my $msg = "ssh2->auth by keypair for $host using $key";
380 if ($ssh2->auth(%auth_args)) {
381 $logger->info("Successful $msg");
385 if ($self->specific) {
386 $logger->error($self->error("Aborting. FAILED $msg: " . ($ssh2->error || '')));
388 $logger->warn($self->error("Unsuccessful keypair: FAILED $msg: " . ($ssh2->error || '')));
398 rank => [qw/ publickey hostbased password /],
400 $self->remote_user and $auth_args{username} = $self->remote_user ;
401 $self->remote_password and $auth_args{password} = $self->remote_password;
402 $self->remote_host and $auth_args{hostname} = $self->remote_host ;
408 my $keys = shift; # could have many keypairs here
410 $logger->error($self->_error("put_ssh2 called without target: nothing to put!"));
414 $logger->info("*** attempting put (" . join(", ", @_) . ") with ssh keys");
415 my $ssh2 = $self->_ssh2($keys) or return;
417 if ($res = $ssh2->scp_put( @_ )) {
418 $logger->info(_pkg("successfully sent", $self->remote_host, join(' --> ', @_ )));
421 $logger->error($self->_error(sprintf "put with keys to %s failed with error: $!", $self->remote_host));
427 my $keys = shift; # could have many keypairs here
429 $logger->error($self->_error("get_ssh2 called without target: nothing to get!"));
433 $logger->info("*** get args: " . Dumper(\@_));
434 $logger->info("*** attempting get (" . join(", ", map {$_ =~ /\S/ ? $_ : '*Object'} map {defined($_) ? $_ : '*Object'} @_) . ") with ssh keys");
435 my $ssh2 = $self->_ssh2($keys) or return;
437 if ($res = $ssh2->scp_get( @_ )) {
438 $logger->info(_pkg("successfully got", $self->remote_host, join(' --> ', @_ )));
441 $logger->error($self->_error(sprintf "get with keys from %s failed with error: $!", $self->remote_host));
447 my @list = $self->ls_ssh2_full(@_);
448 @list and return sort map {$_->{slash_path}} @list;
449 # @list and return sort grep {$_->{name} !~ /./ and {$_->{name} !~ /./ } map {$_->{slash_path}} @list;
454 my $keys = shift; # could have many keypairs here
455 my @targets = grep {defined} @_;
457 $logger->info("*** attempting ls ('" . join("', '", @targets) . "') with ssh keys");
458 my $ssh2 = $self->_ssh2($keys) or return;
459 my $sftp = $ssh2->sftp or return;
462 foreach my $target (@targets) {
464 my ($dirpath, $regex) = $self->glob_parse($target);
465 $dir = $sftp->opendir($dirpath || $target); # Try to open it like a directory
467 $file = $sftp->stat($target); # Otherwise, check it like a file
469 $file->{slash_path} = $self->_slash_path($target, $file->{name}); # it was a file, not a dir. That's OK.
472 $logger->warn($self->_error("sftp->opendir($target) failed: " . $sftp->error));
477 while ($file = $dir->read()) {
478 $file->{slash_path} = $self->_slash_path($target, $file->{name});
482 my $count = scalar(@pool);
483 @pool = grep {$_->{name} =~ /$regex/} @pool;
484 $logger->info("Glob regex($regex) matches " . scalar(@pool) . " of $count files");
492 sub _slash_path { # not OO
494 my $dir = shift || '.';
495 my $file = shift || '';
496 return $dir . ($dir =~ /\/$/ ? '' : '/') . $file;
502 $self->{uftp} and return $self->{uftp}; # caching
503 foreach (qw/debug type port/) {
504 $options{$_} = $self->{$_} if $self->{$_};
507 my $ftp = Net::uFTP->new($self->remote_host, %options);
509 $logger->error($self->_error('Net::uFTP->new("' . $self->remote_host . ", ...) FAILED: $@"));
514 foreach (qw/remote_user remote_password remote_account/) {
516 push @login_args, $self->{$_};
519 eval { $login_ok = $ftp->login(@login_args) };
520 if ($@ or !$login_ok) {
521 $logger->error($self->_error("failed login to", $self->remote_host, "w/ args(" . join(',', @login_args) . ") : $@"));
524 return $self->{uftp} = $ftp;
529 my $ftp = $self->_uftp or return;
531 eval { $filename = $ftp->put(@{$self->{put_args}}) };
532 if ($@ or ! $filename) {
533 $logger->error($self->_error("put to", $self->remote_host, "failed with error: $@"));
536 $self->remote_file($filename);
537 $logger->info(_pkg("successfully sent", $self->remote_host, $self->local_file, '-->', $filename));
543 my $ftp = $self->_uftp or return;
545 eval { $filename = $ftp->get(@{$self->{get_args}}) };
546 if ($@ or ! $filename) {
547 $logger->error($self->_error("get from", $self->remote_host, "failed with error: $@"));
550 $self->local_file($filename);
551 $logger->info(_pkg("successfully retrieved $filename <--", $self->remote_host . '/' . $self->remote_file));
552 return $self->local_file;
557 my $ftp = $self->_uftp or return;
561 my ($dirpath, $regex) = $self->glob_parse($_);
562 eval { @part = $ftp->ls($dirpath || $_) };
564 $logger->error($self->_error("ls from", $self->remote_host, "failed with error: $@"));
568 my $count = scalar(@part);
569 @part = grep {/$regex/} @part;
570 $logger->info("Glob regex($regex) matches " . scalar(@part) . " of $count files");
579 my $ftp = $self->_uftp or return;
580 return $ftp->delete(shift);
584 return __PACKAGE__ . ' : ' unless @_;
585 return __PACKAGE__ . ' : ' . join(' ', @_);
590 return _pkg($self->error(join(' ',@_)));
596 my @required = @_; # qw(remote_host) ; # nothing required now
598 if ($params->{account_object}) { # if we got passed an object, we initialize off that first
599 $self->{remote_host } = $params->{account_object}->host;
600 $self->{remote_user } = $params->{account_object}->username;
601 $self->{remote_password} = $params->{account_object}->password;
602 $self->{remote_account } = $params->{account_object}->account;
603 $self->{remote_path } = $params->{account_object}->path; # not really the same as remote_file, maybe expand on this later
606 foreach (keys %{$self->{_permitted}}) {
607 $self->{$_} = $params->{$_} if defined $params->{$_}; # possibly override settings from object
610 foreach (@required) {
611 unless ($self->{$_}) {
612 $logger->error("Required parameter $_ not specified");
620 my ($class, %args) = @_;
621 my $self = { _permitted => \%fields, %fields };
625 $self->init(\%args); # or croak "Initialization error caused by bad args";
630 # in order to create, we must first ...
632 $self->{ssh2} and $self->{ssh2}->disconnect(); # let the other end know we're done.
633 $self->{uftp} and $self->{uftp}->quit(); # let the other end know we're done.
638 my $class = ref($self) or croak "AUTOLOAD error: $self is not an object";
639 my $name = $AUTOLOAD;
641 $name =~ s/.*://; # strip leading package stuff
643 unless (exists $self->{_permitted}->{$name}) {
644 croak "AUTOLOAD error: Cannot access '$name' field of class '$class'";
648 return $self->{$name} = shift;
650 return $self->{$name};