# REMOTE.pm: Remote Collection Command Library

package RDA::Request::REMOTE;

# $Id: REMOTE.pm,v 1.18 2015/05/08 18:12:55 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Request/REMOTE.pm,v 1.18 2015/05/08 18:12:55 RDA Exp $
#
# Change History
# 20150428  MSC  Introduce the control and slave agent concepts.

=head1 NAME

RDA::Request::REMOTE - Remote Collection Command Library

=head1 SYNOPSIS

 require RDA::Request::REMOTE;

=head1 DESCRIPTION

The objects of the C<RDA::Request::REMOTE> class are used to interface with
remote collection commands.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Alarm qw(clear_alarm set_alarm);
  use RDA::Object;
  use RDA::Object::Message;
}

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

# Define the global private constants
my $ALR = '___Alarm___';
my $GRP = [qw(DB RDA)];

# Define the global private variables
my %tb_cmd = (
  'REMOTE.DISABLE' => \&_do_disable,
  'REMOTE.EDIT'    => \&_do_edit,
  'REMOTE.EXIT'    => \&_do_exit,
  'REMOTE.LIST'    => \&_do_list,
  'REMOTE.RESTART' => \&_do_restart,
  'REMOTE.RETRY'   => \&_do_retry,
  'REMOTE.SET'     => \&_do_set,
  'REMOTE.START'   => \&_do_start,
  'REMOTE.STOP'    => \&_do_stop,
  'REMOTE.SUSPEND' => \&_do_suspend,
  );
my %tb_set = (
  remsh => ['remsh', q{},
            'rcp',   '-p',
           ],
  rsh   => ['rsh',   q{},
            'rcp',   '-p',
           ],
  ssh   => ['ssh',   '-Cnq -o ConnectTimeout=30',
            'scp',   '-BCpq -o ConnectTimeout=30',
           ],
  ssh0  => ['ssh',   '-Cnq',
            'scp',   '-Cpq',
           ],
  );

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

=head2 S<$h = RDA::Request::REMOTE-E<gt>new($agt)>

The object constructor. This method enables you to specify the agent reference
as an argument.

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

=over 10

=item S<  B<'_agt'> > Reference to the agent object

=item S<  B<'_cfg'> > Reference to the RDA software configuration

=item S<  B<'_col'> > Reference to the collector object

=item S<  B<'_dsp'> > Reference to the display control object when verbose

=item S<  B<'_rem'> > Reference to the remote collection control object

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $agt) = @_;
  my ($col);

  # Create the library object and return the object reference
  $col = $agt->get_collector;
  return bless {
    _agt => $agt,
    _cfg => $agt->get_config,
    _col => $col,
    _dsp => $agt->is_verbose,
    _rem => $col->get_remote,
    }, ref($cls) || $cls;
}

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

This method deletes the library object.

=cut

sub delete_object
{ RDA::Object::dump_caller($_[0], 'Commands') if $RDA::Object::DELETE;
  undef %{$_[0]};
  undef $_[0];
  return;
}

=head2 S<$h-E<gt>exec_command($req)>

This method executes the command specified in the message.

=cut

sub exec_command
{ my ($slf, $req) = @_;

  my $cmd = $req->{'msg'};
  return exists($tb_cmd{$cmd})
    ? &{$tb_cmd{$cmd}}($slf, $req)
    : $req->error('NotImplemented', get_string('BAD_COMMAND', $cmd));
}

=head1 REMOTE COMMANDS

=head2 REMOTE.DISABLE - Disable command

This command disables the remote collection. This is only performed for nodes
that are executing a step before the post treatment or the report package
transfer.

It supports the following attributes:

=over 13

=item B<  all>

When true, disables all nodes (false by default).

=item B<  nodes>

Provides the list of nodes where the collection is disabled.

=back

=cut

sub _do_disable
{ my ($slf, $req) = @_;
  my ($sta);

  eval {
    $sta = _adapt_step($slf, $req,
      {I => 'd', N => 'd', P => 'P', R => 'd', T => 'T'},
      $slf->{'_dsp'}
        ? {P => 'WaitPost',  # Text:WaitPost
           T => 'WaitXfr',   # Text:WaitXfr
           d => 'Disable'}   # Text:Disable
        : undef);
    };
  return $req->reply($@, 'Disable', status => $sta);
}

=head2 REMOTE.EDIT - Edit command

This command edits one or more remote node initial settings.

It supports the following attributes:

=over 13

=item B<  all>

When true, updates all nodes (false by default).

=item B<  edit>

Provides the setting changes as a list of key/value pairs. No settings are
created.

=item B<  nodes>

