# Ssh.pm: Class Used for Remote Access with ssh

package RDA::Driver::Ssh;

# $Id: Ssh.pm,v 1.16 2015/06/29 06:40:33 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Driver/Ssh.pm,v 1.16 2015/06/29 06:40:33 RDA Exp $
#
# Change History
# 20150629  MSC  Add the end method.

=head1 NAME

RDA::Driver::Ssh - Class Used for Remote Access using ssh

=head1 SYNOPSIS

 require RDA::Driver::Ssh;

=head1 DESCRIPTION

The objects of the C<RDA::Driver::Ssh> class are used for execution remote
access requests using F<ssh>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::Handle;
  use RDA::Text qw(debug get_string);
  use RDA::Object::Rda;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA);
$VERSION = sprintf('%d.%02d', q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(Exporter);

# Define the global private constants

# Define the global private variables
my %tb_cmd = (
  scp => '-BCpq -o ConnectTimeout=30',
  ssh => '-Cnq -o ConnectTimeout=30',
  SCP => '-BCpq',
  SSH => '-Cnq',
  );

# Report the package version
sub Version
{ return $VERSION;
}

=head2 S<$h = RDA::Driver::Ssh-E<gt>new($collector)>

The remote access manager object constructor. It takes the collector object
reference as an argument.

=head2 S<$h-E<gt>new($session)>

The remote session manager object constructor. It takes the remote session
object reference as an argument.

C<RDA::Driver::Ssh> is represented by a blessed hash reference. The
following special keys are used:

=over 12

=item S<    B<'-col'> > Reference to the collector object (M,S)

=item S<    B<'-lin'> > Stored lines (S)

=item S<    B<'-msg'> > Last message (M,S)

=item S<    B<'-nod'> > Node identifier (M,S)

=item S<    B<'-out'> > Timeout indicator (M,S)

=item S<    B<'-pre'> > Trace prefix (M,S)

=item S<    B<'-ses'> > Reference to the session object (S)

=item S<    B<'-ssh'> > SSH agent indicator (S)

=item S<    B<'-sta'> > Last captured exit code (M,S)

=item S<    B<'-trc'> > Trace indicator (M,S)

=back

Internal keys are prefixed by a dash.

=cut

sub new
{ my ($cls, $ses) = @_;
  my ($nod);

  # Create the object and return its reference
  $nod = $ses->get_oid;
  return ref($cls)
    ? bless {
        -col => $cls->{'-col'},
        -lin => [],
        -msg => undef,
        -nod => $nod,
        -pre => $cls->{'-col'}->get_first("REMOTE.$nod.W_PREFIX", $nod),
        -out => 0,
        -ses => $ses,
        -sta => 0,
        -trc => $cls->{'-trc'} || $ses->get_level,
        }, ref($cls)
    : _create_manager(@_);
}

=head2 S<$h-E<gt>as_type>

This method returns the driver type.

=cut

sub as_type
{ return 'ssh';
}

=head2 S<$h-E<gt>can_interconnect>

This method indicates whether an interconnection is possible.

=cut

sub can_interconnect
{ return RDA::Object::Rda->is_windows ? 0 :
         RDA::Object::Rda->is_vms     ? 0 :
                                        1;
}

=head2 S<$h-E<gt>delete_object>

This method deletes the object.

=cut

sub delete_object
{ undef %{$_[0]};
  undef $_[0];
  return;
}

sub end
{ return;
}

=head2 S<$h-E<gt>get_access>

This method indicates that the driver does not support passwords.

=cut

sub get_access
{ return;
}

=head2 S<$h-E<gt>get_api>

This method returns the version of the interface. It returns an undefined value
in case of problems.

=cut

sub get_api
{ return;
}

=head2 S<$h-E<gt>get_hit>

This method returns the last prompt matched. It returns an undefined value in
case of problems.

=cut

sub get_hit
{ return;
}

=head2 S<$h-E<gt>get_lines>

This method returns the lines stored during the last command execution.

=cut

sub get_lines
{ return @{shift->{'-lin'}};
}

=head2 S<$h-E<gt>get_message>

This method returns the last message.

=cut

sub get_message
{ return shift->{'-msg'};
}

=head2 S<$h-E<gt>has_timeout>

This method indicates whether the last request encountered a timeout.

=cut

sub has_timeout
{ return shift->{'-out'};
}

=head2 S<$h-E<gt>interconnect($dsc,$ifh,$ofh,$efh)>

This method creates a communication channel with a remote command. It returns
a process identifier to the local F<ssh> process when the communication is
established. Otherwise, it returns zero.

=cut

sub interconnect
{ my ($slf, $var, $ifh, $ofh, $efh) = @_;
  my ($col, $nod, $str, @cmd);

  # Set an authentication agent when appropriate
  $slf->{'-ssh'} = $slf->{'-ses'}->set_agent unless $slf->{'-ssh'};

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  @cmd = ($col->get_primary(["REMOTE.$nod.F_SSH_COMMAND",
                             'REMOTE.F_SSH_COMMAND'], 'ssh'));
  if ($str = $col->get_first(["REMOTE.$nod.T_SSH_OPTIONS",
                              'REMOTE.T_SSH_OPTIONS'], $tb_cmd{'ssh'}))
  { $str =~ s/n/T/;
    push(@cmd, split(/\s+/, $str));
  }
  push(@cmd, q{-l}, $var->{'USR'}) if exists($var->{'USR'});
  push(@cmd, $var->{'HST'});
  push(@cmd, join(q{ }, map {RDA::Object::Rda->quote($_)}
                        @{$var->{'CMD'}}, @{$var->{'OPT'}}));

  # Create the communication channel
  require RDA::Handle::Agent;
  debug($slf->{'-pre'}.'] Pipe: '.join(q{ }, @cmd)) if $slf->{'-trc'};
  return RDA::Handle::Agent::exec_command($ifh, $ofh, $efh, @cmd);
}

=head2 S<$h-E<gt>is_skipped>

This method indicates whether the last request was skipped.

=cut

sub is_skipped
{ return 0;
}

=head2 S<$h-E<gt>need_password>

This method indicates whether the driver needs a password.

=cut

sub need_password
{ return 0;
}

=head2 S<$h-E<gt>need_pause([$var])>

This method indicates whether the current connection could require a pause for
providing a password.

=cut

sub need_pause
{ my ($slf, $var) = @_;

  return _do_test($slf, $var);
}

=head2 S<$h-E<gt>request($cmd,$var,@dat)>

This method executes a request and returns the result file. It supports the
following commands:

=over 2

=item * C<DEFAULT>

It changes some interface parameters.

=item * C<EXEC>

It submits one or more commands to the remote servers and collects the results.

=item * C<GET>

It gets one or more remote files.

=item * C<PUT>

It puts one or more local files into the remote server.

=back

It returns a negative value in case of problems.

=cut

sub request
{ my ($slf, $cmd, $var, @dat) = @_;
  my ($msk, $pre);

  # Validate the request
  return -20 unless defined($cmd) && ref($var) eq 'HASH';

  # Trace the request
  if ($slf->{'-trc'})
  { $pre = $slf->{'-pre'}.'] ';
    $msk = exists($var->{'MSK'}) ? $var->{'MSK'} : 'PPH|PWD';
    debug(join(qq{\n}, $pre."Executing a $cmd request",
      map {m/^($msk)$/                  ? "$pre  $_=***" :
           (ref($var->{$_}) eq 'ARRAY') ? "$pre  $_=[".
                                            join(q{|}, @{$var->{$_}}).q{]} :
                                          "$pre  $_='".$var->{$_}.q{'}}
        sort keys(%{$var})));
  }

  # Execute the request
  return _do_default($slf, $var)    if $cmd eq 'DEFAULT';
  return exists($var->{'FLG'})
    ? _do_command($slf, $var)
    : _do_exec($slf, $var, @dat)    if $cmd eq 'EXEC';
  return _do_get($slf, $var)        if $cmd eq 'GET';
  return _do_put($slf, $var)        if $cmd eq 'PUT';
  return -21;
}

# --- Internal routines -------------------------------------------------------

# Create the driver manager
sub _create_manager
{ my ($cls, $col, $lim) = @_;

  # Identify the commands to be used
  unless ($col->get_primary('REMOTE.F_SSH_COMMAND') &&
          $col->get_primary('REMOTE.F_SCP_COMMAND'))
  { my ($alt, $key, $opt, $scp, $ssh);

    # Determine the remote shell and file copy commands
    return unless ($ssh = $col->get_config->find('ssh')) &&
                  ($scp = $col->get_config->find('scp'));

    # Determine the remote shell command
    ## no critic (Eval)
    $opt = $tb_cmd{'ssh'};
    $key = eval "`$ssh $opt -o bad_option=bad_value localhost date 2>&1`";
    $opt = $tb_cmd{'SSH'} if ($alt = ($key =~ m/ConnectTimeout/));
    $col->set_value('REMOTE.F_SSH_COMMAND', $ssh, 'SSH command');
    $col->set_value('REMOTE.T_SSH_OPTIONS', $opt, 'SSH options');

    # Determine the remote file copy command
    $opt = $tb_cmd{$alt ? 'SCP' : 'scp'};
    $col->set_value('REMOTE.F_SCP_COMMAND', $scp, 'SCP command');
    $col->set_value('REMOTE.T_SCP_OPTIONS', $opt, 'SCP options');
  }

  # Create the driver manager object
  return bless {
    -col => $col,
    -msg => undef,
    -nod => 'SSH',
    -out => 0,
    -sta => 0,
    -trc => $col->get_trace('SSH'),
    }, $cls;
}

# Perform an EXEC request (Command mode)
sub _do_command
{ my ($slf, $var) = @_;
  my ($col, $cmd, $flg, $ifh, $nod, $str, $trc);

  # Set an authentication agent when appropriate
  $slf->{'-ssh'} = $slf->{'-ses'}->set_agent unless $slf->{'-ssh'};

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  $cmd = $col->get_primary(["REMOTE.$nod.F_SSH_COMMAND",
                            'REMOTE.F_SSH_COMMAND'], 'ssh');
  $str = $col->get_first(["REMOTE.$nod.T_SSH_OPTIONS",
                          'REMOTE.T_SSH_OPTIONS'], $tb_cmd{'ssh'});
  $cmd .= q{ }.$str;
  $cmd .= q{ -l }.$var->{'USR'} if exists($var->{'USR'});
  $cmd .= q{ }.$var->{'HST'};
  $str = _quote($var->{'CMD'});
  $cmd .= qq{ '$str'};

  # Execute the remote request
  $slf->{'-lin'} = [];
  $flg = $var->{'FLG'};
  if ($slf->{'-trc'})
  { debug($slf->{'-pre'}."] Command: $cmd 2>&1");
    $trc = $slf->{'-pre'}.q{> };
  }
  if (open($ifh = IO::Handle->new, qq{$cmd 2>&1 |}))  ## no critic (Open)
  { while (<$ifh>)
    { s/[\n\r\s]+$//;
      debug($trc, $_) if $trc;
      push(@{$slf->{'-lin'}}, $_) if $flg || m/RDA-\d{5}:/;
    }
    $ifh->close;
  }

  # Indicate the command result
  return $?;
}

# Perform a DEFAULT request
sub _do_default
{ my ($slf, $var) = @_;

  $slf->{'-lim'} = $var->{'LIM'} if exists($var->{'LIM'});
  $slf->{'-pre'} = $var->{'PRE'} if exists($var->{'PRE'});
  $slf->{'-trc'} = $var->{'TRC'} if exists($var->{'TRC'});
  return 0;
}

# Perform an EXEC request (Execute mode)
sub _do_exec
{ my ($slf, $var, @dat) = @_;
  my ($col, $cmd, $cod, $nod, $ofh, $pre, $str);

  # Set an authentication agent when appropriate
  $slf->{'-ssh'} = $slf->{'-ses'}->set_agent unless $slf->{'-ssh'};

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  $cmd = $col->get_primary(["REMOTE.$nod.F_SSH_COMMAND",
                            'REMOTE.F_SSH_COMMAND'], 'ssh');
  $str = $col->get_first(["REMOTE.$nod.T_SSH_OPTIONS",
                          'REMOTE.T_SSH_OPTIONS'], $tb_cmd{'ssh'});
  $str =~ s/n/T/;
  $cmd .= q{ }.$str;
  $cmd .= q{ -l }.$var->{'USR'} if exists($var->{'USR'});
  $cmd .= q{ }.$var->{'HST'};
  $str = _quote($var->{'CMD'});
  $cmd .= qq{ '$str' >};
  $cmd .= q{>} unless $var->{'NEW'};
  $cmd .= RDA::Object::Rda->quote($var->{'OUT'});

  # Execute the remote request
  debug($slf->{'-pre'}."] Command: $cmd 2>/dev/null") if $slf->{'-trc'};
  if (open($ofh = IO::Handle->new, qq{| $cmd 2>/dev/null}))  ## no critic (Open)
  { if (@dat)
    { $cod = join(qq{\n}, @dat);
      if ($slf->{'-trc'})
      { $pre = $slf->{'-pre'}.q{: };
        for (split(/\n/, $cod))
        { debug($pre, $_);
        }
      }
      syswrite($ofh, $cod, length($cod));
    }
    $ofh->close;
  }

  # Indicate the command result
  return $?;
}

# Perform a GET request
sub _do_get
{ my ($slf, $var) = @_;
  my ($src);

  if (exists($var->{'FIL'}))
  { $src = $var->{'HST'}.q{:}.RDA::Object::Rda->quote($var->{'FIL'});
  }
  else
  { $src = $var->{'HST'}.q{:}.RDA::Object::Rda->quote($var->{'DIR'});
    $src .= q{/}.$var->{'PAT'} if exists($var->{'PAT'});
  }
  $src = $var->{'USR'}.q{@}.$src if exists($var->{'USR'});
  return _do_scp($slf, $var->{'FLG'} ? q{-r} : q{}, _quote($var->{'DST'}),
    _quote($src));
}

# Perform a PUT request
sub _do_put
{ my ($slf, $var) = @_;
  my ($dst, $src);

  # Execute the remote request
  $dst = $var->{'HST'}.q{:};
  $dst = $var->{'USR'}.q{@}.$dst if exists($var->{'USR'});
  $dst .= RDA::Object::Rda->quote(_gen_path($var->{'RDR'}, $var->{'RNM'}));
  if (ref($src = $var->{'SRC'}) eq 'ARRAY')
  { $src = join(q{' '}, map {_quote($_)} @{$src});
  }
  else
  { $src = _quote($src);
  }
  return _do_scp($slf, $var->{'FLG'} ? q{-r} : q{}, _quote($dst), $src);
}

# Perform a transfer request
sub _do_scp
{ my ($slf, $rec, $dst, $src) = @_;
  my ($col, $cmd, $ifh, $nod, $opt, $pre, $trc);

  # Set an authentication agent when appropriate
  $slf->{'-ssh'} = $slf->{'-ses'}->set_agent unless $slf->{'-ssh'};

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  $cmd = $col->get_primary(["REMOTE.$nod.F_SCP_COMMAND",
                            'REMOTE.F_SCP_COMMAND'], 'scp');
  $opt = $col->get_first(["REMOTE.$nod.T_SCP_OPTIONS",
                          'REMOTE.T_SCP_OPTIONS'], $tb_cmd{'scp'});

  # Execute the remote request
  $slf->{'_err'} = [];
  if ($slf->{'-trc'})
  { debug($slf->{'-pre'}."] Command: $cmd $opt $rec '$src' '$dst' 2>&1");
    $trc = $slf->{'-pre'}.q{> };
  }
  if (open($ifh = IO::Handle->new,  ## no critic (Open)
    qq{$cmd $opt $rec '$src' '$dst' 2>&1 |}))
  { while (<$ifh>)
    { debug($trc, $_) if $trc;
    }
    $ifh->close;
  }

  # Indicate the command result
  return $?;
}

# Perform a TEST request
sub _do_test
{ my ($slf, $var) = @_;
  my ($col, $cmd, $flg, $ifh, $nod, $str, $trc);

  # Set an authentication agent when appropriate
  $slf->{'-ssh'} = $slf->{'-ses'}->set_agent unless $slf->{'-ssh'};

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  $cmd = $col->get_primary(["REMOTE.$nod.F_SSH_COMMAND",
                            'REMOTE.F_SSH_COMMAND'], 'ssh');
  $str = $col->get_first(["REMOTE.$nod.T_SSH_OPTIONS",
                          'REMOTE.T_SSH_OPTIONS'], $tb_cmd{'ssh'});
  $cmd .= q{ }.$str;
  $cmd .= q{ -o NumberOfPasswordPrompts=0};
  $cmd .= q{ -l }.$var->{'USR'} if exists($var->{'USR'});
  $cmd .= q{ }.$var->{'HST'};
  $cmd .= q{ 'echo OK connect'};

  # Execute the remote request
  $flg = 1;
  if ($slf->{'-trc'})
  { debug($slf->{'-pre'}."] Command: $cmd 2>&1");
    $trc = $slf->{'-pre'}.q{> };
  }
  if (open($ifh = IO::Handle->new, qq{$cmd 2>&1 |}))  ## no critic (Open)
  { while (<$ifh>)
    { s/[\n\r\s]+$//;
      debug($trc, $_) if $trc;
      if ($_ eq 'OK connect')
      { $flg = 0;
        last;
      }
    }
    $ifh->close;
  }

  # Indicate the test result
  return $flg;
}

# Generate a path
sub _gen_path
{ my ($dir, $fil) = @_;

  return (!defined($fil)) ? $dir :
         ($dir eq q{.})   ? $fil :
                            RDA::Object::Rda->cat_file($dir, $fil);
}

# Quote an argument
sub _quote
{ my ($str) = @_;

  $str =~ s/'/'"'"'/g;
  return $str;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Remote|RDA::Object::Remote>,
L<RDA::Text|RDA::Text>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002, 2016, Oracle and/or its affiliates. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle and Java are registered trademarks of Oracle and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut