Open-ILS/src/perlmods/OpenILS/Application/Trigger/Reactor/SendFile.pm

   1 package   OpenILS::Application::Trigger::Reactor::SendFile;
   2 use       OpenILS::Application::Trigger::Reactor;
   3 use base 'OpenILS::Application::Trigger::Reactor';
   4
   5 # use OpenSRF::Utils::SettingsClient;
   6 use OpenSRF::Utils::Logger qw/:logger/;
   7
   8 use Data::Dumper;
   9 use Net::uFTP;
  10 use Net::SSH2;      # because uFTP doesn't handle SSH keys (yet?)
  11 use File::Temp;
  12
  13 $Data::Dumper::Indent = 0;
  14
  15 use strict;
  16 use warnings;
  17
  18 our %keyfiles = ();
  19
  20 sub ABOUT {
  21     return <<ABOUT;
  22
  23 The SendFile Reactor Module attempts to transfer a file to a remote server.
  24 Net::uFTP is used, encapsulating the available options of SCP, FTP and SFTP.
  25
  26 No default template is assumed, and all information is expected to be gathered
  27 by the Event Definition through event parameters:
  28    ~ remote_host (required)
  29    ~ remote_user
  30    ~ remote_password
  31    ~ remote_account
  32    ~ ssh_privatekey
  33    ~ ssh_publickey
  34    ~ type (FTP, SFTP or SCP -- default FTP)
  35    ~ port
  36    ~ debug
  37
  38 The latter three are optionally passed to the Net::uFTP constructor.
  39
  40 Note: none of the parameters are actually required, except remote_host.
  41 That is because remote_user, remote_password and remote_account can all be
  42 extrapolated from other sources, as the Net::FTP docs describe:
  43
  44     If no arguments are given then Net::FTP uses the Net::Netrc package
  45         to lookup the login information for the connected host.
  46
  47     If no information is found then a login of anonymous is used.
  48
  49     If no password is given and the login is anonymous then anonymous@
  50         will be used for password.
  51
  52 Note that specifying a password will require you to specify a user.
  53 Similarly, specifying an account requires both user and password.
  54 That is, there are no assumed defaults when the latter arguments are used.
  55
  56 SSH KEYS:
  57
  58 The use of ssh keys is preferred.
  59
  60 The reactor attempts to use SSH keys where they are specified or otherwise found
  61 in the runtime environment.  If only one key is specified, we attempt to derive
  62 the corresponding filename based on the ssh-keygen defaults.  If either key is
  63 specified, but both are not found (and readable) then the result is failure.  If
  64 no key is specified, but keys are found, the key-based connections will be attempted,
  65 but failure will be non-fatal.
  66
  67 ABOUT
  68 }
  69
  70 sub plausible_dirs {
  71     # returns plausible locations of a .ssh subdir where SSH keys might be stashed
  72     # NOTE: these would need to be properly genericized w/ Makefule vars
  73     # in order to support Debian packaging and multiple EG's on one box.
  74     # Until that happens, we just rely on $HOME
  75
  76     my @bases = (
  77        # '/openils/conf',     # __EG_CONFIG_DIR__
  78     );
  79     ($ENV{HOME}) and unshift @bases, $ENV{HOME};
  80
  81     return grep {-d $_} map {"$_/.ssh"} @bases;
  82 }
  83
  84 sub get_keyfiles {
  85     # populates %keyfiles hash
  86     # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY
  87     my $force = (@_ ? shift : 0);
  88     return %keyfiles if (%keyfiles and not $force);   # caching
  89     $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : ''));
  90     %keyfiles = ();  # reset to empty
  91     my @dirs = plausible_dirs();
  92     $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs));
  93     foreach my $dir (@dirs) {
  94         foreach my $key (qw/rsa dsa/) {
  95             my $private = "$dir/id_$key";
  96             my $public  = "$dir/id_$key.pub";
  97             unless (-r $private) {
  98                 $logger->debug("Key '$private' cannot be read: $!");
  99                 next;
 100             }
 101             unless (-r $public) {
 102                 $logger->debug("Key '$public' cannot be read: $!");
 103                 next;
 104             }
 105             $keyfiles{$private} = $public;
 106         }
 107     }
 108     return %keyfiles;
 109 }
 110
 111 sub param_keys {
 112     my $params = shift;
 113     my %keys = ();
 114     if ($params->{ssh_publickey } and not $params->{ssh_privatekey}) {
 115         $params->{ssh_privatekey} = $params->{ssh_publickey};        # try to guess missing private key name
 116         unless ($params->{ssh_privatekey} =~ s/\.pub$// and -r $params->{ssh_privatekey}) {
 117             $logger->error("No ssh_privatekey specified or found to pair with " . $params->{ssh_publickey});
 118             return;
 119         }
 120     }
 121     if ($params->{ssh_privatekey} and not $params->{ssh_publickey }) {
 122         $params->{ssh_publickey}  = $params->{ssh_privatekey} . '.pub'; # guess missing public key name
 123         unless (-r $params->{ssh_publickey}) {
 124             $logger->error("No ssh_publickey specified or found to pair with " . $params->{ssh_privatekey});
 125             return;
 126         }
 127     }
 128
 129     # so now, we have either both ssh_p*key params or neither
 130     foreach (qw/ssh_publickey ssh_privatekey/) {
 131         unless (-r $params->{$_}) {
 132             $logger->error("$_ '" . $params->{$_} . "' cannot be read: $!");
 133             return;                 # quit w/ error if we fail on any user-specified key
 134         }
 135         $keys{$params->{ssh_privatekey}} = $params->{ssh_publickey};
 136     }
 137     return %keys;
 138 }
 139
 140 sub handler {
 141     my $self = shift;
 142     my $env  = shift;
 143     my $params = $env->{params};
 144
 145     my $host = $params->{remote_host};
 146     unless ($host) {
 147         $logger->error("No remote_host specified in env");
 148         return;
 149     }
 150
 151     my $text = $self->run_TT($env) or return;
 152     my $tmp  = File::Temp->new();    # magical self-destructing tempfile
 153     print $tmp $text;
 154     $logger->info("SendFile Reactor: using tempfile $tmp");
 155
 156     my %keys     = ();
 157     my $specific = 0;
 158     my @put_args = ($tmp->filename);      # same for scp_put and uFTP put
 159     push @put_args, $params->{remote_file} if $params->{remote_file};     # user can specify remote_file name, optionally
 160
 161     unless ($params->{type} and $params->{type} eq 'FTP') {
 162         if ($params->{ssh_publickey} || $params->{ssh_privatekey}) {
 163             $specific = 1;
 164             %keys = param_keys($params) or return;  # we got one or both params, but they didn't pan out
 165         } else {
 166             %keys = get_keyfiles();     # optional "force" arg could be used here to empty cache
 167         }
 168     }
 169
 170     if (%keys) {
 171         my $ssh2 = Net::SSH2->new();
 172         unless($ssh2->connect($host)) {
 173             $logger->warn("SSH2 connect FAILED: $!" . join(" ", $ssh2->error));
 174             $specific and return;
 175             %keys = ();     # forget the keys, we cannot connect
 176         }
 177         foreach (keys %keys) {
 178             my %auth_args = (
 179                 privatekey => $_,
 180                 publickey  => $keys{$_},
 181                 rank => [qw/ publickey hostbased password /],
 182             );
 183             $params->{remote_user    } and $auth_args{username} = $params->{remote_user    };
 184             $params->{remote_password} and $auth_args{password} = $params->{remote_password};
 185             $params->{remote_host    } and $auth_args{hostname} = $params->{remote_host    };
 186
 187             if ($ssh2->auth(%auth_args)) {
 188                 if ($ssh2->scp_put(@put_args)) {
 189                     $logger->info("SendFile Reactor: successfully sent ${host} " . join(' --> ', @put_args));
 190                     return 1;
 191                 } else {
 192                     $logger->error("SendFile Reactor: put to $host failed with error: $!");
 193                     return;
 194                 }
 195             } elsif ($specific) {
 196                 $logger->error("Abort reactor: ssh2->auth FAILED for $host using $_: $!");
 197                 return;
 198             } else {
 199                 $logger->notice("Unsuccessful keypair: ssh2->auth FAILED for $host using $_: $!");
 200             }
 201         }
 202     }
 203     # my $conf = OpenSRF::Utils::SettingsClient->new;
 204     # $$env{something_hardcoded} = $conf->config_value('category', 'whatever');
 205
 206     # Try w/ non-key uFTP methods
 207     my %options = ();
 208     foreach (qw/debug type port/) {
 209         $options{$_} = $params->{$_} if $params->{$_};
 210     }
 211     my $ftp = Net::uFTP->new($host, %options);
 212
 213     my @login_args = ();
 214     foreach (qw/remote_user remote_password remote_account/) {
 215         push @login_args, $params->{$_} if $params->{$_};
 216     }
 217     unless ($ftp->login(@login_args)) {
 218         $logger->error("SendFile Reactor: failed login to $host w/ args(" . join(',', @login_args) . ")");
 219         return;
 220     }
 221
 222     my $filename = $ftp->put(@put_args);
 223     if ($filename) {
 224         $logger->info("SendFile Reactor: successfully sent ${host} $tmp --> $filename");
 225         return 1;
 226     } else {
 227         $logger->error("SendFile Reactor: put to $host failed with error: $!");
 228         return;
 229     }
 230 }
 231
 232 1;
 233