Provides the list of nodes to update.

=back

=cut

sub _do_edit
{ my ($slf, $req) = @_;
  my ($cnt, $def, $dsp, $edt, $rem);

  eval {
    if ($def = $slf->{'_col'}->find('REMOTE'))
    { # Get the edit directives
      $cnt = 0;
      $edt = {};
      foreach my $val ($req->get_value('edit'))
      { next unless $val =~ m/^((\w+\.)*[A-Z]_[A-Z]\w*)=(.*)$/;
        $edt->{$1} = $3;
        ++$cnt;
      }

      # Apply the edit directives
      if ($cnt)
      { $dsp = $slf->{'_dsp'};
        $rem = $slf->{'_col'}->get_remote;
        foreach my $nod (_get_nodes($def, $req))
        { $dsp->dsp_line(get_string('V_Modified', $nod))
            if $rem->edit_setup($nod, $edt) && $dsp;
        }
      }
    }
    };

  return $req->reply($@, 'Edit');
}

=head2 REMOTE.EXIT - Exit command

This command collects usage information before closing a remote agent.

=cut

sub _do_exit
{ my ($slf, $req) = @_;
  my ($use);

  # Indicate the completion status
  $use = $slf->{'_agt'}->get_info('use', {});
  return $req->new('OK.Exit',
    _use => [map {$_.qq{=\173}.join(q{,}, %{$use->{$_}}).qq{\175}}
                keys(%{$use})]);
}

=head2 REMOTE.LIST - List command

This command lists the nodes and the related Oracle system identifiers. For the
remote nodes, a command is executed to check its accessibility.

It supports the following attributes:

=over 15

=item B<  description>

When true, includes the description as data.

=item B<  full>

When true, includes the connection status in the descriptions.

=back

=cut

sub _do_list
{ my ($slf, $req) = @_;
  my ($buf, $col, $ctl, $def, $dsp, $dwn, $flg, $rem, @nod);

  eval {
    # Get the node list
    $col = $slf->{'_col'};
    $rem = $col->get_remote;
    @nod = $col->find('REMOTE', 1)->grep('^T_HOSTNAME$','or');

    # Geth the descriptions when requested
    if ($req->get_first('description'))
    { $buf = q{};
      if ($flg = $req->get_first('full'))
      { $dsp = $slf->{'_dsp'};
        $ctl = $rem->new($col);
      }
      foreach my $nod (@nod)
      { my ($hst, $sid, $sta, @sid);

        $hst = $col->get_first("REMOTE.$nod.T_HOSTNAME");
        $sid = q{};
        if ($def = $rem->load_setup($nod))
        { foreach my $tgt ($def->find('TARGET.DB', 1)->get_childs)
          { push(@sid, $tgt->get_first('T_ORACLE_SID'));
          }
          $sid = join(q{,}, @sid) if @sid;
        }
        $sta = '\040';  ## no critic (Interpolation)
        if ($flg && $rem->is_remote($nod))
        { $dsp->dsp_line(get_string('V_Check', $nod)) if $dsp;
          if (_rexec($ctl, $nod, 'env', 1))
          { $sta = get_string('Down');
            ++$dwn;
          }
        }
        $buf .= "$nod|$hst|$sid|$sta\n";
      }
      $ctl->delete_object if $flg;
    }
    };
  $req->add_error($@) if $@;

  # Return the completion status
  return $req->has_errors
    ? $req->reply('List')
    : $req->new('OK.List', down => $dwn, nodes => [@nod])->add_data($buf);
}

=head2 REMOTE.RESTART - Restart command

This command restarts the remote node collection from the beginning. This
action is only performed if the node step has been defined already.

It supports the following attributes:

=over 13

=item B<  all>

When true, restarts all nodes (false by default).

=item B<  nodes>

Provides the list of nodes to restart.

=back

=cut

sub _do_restart
{ my ($slf, $req) = @_;
  my ($sta);

  eval {
    $sta = _adapt_step($slf, $req, 'N',
      $slf->{'_dsp'} ? 'Restart' : undef);  # Text:Restart
    };
  return $req->reply($@, 'Retry', status => $sta);
}

=head2 REMOTE.RETRY - Suspend command

This command resets the status to execute the last step of remote data
collections again and this is only performed for nodes with errors.

It supports the following attributes:

=over 13

=item B<  all>

When true, updates all nodes (false by default).

=item B<  nodes>

Provides the list of nodes to update.

=back

=cut

