# Rsh.pm: Class Used for Remote Access with rsh or remsh

package RDA::Driver::Rsh;

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

=for stopwords remsh

=head1 NAME

RDA::Driver::Rsh - Class Used for Remote Access using rsh or remsh

=head1 SYNOPSIS

 require RDA::Driver::Rsh;

=head1 DESCRIPTION

The objects of the C<RDA::Driver::Rsh> class are used for execution remote
access requests using F<rsh> or F<remsh>.

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.15 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(Exporter);

# Define the global private constants

# Define the global private variables

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

=head2 S<$h = RDA::Driver::Rsh-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<'-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 'rsh';
}

=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);

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  @cmd = ($col->get_primary(["REMOTE.$nod.F_RSH_COMMAND",
                             'REMOTE.F_RSH_COMMAND'], 'ssh'));
  if ($str = $col->get_first(["REMOTE.$nod.T_RSH_OPTIONS",
                              'REMOTE.T_RSH_OPTIONS'], q{}))
  { $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>

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

=cut

sub need_pause
{ return 0;
}

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

This method executes a requests 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 -30 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  $_=***" : "$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 -31;
}

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

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

  # Determine the remote shell command
  unless ($col->get_primary('REMOTE.F_RSH_COMMAND'))
  { return unless ($val = $col->get_config->find('rsh')) ||
                  ($val = $col->get_config->find('remsh'));
    $col->set_value('REMOTE.F_RSH_COMMAND', $val, 'RSH command');
    $col->set_value('REMOTE.T_RSH_OPTIONS', q{},  'RSH options');
  }

  # Determine the remote file copy command
  unless ($col->get_primary('REMOTE.F_RCP_COMMAND'))
  { return unless ($val = $col->get_config->find('rcp'));
    $col->set_value('REMOTE.F_RCP_COMMAND', $val, 'RCP command');
    $col->set_value('REMOTE.T_RCP_OPTIONS', '-p', 'RCP options');
  }

  # Create the driver manager object
  return bless {
    -col => $col,
    -msg => undef,
    -nod => 'RSH',
    -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);

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  $cmd = $col->get_primary(["REMOTE.$nod.F_RSH_COMMAND",
                            'REMOTE.F_RSH_COMMAND'], 'rsh');

  $str = $col->get_first(["REMOTE.$nod.T_RSH_OPTIONS",
                          'REMOTE.T_RSH_OPTIONS'], q{});
  $cmd .= q{ }.$str;
  $cmd .= ' -l '.$var->{'USR'} if exists($var->{'USR'});
  $cmd .= q{ }.$var->{'HST'};
  $str = $var->{'CMD'};
  $str =~ s/'/'"'"'/g;
  $cmd .= " '$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, "$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);

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  $cmd = $col->get_primary(["REMOTE.$nod.F_RSH_COMMAND",
                            'REMOTE.F_RSH_COMMAND'], 'rsh');
  $str = $col->get_first(["REMOTE.$nod.T_RSH_OPTIONS",
                          'REMOTE.T_RSH_OPTIONS'], q{});
  $str =~ s/n/T/;
  $cmd .= q{ }.$str;
  $cmd .= ' -l '.$var->{'USR'} if exists($var->{'USR'});
  $cmd .= q{ }.$var->{'HST'};
  $str = $var->{'CMD'};
  $str =~ s/'/'"'"'/g;
  $cmd .= " '$str' >";
  $cmd .= '>' 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, "| $cmd 2>/dev/null"))  ## no critic (Open)
  { if (@dat)
    { $cod = join(qq{\n}, @dat);
      if ($slf->{'-trc'})
      { $pre = $slf->{'-pre'}.': ';
        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 ($dst, $src);

  $dst = $var->{'DST'};
  if (exists($var->{'FIL'}))
  { $src = $var->{'HST'}.q{:}.$var->{'FIL'};
  }
  else
  { $src = $var->{'HST'}.q{:}.$var->{'DIR'};
    $src .= q{/}.$var->{'PAT'} if exists($var->{'PAT'});
  }
  $src = $var->{'USR'}.q{@}.$src if exists($var->{'USR'});
  return _do_rcp($slf, $var->{'FLG'} ? '-r' : q{}, $dst, $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 .= _gen_path($var->{'RDR'}, $var->{'RNM'});
  $src = join(q{' '}, @{$src}) if ref($src = $var->{'SRC'}) eq 'ARRAY';
  return _do_rcp($slf, $var->{'FLG'} ? '-r' : q{}, $dst, $src);
}

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

  # Determine the command and its options
  $col = $slf->{'-col'};
  $nod = $slf->{'-nod'};
  $cmd = $col->get_primary(["REMOTE.$nod.F_RCP_COMMAND",
                            'REMOTE.F_RCP_COMMAND'], 'rcp');
  $opt = $col->get_first(["REMOTE.$nod.T_RCP_OPTIONS",
                          'REMOTE.T_RCP_OPTIONS'], '-p');

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

  # Indicate the command result
  return $?;
}

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

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

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