From: erickson Date: Thu, 21 Jan 2010 17:58:44 +0000 (+0000) Subject: Patch from Joe Atzberger that does several things: X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=87b1828b28045d92f7e632b2372ea5c77d230bc7;p=evergreen%2Fbjwebb.git Patch from Joe Atzberger that does several things: 1. Iniatial API calls for managing EDI documents at the server. EDI file fetching script to come soon. 2. Creates OpenILS::Utils::Cronscript and Lockfile modules to share and abstract the common setup tasks for Evergreen cron jobs 3. Creates a OpenILS::Utils::RemoteAccount module for managing access to remote services via ftp/scp. This is mostly taken from the SendFile reactor 4. Updates sendfile to use remoteaccount git-svn-id: svn://svn.open-ils.org/ILS/trunk@15358 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm new file mode 100644 index 000000000..78d47cdc2 --- /dev/null +++ b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI.pm @@ -0,0 +1,105 @@ +package OpenILS::Application::Acq::EDI; +use base qw/OpenILS::Application/; + +use strict; use warnings; + +use OpenSRF::AppSession; +use OpenSRF::EX qw/:try/; +use OpenILS::Application::Acq::EDI::Translator; + +# use OpenILS::Event; +use OpenSRF::Utils::Logger qw(:logger); +# use OpenSRF::Utils::JSON; +# use OpenILS::Utils::Fieldmapper; +# use OpenILS::Utils::CStoreEditor q/:funcs/; +# use OpenILS::Const qw/:const/; +# use OpenILS::Application::AppUtils; + +sub new { + my($class, %args) = @_; + my $self = bless(\%args, $class); + # $self->{args} = {}; + return $self; +} + +our $translator; + +sub translator { + return $translator ||= OpenILS::Application::Acq::EDI::Translator->new(@_); +} + +__PACKAGE__->register_method( + method => 'retrieve', + api_name => 'open-ils.acq.edi.retrieve', + signature => { + desc => 'Fetch incoming message(s) from EDI accounts. ' . + 'Optional arguments to restrict to one vendor and/or a max number of messages. ' . + 'Note that messages are not parsed or processed here, just fetched and translated.', + param => [ + {desc => 'Authentication token', type => 'string'}, + {desc => 'Vendor ID (undef for "all")', type => 'number'}, + {desc => 'Max Messages Retrieved', type => 'number'} + ], + return => { + desc => 'List of new message IDs (empty if none)', + type => 'array' + } + } +); + +sub retrieve { + my ($self, $conn, $auth, $vendor_id, $max) = @_; + + my @return = (); + my $e = new_editor(xact=>1, authtoken=>$auth); + unless ($e->checkauth) { + $logger->warn("checkauth failed for authtoken '$auth'"); + return @return; + } + + my $criteria = {}; + $criteria->{vendor_id} = $vendor_id if $vendor_id; + my $set = $e->search_acq_edi_account( + $criteria, { + flesh => 1, + flesh_fields => { + } + } + ) or return $e->die_event; + + my $tran = translator(); + foreach my $account (@$set) { + $logger->warn("EDI check for " . $account->host); +# foreach message { +# my $incoming = $e->create_acq_edi_message; +# $incoming->edi($content); +# $incoming->edi_account($account->id); +# my $json = $tran->edi2json; +# unless ($json) { +# $logger->error("EDI Translator failed on $incoming->id"); +# next; +# } +# $incoming->json($json); +# $e->commit; +# delete remote copies of saved message (?) +# push @return, $incoming->id; +# } + } + # return $e->die_event unless $e->allowed('RECEIVE_PURCHASE_ORDER', $li->purchase_order->ordering_agency); + # $e->commit; + return @return; +} + +sub record_activity { + my $self = shift; + my $account = shift or return; +} + +sub retrieve_one { + my $self = shift; + my $account = shift or return; + +} + +1; + diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm new file mode 100644 index 000000000..0dea8b0fe --- /dev/null +++ b/Open-ILS/src/perlmods/OpenILS/Application/Acq/EDI/Translator.pm @@ -0,0 +1,65 @@ +package OpenILS::Application::Acq::EDI::Translator; + +use warnings; +use strict; + +use RPC::XML::Client; +use Data::Dumper; + +# DEFAULTS +my $proto = 'http://'; +my $host = $proto . 'localhost'; +my $path = '/EDI'; +my $port = 9191; +my $verbose = 0; + +sub new { + my ($class, %args) = @_; + my $self = bless(\%args, $class); + $self->init; + return $self; +} + +sub init { + my $self = shift; + $self->host_cleanup; +} + +sub host_cleanup { + my $self = shift; + my $target = $self->{host} || $host; + $target =~ /^\S+:\/\// or $target = ($self->{proto} || $proto) . $target; + $target =~ /:\d+$/ or $target .= ':' . ($self->{port} || $port); + $target .= ($self->{path} || $path); + $self->{verbose} and print "Cleanup: $self->{host} ==> $target\n"; + $self->{host} = $target; + return $target; +} + +sub client { + my $self = shift; + return $self->{client} ||= RPC::XML::Client->new($self->{host}); # TODO: auth +} + +sub json2edi { + my $self = shift; + my $text = shift; + my $client = $self->client(); + $self->{verbose} and print "Trying json2edi on host: $self->{host}\n"; + my $resp = $client->send_request('edi2json', $text); + $self->{verbose} and print Dumper($resp); + return $resp; +} + +sub edi2json { + my $self = shift; + my $text = shift; + my $client = $self->client(); + $self->{verbose} and print "Trying edi2json on host: $self->{host}\n"; + my $resp = $client->send_request('json2edi', $text); + $self->{verbose} and print Dumper($resp); + return $resp; +} + +1; + diff --git a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendFile.pm b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendFile.pm index 70f343abf..e3e6a9bf2 100644 --- a/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendFile.pm +++ b/Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendFile.pm @@ -3,25 +3,16 @@ use OpenILS::Application::Trigger::Reactor; use base 'OpenILS::Application::Trigger::Reactor'; # use OpenSRF::Utils::SettingsClient; -use OpenSRF::Utils::Logger qw/:logger/; - -use Data::Dumper; -use Net::uFTP; -use Net::SSH2; # because uFTP doesn't handle SSH keys (yet?) -use File::Temp; - -$Data::Dumper::Indent = 0; +use OpenILS::Utils::RemoteAccount; use strict; use warnings; -our %keyfiles = (); - sub ABOUT { return < SSH_PUBLICKEY - my $force = (@_ ? shift : 0); - return %keyfiles if (%keyfiles and not $force); # caching - $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : '')); - %keyfiles = (); # reset to empty - my @dirs = plausible_dirs(); - $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs)); - foreach my $dir (@dirs) { - foreach my $key (qw/rsa dsa/) { - my $private = "$dir/id_$key"; - my $public = "$dir/id_$key.pub"; - unless (-r $private) { - $logger->debug("Key '$private' cannot be read: $!"); - next; - } - unless (-r $public) { - $logger->debug("Key '$public' cannot be read: $!"); - next; - } - $keyfiles{$private} = $public; - } - } - return %keyfiles; -} - -sub param_keys { - my $params = shift; - my %keys = (); - if ($params->{ssh_publickey } and not $params->{ssh_privatekey}) { - $params->{ssh_privatekey} = $params->{ssh_publickey}; # try to guess missing private key name - unless ($params->{ssh_privatekey} =~ s/\.pub$// and -r $params->{ssh_privatekey}) { - $logger->error("No ssh_privatekey specified or found to pair with " . $params->{ssh_publickey}); - return; - } - } - if ($params->{ssh_privatekey} and not $params->{ssh_publickey }) { - $params->{ssh_publickey} = $params->{ssh_privatekey} . '.pub'; # guess missing public key name - unless (-r $params->{ssh_publickey}) { - $logger->error("No ssh_publickey specified or found to pair with " . $params->{ssh_privatekey}); - return; - } - } - - # so now, we have either both ssh_p*key params or neither - foreach (qw/ssh_publickey ssh_privatekey/) { - unless (-r $params->{$_}) { - $logger->error("$_ '" . $params->{$_} . "' cannot be read: $!"); - return; # quit w/ error if we fail on any user-specified key - } - $keys{$params->{ssh_privatekey}} = $params->{ssh_publickey}; - } - return %keys; -} - sub handler { my $self = shift; my $env = shift; my $params = $env->{params}; - my $host = $params->{remote_host}; - unless ($host) { - $logger->error("No remote_host specified in env"); - return; - } - - my $text = $self->run_TT($env) or return; - my $tmp = File::Temp->new(); # magical self-destructing tempfile - print $tmp $text; - $logger->info("SendFile Reactor: using tempfile $tmp"); - - my %keys = (); - my $specific = 0; - my @put_args = ($tmp->filename); # same for scp_put and uFTP put - push @put_args, $params->{remote_file} if $params->{remote_file}; # user can specify remote_file name, optionally - - unless ($params->{type} and $params->{type} eq 'FTP') { - if ($params->{ssh_publickey} || $params->{ssh_privatekey}) { - $specific = 1; - %keys = param_keys($params) or return; # we got one or both params, but they didn't pan out - } else { - %keys = get_keyfiles(); # optional "force" arg could be used here to empty cache - } - } - - if (%keys) { - my $ssh2 = Net::SSH2->new(); - unless($ssh2->connect($host)) { - $logger->warn("SSH2 connect FAILED: $!" . join(" ", $ssh2->error)); - $specific and return; - %keys = (); # forget the keys, we cannot connect - } - foreach (keys %keys) { - my %auth_args = ( - privatekey => $_, - publickey => $keys{$_}, - rank => [qw/ publickey hostbased password /], - ); - $params->{remote_user } and $auth_args{username} = $params->{remote_user }; - $params->{remote_password} and $auth_args{password} = $params->{remote_password}; - $params->{remote_host } and $auth_args{hostname} = $params->{remote_host }; - - if ($ssh2->auth(%auth_args)) { - if ($ssh2->scp_put(@put_args)) { - $logger->info("SendFile Reactor: successfully sent ${host} " . join(' --> ', @put_args)); - return 1; - } else { - $logger->error("SendFile Reactor: put to $host failed with error: $!"); - return; - } - } elsif ($specific) { - $logger->error("Abort reactor: ssh2->auth FAILED for $host using $_: $!"); - return; - } else { - $logger->notice("Unsuccessful keypair: ssh2->auth FAILED for $host using $_: $!"); - } - } - } - # my $conf = OpenSRF::Utils::SettingsClient->new; - # $$env{something_hardcoded} = $conf->config_value('category', 'whatever'); - - # Try w/ non-key uFTP methods - my %options = (); - foreach (qw/debug type port/) { - $options{$_} = $params->{$_} if $params->{$_}; - } - my $ftp = Net::uFTP->new($host, %options); - - my @login_args = (); - foreach (qw/remote_user remote_password remote_account/) { - push @login_args, $params->{$_} if $params->{$_}; - } - unless ($ftp->login(@login_args)) { - $logger->error("SendFile Reactor: failed login to $host w/ args(" . join(',', @login_args) . ")"); - return; - } - - my $filename = $ftp->put(@put_args); - if ($filename) { - $logger->info("SendFile Reactor: successfully sent ${host} $tmp --> $filename"); - return 1; - } else { - $logger->error("SendFile Reactor: put to $host failed with error: $!"); - return; - } + $params->{content} = $self->run_TT($env) or return; + my $connection = OpenILS::Utils::RemoteAccount->new(%$params) or return; + return $connection->put; } 1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm b/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm new file mode 100644 index 000000000..5432c4c51 --- /dev/null +++ b/Open-ILS/src/perlmods/OpenILS/Utils/Cronscript.pm @@ -0,0 +1,224 @@ +package OpenILS::Utils::Cronscript; + +# --------------------------------------------------------------- +# Copyright (C) 2010 Equinox Software, Inc +# Author: Joe Atzberger +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# --------------------------------------------------------------- + +# The purpose of this module is to consolidate the common aspects +# of various cron tasks that all need the same things: +# ~ non-duplicative processing, i.e. lockfiles and lockfile checking +# ~ opensrf_core.xml file location +# ~ common options like help and debug + +use strict; +use warnings; + +use Getopt::Long; +use OpenSRF::System; +use OpenSRF::AppSession; +use OpenSRF::Utils::JSON; +use OpenSRF::EX qw(:try); +use OpenILS::Utils::Fieldmapper; +use OpenILS::Utils::Lockfile; + +use File::Basename qw/fileparse/; + +use Data::Dumper; + +our @extra_opts = ( # additional keys are stored here + # 'addlopt' +); + +our $debug = 0; + +sub _default_self { + return { + # opts => {}, + # opts_clean => {}, + # default_opts_clean => {}, + default_opts => { + 'lock-file=s' => OpenILS::Utils::Lockfile::default_filename, + 'osrf-config=s' => '/openils/conf/opensrf_core.xml', # TODO: packaging needs a make variable like @@EG_CONF_DIR@@ + 'debug' => 0, + 'verbose+' => 0, + 'help' => 0, + 'internal_var' => 'XYZ', + }, + # lockfile => undef, + } +} + +sub is_clean { + my $key = shift or return 1; + $key =~ /[=:].*$/ and return 0; + $key =~ /[+!]$/ and return 0; + return 1; +} + +sub clean { + my $key = shift or return; + $key =~ s/[=:].*$//; + $key =~ s/[+!]$//; + return $key; +} + +sub fuzzykey { # when you know the hash you want from, but not the exact key + my $self = shift or return; + my $key = shift or return; + my $target = @_ ? shift : 'opts_clean'; + foreach (map {clean($_)} keys %{$self->{default_opts}}) { # TODO: cache + $key eq $_ and return $self->{$target}->{$_}; + } +} + +# MyGetOptions +# A wrapper around GetOptions +# {opts} does two things for GetOptions (see Getopt::Long) +# (1) maps command-line options to the *other* variables where values are stored (in opts_clean) +# (2) provides hashspace for the rest of the arbitrary options from the command-line +# +# TODO: allow more options to be passed here, maybe mimic Getopt::Long::GetOptions style + +sub MyGetOptions { + my $self = shift; + my @keys = sort {is_clean($b) <=> is_clean($a)} keys %{$self->{default_opts}}; + $debug and print "KEYS: ", join(", ", @keys), "\n"; + foreach (@keys) { + my $clean = clean($_); + $self->{opts_clean}->{$clean} = $self->{default_opts_clean}->{$clean}; # prepopulate default + $self->{opts}->{$_} = \$self->{opts_clean}->{$clean}; # pointer for GetOptions + } + GetOptions($self->{opts}, @keys); + foreach (@keys) { + delete $self->{opts}->{$_}; # now remove the mappings from (1) so we just have (2) + } + $self->clean_mirror('opts'); # populate clean_opts w/ cleaned versions of (2), plus everything else + + print $self->help() and exit if $self->{opts_clean}->{help}; + $debug and $OpenILS::Utils::Lockfile::debug = $debug; + + unless ($self->{opts_clean}->{nolockfile} || $self->{default_opts_clean}->{nolockfile}) { + $self->{lockfile_obj} = OpenILS::Utils::Lockfile->new($self->first_defined('lock-file')); + $self->{lockfile} = $self->{lockfile_obj}->filename; + } +} + +sub first_defined { + my $self = shift; + my $key = shift or return; + foreach (qw(opts_clean opts default_opts_clean default_opts)) { + defined $self->{$_}->{$key} and return $self->{$_}->{$key}; + } + return; +} + +sub clean_mirror { + my $self = shift; + my $dirty = @_ ? shift : 'default_opts'; + foreach (keys %{$self->{$dirty}}) { + defined $self->{$dirty}->{$_} or next; + $self->{$dirty . '_clean'}->{clean($_)} = $self->{$dirty}->{$_}; + } +} + +sub new { + my $class = shift; + my $self = _default_self; + bless ($self, $class); + $self->init(@_); + $debug and print "new obj: ", Dumper($self); + return $self; +} + +sub add_and_purge { + my $self = shift; + my $key = shift; + my $val = shift; + my $clean = clean($key); + my @others = grep {/$clean/ and $_ ne $key} keys %{$self->{default_opts}}; + foreach (@others) { + $debug and print "variant of $key => $_\n"; + if ($key ne $clean) { # if it is a dirtier key, delete the clean one + delete $self->{default_opts}->{$_}; + $self->{default_opts}->{$key} = $val; + } else { # else update the dirty one + $self->{default_opts}->{$_} = $val; + } + } +} + +sub init { # not INIT + my $self = shift; + my $opts = @_ ? shift : {}; # user can specify more default options to constructor +# TODO: check $opts is hashref; then check verbose/debug first. maybe check negations e.g. "no-verbose" ? + @extra_opts = keys %$opts; + foreach (@extra_opts) { # add any other keys w/ default values + $self->add_and_purge($_, $opts->{$_}); + } + $self->clean_mirror; + return $self; +} + +sub usage { + my $self = shift; + return "\nUSAGE: $0 [OPTIONS]"; +} + +sub options_help { + my $self = shift; + my $chunk = @_ ? shift : ''; + return < Default: $self->{default_opts_clean}->{'osrf-config'} + Specify OpenSRF core config file. + + --lock-file Default: $self->{default_opts_clean}->{'lock-file'} + Specify lock file. + +HELP + . $chunk . <usage() . "\n" . $self->options_help(@_) . $self->example(); +} + +sub example { + return "\n\nEXAMPLES:\n\n $0 --osrf-config /my/other/opensrf_core.xml\n"; +} + +sub session { + my $self = shift or return; + return ($self->{session} ||= OpenSRF::AppSession->create(@_)); +} + +sub bootstrap { + my $self = shift or return; + try { + $debug and print "bootstrap lock-file : ", $self->first_defined('lock-file'), "\n"; + $debug and print "bootstrap osrf-config: ", $self->first_defined('osrf-config'), "\n"; + OpenSRF::System->bootstrap_client(config_file => $self->first_defined('osrf-config')); + Fieldmapper->import(IDL => OpenSRF::Utils::SettingsClient->new->config_value("IDL")); + } otherwise { + warn shift; + }; +} + +1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/Lockfile.pm b/Open-ILS/src/perlmods/OpenILS/Utils/Lockfile.pm new file mode 100644 index 000000000..d13e4150a --- /dev/null +++ b/Open-ILS/src/perlmods/OpenILS/Utils/Lockfile.pm @@ -0,0 +1,83 @@ +package OpenILS::Utils::Lockfile; + +# --------------------------------------------------------------- +# Copyright (C) 2010 Equinox Software, Inc +# Author: Joe Atzberger +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# --------------------------------------------------------------- + +# The purpose of this module is to consolidate +# non-duplicative processing, i.e. lockfiles and lockfile checking + +use strict; +use warnings; +use Carp; + +use File::Basename qw/fileparse/; + +sub _tempdir { + return $ENV{TEMP} || $ENV{TMP} || '/tmp'; +} + +our $debug = 0; + +sub default_filename { + my $tempdir = _tempdir; + my $filename = fileparse($0, '.pl'); + return "$tempdir/$filename-LOCK"; +} + +sub new { + my $class = shift; + my $lockfile = @_ ? shift : default_filename; + + croak "Script already running with lockfile $lockfile" if -e $lockfile; + $debug and print "Writing lockfile $lockfile (PID: $$)\n"; + + open (F, ">$lockfile") or croak "Cannot write to lockfile '$lockfile': $!"; + print F $$; + close F; + + my $self = { + filename => $lockfile, + contents => $$, + }; + return bless ($self, $class); +} + +sub filename { + my $self = shift; + return $self->{filename}; +} +sub contents { + my $self = shift; + return $self->{contents}; +} + +DESTROY { + my $self = shift; + # lockfile cleanup + if (-e $self->{filename}) { + open LF, $self->{filename}; + my $contents = ; + close LF; + $debug and print "deleting lockfile $self->{filename}\n"; + if ($contents == $self->{contents}) { + unlink $self->{filename} or carp "Failed to remove lockfile '$self->{filename}'"; + } else { + carp "Lockfile contents '$contents' no longer match '$self->{contents}'. Cannot remove $self->{filename}"; + } + + } +} + +1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm b/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm new file mode 100644 index 000000000..438aabece --- /dev/null +++ b/Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm @@ -0,0 +1,360 @@ +package OpenILS::Utils::RemoteAccount; + +# use OpenSRF::Utils::SettingsClient; +use OpenSRF::Utils::Logger qw/:logger/; + +use Data::Dumper; +use Net::uFTP; +use Net::SSH2; # because uFTP doesn't handle SSH keys (yet?) +use File::Temp; + +$Data::Dumper::Indent = 0; + +use strict; +use warnings; + +use Carp; + +our $AUTOLOAD; + +our %keyfiles = (); + +my %fields = ( + remote_host => undef, + remote_user => undef, + remote_password => undef, + remote_account => undef, + remote_file => undef, + ssh_privatekey => undef, + ssh_publickey => undef, + type => undef, + port => undef, + content => undef, + localfile => undef, + tempfile => undef, + error => undef, + specific => 0, + debug => 0, +); + + +=pod + +The Remote Account module attempts to transfer a file to/from a remote server. +Net::uFTP is used, encapsulating the available options of SCP, FTP and SFTP. + +All information is expected to be gathered by the Event Definition through event parameters: + ~ remote_host (required) + ~ remote_user + ~ remote_password + ~ remote_account + ~ ssh_privatekey + ~ ssh_publickey + ~ type (FTP, SFTP or SCP -- default FTP) + ~ port + ~ debug + +The latter three are optionally passed to the Net::uFTP constructor. + +Note: none of the parameters are actually required, except remote_host. +That is because remote_user, remote_password and remote_account can all be +extrapolated from other sources, as the Net::FTP docs describe: + + If no arguments are given then Net::FTP uses the Net::Netrc package + to lookup the login information for the connected host. + + If no information is found then a login of anonymous is used. + + If no password is given and the login is anonymous then anonymous@ + will be used for password. + +Note that specifying a password will require you to specify a user. +Similarly, specifying an account requires both user and password. +That is, there are no assumed defaults when the latter arguments are used. + +SSH KEYS: + +The use of ssh keys is preferred. + +We attempt to use SSH keys where they are specified or otherwise found +in the runtime environment. If only one key is specified, we attempt to derive +the corresponding filename based on the ssh-keygen defaults. If either key is +specified, but both are not found (and readable) then the result is failure. If +no key is specified, but keys are found, the key-based connections will be attempted, +but failure will be non-fatal. + +=cut + +sub plausible_dirs { + # returns plausible locations of a .ssh subdir where SSH keys might be stashed + # NOTE: these would need to be properly genericized w/ Makefule vars + # in order to support Debian packaging and multiple EG's on one box. + # Until that happens, we just rely on $HOME + + my @bases = ( + # '/openils/conf', # __EG_CONFIG_DIR__ + ); + ($ENV{HOME}) and unshift @bases, $ENV{HOME}; + + return grep {-d $_} map {"$_/.ssh"} @bases; +} + +sub get_keyfiles { + # populates %keyfiles hash + # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY + my $self = shift; + my $force = (@_ ? shift : 0); + return %keyfiles if (%keyfiles and not $force); # caching + $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : '')); + %keyfiles = (); # reset to empty + my @dirs = plausible_dirs(); + $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs)); + foreach my $dir (@dirs) { + foreach my $key (qw/rsa dsa/) { + my $private = "$dir/id_$key"; + my $public = "$dir/id_$key.pub"; + unless (-r $private) { + $logger->debug("Key '$private' cannot be read: $!"); + next; + } + unless (-r $public) { + $logger->debug("Key '$public' cannot be read: $!"); + next; + } + $keyfiles{$private} = $public; + } + } + return %keyfiles; +} + +sub param_keys { + my $self = shift; + my %keys = (); + if ($self->ssh_publickey and not $self->ssh_privatekey) { + my $private = $self->ssh_publickey; + unless ($private and $private =~ s/\.pub$// and -r $self->ssh_privatekey) { # try to guess missing private key name + $logger->error("No ssh_privatekey specified or found to pair with " . $self->ssh_publickey); + return; + } + $self->ssh_privatekey($private); + } + if ($self->ssh_privatekey and not $self->ssh_publickey) { + my $pub = $self->ssh_privatekey . '.pub'; # guess missing public key name + unless (-r $pub) { + $logger->error("No ssh_publickey specified or found to pair with " . $self->ssh_privatekey); + return; + } + $self->ssh_publickey($pub); + } + + # so now, we have either both ssh_p*keys params or neither + foreach (qw/ssh_publickey ssh_privatekey/) { + unless (-r $self->{$_}) { + $logger->error("$_ '" . $self->{$_} . "' cannot be read: $!"); + return; # quit w/ error if we fail on any user-specified key + } + } + $keys{$self->ssh_privatekey} = $self->ssh_publickey; + return %keys; +} + +sub new_tempfile { + my $self = shift; + my $text = shift || $self->content || ''; + my $tmp = File::Temp->new(); # magical self-destructing tempfile + # print $tmp "THIS IS TEXT\n"; + print $tmp $text or $logger->error(__PACKAGE__ . " : could not write to tempfile '$tmp'"); + close $tmp; + $self->tempfile($tmp); # save the object + $self->localfile($tmp->filename); # save the filename + $logger->info(__PACKAGE__ . " : using tempfile $tmp"); + return $self->localfile; # return the filename +} + +sub get { + my $self = shift; + my $params = shift; + + $self->init($params); # secondary init +} + +sub outbound_file { + my $self = shift; + my $params = shift; + + unless (defined $self->content or $self->localfile) { # content can be emptystring + $logger->error($self->error("No content or localfile specified -- nothing to send")); + return; + } + + # tricky subtlety: we want to use the most recently specified options + # with priority order: filename, content, old filename, old content. + # + # The $params->{x} will already match $self->x after the init above, + # so the checks using $params below are for whether the value was specified NOW (via put()) or not. + # + # if we got a new localfile value, we use it + # else if the content is new to this call, build a new tempfile w/ it, + # else use existing localfile, + # else build new tempfile w/ content already specified via new() + + return $params->{localfile} || ( + (defined $params->{content}) ? + $self->new_tempfile($self->content) : # $self->content is same value as $params->{content} + ($self->localfile || $self->new_tempfile($self->content)) + ); +} + +sub put { + my $self = shift; + my $params = shift; + + $self->init($params); # secondary init + + my $localfile = $self->outbound_file($params) or return; + + my %keys = (); + $self->{put_args} = [$localfile]; # same for scp_put and uFTP put + + push @{$self->{put_args}}, $self->remote_file if $self->remote_file; # user can specify remote_file name, optionally + + unless ($self->type and $self->type eq 'FTP') { + if ($self->ssh_publickey || $self->ssh_privatekey) { + $self->specific(1); + %keys = $self->param_keys() or return; # we got one or both params, but they didn't pan out + } else { + %keys = get_keyfiles(); # optional "force" arg could be used here to empty cache + } + } + + my $try; + $try = $self->put_ssh2(%keys) if (%keys); + return $try if $try; # if we had keys and they worked, we're done + + # Otherwise, try w/ non-key uFTP methods + return $self->put_uftp; +} + +sub put_ssh2 { + my $self = shift; + my %keys = (@_); + + $logger->info("*** attempting put with ssh keys"); + my $ssh2 = Net::SSH2->new(); + unless($ssh2->connect($self->remote_host)) { + $logger->warn($self->error("SSH2 connect FAILED: $!" . join(" ", $ssh2->error))); + $self->specific and return; # user told us what key(s) she wanted, and it failed. + %keys = (); # forget the keys, we cannot connect + } + foreach (keys %keys) { + my %auth_args = ( + privatekey => $_, + publickey => $keys{$_}, + rank => [qw/ publickey hostbased password /], + ); + $self->remote_user and $auth_args{username} = $self->remote_user ; + $self->remote_password and $auth_args{password} = $self->remote_password; + $self->remote_host and $auth_args{hostname} = $self->remote_host ; + + if ($ssh2->auth(%auth_args)) { + if ($ssh2->scp_put( @{$self->{put_args}} )) { + $logger->info(sprintf __PACKAGE__ . " : successfully sent %s %s", $self->remote_host, join(' --> ', @{$self->{put_args}} )); + return 1; + } else { + $logger->error($self->error(sprintf __PACKAGE__ . " : put to %s failed with error: $!", $self->remote_host)); + return; + } + } elsif ($self->specific) { + $logger->error($self->error(sprintf "Abort: ssh2->auth FAILED for %s using %s: $!", $self->remote_host, $_)); + return; + } else { + $logger->notice($self->error(sprintf "Unsuccessful keypair: ssh2->auth FAILED for %s using %s: $!", $self->remote_host, $_)); + } + } +} + +sub uftp { + my $self = shift; + my %options = (); + foreach (qw/debug type port/) { + $options{$_} = $self->{$_} if $self->{$_}; + } + # TODO: eval wrapper, set $self->error($!) on failure + my $ftp = Net::uFTP->new($self->remote_host, %options) or return; + + my @login_args = (); + foreach (qw/remote_user remote_password remote_account/) { + push @login_args, $self->{$_} if $self->{$_}; + } + unless ($ftp->login(@login_args)) { + $logger->error(__PACKAGE__ . ' : ' . $self->error("failed login to " . $self->remote_host . " w/ args(" . join(',', @login_args) . ')')); + return; + } + return $ftp; +} + +sub put_uftp { + my $self = shift; + my $ftp = $self->uftp or return; + my $filename = $ftp->put(@{$self->{put_args}}); + if ($filename) { + $logger->info(__PACKAGE__ . " : successfully sent $self->remote_host $self->localfile --> $filename"); + return $filename; + } else { + $logger->error(__PACKAGE__ . ' : ' . $self->error("put to " . $self->remote_host . " failed with error: $!")); + return; + } +} + +sub init { + my $self = shift; + my $params = shift; + my @required = @_; # qw(remote_host) ; # nothing required now + + foreach (keys %{$self->{_permitted}}) { + $self->{$_} = $params->{$_} if defined $params->{$_}; + } + + foreach (@required) { + unless ($self->{$_}) { + $logger->error("Required parameter $_ not specified"); + return; + } + } + return $self; +} + + +sub new { + my( $class, %args ) = @_; + my $self = { _permitted => \%fields, %fields }; + + bless $self, $class; + + $self->init(\%args); # or croak "Initialization error caused by bad args"; + return $self; +} + +sub DESTROY { + # in order to create, we must first ... +} + +sub AUTOLOAD { + my $self = shift; + my $class = ref($self) or croak "$self is not an object"; + my $name = $AUTOLOAD; + + $name =~ s/.*://; # strip leading package stuff + + unless (exists $self->{_permitted}->{$name}) { + croak "Cannot access '$name' field of class '$class'"; + } + + if (@_) { + return $self->{$name} = shift; + } else { + return $self->{$name}; + } +} + +1;