sub _do_retry
{ my ($slf, $req) = @_;
  my ($sta);

  eval {
    $sta = _adapt_step($slf, $req,
      {c => 'I', d => 'N', i => 'I', n => 'N', p => 'P', r => 'R', t => 'T'},
      $slf->{'_dsp'}
        ? {I => 'Install',   # Text:Install
           N => 'New',       # Text:New
           P => 'Post',      # Text:Post
           R => 'Run',       # Text:Run
           T => 'Transfer'}  # Text:Transfer
        : undef);
    };
  return $req->reply($@, 'Retry', status => $sta);
}

=head2 REMOTE.SET - Set command

This command specifies which commands to use for remote operations for the
specified nodes. It supports the following attributes:

=for stopwords rcp remsh rsh scp ssh

=over 13

=item B<  all>

When true, disables all nodes (false by default).

=item B<  nodes>

Provides the list of nodes where the collection is disabled.

=item B<  type>

Specifies the connection type. It supports the following connection types:

=over 11

=item S<  C<default>>

Restores the default settings.

=item S<  C<remsh>>

Uses F<remsh> and F<rcp>.

=item S<  C<rsh>>

Uses F<rsh> and F<rcp>.

=item S<  C<ssh>>

Uses F<ssh> and F<scp>.

=item S<  C<ssh0>>

Uses F<ssh> and F<scp> without connection timeout.

=back

=back

=cut

sub _do_set
{ my ($slf, $req) = @_;
  my ($cnt, $col, $def, $rec, $scp, $set, $ssh, $typ);

  eval {
    if ($def = $slf->{'_col'}->find('REMOTE'))
    { $cnt = 0;
      $typ = $req->get_first('type', q{});
      if ($typ eq 'default')
      { foreach my $nod (_get_nodes($def, $req))
        { next unless ($set = $def->find($nod));
          $slf->{'_dsp'}->dsp_line(get_string('V_Reset', $nod))
            if $slf->{'_dsp'};
          $cnt++;
          $set->set_value('F_SSH_COMMAND');
          $set->set_value('T_SSH_OPTIONS');
          $set->set_value('F_SCP_COMMAND');
          $set->set_value('T_SCP_OPTIONS');
        }
      }
      elsif (exists($tb_set{$typ}))
      { $rec = $tb_set{$typ};
        die get_string('NOT_FOUND', $rec->[0])
          unless ($ssh = $slf->{'_cfg'}->find($rec->[0], 1));
        die get_string('NOT_FOUND', $rec->[2])
          unless ($scp = $slf->{'_cfg'}->find($rec->[2], 1));
        foreach my $nod (_get_nodes($def, $req))
        { next unless ($set = $def->find($nod));
          $slf->{'_dsp'}->dsp_line(get_string('V_Set', $ssh, $scp, $nod))
            if $slf->{'_dsp'};
          $cnt++;
          $set->set_value('F_SSH_COMMAND', $ssh,
                          'Node specific remote command');
          $set->set_value('T_SSH_OPTIONS', $rec->[1],
                          'Node specific remote command options');
          $set->set_value('F_SCP_COMMAND', $scp,
                          'Node specific remote copy command');
          $set->set_value('T_SCP_OPTIONS', $rec->[3],
                          'Node specific remote copy command options');
        }
      }

      # Save changes
      $slf->{'_col'}->save if $cnt;
    }
    };
  return $req->reply($@, 'Set', cnt => $cnt);
}

=head2 REMOTE.START - Start command

This command starts a background collection on the specified nodes.

It supports the following attributes:

=over 13

=item B<  all>

When true, treats all nodes (false by default).

=item B<  nodes>

Provides the list of nodes to treat.

=back

=cut

sub _do_start
{ my ($slf, $req) = @_;
  my ($col, $ctl, $def, $dsp);

  eval {
    $col = $slf->{'_col'};
    if ($def = $col->find('REMOTE'))
    { $ctl = $col->get_remote->new($col);
      $dsp = $slf->{'_dsp'};
      foreach my $nod (_get_nodes($def, $req))
      { $dsp->dsp_line(get_string('V_Started', $nod))
          if _rda($ctl, $nod, '-vBXRda', 1) == 0 && $dsp;
      }
      $ctl->delete_object;
    }
    };
  return $req->reply($@, 'Start');
}

=head2 REMOTE.STOP - Stop command

This command stops the background collection on the specified nodes.

It supports the following attributes:

=over 13

=item B<  all>

When true, treats all nodes (false by default).

=item B<  nodes>

Provides the list of nodes to treat.

=back

=cut

