Open-ILS/src/perlmods/OpenILS/Utils/RemoteAccount.pm

   1 package   OpenILS::Utils::RemoteAccount;
   2
   3 # use OpenSRF::Utils::SettingsClient;
   4 use OpenSRF::Utils::Logger qw/:logger/;
   5
   6 use Data::Dumper;
   7 use Net::uFTP;
   8 use Net::SSH2;      # because uFTP doesn't handle SSH keys (yet?)
   9 use File::Temp;
  10
  11 $Data::Dumper::Indent = 0;
  12
  13 use strict;
  14 use warnings;
  15
  16 use Carp;
  17
  18 our $AUTOLOAD;
  19
  20 our %keyfiles = ();
  21
  22 my %fields = (
  23     remote_host     => undef,
  24     remote_user     => undef,
  25     remote_password => undef,
  26     remote_account  => undef,
  27     remote_file     => undef,
  28     ssh_privatekey  => undef,
  29     ssh_publickey   => undef,
  30     type            => undef,
  31     port            => undef,
  32     content         => undef,
  33     localfile       => undef,
  34     tempfile        => undef,
  35     error           => undef,
  36     specific        => 0,
  37     debug           => 0,
  38 );
  39
  40
  41 =pod
  42
  43 The Remote Account module attempts to transfer a file to/from a remote server.
  44 Net::uFTP is used, encapsulating the available options of SCP, FTP and SFTP.
  45
  46 All information is expected to be gathered by the Event Definition through event parameters:
  47    ~ remote_host (required)
  48    ~ remote_user
  49    ~ remote_password
  50    ~ remote_account
  51    ~ ssh_privatekey
  52    ~ ssh_publickey
  53    ~ type (FTP, SFTP or SCP -- default FTP)
  54    ~ port
  55    ~ debug
  56
  57 The latter three are optionally passed to the Net::uFTP constructor.
  58
  59 Note: none of the parameters are actually required, except remote_host.
  60 That is because remote_user, remote_password and remote_account can all be
  61 extrapolated from other sources, as the Net::FTP docs describe:
  62
  63     If no arguments are given then Net::FTP uses the Net::Netrc package
  64         to lookup the login information for the connected host.
  65
  66     If no information is found then a login of anonymous is used.
  67
  68     If no password is given and the login is anonymous then anonymous@
  69         will be used for password.
  70
  71 Note that specifying a password will require you to specify a user.
  72 Similarly, specifying an account requires both user and password.
  73 That is, there are no assumed defaults when the latter arguments are used.
  74
  75 SSH KEYS:
  76
  77 The use of ssh keys is preferred.
  78
  79 We attempt to use SSH keys where they are specified or otherwise found
  80 in the runtime environment.  If only one key is specified, we attempt to derive
  81 the corresponding filename based on the ssh-keygen defaults.  If either key is
  82 specified, but both are not found (and readable) then the result is failure.  If
  83 no key is specified, but keys are found, the key-based connections will be attempted,
  84 but failure will be non-fatal.
  85
  86 =cut
  87
  88 sub plausible_dirs {
  89     # returns plausible locations of a .ssh subdir where SSH keys might be stashed
  90     # NOTE: these would need to be properly genericized w/ Makefule vars
  91     # in order to support Debian packaging and multiple EG's on one box.
  92     # Until that happens, we just rely on $HOME
  93
  94     my @bases = (
  95        # '/openils/conf',     # __EG_CONFIG_DIR__
  96     );
  97     ($ENV{HOME}) and unshift @bases, $ENV{HOME};
  98
  99     return grep {-d $_} map {"$_/.ssh"} @bases;
 100 }
 101
 102 sub get_keyfiles {
 103     # populates %keyfiles hash
 104     # %keyfiles maps SSH_PRIVATEKEY => SSH_PUBLICKEY
 105     my $self  = shift;
 106     my $force = (@_ ? shift : 0);
 107     return %keyfiles if (%keyfiles and not $force);   # caching
 108     $logger->info("Checking for SSH keyfiles" . ($force ? ' (ignoring cache)' : ''));
 109     %keyfiles = ();  # reset to empty
 110     my @dirs = plausible_dirs();
 111     $logger->debug(scalar(@dirs) . " plausible dirs: " . join(', ', @dirs));
 112     foreach my $dir (@dirs) {
 113         foreach my $key (qw/rsa dsa/) {
 114             my $private = "$dir/id_$key";
 115             my $public  = "$dir/id_$key.pub";
 116             unless (-r $private) {
 117                 $logger->debug("Key '$private' cannot be read: $!");
 118                 next;
 119             }
 120             unless (-r $public) {
 121                 $logger->debug("Key '$public' cannot be read: $!");
 122                 next;
 123             }
 124             $keyfiles{$private} = $public;
 125         }
 126     }
 127     return %keyfiles;
 128 }
 129
 130 sub param_keys {
 131     my $self = shift;
 132     my %keys = ();
 133     if ($self->ssh_publickey and not $self->ssh_privatekey) {
 134         my $private = $self->ssh_publickey;
 135         unless ($private and $private =~ s/\.pub$// and -r $self->ssh_privatekey) {        # try to guess missing private key name
 136             $logger->error("No ssh_privatekey specified or found to pair with " . $self->ssh_publickey);
 137             return;
 138         }
 139         $self->ssh_privatekey($private);
 140     }
 141     if ($self->ssh_privatekey and not $self->ssh_publickey) {
 142         my $pub = $self->ssh_privatekey . '.pub'; # guess missing public key name
 143         unless (-r $pub) {
 144             $logger->error("No ssh_publickey specified or found to pair with " . $self->ssh_privatekey);
 145             return;
 146         }
 147         $self->ssh_publickey($pub);
 148     }
 149
 150     # so now, we have either both ssh_p*keys params or neither
 151     foreach (qw/ssh_publickey ssh_privatekey/) {
 152         unless (-r $self->{$_}) {
 153             $logger->error("$_ '" . $self->{$_} . "' cannot be read: $!");
 154             return;                 # quit w/ error if we fail on any user-specified key
 155         }
 156     }
 157     $keys{$self->ssh_privatekey} = $self->ssh_publickey;
 158     return %keys;
 159 }
 160
 161 sub new_tempfile {
 162     my $self = shift;
 163     my $text = shift || $self->content || '';
 164     my $tmp  = File::Temp->new();      # magical self-destructing tempfile
 165     # print $tmp "THIS IS TEXT\n";
 166     print $tmp $text  or  $logger->error(__PACKAGE__ . " : could not write to tempfile '$tmp'");
 167     close $tmp;
 168     $self->tempfile($tmp);             # save the object
 169     $self->localfile($tmp->filename);  # save the filename
 170     $logger->info(__PACKAGE__ . " : using tempfile $tmp");
 171     return $self->localfile;           # return the filename
 172 }
 173
 174 sub get {
 175     my $self   = shift;
 176     my $params = shift;
 177
 178     $self->init($params);   # secondary init
 179 }
 180
 181 sub outbound_file {
 182     my $self   = shift;
 183     my $params = shift;
 184
 185     unless (defined $self->content or $self->localfile) {   # content can be emptystring
 186         $logger->error($self->error("No content or localfile specified -- nothing to send"));
 187         return;
 188     }
 189
 190     # tricky subtlety: we want to use the most recently specified options
 191     #   with priority order: filename, content, old filename, old content.
 192     #
 193     # The $params->{x} will already match $self->x after the init above,
 194     # so the checks using $params below are for whether the value was specified NOW (via put()) or not.
 195     #
 196     # if we got a new localfile value, we use it
 197     # else if the content is new to this call, build a new tempfile w/ it,
 198     # else use existing localfile,
 199     # else build new tempfile w/ content already specified via new()
 200
 201     return $params->{localfile} || (
 202         (defined $params->{content})          ?
 203          $self->new_tempfile($self->content)  :     # $self->content is same value as $params->{content}
 204         ($self->localfile || $self->new_tempfile($self->content))
 205     );
 206 }
 207
 208 sub put {
 209     my $self   = shift;
 210     my $params = shift;
 211
 212     $self->init($params);   # secondary init
 213
 214     my $localfile = $self->outbound_file($params) or return;
 215
 216     my %keys = ();
 217     $self->{put_args} = [$localfile];      # same for scp_put and uFTP put
 218
 219     push @{$self->{put_args}}, $self->remote_file if $self->remote_file;     # user can specify remote_file name, optionally
 220
 221     unless ($self->type and $self->type eq 'FTP') {
 222         if ($self->ssh_publickey || $self->ssh_privatekey) {
 223             $self->specific(1);
 224             %keys = $self->param_keys() or return;  # we got one or both params, but they didn't pan out
 225         } else {
 226             %keys = get_keyfiles();     # optional "force" arg could be used here to empty cache
 227         }
 228     }
 229
 230     my $try;
 231     $try = $self->put_ssh2(%keys) if (%keys);
 232     return $try if $try;  # if we had keys and they worked, we're done
 233
 234     # Otherwise, try w/ non-key uFTP methods
 235     return $self->put_uftp;
 236 }
 237
 238 sub put_ssh2 {
 239     my $self = shift;
 240     my %keys = (@_);
 241
 242     $logger->info("*** attempting put with ssh keys");
 243     my $ssh2 = Net::SSH2->new();
 244     unless($ssh2->connect($self->remote_host)) {
 245         $logger->warn($self->error("SSH2 connect FAILED: $!" . join(" ", $ssh2->error)));
 246         $self->specific and return;     # user told us what key(s) she wanted, and it failed.
 247         %keys = ();     # forget the keys, we cannot connect
 248     }
 249     foreach (keys %keys) {
 250         my %auth_args = (
 251             privatekey => $_,
 252             publickey  => $keys{$_},
 253             rank => [qw/ publickey hostbased password /],
 254         );
 255         $self->remote_user     and $auth_args{username} = $self->remote_user    ;
 256         $self->remote_password and $auth_args{password} = $self->remote_password;
 257         $self->remote_host     and $auth_args{hostname} = $self->remote_host    ;
 258
 259         if ($ssh2->auth(%auth_args)) {
 260             if ($ssh2->scp_put( @{$self->{put_args}} )) {
 261                 $logger->info(sprintf __PACKAGE__ . " : successfully sent %s %s", $self->remote_host, join(' --> ', @{$self->{put_args}} ));
 262                 return 1;
 263             } else {
 264                 $logger->error($self->error(sprintf __PACKAGE__ . " : put to %s failed with error: $!", $self->remote_host));
 265                 return;
 266             }
 267         } elsif ($self->specific) {
 268             $logger->error($self->error(sprintf "Abort: ssh2->auth FAILED for %s using %s: $!", $self->remote_host, $_));
 269             return;
 270         } else {
 271             $logger->notice($self->error(sprintf "Unsuccessful keypair: ssh2->auth FAILED for %s using %s: $!", $self->remote_host, $_));
 272         }
 273     }
 274 }
 275
 276 sub uftp {
 277     my $self = shift;
 278     my %options = ();
 279     foreach (qw/debug type port/) {
 280         $options{$_} = $self->{$_} if $self->{$_};
 281     }
 282     # TODO: eval wrapper, set $self->error($!) on failure
 283     my $ftp = Net::uFTP->new($self->remote_host, %options) or return;
 284
 285     my @login_args = ();
 286     foreach (qw/remote_user remote_password remote_account/) {
 287         push @login_args, $self->{$_} if $self->{$_};
 288     }
 289     unless ($ftp->login(@login_args)) {
 290         $logger->error(__PACKAGE__ . ' : ' . $self->error("failed login to " . $self->remote_host . " w/ args(" . join(',', @login_args) . ')'));
 291         return;
 292     }
 293     return $ftp;
 294 }
 295
 296 sub put_uftp {
 297     my $self = shift;
 298     my $ftp = $self->uftp or return;
 299     my $filename = $ftp->put(@{$self->{put_args}});
 300     if ($filename) {
 301         $logger->info(__PACKAGE__ . " : successfully sent $self->remote_host $self->localfile --> $filename");
 302         return $filename;
 303     } else {
 304         $logger->error(__PACKAGE__ . ' : ' . $self->error("put to " . $self->remote_host . " failed with error: $!"));
 305         return;
 306     }
 307 }
 308
 309 sub init {
 310     my $self   = shift;
 311     my $params = shift;
 312     my @required = @_;  # qw(remote_host) ;     # nothing required now
 313
 314     foreach (keys %{$self->{_permitted}}) {
 315         $self->{$_} = $params->{$_} if defined $params->{$_};
 316     }
 317
 318     foreach (@required) {
 319         unless ($self->{$_}) {
 320             $logger->error("Required parameter $_ not specified");
 321             return;
 322         }
 323     }
 324     return $self;
 325 }
 326
 327
 328 sub new {
 329     my( $class, %args ) = @_;
 330     my $self = { _permitted => \%fields, %fields };
 331
 332         bless $self, $class;
 333
 334     $self->init(\%args); # or croak "Initialization error caused by bad args";
 335     return $self;
 336 }
 337
 338 sub DESTROY {
 339         # in order to create, we must first ...
 340 }
 341
 342 sub AUTOLOAD {
 343         my $self  = shift;
 344         my $class = ref($self) or croak "$self is not an object";
 345         my $name  = $AUTOLOAD;
 346
 347         $name =~ s/.*://;   #   strip leading package stuff
 348
 349         unless (exists $self->{_permitted}->{$name}) {
 350                 croak "Cannot access '$name' field of class '$class'";
 351         }
 352
 353         if (@_) {
 354                 return $self->{$name} = shift;
 355         } else {
 356                 return $self->{$name};
 357         }
 358 }
 359
 360 1;