sub _do_stop
{ my ($slf, $req) = @_;
  my ($col, $ctl, $def, $dsp);

  eval {
    $col = $slf->{'_col'};
    if ($def = $col->find('REMOTE'))
    { $ctl = $col->get_remote->new($col);
      $dsp = $slf->{'_dsp'};
      foreach my $nod (_get_nodes($def, $req))
      { $dsp->dsp_line(get_string('V_Stopped', $nod))
          if _rda($ctl, $nod, '-vHXRda', 1) == 0 && $dsp;
      }
      $ctl->delete_object;
    }
    };
  return $req->reply($@, 'Stop');
}

=head2 REMOTE.SUSPEND - Suspend command

This command suspends the remote collection by putting the current step in an
error state. This action is only performed for nodes where the collection is
not completed. You can enable the remote collection again by using a
C<REMOTE.RETRY> command.

It supports the following attributes:

=over 13

=item B<  all>

When true, suspends all nodes (false by default).

=item B<  nodes>

Provides the list of nodes to suspend.

=back

=cut

sub _do_suspend
{ my ($slf, $req) = @_;
  my ($sta);

  eval {
    $sta = _adapt_step($slf, $req,
      {I => 'i', N => 'n', P => 'p', R => 'r', T => 't'},
      $slf->{'_dsp'}
        ? {i => 'Suspend',
           n => 'Suspend',
           p => 'Suspend',
           r => 'Suspend',
           t => 'Suspend'}  # Text:Suspend
        : undef);
    };
  return $req->reply($@, 'Suspend', status => $sta);
}

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

# Adapt node steps
sub _adapt_step
{ my ($slf, $req, $chg, $dsc) = @_;
  my ($col, $def, $key, $sta, $stp);

  $col = $slf->{'_col'};
  $sta = [] if $dsc;
  if ($def = $col->find('REMOTE'))
  { # Recover step information from aborted sessions
    $slf->{'_rem'}->end_steps if $slf->{'_rem'}->init_steps(1);

    # Update the node status
    if (ref($chg))
    { foreach my $nod (_get_nodes($def, $req))
      { $key = "$nod.T_STEP";
        next unless exists($chg->{$stp = $def->get_first($key, q{?})});
        $def->set_value($key, $stp = $chg->{$stp});
        push(@{$sta}, $nod.q{|}.get_string($dsc->{$stp})) if $dsc;
      }
    }
    else
    { foreach my $nod (_get_nodes($def, $req))
      { $key = "$nod.T_STEP";
        next unless defined($def->get_first($key));
        $def->set_value($key, $chg);
        push(@{$sta}, $nod.q{|}.get_string($dsc)) if $dsc;
      }
    }

    # Save the result set definition
    $col->save;
  }

  # Return modified statuses
  return $sta;
}

# Get the node list
sub _get_nodes
{ my ($def, $req) = @_;
  my ($nod, @err, @nod);

  # Detect if it is applicable to all nodes
  return ($def->grep('^T_HOSTNAME$','or'))
    if $req->get_first('all');

  # Validate specified nodes
  foreach my $nod ($req->get_value('nodes'))
  { if ($nod =~ m/^((\w+\.)*\w+)$/ && $def->is_defined("$1.T_HOSTNAME"))
    { push(@nod, $1);
    }
    else
    { push(@err, $1)
    }
  }
  die get_string('BAD_NODES', join(', ',@err)) if @err;
  return @nod;
}

# Execute RDA
sub _rda
{ my ($ctl, $nod, $opt, $flg) = @_;
  my ($ret);

  $ret = ($ctl->is_remote($nod)
    ? $ctl->get_session($nod, 1)
    : $ctl->add_local($nod))->rda($opt, $flg);
  $ctl->end_session($nod);
  return $ret;
}

# Execute a remote command
sub _rexec
{ my ($ctl, $nod, $cmd, $flg) = @_;
  my ($lim, $ret);

  # Execute the remote request
  $lim = $ctl->get_info('lim');
  $ret = -1;
  eval {
    local $SIG{'__WARN__'} = sub {};
    local $SIG{'ALRM'}     = sub { die "$ALR\n" } if $lim;
    local $SIG{'PIPE'}     = sub { die "$ALR\n" } if $lim;

    set_alarm($lim) if $lim;
    $ret = $ctl->get_session($nod, 1)->command($cmd, $flg);
    clear_alarm() if $lim;
    $ctl->end_session($nod);
    };

  # Propagate errors
  if ($@ && $@ !~ m/^$ALR\n/)
  { clear_alarm() if $lim;
    die $@;
  }

  # Return the command result
  return $ret;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Alarm|RDA::Alarm>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Display|RDA::Object::Display>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Remote|RDA::Object::Remote>,
L<RDA::SDCL::Language|RDA::SDCL::Language>,
L<RDA::Request::DISPLAY|RDA::Request::DISPLAY>,
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