# Remote.pm: Class Used for Managing Remote Requests

package RDA::Object::Remote;

# $Id: Remote.pm,v 1.39 2015/08/03 00:38:58 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object/Remote.pm,v 1.39 2015/08/03 00:38:58 RDA Exp $
#
# Change History
# 20150803  MSC  Extend the SDCL interface.

=head1 NAME

RDA::Object::Remote - Class Used for Managing Remote Requests

=head1 SYNOPSIS

 require RDA::Object::Remote;

=head1 DESCRIPTION

The objects of the C<RDA::Object::Remote> class are used for managing remote
requests.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::Handle;
  use IO::File;
  use RDA::Text qw(debug get_string);
  use RDA::Alarm qw(check_alarm);
  use RDA::Driver::Sgml;
  use RDA::Local::Unix;
  use RDA::Object::Buffer;
  use RDA::Object::Item;
  use RDA::Object::Java;
  use RDA::Object::Rda qw($APPEND $FIL_PERMS);
  use RDA::Object::View;
  use RDA::Value::List;
  use RDA::Value::Scalar qw(new_number new_object new_text new_undef);
}

# Define the global public variables
use vars qw($AUTOLOAD $STRINGS $VERSION @DELETE @DUMP @ISA %SDCL);
$VERSION = sprintf('%d.%02d', q$Revision: 1.39 $ =~ /(\d+)\.(\d+)/);
@DELETE  = qw(_drv _lck _mgr _ses);
@DUMP    = (
  hsh => {'RDA::Object::Remote' => 1,
          'RDA::Driver::Da'     => 1,
          'RDA::Driver::Jsch'   => 1,
          'RDA::Driver::Local'  => 1,
          'RDA::Driver::Rsh'    => 1,
          'RDA::Driver::Ssh'    => 1,
         },
  );
@ISA     = qw(RDA::Object Exporter);
%SDCL    = (
  als => {
    ## no critic (Interpolation)
    'addLocalSession'   => ['$[REM]', 'add_local'],
    'addRemoteSession'  => ['$[REM]', 'add_remote'],
    'clearRemoteBuffer' => ['$[REM]', 'clear_buffer'],
    'clearRemoteGroup'  => ['$[REM]', 'clear_group'],
    'endRemoteSession'  => ['$[REM]', 'end_session'],
    'endSteps'          => ['$[REM]', 'end_steps'],
    'genRemoteSetup'    => ['$[REM]', 'gen_setup'],
    'getRemoteBuffer'   => ['$[REM]', 'get_buffer'],
    'getRemoteGroup'    => ['$[REM]', 'get_group'],
    'getRemoteSession'  => ['$[REM]', 'get_session'],
    'getRemoteSetup'    => ['$[REM]', 'get_setup'],
    'getRemoteTimeout'  => ['$[REM]', 'get_timeout'],
    'getStep'           => ['$[REM]', 'get_step'],
    'initSteps'         => ['$[REM]', 'init_steps'],
    'isRemote'          => ['$[REM]', 'is_remote'],
    'loadRemoteSetup'   => ['$[REM]', 'load_setup'],
    'setRemoteTimeout'  => ['$[REM]', 'set_timeout'],
    'setRemoteTrace'    => ['$[REM]', 'set_trace'],
    'setStep'           => ['$[REM]', 'set_step'],
    'writeRemoteResult' => ['$[REM]', 'write_result'],
    },
  beg => \&_begin_remote,
  dep => [qw(RDA::Object::Java)],
  end => \&_end_remote,
  inc => [qw(RDA::Object)],
  met => {
    'add_local'     => {ret => 0},
    'add_remote'    => {ret => 0},
    'basename'      => {ret => 0},
    'cat_dir'       => {ret => 0},
    'cat_file'      => {ret => 0},
    'clean_path'    => {ret => 0},
    'current_dir'   => {ret => 0},
    'dev_null'      => {ret => 0},
    'dev_tty'       => {ret => 0},
    'dirname'       => {ret => 0},
    'can_use'       => {ret => 0},
    'choose'        => {ret => 0},
    'clear_buffer'  => {ret => 0},
    'clear_group'   => {ret => 0},
    'close'         => {ret => 0},
    'collect'       => {ret => 0},
    'command'       => {ret => 0},
    'end_session'   => {ret => 0},
    'end_steps'     => {ret => 0, blk => 1},
    'execute'       => {ret => 0},
    'gen_setup'     => {ret => 0},
    'get'           => {ret => 0},
    'get_api'       => {ret => 0},
    'get_buffer'    => {ret => 0},
    'get_group'     => {ret => 1},
    'get_hit'       => {ret => 0},
    'get_info'      => {ret => 0},
    'get_input'     => {ret => 0},
    'get_lines'     => {ret => 1},
    'get_session'   => {ret => 0},
    'get_shlib'     => {ret => 0},
    'get_step'      => {ret => 0},
    'get_message'   => {ret => 0},
    'get_separator' => {ret => 0},
    'get_session'   => {ret => 0},
    'get_setup'     => {ret => 0},
    'get_timeout'   => {ret => 0},
    'get_type'      => {ret => 0},
    'has_agent'     => {ret => 0},
    'has_short'     => {ret => 0},
    'init_steps'    => {ret => 0},
    'is_absolute'   => {ret => 0},
    'is_cygwin'     => {ret => 0},
    'is_path'       => {ret => 0},
    'is_remote'     => {ret => 0},
    'is_unix'       => {ret => 0},
    'is_vms'        => {ret => 0},
    'is_windows'    => {ret => 0},
    'load_setup'    => {ret => 0},
    'login'         => {ret => 0},
    'logout'        => {ret => 0},
    'mget'          => {ret => 0},
    'mput'          => {ret => 0},
    'need_password' => {ret => 0},
    'need_pause'    => {ret => 0},
    'open'          => {ret => 0},
    'parse_path'    => {ret => 1},
    'put'           => {ret => 0},
    'quote'         => {ret => 0},
    'quote2'        => {ret => 0},
    're'            => {ret => 0},
    'request'       => {ret => 0, blk => 1},
    'set_agent'     => {ret => 0},
    'set_default'   => {ret => 0},
    'set_step'      => {ret => 0},
    'set_timeout'   => {ret => 0},
    'set_trace'     => {ret => 0},
    'set_type'      => {ret => 0},
    'split_dir'     => {ret => 1},
    'split_volume'  => {ret => 1},
    'unquote'       => {ret => 0},
    'up_dir'        => {ret => 0},
    'write_result'  => {ret => 0, blk => 1},
    },
  top => 'REM',
  );

# Define the global private constants
my $OUT = qr{timeout};
my $TOP = "[[#Top][Back to top]]\n";
my $WRK = 'remote.tmp';

my $TEST_BEG_PAT = '1 if ($slf->{"_buf"} =~ ';  ## no critic (Interpolation)
my $TEST_END_PAT = q{)};

# Define the global private variables
my @tb_loc = qw(da jsch);
my @tb_rem = qw(da jsch ssh);
my %tb_cap = (
  da   => ['RDA::Driver::Da',   'REMOTE.B_NO_DA'],
  jsch => ['RDA::Driver::Jsch', 'REMOTE.B_NO_JSCH'],
  ssh  => ['RDA::Driver::Ssh',  'REMOTE.B_NO_SSH'],
  rsh  => ['RDA::Driver::Rsh',  'REMOTE.B_NO_RSH'],
  );
my %tb_set = (
  T_STEP    => 'Remote node execution step',
  W_STORAGE => 'Remote node storage type',
  );

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

=head2 S<$h = RDA::Object::Remote-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($package)>

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

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

=over 12

=item S<    B<'agt' > > Reference to the agent object (L,M,S,T)

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

=item S<    B<'lim' > > Execution time limit (in sec) (L,M,S)

=item S<    B<'lvl' > > Trace level (L,M,S,T)

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

=item S<    B<'oid' > > Object identifier (L,M,S,T)

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

=item S<    B<'par' > > Reference to the session manager object (M)

=item S<    B<'pkg' > > Reference to the package object (M)

=item S<    B<'skp' > > Skip indicator (L,S)

=item S<    B<'_buf'> > Buffer hash (M)

=item S<    B<'_cfg'> > Reference to the software configuration object (L,M,S,T)

=item S<    B<'_dft'> > Default driver list (L,S)

=item S<    B<'_drv'> > Reference to the driver object (L,S)

=item S<    B<'_err'> > Number of remote requests in error (L,M,S)

=item S<    B<'_fam'> > Operating system family of the remote host (L,S)

=item S<    B<'_hst'> > Host (C<localhost> by default) (L,S)

=item S<    B<'_lck'> > Reference to the lock control object (M)

=item S<    B<'_lfp'> > Lock file path (M)

=item S<    B<'_lnm'> > Lock name (M)

=item S<    B<'_mgr'> > Driver manager hash (T)

=item S<    B<'_out'> > Number of remote requests timed out (L,M,S)

=item S<    B<'_pre'> > Trace prefix (L,S)

=item S<    B<'_pwd'> > Reference to the access control object (M)

=item S<    B<'_req'> > Number of remote requests (L,M,S)

=item S<    B<'_rlg'> > Remote log file path (L,T)

=item S<    B<'_rfh'> > Remote log file handle (L,T)

=item S<    B<'_seq'> > Session sequencer (M)

=item S<    B<'_ses'> > Remote session hash (M)

=item S<    B<'_shl'> > Remote shell (C</bin/sh> by default) (L,S)

=item S<    B<'_skp'> > Number of remote requests skipped (L,M,S)

=item S<    B<'_ssh'> > Authentication agent indicator (T)

=item S<    B<'_stp'> > Step hash (L,T)

=item S<    B<'_typ'> > Object type (L,M,S,T)

=item S<    B<'_usr'> > Login user (L,M,S,T)

=item S<    B<'_var'> > Variable group hash (M)

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $arg) = @_;
  my ($col, $slf, $val);

  # Create the object
  if (ref($cls))
  { # Create the remote session manager object
    $col = $cls->{'col'};
    $slf = bless {
      agt  => $col->get_agent,
      col  => $col,
      lim  => check_alarm($col->get_first('REMOTE.N_TIMEOUT', 30)),
      lvl  => $cls->{'lvl'},
      oid  => 'REM/'.$arg->get_oid,
      par  => $cls,
      pkg  => $arg,
      _buf => {},
      _cfg => $col->get_config,
      _err => 0,
      _out => 0,
      _req => 0,
      _seq => 0,
      _ses => {},
      _skp => 0,
      _typ => 'M',
      _usr => $cls->{'_usr'},
      _var => {},
      }, ref($cls);
  }
  else
  { # Create the remote access control object
    $slf = bless {
      agt  => $arg->get_agent,
      col  => $arg,
      lvl  => $arg->get_trace('REMOTE'),
      oid  => 'REM',
      _cfg => $arg->get_config,
      _mgr => {},
      _ssh => ($arg->get_first('REMOTE.B_NO_SSH_AGENT', 0) ||
               RDA::Object::Rda->is_vms ||
               RDA::Object::Rda->is_windows) ? -1 : 0,
      _typ => 'T',
      _usr => $arg->get_first('REMOTE.T_USER', q{}),
      }, $cls;
  }

  # Return the object reference
  return $slf;
}

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

This method terminates the remote operations.

=cut

sub delete_object
{ # Prepare the object deletion
  if ($_[0]->{'_typ'} eq 'M')
  { my ($use);

    # Close the remote log file
    $_[0]->{'_rfh'}->close if exists($_[0]->{'_rfh'});

    # Close open sessions
    $_[0]->end_session;

    # Get the statistics record
    $use = $_[0]->{'col'}->get_usage;
    $use->{'REM'} = {err => 0, not => q{}, out => 0, req => 0, skp => 0}
      unless exists($use->{'REM'});
    $use = $use->{'REM'};

    # Generate the module statistics
    $use->{'err'} += $_[0]->{'_err'};
    $use->{'out'} += $_[0]->{'_out'};
    $use->{'req'} += $_[0]->{'_req'};
    $use->{'skp'} += $_[0]->{'_skp'};
  }
  elsif ($_[0]->{'_typ'} eq 'T')
  { # Release any lock
    if (exists($_[0]->{'_lnm'}) && $_[0]->{'_lck'}->unlock($_[0]->{'_lnm'}, 1))
    { delete($_[0]->{'_lfn'});
      delete($_[0]->{'_lnm'});
    }

    # Kill the authentication agent
    if ($_[0]->{'_ssh'} > 0)
    { my $tmp = `ssh-agent -k 2>&1`;
      $_[0]->{'_ssh'} = 0;
    }
  }

  # Delete the object
  $_[0]->SUPER::delete_object;
  return;
}

=head1 REMOTE SESSION MANAGER METHODS

=head2 S<$h-E<gt>add_local($oid)>

This method adds a new local session.

=cut

sub add_local
{ my ($slf, $oid, $flg) = @_;
  my ($cfg, $col, $obj);

  # Validate the identifier
  $oid = $slf->get_unique($oid);

  # Clear any previous entry
  $slf->end_session($oid) if exists($slf->{'_ses'}->{$oid});

  # Define the session object
  $col = $slf->{'col'};
  $cfg = $col->get_config;
  $obj = bless {
    agt  => $slf->{'agt'},
    col  => $col,
    lim  => $slf->{'lim'},
    lvl  => $slf->{'lvl'},
    oid  => $oid,
    out  => 0,
    par  => $slf,
    skp  => 0,
    _cfg => $cfg,
    _err => 0,
    _fam => $cfg->get_family,
    _hst => 'localhost',
    _out => 0,
    _pre => "LOC($oid)",
    _usr => $slf->{'_usr'},
    _req => 0,
    _shl => $col->get_first('REMOTE.T_SHELL', '/bin/sh'),
    _skp => 0,
    _typ => 'L',
    }, __PACKAGE__;

  # Add the driver
  if ($flg)
  { $obj->{'_dft'} = [@tb_loc];
  }
  else
  { $obj->{'_drv'} = _get_local($slf)->new($obj);
  }

  # Return the session object reference
  return $slf->{'_ses'}->{$oid} = $obj;
}

=head2 S<$h-E<gt>add_remote($oid[,$host[,$user[,$password]]])>

This method adds a new remote session.

=cut

sub add_remote
{ my ($slf, $oid, $hst, $usr, $pwd) = @_;
  my ($col, $obj);

  # Validate the identifier
  $oid = $slf->get_unique($oid);

  # Clear any previous entry
  $slf->end_session($oid) if exists($slf->{'_ses'}->{$oid});

  # Define the session object
  $col = $slf->{'col'};
  $hst = $col->get_first("REMOTE.$oid.T_HOSTNAME", 'localhost')
    unless defined($hst = RDA::Object::View->is_host($hst, 1));
  $obj = bless {
    agt  => $slf->{'agt'},
    col  => $col,
    lim  => $slf->{'lim'},
    lvl  => $slf->{'lvl'},
    oid  => $oid,
    out  => 0,
    par  => $slf,
    skp  => 0,
    _dft => [@tb_rem],
    _err => 0,
    _hst => $hst,
    _out => 0,
    _pre => "REM($oid)",
    _req => 0,
    _shl => $col->get_first('REMOTE.T_SHELL', '/bin/sh'),
    _skp => 0,
    _typ => 'S',
    }, __PACKAGE__;

  # Manage the credentials
  if (defined($usr))
  { $obj->{'_usr'} = $usr;
    $slf->_get_access->set_password('host', $hst, $usr, $pwd)
      if defined($pwd);
  }
  elsif (defined($usr = $col->get_first("REMOTE.$oid.T_USER")))
  { $obj->{'_usr'} = $usr;
  }
  else
  { $obj->{'_usr'} = $slf->{'_usr'};
  }

  # Return the session object reference
  return $slf->{'_ses'}->{$oid} = $obj;
}

=head2 S<$h-E<gt>can_use($type)>

This method indicates whether RDA can use the specified type.

=cut

sub can_use
{ my ($slf, $typ) = @_;

  return defined(shift->_get_manager($typ));
}

=head2 S<$h-E<gt>clear_buffer([$name,...])>

This method deletes the specified capture buffers. The capture buffer names are
not case sensitive. It deletes all capture buffers when called without
arguments.

=cut

sub clear_buffer
{ my ($slf, @arg) = @_;

  if (exists($slf->{'_buf'}))
  { if (@arg)
    { foreach my $nam (@arg)
      { delete($slf->{'_buf'}->{lc($nam)}) if defined($nam);
      }
    }
    else
    { $slf->{'_buf'} = {};
    }
  }
  return 0;
}

=head2 S<$h-E<gt>clear_group([$name,...])>

This method deletes the specified variable groups. The variable group names are
not case sensitive. It deletes all variable groups when called without
arguments.

=cut

sub clear_group
{ my ($slf, @arg) = @_;

  if (exists($slf->{'_var'}))
  { if (@arg)
    { foreach my $nam (@arg)
      { delete($slf->{'_var'}->{uc($nam)}) if defined($nam);
      }
    }
    else
    { $slf->{'_var'} = {};
    }
  }
  return 0;
}

=head2 S<$h-E<gt>end_session([$session...])>

This method ends the corresponding sessions. You can specify a session by its
object reference or its object identifier. When no sessions are specified, it
ends all sessions.

It returns the number of deleted sessions.

=cut

sub end_session
{ my ($slf, @arg) = @_;
  my ($cnt, $obj, $oid, $tbl);

  $cnt = 0;
  if (exists($slf->{'_ses'}))
  { $tbl = $slf->{'_ses'};
    if (@arg)
    { foreach my $arg (@arg)
      { $oid = ref($arg) ? $arg->get_oid : uc($arg);
        next unless defined($oid) && ($obj = delete($tbl->{$oid}));
        $slf->{'_err'} += $obj->{'_err'};
        $slf->{'_out'} += $obj->{'_out'};
        $slf->{'_req'} += $obj->{'_req'};
        $slf->{'_skp'} += $obj->{'_skp'};
        $obj->delete_object;
        ++$cnt;
      }
    }
    else
    { foreach my $oid (keys(%{$tbl}))
      { $obj = delete($tbl->{$oid});
        $slf->{'_err'} += $obj->{'_err'};
        $slf->{'_out'} += $obj->{'_out'};
        $slf->{'_req'} += $obj->{'_req'};
        $slf->{'_skp'} += $obj->{'_skp'};
        $obj->delete_object;
        ++$cnt;
      }
    }
  }
  elsif (exists($slf->{'par'}))
  { $cnt += $slf->{'par'}->end_session($slf);
  }
  return $cnt;
}

=head2 S<$h-E<gt>get_buffer([$name[,$flag]])>

This method returns the specified capture buffer or undefined value when the
name is undefined. The capture buffer names are not case sensitive. Unless the
flag is set, it assumes Wiki data.

=cut

sub get_buffer
{ my ($slf, $nam, $flg) = @_;

  return defined($nam)
    && exists($slf->{'_buf'}) && exists($slf->{'_buf'}->{$nam = lc($nam)})
    ? RDA::Object::Buffer->new($flg ? 'L' : 'l', $slf->{'_buf'}->{$nam})
    : undef;
}

=head2 S<$h-E<gt>get_group($name)>

This method returns the specified variable group as a list. The variable group
names are not case sensitive.

=cut

sub get_group
{ my ($slf, $nam) = @_;

  return () unless defined($nam)
    && exists($slf->{'_var'}) && exists($slf->{'_var'}->{$nam = uc($nam)});
  return (%{$slf->{'_var'}->{$nam}});
}

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

This method returns the path of the lock file. On the first call, it takes an
exclusive lock on the file to indicate that the process is alive.

=cut

sub get_lock
{ my ($slf) = @_;
  my ($agt, $dir, $lck, $nam);

  $slf = $slf->get_top;
  unless (exists($slf->{'_lfp'}))
  { $slf->{'_lfp'} = undef;
    $agt = $slf->{'agt'};
    $dir = $slf->{'_cfg'}->get_group('D_CWD') unless defined($dir =
      RDA::Object::Rda->is_path($agt->get_env('RDA_LOCK'))) && -d $dir;
    eval {
      require RDA::Object::Lock;
      $slf->{'_lck'} = $lck = RDA::Object::Lock->new($agt, $dir);
      if ($lck->lock($nam = '-R-'.$agt->get_oid, 1))
      { $slf->{'_lfp'} = $lck->get_file($nam);
        $slf->{'_lnm'} = $nam;
      }
      };
  }
  return $slf->{'_lfp'};
}

=head2 S<$h-E<gt>get_session($oid[,$flag])>

This method returns a reference to the corresponding session. When the flag is
set, it created missing session automatically. It returns an undefined value
when the session does not exist.

=cut

sub get_session
{ my ($slf, $oid, $flg) = @_;

  return
    !defined($oid)                            ? undef :
    !exists($slf->{'_ses'})                   ? undef :
    exists($slf->{'_ses'}->{$oid = uc($oid)}) ? $slf->{'_ses'}->{$oid} :
    $flg                                      ? $slf->add_remote($oid) :
                                                undef;
}

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

This method returns the current duration of the timeout for executing remote
commands. When this mechanism is disabled, it returns 0.

=head2 S<$h-E<gt>get_unique($oid)>

This method replaces the C<$$> string in the session identifier by a sequence
number. It takes care that the resulting identifier is not currently used.

=cut

sub get_unique
{ my ($slf, $oid) = @_;
  my ($pat, $seq, $uid);

  # Detect a variable identifier
  die get_string('NOT_MANAGER')
    unless $slf->{'_typ'} eq 'M';
  die get_string('NO_ID')
    unless defined($oid);
  $pat = uc($oid);
  die get_string('BAD_ID', $pat)
    unless $pat =~ m/^[A-Z][A-Z\d_]*(\$\$)?$/;
  return $pat unless $1;

  # Make it unique
  do
  { $uid = $pat;
    $seq = ++$slf->{'_seq'};
    $uid =~ s/\$\$/$seq/;
  } while exists($slf->{'_ses'}->{$uid});
  return $uid;
}

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

This method indicates whether an authentication agent is available.

=cut

sub has_agent
{ return defined(shift->{'col'}->get_agent->get_system('SSH_AUTH_SOCK'));
}

=head2 S<$h-E<gt>is_remote($node)>

This method indicates if the specified node is a remote one.

=cut

sub is_remote
{ my ($slf, $nod) = @_;
  my ($cfg, $col, $hst);

  $col = $slf->{'col'};
  $cfg = $col->get_config;
  $hst = $col->get_first("REMOTE.$nod.T_HOSTNAME", 'localhost');

  return
    $hst ne 'localhost' &&
    $hst ne 'localhost.localdomain' &&
    $hst ne $cfg->get_node &&
    $hst ne $cfg->get_host;
}

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

This method resets the object for its new environment to allow a thread-save
execution.

=cut

sub reset  ## no critic (Builtin)
{ my ($slf) = @_;

  $slf->{'_ses'} = {} if exists($slf->{'_ses'});
  return;
}

=head2 S<$h-E<gt>resume([$fork])>

This method resumes previous remote activities. It returns the object
reference.

=cut

sub resume
{ my ($slf, $frk) = @_;
  my ($bkp);

  die get_string('NO_BACKUP') unless ref($bkp = delete($slf->{'_bkp'}));

  # Close the remote log file
  if ($frk && exists($slf->{'_rfh'}))
  { delete($slf->{'_rfh'})->close;
    delete($slf->{'_rlg'});
    delete($slf->{'_stp'});
  }

  # Close remote sessions
  $slf->end_session;

  # Restore the original definitions
  foreach my $key (keys(%{$bkp}))
  { $slf->{$key} = $bkp->{$key};
  }

  # Return the object reference
  return $slf;
}

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

This method forces the initialization of the authentication agent. It returns
the authentication agent status.

=cut

sub set_agent
{ my ($slf) = @_;
  my ($key, $val, $sys);

  $slf = $slf->get_top;
  return $slf->{'_ssh'} if $slf->{'_ssh'};

  # Check if an authentication agent must be started
  $sys = $slf->{'col'}->get_agent->get_system;
  return $slf->{'_ssh'} = -1
    if $slf->{'col'}->get_first('REMOTE.B_NO_SSH_AGENT')
    || defined($sys->get_value('SSH_AUTH_SOCK'))
    || defined($sys->get_value('SSH_AGENT_PID'));

  # Create an authentication agent
  foreach my $lin (`ssh-agent -s 2>/dev/null`)
  { next unless $lin =~ m/ export /;
    ($key, $val) = split(/[=;]/, $lin, 3);
    $sys->set_value($key, $val);
  }
  return $slf->{'_ssh'} = -1 if $?;

  # Add RSA or DSA identities to the authentication agent
  `ssh-add 2>/dev/null`;
  return $slf->{'_ssh'} = 1;
}

=head2 S<$h-E<gt>set_family($family)>

This method stores the family of the remote host.

=cut

sub set_family
{ my ($slf, $fam) = @_;

  # Adjust the control object for operating system-specific methods
  if (defined($fam))
  { eval "require RDA::Local::$fam";
    die get_string('ERR_REQUIRE', "RDA::Local::$fam", $@) if $@;
    $slf->{'_cfg'} = bless {}, "RDA::Local::$fam";
    $slf->{'_fam'} = $fam;
  }

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>set_timeout($limit)>

This method sets the timeout for the session, specified in seconds, only if the
value is strictly positive. Otherwise, it disables the timeout mechanism. It is
disabled also if the C<alarm> function is not implemented.

It returns the effective value.

=head2 S<$h-E<gt>set_trace([$level])>

This method sets the remote trace level:

=over 7

=item B<    0 > Disables the remote trace.

=item B<    1 > Traces the remote command execution.

=back

The level is unchanged if the new level is not defined.

It returns the previous level.

=head2 S<$h-E<gt>suspend([$fork]>

This method suspends current remote activities.

=cut

sub suspend
{ my ($slf, $frk) = @_;

  # Backup the current operations
  $slf->{'_bkp'} = $frk
    ? {}
    : {_buf => delete($slf->{'_buf'}),
       _ses => delete($slf->{'_ses'}),
       _var => delete($slf->{'_var'}),
      };

  # Reset the control object
  $slf->{'_buf'} = {};
  $slf->{'_ses'} = {};
  $slf->{'_var'} = {};

  # Return the object reference
  return $slf;
}

=head1 REMOTE SESSION METHODS

=head2 S<$h-E<gt>choose($input,$password[,$request])>

This method performs a device access by waiting for a input prompt and
responding with the specified input value, then waiting for the password prompt
and responding with the specified password, and finally waiting for the command
interpreter prompt.

The input prompt must match this case insensitive pattern:

    /input[: ]*$/i

The password prompt must match this case insensitive pattern:

    /password[: ]*$/i

The current prompt pattern must match the command interpreter prompt.

When any of those prompts sent by the remote side do not match what is
expected, this method will time out, unless the timeout mechanism is disabled.

To alter temporarily some object attributes, you can specify a hash reference
as an argument. It supports following keys:

=over 11

=item S<    B<'chk'> > Banner check pattern

=item S<    B<'dis'> > Disconnection command

=item S<    B<'flg'> > Input capture indicator (false per default)

=item S<    B<'hit'> > Last prompt capture indicator (false by default)

=item S<    B<'inp'> > Input string (C<0> per default)

=item S<    B<'lim'> > Execution time limit

=item S<    B<'pat'> > Prompt pattern

=item S<    B<'plf'> > Prompt line indicator (false by default)

=item S<    B<'pwd'> > User password

=item S<    B<'try'> > Maximum number of login attempts (2 per default)

=item S<    B<'usr'> > Associated user name (C<[input]> by default)

=back

It returns the object reference on successful completion. Otherwise, it stores
the error message and returns an undefined value.

=head2 S<$h-E<gt>choose($request)>

Since you can specify the input string and password in the request hash, you
can omit the two first arguments when specifying a request argument.

=cut

sub choose  ## no critic (Complex)
{ my ($slf, $inp, $pwd, $def) = @_;
  my ($acc, $drv, $flg, $hit, $hst, $plf, $ref, $usr, $val, %var);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Abort when no driver is available
  unless ($drv = get_driver($slf, 1))
  { ++$slf->{'_err'};
    return -1;
  }

  # Analyze the request
  if ($ref = ref($inp))
  { $def = $inp;
    $inp = '0';
    $pwd = undef;
  }
  elsif ($ref = ref($pwd))
  { $def = $pwd;
    $pwd = undef;
  }
  else
  { $ref = ref($def);
  }
  $hst = $slf->{'_hst'};
  $usr = '[input]';

  $var{'LIM'} = $slf->{'lim'} if $slf->{'lim'};
  if ($ref eq 'HASH')
  { foreach my $key (keys(%{$def}))
    { if ($key eq 'chk')
      { $var{'CHK'} = $val if defined($val = _parse_prompt($def->{$key}));
      }
      elsif ($key eq 'dis')
      { $var{'DIS'} = $val if defined($val = $def->{$key}) && $val =~ m/^\w/;
      }
      elsif ($key eq 'flg')
      { $flg = $def->{$key};
      }
      elsif ($key eq 'hit')
      { $hit = $def->{$key};
      }
      elsif ($key eq 'inp')
      { $inp = $def->{$key} if defined($def->{$key});
      }
      elsif ($key eq 'lim')
      { $var{'LIM'} = $val if defined($val = _parse_timeout($def->{$key}));
      }
      elsif ($key eq 'pat')
      { $var{'PAT'} = $val if defined($val = _parse_prompt($def->{$key}));
      }
      elsif ($key eq 'plf')
      { $plf = $def->{$key};
      }
      elsif ($key eq 'pwd')
      { $pwd = $def->{$key} if defined($def->{$key});
      }
      elsif ($key eq 'try')
      { $var{'TRY'} = $val
          if defined($val = $def->{$key}) && $val =~ m/^\d+$/;
      }
      elsif ($key eq 'usr')
      { $usr = $def->{$key} if defined($def->{$key});
      }
    }
  }
  $acc = $slf->{'par'}->_get_access;
  $var{'FLG'} = 1 if $flg;
  $var{'HIT'} = 1 if $hit;
  $var{'HST'} = $hst;
  $var{'PLF'} = 1 if $plf;
  $var{'STA'} = 1;
  $var{'INP'} = $inp;
  $var{'PWD'} = $pwd
    if defined($pwd = defined($pwd)
                        ? $acc->set_password('host', $hst, $usr, $pwd) :
                      $acc->has_password('host', $hst, $usr)
                        ? $acc->get_password('host', $hst, $usr) :
                      undef);

  # Execute the request
  return _update_status($slf, $drv->request('CHOOSE', {%var})) ? undef : $slf;
}

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

This method closes the communication channel with the remote host. It returns
the object reference.

=cut

sub close  ## no critic (Ambiguous,Builtin)
{ my ($slf) = @_;
  my ($drv);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Execute the request when a driver is available
  if ($drv = get_driver($slf, 1))
  { _update_status($slf, $drv->request('CLOSE',
      $slf->{'lim'} ? {LIM => $slf->{'lim'}, STA => 1} : {STA => 1}));
  }
  else
  { ++$slf->{'_err'};
  }

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>collect($report,$command)>

This method sends the specified command and includes in the report the
characters sent back by the command.

=head2 S<$h-E<gt>collect($report,$definition)>

To alter temporarily some object attributes, you can specify a hash reference
as the argument. It supports following keys:

=over 11

=item S<    B<'ack'> > Acknowledge string (a line feed by default)

=item S<    B<'cln'> > Line cleanup indicator (true by default)

=item S<    B<'cmd'> > Command to execute

=item S<    B<'fix'> > Fix mode (false by default)

=item S<    B<'hit'> > Last prompt capture indicator (false by default)

=item S<    B<'max'> > Maximum command execution time

=item S<    B<'nxt'> > Continuation pattern(s)

=item S<    B<'pat'> > Prompt pattern

=item S<    B<'skp'> > Skip mode

=back

=cut

sub collect  ## no critic (Complex)
{ my ($slf, $rpt, $def, $inc) = @_;
  my ($drv, $fix, $hit, $ref, $val, @msk, @pwd, %var);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Abort when no driver is available
  unless ($drv = get_driver($slf, 1))
  { ++$slf->{'_err'};
    return -1;
  }

  # Analyze the request
  $var{'COL'} = $rpt;
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = $val if ($val = _get_alarm($slf, $inc));
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'STA'} = 1;
  $var{'TMP'} = 1;
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  $ref = ref($def);
  if ($ref eq 'HASH')
  { foreach my $key (keys(%{$def}))
    { if ($key eq 'ack')
      { $var{'ACK'} = $val
          if defined($val = _parse_string($def->{$key}, 1));
      }
      elsif ($key eq 'awp')
      { if (ref($val = $def->{$key}) eq 'ARRAY')
        { ($val, @pwd) = @{$val};
          $var{'ACK'} =
            sprintf($val, $slf->{'par'}->_get_access->get_password(@pwd));
        }
        else
        { $var{'ACK'} = $val;
        }
        push(@msk,'ACK');
      }
      elsif ($key eq 'cln')
      { $var{'CLN'} = $def->{$key};
      }
      elsif ($key eq 'cmd')
      { $var{'CMD'} = (ref($val = $def->{$key}) eq 'ARRAY')
          ? join(q{ }, @{$val})
          : $val;
      }
      elsif ($key eq 'cwp')
      { if (ref($val = $def->{$key}) eq 'ARRAY')
        { ($val, @pwd) = @{$val};
          $var{'CMD'} =
            sprintf($val, $slf->{'par'}->_get_access->get_password(@pwd));
        }
        else
        { $var{'CMD'} = $val;
        }
        push(@msk,'CMD');
      }
      elsif ($key eq 'fix')
      { $fix = $def->{$key};
      }
      elsif ($key eq 'hit')
      { $hit = $def->{$key};
      }
      elsif ($key eq 'max')
      { $var{'LIM'} = $val
          if defined($val = _parse_timeout($def->{$key}));
      }
      elsif ($key eq 'nxt')
      { $var{'NXT'} = $val
          if defined($val = _parse_next($def->{$key}, qq{\n}));
      }
      elsif ($key eq 'nwp')
      { $var{'NXT'} = $val
          if defined($val = _parse_next($def->{$key}, qq{\n},
                                        $slf->{'par'}->_get_access));
        push(@msk,'NXT');
      }
      elsif ($key eq 'pat')
      { $var{'PAT'} = $val
          if defined($val = _parse_prompt($def->{$key}));
      }
      elsif ($key eq 'skp')
      { $var{'SKP'} = $val
          if defined($val = _parse_skip_mode($def->{$key}));
      }
    }
  }
  elsif ($ref eq 'ARRAY')
  { $var{'CMD'} = join(q{ }, @{$def});
  }
  elsif ($ref)
  { return -2;
  }
  else
  { $var{'CMD'} = $def;
  }
  return -3 unless exists($var{'CMD'});
  $var{'FIX'} = 1 if $fix;
  $var{'HIT'} = 1 if $hit;
  $var{'MSK'} = join(q{|},'PPH|PWD', @msk) if @msk;

  # Execute the request
  return _update_status($slf, $drv->request('COLLECT', {%var}));
}

=head2 S<$h-E<gt>command($command[,$flag])>

This method executes the specified command on a remote node. There is no attempt
to treat the request differently if the remote node is the local node. When the
flag is set, it captures all output lines.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=head2 S<$h-E<gt>command($definition[,$flag])>

To alter temporarily some object attributes, you can specify a hash reference
as the argument. It supports following keys:

=over 11

=item S<    B<'cmd'> > Command to execute

=item S<    B<'inp'> > Input string

=item S<    B<'max'> > Maximum command execution time

=item S<    B<'new'> > When present, executes the command with a new connection

=back

=cut

sub command  ## no critic (Complex)
{ my ($slf, $def, $flg, $inc) = @_;
  my ($drv, $ref, $val, @dat, @msk, @pwd, %var);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Abort when no driver is available
  unless ($drv = get_driver($slf, 1))
  { ++$slf->{'_err'};
    return -1;
  }

  # Parse the command definition
  $var{'FLG'} = $flg;
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = $val if ($val = _get_alarm($slf, $inc));
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'STA'} = 1;
  $var{'TMP'} = 1;
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  $ref = ref($def);
  if ($ref eq 'HASH')
  { foreach my $key (keys(%{$def}))
    { if ($key eq 'cmd')
      { $var{'CMD'} = (ref($val = $def->{$key}) eq 'ARRAY')
          ? join(q{ }, @{$val})
          : $val;
      }
      elsif ($key eq 'cwp')
      { if (ref($val = $def->{$key}) eq 'ARRAY')
        { ($val, @pwd) = @{$val};
          $var{'CMD'} =
            sprintf($val, $slf->{'par'}->_get_access->get_password(@pwd));
        }
        else
        { $var{'CMD'} = $val;
        }
        push(@msk,'CMD');
      }
      elsif ($key eq 'inp')
      { $ref = ref($val = $def->{$key});
        if ($ref eq 'ARRAY')
        { push(@dat, @{$val});
        }
        elsif (!$ref && defined($val))
        { push(@dat, $val);
        }
      }
      elsif ($key eq 'max')
      { $var{'LIM'} = $val
          if defined($val = _parse_timeout($def->{$key}));
      }
      elsif ($key eq 'new')
      { $var{'NEW'} = 1;
      }
      elsif ($key eq 'pwi')
      { @dat = $slf->{'par'}->_get_access->get_input($def->{$key});
      }
    }
  }
  elsif ($ref eq 'ARRAY')
  { $var{'CMD'} = join(q{ }, @{$def});
  }
  elsif ($ref)
  { return -2;
  }
  else
  { $var{'CMD'} = $def;
  }
  return -3 unless exists($var{'CMD'});
  $var{'MSK'} = join(q{|},'PPH|PWD', @msk) if @msk;

  # Execute the request
  return _update_status($slf, $drv->request('EXEC', {%var}, @dat));
}

=head2 S<$h-E<gt>execute($job,$file[,$inc])>

This method saves the output of the shell execution on the remote node in the
specified file.

It returns the command exit code when the request is executed. Otherwise, it
returns a negative value.

=cut

sub execute
{ my ($slf, $job, $fil, $inc, $add) = @_;
  my ($drv, $val, %var);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Abort when no driver is available
  unless ($drv = get_driver($slf, 1))
  { ++$slf->{'_err'};
    return -1;
  }

  # Skip empty job
  return -1 unless $job;

  # Execute the request
  $var{'CLR'} = 1 unless $add;
  $var{'CMD'} = $slf->{'_shl'};
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = $val if ($val = _get_alarm($slf, $inc));
  $var{'OUT'} = $fil;
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'STA'} = 1;
  $var{'TMP'} = 1;
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  return _update_status($slf, $drv->request('EXEC', {%var}, $job));
}

=head2 S<$h-E<gt>get($rdir,$rname[,$ldir[,$lname]])>

This method gets a single file from a remote node. By default, the same
directory and file name are assumed for the local destination. However, it
takes remote relative paths from the home directory, and local paths from the
working directory.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub get
{ my ($slf, $rdr, $rnm, $ldr, $lnm) = @_;
  my ($drv, $val, %var);

  return -2 unless $rdr && $rnm;

  # Abort when no driver is available
  return -1 unless ($drv = get_driver($slf, 1));

  # Execute the remote request
  $var{'DST'} = _gen_path($slf, defined($ldr) ? $ldr : $rdr, $lnm);
  $var{'FIL'} = _gen_path($slf, $rdr, $rnm);
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = 0;
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'STA'} = 1;
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  return _update_status($slf, $drv->request('GET', {%var}));
}

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

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

=cut

sub get_api
{ return get_driver(shift)->get_api;
}

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

This method returns the session driver.

=cut

sub get_driver
{ my ($slf, $flg) = @_;
  my ($ctl);

  # Return any previously defined driver
  return $slf->{'_drv'} if exists($slf->{'_drv'});

  # Allocate a driver
  die get_string('NOT_REMOTE') unless exists($slf->{'_dft'});
  foreach my $typ (@{$slf->{'_dft'}})
  { return $slf->{'_drv'} = $ctl->new($slf)
      if ($ctl = _get_manager($slf, $typ));
  }
  $slf->{'msg'} = get_string('ERR_EXEC');
  die $slf->{'msg'}.qq{\n} unless $flg;
  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 get_driver(shift)->get_hit;
}

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

This method returns the lines stored during the last command execution, as a
reference to a RDA buffer.

=cut

sub get_input
{ return RDA::Object::Buffer->new('L', [get_driver(shift)->get_lines]);
}

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

This method returns the lines stored during the last command execution, as a
list.

=cut

sub get_lines
{ return get_driver(shift)->get_lines;
}

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

This method returns the last message.

=cut

sub get_message
{ my ($slf) = @_;

  return exists($slf->{'msg'}) ? $slf->{'msg'} : undef;
}

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

This method returns the current duration of the timeout for executing remote
commands. When this mechanism is disabled, it returns 0.

=cut

sub get_timeout
{ return shift->{'lim'};
}

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

This method returns the session type. It returns an undefined value when a
driver is not yet associated to the session.

=cut

sub get_type
{ my ($slf) = @_;

  return exists($slf->{'_drv'}) ? $slf->{'_drv'}->as_type : undef;
}

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

This method indicates whether the last request encountered a timeout.

=cut

sub has_timeout
{ my ($slf) = @_;

  return exists($slf->{'out'}) ? $slf->{'out'} : undef;
}

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

This method creates a communication channel with a remote command. It returns
a process identifier when the communication is established. Otherwise, it
returns zero.

=cut

sub interconnect
{ my ($slf, $dsc, @arg) = @_;
  my ($drv, $val, %var);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Abort when no driver is available
  unless ($drv = get_driver($slf, 1))
  { ++$slf->{'_err'};
    return 0;
  }

  # Skip empty job
  return 0 unless ref($dsc->{'cmd'}) eq 'ARRAY';

  # Execute the request
  $var{'CLR'} = 1;
  $var{'CMD'} = $dsc->{'cmd'};
  $var{'HST'} = $slf->{'_hst'};
  $var{'LOC'} = $slf->{'_typ'} eq 'L';
  $var{'OPT'} = (ref($dsc->{'opt'}) eq 'ARRAY') ? $dsc->{'opt'} : [];
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  unless ($val = $drv->interconnect({%var}, @arg))
  { $slf->{'msg'} = $drv->get_message;
    ++$slf->{'_err'};
  }
  return $val;
}

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

This method indicates whether the last request was skipped.

=cut

sub is_skipped
{ my ($slf) = @_;

  return exists($slf->{'skp'}) ? $slf->{'skp'} : undef;
}

=head2 S<$h-E<gt>login($username,$password[,$request])>

This method performs a login by waiting for a login prompt and responding with
the specified user name, then waiting for the password prompt and responding
with the specified password, and finally waiting for the command interpreter
prompt.

The login prompt must match either of these case insensitive patterns:

    /login[: ]*$/i
    /username[: ]*$/i

The password prompt must match this case insensitive pattern:

    /password[: ]*$/i

The current prompt pattern must match the command interpreter prompt.

When any of those prompts sent by the remote side do not match what is
expected, this method will time out, unless the timeout mechanism is disabled.

To alter temporarily some object attributes, you can specify a hash reference
as an argument. It supports following keys:

=over 11

=item S<    B<'chk'> > Banner check pattern

=item S<    B<'dis'> > Disconnection command

=item S<    B<'flg'> > Input capture indicator (false per default)

=item S<    B<'hit'> > Last prompt capture indicator (false by default)

=item S<    B<'lim'> > Execution time limit

=item S<    B<'pat'> > Prompt pattern

=item S<    B<'plf'> > Prompt line indicator (false by default)

=item S<    B<'pwd'> > User password

=item S<    B<'try'> > Maximum number of login attempts (2 per default)

=item S<    B<'usr'> > User name

=back

It returns the object reference on successful completion. Otherwise, it stores
the error message and returns an undefined value.

=head2 S<$h-E<gt>login($request)>

Since you can specify the user name and password in the request hash, you can
omit the two first arguments when specifying a request argument.

=cut

sub login  ## no critic (Complex)
{ my ($slf, $usr, $pwd, $def) = @_;
  my ($acc, $drv, $flg, $hit, $hst, $plf, $ref, $val, %var);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Abort when no driver is available
  unless ($drv = get_driver($slf, 1))
  { ++$slf->{'_err'};
    return -1;
  }

  # Analyze the request
  if ($ref = ref($usr))
  { $def = $usr;
    $usr = $pwd = undef;
  }
  elsif ($ref = ref($pwd))
  { $def = $pwd;
    $pwd = undef;
  }
  else
  { $ref = ref($def);
  }
  $hst = $slf->{'_hst'};
  $usr = $slf->{'_usr'} unless defined($usr);

  $var{'LIM'} = $slf->{'lim'} if $slf->{'lim'};
  if ($ref eq 'HASH')
  { foreach my $key (keys(%{$def}))
    { if ($key eq 'chk')
      { $var{'CHK'} = $val if defined($val = _parse_prompt($def->{$key}));
      }
      elsif ($key eq 'dis')
      { $var{'DIS'} = $val if defined($val = $def->{$key}) && $val =~ m/^\w/;
      }
      elsif ($key eq 'flg')
      { $flg = $def->{$key};
      }
      elsif ($key eq 'hit')
      { $hit = $def->{$key};
      }
      elsif ($key eq 'lim')
      { $var{'LIM'} = $val if defined($val = _parse_timeout($def->{$key}));
      }
      elsif ($key eq 'pat')
      { $var{'PAT'} = $val if defined($val = _parse_prompt($def->{$key}));
      }
      elsif ($key eq 'plf')
      { $plf = $def->{$key};
      }
      elsif ($key eq 'pwd')
      { $pwd = $def->{$key} if defined($def->{$key});
      }
      elsif ($key eq 'try')
      { $var{'TRY'} = $val
          if defined($val = $def->{$key}) && $val =~ m/^\d+$/;
      }
      elsif ($key eq 'usr')
      { $usr = $def->{$key} if defined($def->{$key});
      }
    }
  }
  die get_string('NO_USER') unless length($usr);
  $acc = $slf->{'par'}->_get_access;
  $var{'FLG'} = 1 if $flg;
  $var{'HIT'} = 1 if $hit;
  $var{'HST'} = $hst;
  $var{'PLF'} = 1 if $plf;
  $var{'STA'} = 1;
  $var{'USR'} = $usr;
  $var{'PWD'} = $pwd
    if defined($pwd = defined($pwd)
                        ? $acc->set_password('host', $hst, $usr, $pwd) :
                      $acc->has_password('host', $hst, $usr)
                        ? $acc->get_password('host', $hst, $usr) :
                      undef);

  # Execute the request
  return _update_status($slf, $drv->request('LOGIN', {%var})) ? undef : $slf;
}

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

This method closes the connection with the remote host. It returns the object
reference.

=cut

sub logout
{ my ($slf) = @_;
  my ($drv);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Execute the request when a driver is available
  if ($drv = get_driver($slf, 1))
  { _update_status($slf, $drv->request('LOGOUT',
      $slf->{'lim'} ? {LIM => $slf->{'lim'}, STA => 1} : {STA => 1}));
  }
  else
  { ++$slf->{'_err'};
  }

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>mget($flag,$rdir[,$rname[,$ldir]])>

This method gets one or more files from a remote node. The name may contain
shell meta characters. By default, the same directory name is assumed for the
local destination. However, it takes remote relative paths from the home
directory and local paths from the working directory. If the flag is set, it
copies entire directories recursively.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub mget
{ my ($slf, $flg, $rdr, $pat, $ldr) = @_;
  my ($drv, $val, %var);

  return 0 unless $rdr;

  # Abort when no driver is available
  return -1 unless ($drv = get_driver($slf, 1));

  # Execute the remote request
  $var{'DIR'} = $rdr;
  $var{'DST'} = defined($ldr) ? $ldr : $rdr;
  $var{'FLG'} = 1 if $flg;
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = 0;
  $var{'PAT'} = $pat if defined($pat);
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'STA'} = 1;
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  return _update_status($slf, $drv->request('GET', {%var}));
}

=head2 S<$h-E<gt>mput($flag,$ldir[,$re[,$rdir]])>

This method puts one or more files into a remote node. You can use a regular
expression to select the files inside the local directory. By default, it
assumes the same directory name for the remote destination. However, it takes
remote relative paths from the home directory, and local paths from the working
directory. If the flag is set, it copies entire directories recursively.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub mput
{ my ($slf, $flg, $ldr, $pat, $rdr) = @_;
  my ($drv, $val, @src, %var);

  return -1 unless $ldr;

  # Determine the list of the files to copy
  if ($pat = RDA::Object::View->is_pattern($pat, undef, 1))
  { if (opendir(DIR, $ldr))
    { @src = grep {$_ =~ $pat && !m/^\.+$/} readdir(DIR);
      closedir(DIR)
    }
    return -2 unless (scalar @src);
    $var{'SRC'} = [ map
      {RDA::Object::Rda->cat_file($ldr, RDA::Object::Rda->is_path($_))}
      @src];
  }
  else
  { $var{'SRC'} = [$ldr];
  }

  # Abort when no driver is available
  return -1 unless ($drv = get_driver($slf, 1));

  # Execute the remote request
  $var{'FLG'} = 1 if $flg;
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = 0;
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'RDR'} = defined($rdr) ? $rdr : $ldr;
  $var{'STA'} = 1;
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  return _update_status($slf, $drv->request('PUT', {%var}));
}

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

This method indicates whether the current connection requires a password.

=cut

sub need_password
{ my ($slf, $inc) = @_;
  my ($drv, $ret);

  # Abort when no driver is available
  return 0 unless ($drv = get_driver($slf, 1));

  # Execute the request
  $slf->{'msg'} = $drv->get_message
    if ($ret = _need_password($slf, $drv, $inc));
  return $ret;
}

sub _need_password
{ my ($slf, $drv, $inc) = @_;
  my ($val, %var);

  # Execute the request
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = $val if ($val = _get_alarm($slf, $inc));
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  return $drv->need_password({%var});
}

=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
{ my ($slf, $inc) = @_;
  my ($drv, $val, %var);

  # Abort when no driver is available
  return 0 unless ($drv = get_driver($slf, 1));

  # Execute the request
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = $val if ($val = _get_alarm($slf, $inc));
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  return $drv->need_pause({%var});
}

=head2 S<$h-E<gt>open([$request])>

This method opens a communication channel with the remote host. To alter
temporarily some object attributes, you can specify a hash reference as an
argument. It supports following keys:

=over 11

=item S<    B<'lim'> > Execution time limit

=item S<    B<'pwd'> > User password

=item S<    B<'usr'> > User name

=back

It returns the object reference on successful completion. Otherwise, it stores
the error message and returns an undefined value.

=cut

sub open  ## no critic (Builtin)
{ my ($slf, $def) = @_;
  my ($acc, $drv, $hst, $pwd, $usr, $val, %var);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Abort when no driver is available
  unless ($drv = get_driver($slf, 1))
  { ++$slf->{'_err'};
    return -1;
  }

  # Analyze the request
  $hst = $slf->{'_hst'};
  $usr = $slf->{'_usr'};
  $var{'LIM'} = $slf->{'lim'} if $slf->{'lim'};
  if (ref($def) eq 'HASH')
  { foreach my $key (keys(%{$def}))
    { if ($key eq 'lim')
      { $var{'LIM'} = $val if defined($val = _parse_timeout($def->{$key}));
      }
      elsif ($key eq 'pwd')
      { $pwd = $def->{$key} if defined($def->{$key});
      }
      elsif ($key eq 'usr')
      { $usr = $def->{$key} if defined($def->{$key});
      }
    }
  }
  die "RDA-01507: Missing user name\n" unless length($usr);
  $acc = $slf->{'par'}->_get_access;
  $var{'HST'} = $hst;
  $var{'STA'} = 1;
  $var{'USR'} = $usr;
  $var{'PWD'} = $pwd
    if defined($pwd = defined($pwd)
                        ? $acc->set_password('host', $hst, $usr, $pwd) :
                      $acc->has_password('host', $hst, $usr)
                        ? $acc->get_password('host', $hst, $usr) :
                      undef);

  # Execute the request
  return _update_status($slf, $drv->request('OPEN', {%var})) ? undef : $slf;
}

=head2 S<$h-E<gt>put($ldir,$lname[,$rdir[,$rname]])>

This method puts a single file into a remote node. By default, it assumes the
same directory and file name for the remote destination. However, it takes
remote relative paths from the home directory, and local paths from the working
directory.

It returns the command exit code when the request is executed. Otherwise, it
returns a negative value.

=cut

sub put
{ my ($slf, $ldr, $lnm, $rdr, $rnm) = @_;
  my ($drv, $val, %var);

  return -1 unless $ldr && $lnm;

  # Abort when no driver is available
  return -1 unless ($drv = get_driver($slf, 1));

  # Execute the remote request
  $var{'HST'} = $slf->{'_hst'};
  $var{'LIM'} = 0;
  $var{'PWD'} = $val if defined($val = _get_password($slf, $drv));
  $var{'RDR'} = defined($rdr) ? $rdr : $ldr;
  $var{'RNM'} = $rnm if defined($rnm);
  $var{'SRC'} = RDA::Object::Rda->cat_file($ldr, $lnm);
  $var{'STA'} = 1;
  $var{'USR'} = $val if length($val = $slf->{'_usr'});
  return _update_status($slf, $drv->request('PUT', {%var}));
}

=head2 S<$h-E<gt>rda($options[,$flag])>

This method executes RDA with the specified options on a remote node. It treats
requests differently, depending on whether they are on local or remote
systems. When the flag is set, it captures all output lines.

It returns the command exit code when the request is executed. Otherwise, it
returns -1.

=cut

sub rda
{ my ($slf, $opt, $flg, $inc) = @_;
  my ($col, $cmd, $pre);

  return -1 unless defined($opt) && get_driver($slf, 1);

  # Execute the RDA command
  $col = $slf->{'col'};
  if ($slf->{'_typ'} eq 'L')
  { $cmd = $col->get_first('REMOTE.T_LOCAL_RDA') ||
      $col->get_config->get_value('T_SHORT');
  }
  else
  { $cmd = $col->get_first(['REMOTE.'.$slf->{'oid'}.'.T_RDA_COMMAND',
                            'REMOTE.T_RDA_COMMAND']) ||
      RDA::Local::Unix->quote(RDA::Local::Unix->cat_file(
        $col->get_first('REMOTE.'.$slf->{'oid'}.'.T_HOME'), 'rda.sh'));
  }
  $cmd .= q{ }.$opt if $opt;
  $cmd .= ' 2>&1';
  debug($slf->{'_pre'}.'> RDA command: '.$cmd) if $slf->{'lvl'};
  return $slf->command($cmd, $flg, $inc);
}

=head2 S<$h-E<gt>request($context,$job,$file,$inc)>

This method executes a remote job and puts the results in the specified
file. It supports the following directives:

=over 2

=item * C<#BEGIN>

It adds into the result file a tag to start capturing the output lines until an
END directive treats them.

=item * C<#BEGIN CAPTURE:E<lt>nameE<gt>>

It adds into the result file a tag to copy the following lines in the named
capture buffer. It clears the capture buffer unless its name is in lower case.

=item * C<#BEGIN LIST>

It adds into the result file a tag to start a new list.

=item * C<#BEGIN SECTION:E<lt>pretoc stringE<gt>>

It adds into the result file a tag to start a new section.

=item * C<#CALL E<lt>nameE<gt>(E<lt>nE<gt>)>

It executes the specified macro before treating the next directive.

=item * C<#DEFAULT>

It extracts all specifications until it finds a C</> lines and assigns them
as default interface parameters.

=item * C<#ECHO>

It extracts all lines until it finds a C</> lines and adds extracted lines
into the result file.

=item * C<#END CAPTURE>

It adds into the result file a tag to stop copying lines in a capture
buffer. It does not stop the line capture for other END directives.

=item * C<#END DATA:E<lt>pathE<gt>>

It adds into the result file a tag to treat the captured lines as data file
content. It generates a report but let the next END LIST adding it in a report.

=item * C<#END FILE:E<lt>pathE<gt>>

It adds into the result file a tag to treat the captured lines as file
content. It generates a report but let the next END SECTION adding it in the
table of content.

=item * C<#END LIST E<lt>nameE<gt>:E<lt>argument stringE<gt>>

It adds into the result file a tag to execute the specified macro with a buffer
containing the data file links and the argument string as arguments.

=item * C<#END MACRO E<lt>nameE<gt>:E<lt>argument stringE<gt>>

It adds into the result file a tag to execute the specified macro with a buffer
containing the captured lines and the argument string as arguments.

=item * C<#END PARSE>

It adds into the result file a tag to stop the file parsing.

=item * C<#END REPORT:E<lt>report descriptionE<gt>>

It adds into the result file a tag to produce a report with the captured
lines. The report description string contains the table of content level, the
link text, the report title, the location, and the report name separated by
C<|> characters. The last two elements are optional.

=item * C<#END SECTION>

It adds into the result file a tag to It ends a section.

=item * C<#END SECTION:E<lt>index levelE<gt>>

It adds into the result file a tag to It produces the file index and ends a
section.

=item * C<#EXEC>

It extracts all lines until it finds a C</> lines, executes them on the remote
server, and stores their output into the result file.

=item * C<#EXIT>

It closes the communication interface and aborts the job.

=item * C<#QUIT>

It closes the communication interface and aborts the job.

=item * C<#SET TIMEOUT:E<lt>timeout stringE<gt>>

It adds into the result file a tag to It replaces the captured lines by the
specified string.

=item * C<#SET TITLE:E<lt>toc stringE<gt>>

It adds into the result file a tag to It adds the specified string in the table
of content.

=item * C<#SET VARIABLE:E<lt>groupE<gt>:E<lt>varE<gt>="E<lt>valueE<gt>">

It adds into the result file a tag to It adds a scalar variable to the named
variable group.

=item * C<#SET VARIABLE:E<lt>groupE<gt>:E<lt>varE<gt>=(E<lt>listE<gt>)>

It adds into the result file a tag to It adds an array variable to the named
variable group. The array is provided as a comma-separated list of quoted
values.

=item * C<#SLEEP(E<lt>durationE<gt>)>

It makes a pause of the specified number of seconds.

=back

It returns 0 for a successful completion.

=cut

sub request  ## no critic (Complex)
{ my ($slf, $ctx, $job, $fil, $inc) = @_;
  my ($buf, $drv, $err, $lim, $lin, $ofh, $trc, @job);

  # Abort when the job is missing
  return 0 unless $job;

  # Execute the job
  ++$slf->{'_req'};
  $drv = get_driver($slf);
  $ofh = IO::File->new;
  $ofh->open($fil, $APPEND, $FIL_PERMS)
    or die get_string('ERR_OPEN', $slf->{'oid'}, $!);

  $lim = $slf->get_alarm($inc);
  @job = split(/\n/, $job);
  if ($trc = $slf->{'lvl'})
  { for (@job)
    { debug('REM: ', $_);
    }
  }
  eval {
    local $SIG{'__WARN__'} = sub {};

    unless (_need_password($slf, $drv, $inc))
    { while (defined($lin = shift(@job)))
      { if ($lin =~ m/^#\s*((BEGIN|END\SET)\b.*)$/)
        { $buf = "---#RDA:$1\n";
          $ofh->syswrite($buf, length($buf));
        }
        elsif ($lin = m/^#\s*CALL\s+(caller:)?(\w+)\((\d+)\)\s*$/)
        { my ($blk, $val);

          $blk = $1 ? $ctx->get_current : $ctx;
          $val = RDA::Value::Scalar::new_number($3);
          $val = RDA::Value::List->new($val);
          $val = $blk->define_operator([$2, '.macro.'], $blk, $2, $val);
          $val->eval_value;
        }
        elsif ($lin = m/^#\s*(COLLECT\d*)\s*$/)
        { my ($tag, @req);

          $tag = $1;
          while (defined($lin = shift(@job)) && $lin ne q{/})
          { push(@req, $1, $2) if $lin =~ m/^([A-Z]{3})\s*=\s*'(.*)'/;
          }
          next unless @req;
          $slf->set_collect({@req});
          $slf->{'col'}->log_timeout($ctx, $tag) if $slf->{'out'};
        }
        elsif ($lin = m/^#\s*(DEFAULT\d*)\s*$/)
        { my ($tag, @req);

          $tag = $1;
          while (defined($lin = shift(@job)) && $lin ne q{/})
          { push(@req, $1, $2) if $lin =~ m/^([A-Z]{3})\s*=\s*'(.*)'/;
          }
          next unless @req;
          $slf->set_default({@req});
          $slf->{'col'}->log_timeout($ctx, $tag) if $slf->{'out'};
        }
        elsif ($lin = m/^#\s*ECHO(\s+(.*))?$/)
        { $ofh->syswrite($2, length($2)) if defined($1);
        }
        elsif ($lin = m/^#\s*(EXEC\d*)\s*$/)
        { my ($tag, @req);

          $tag = $1;
          push(@req, $lin) while defined($lin = shift(@job)) && $lin ne q{/};
          next unless @req;
          $slf->execute(join(qq{\n}, @req), $ofh, undef, 1);
          $slf->{'col'}->log_timeout($ctx, $tag) if $slf->{'out'};
        }
        elsif ($lin = m/^#\s*(?:EXIT|QUIT)\s*$/)
        { $slf->disconnect;
        }
        elsif ($lin = m/^#\s*SLEEP\((\d+)\)\s*$/)
        { sleep($1);
        }
      }
    }
    };
  $ofh->close;

  # Detect and treat interrupts
  if ($err = $@)
  {
  }

  # Terminate the output treatment
  return exists($slf->{'_msg'}) ? 0 : 1;
}

=head2 S<$h-E<gt>set_default($var)>

This method specifies default values to the remote interface. It returns 0 for
a successful completion. Otherwise, it returns a negative value.

=cut

sub set_default
{ my ($slf, $var, $inc) = @_;
  my ($dft, $drv, $val, @dft);

  delete($slf->{'msg'});
  $slf->{'out'} = 0;
  ++$slf->{'_req'};

  # Abort when no driver is available
  unless ($drv = get_driver($slf, 1))
  { ++$slf->{'_err'};
    return -1;
  }

  # Skip empty job
  @dft = map {$_ => $var->{$_}}
         grep { m/^[A-Z]{3}$/ && _val_default($var->{$_})} keys(%{$var})
    if ref($var) eq 'HASH';
  return 0 unless @dft;

  # Execute the request
  $dft = {@dft};
  $slf->{'_hst'} = $dft->{'HST'} if exists($dft->{'HST'});
  $slf->{'_usr'} = $dft->{'USR'} if exists($dft->{'USR'});
  $slf->{'par'}->_get_access->set_password('host',
    $slf->{'_hst'}, $slf->{'_usr'}, $dft->{'PWD'}) if exists($dft->{'PWD'});
  $dft->{'STA'} = 1;
  $dft->{'LIM'} = $val if ($val = _get_alarm($slf, $inc));
  return _update_status($slf, $drv->request('DEFAULT', $dft));
}

sub _val_default
{ my ($val) = @_;
  my ($ref);

  return 0 unless defined($val);
  if ($ref = ref($val))
  { return 0 unless $ref eq 'ARRAY';
    foreach my $itm (@{$val})
    { return 0 unless defined($itm) && !ref($itm);  ## no critic (Unless)
    }
  }
  return 1;
}

=head2 S<$h-E<gt>set_timeout($limit)>

This method sets the timeout for the remote session, specified in seconds, only
if the value is strictly positive. Otherwise, it disables the timeout
mechanism. It is disabled also if the C<alarm> function is not implemented.

It returns the effective value.

=cut

sub set_timeout
{ my ($slf, $lim) = @_;

  return $slf->{'lim'} = check_alarm($lim);
}

=head2 S<$h-E<gt>set_trace([$level])>

This method sets the remote trace level:

=over 7

=item B<    0 > Disables the remote trace.

=item B<    1 > Traces the remote command execution.

=back

The level is unchanged if the new level is not defined.

It returns the previous level.

=cut

sub set_trace
{ my ($slf, $lvl) = @_;
  my ($old);

  $old = $slf->{'lvl'};
  if (defined($lvl))
  { $slf->{'lvl'} = $lvl;
    $slf->{'_drv'}->request('DEFAULT', {TRC => $lvl})
      if exists($slf->{'_drv'});
  }
  return $old;
}

=head2 S<$h-E<gt>set_type($type)>

This method assigns the specified type to the remote session. It deletes any
previous driver associate to it. It returns a zero value on successful
completion.

=cut

sub set_type
{ my ($slf, $typ) = @_;
  my ($ctl);

  # Validate the arguments
  die get_string('NOT_SESSION')
    unless $slf->{'_typ'} eq 'S';
  die get_string('NO_TYPE')
    unless defined($typ);
  die get_string('BAD_TYPE', $typ)
    unless exists($tb_cap{$typ = lc($typ)});
  return 1 unless ref($ctl = _get_manager($slf, $typ));

  # Associate the a driver to the session
  $slf->{'_drv'}->delete_object if exists($slf->{'_drv'});
  $slf->{'_drv'} = $ctl->new($slf);

  # Indicate the successful completion
  return 0;
}

=head2 S<$h-E<gt>write_result($context,$file[,$prefix])>

This method treats a result file or a result buffer. It supports the following
directives:

=over 2

=item * C<---#RDA:BEGIN>

It starts capturing the output lines until an END directive treats them.

=item * C<---#RDA:BEGIN CAPTURE:E<lt>nameE<gt>>

It copies the following lines in the named capture buffer. It clears the
capture buffer unless its name is in lower case.

=item * C<---#RDA:BEGIN LIST>

It starts a new list.

=item * C<---#RDA:BEGIN SECTION:E<lt>pretoc stringE<gt>>

It starts a new section.

=item * C<---#RDA:END CAPTURE>

It stops copying lines in a capture buffer. It does not stop the line capture
for other END directives.

=item * C<---#RDA:END DATA:E<lt>pathE<gt>>

It treats the captured lines as data file content. It generates a report but
let the next END LIST adding it in a report.

=item * C<---#RDA:END FILE:E<lt>pathE<gt>>

It treats the captured lines as file content. It generates a report but let the
next END SECTION adding it in the table of content.

=item * C<---#RDA:END LIST E<lt>nameE<gt>:E<lt>argument stringE<gt>>

It executes the specified macro with a buffer containing the data file links
and the argument string as arguments.

=item * C<---#RDA:END MACRO E<lt>nameE<gt>:E<lt>argument stringE<gt>>

It executes the specified macro with a buffer containing the captured lines and
the argument string as arguments.

=item * C<---#RDA:END PARSE>

It stops the file parsing.

=item * C<---#RDA:END REPORT:E<lt>report descriptionE<gt>>

It produces a report with the captured lines. The report description string
contains the table of content level, the link text, the report title, the
location, and the report name separated by C<|> characters. The last two
elements are optional.

=item * C<---#RDA:END SECTION>

It ends a section.

=item * C<---#RDA:END SECTION:E<lt>index levelE<gt>>

It produces the file index and ends a section.

=item * C<---#RDA:SET TIMEOUT:E<lt>timeout stringE<gt>>

It replaces the captured lines by the specified string.

=item * C<---#RDA:SET TITLE:E<lt>toc stringE<gt>>

It adds the specified string in the table of content.

=item * C<---#RDA:SET VARIABLE:E<lt>groupE<gt>:E<lt>varE<gt>="E<lt>valueE<gt>">

It adds a scalar variable to the named variable group.

=item * C<---#RDA:SET VARIABLE:E<lt>groupE<gt>:E<lt>varE<gt>=(E<lt>listE<gt>)>

It adds an array variable to the named variable group. The array is provided
as a comma-separated list of quoted values.

=back

It returns 0 for a successful completion.

=cut

sub write_result
{ my ($slf, $ctx, $res, $pre) = @_;
  my ($ifh);

  $pre = $slf->{'_pre'} unless defined($pre);
  if (ref($res) eq 'RDA::Object::Buffer')
  { _write_result($slf, $ctx, $res->get_handle, $pre);
  }
  else
  { $ifh = IO::File->new;
    if ($ifh->open("<$res"))
    { _write_result($slf, $ctx, $ifh, $pre);
      $ifh->close;
    }
  }

  # Indicate a sucessful completion
  return 0;
}

sub _write_result  ## no critic (Complex)
{ my ($slf, $ctx, $ifh, $pre) = @_;
  my ($buf, $cut, $out, $rpt, $toc, $trc, $val, @buf, @tbl, %idx);

  # Initialization
  $out = $ctx->get_output;
  $toc = $out->get_info('toc');
  $trc = $slf->{'lvl'};

  # Treat the results
  $cut = 1;
  $slf->{'var'} = {};
  while (<$ifh>)
  { s/[\n\r\s]+$//;
    debug($pre.'> '.$_) if $trc;
    if (m/^\-{3}#\s+RDA:(?:BEGIN|END|SET)/)
    { my ($blk, $cmd, $dat);

      (undef, $cmd, $dat) = split(/:/, $_, 3);
      if ($cmd eq 'BEGIN')
      { $cut = 0;
        @buf = ();
      }
      elsif ($cmd eq 'BEGIN CAPTURE')
      { $dat = q{?} unless defined($dat) && length($dat);
        $buf = lc($dat);
        $slf->{'_buf'}->{$buf} = [] unless $dat eq $buf;
      }
      elsif ($cmd eq 'BEGIN LIST')
      { @tbl = ();
      }
      elsif ($cmd eq 'BEGIN SECTION')
      { %idx = ();
        $toc->push_line(qq{$dat\n}) if $toc;
      }
      elsif ($cmd eq 'END CAPTURE')
      { $buf = undef;
      }
      elsif ($cmd eq 'END DATA')
      { $cut = 1;
        $dat = q{?} unless defined($dat) && length($dat);
        $val = RDA::Object::Rda->basename($dat);
        if (@buf)
        { $rpt = $out->add_report('D', qq{log_$val});
          $rpt->write_lines(RDA::Object::Buffer->new('l', \@buf));
          push(@tbl, q{[[}.$rpt->get_raw(1).q{][_blank][}.$val.q{]]});
          $out->end_report($rpt);
        }
        else
        { push(@tbl, $val);
        }
      }
      elsif ($cmd eq 'END FILE')
      { $cut = 1;
        if (@buf)
        { $dat = q{?} unless defined($dat) && length($dat);
          $val = RDA::Object::Rda->basename($dat);
          $rpt = $out->add_report('F', qq{log_$val});
          $val = RDA::Driver::Sgml::encode($val);
          $rpt->write(qq{---+ Display of $val File\n}
             .q{---## Information Taken from }
             .RDA::Driver::Sgml::encode($dat).qq{\n});
          $rpt->write_lines(RDA::Object::Buffer->new('L', \@buf));
          $rpt->write($TOP);
          $idx{RDA::Object::Rda->dirname($dat)}->{$val} =
            q{:[[}.$rpt->get_report.q{][rda_report][}.$val.qq{]]\n};
          $out->end_report($rpt);
        }
      }
      elsif ($cmd =~ m/^END LIST (caller:)?(\w+)$/)
      { $cut = 1;
        if (@tbl)
        { $blk = $1 ? $ctx->get_current : $ctx;
          $dat = (defined($dat) && length($dat))
            ? new_text($dat)
            : new_undef();
          $val = RDA::Value::List->new(new_object(
            RDA::Object::Buffer->new('L', \@tbl)), $dat);
          $val = $blk->define_operator([$2, '.macro.'], $blk, $2, $val);
          $val->eval_value;
        }
      }
      elsif ($cmd =~ m/^END MACRO (caller:)?(\w+)$/)
      { $cut = 1;
        if (@buf)
        { $blk = $1 ? $ctx->get_current : $ctx;
          $dat = (defined($dat) && length($dat))
            ? new_text($dat)
            : new_undef();
          $val = RDA::Value::List->new(new_object(
            RDA::Object::Buffer->new('L', \@buf)), $dat);
          $val = $blk->define_operator([$2, '.macro.'], $blk, $2, $val);
          $val->eval_value;
        }
      }
      elsif ($cmd eq 'END PARSE')
      { return;
      }
      elsif ($cmd eq 'END REPORT')
      { $cut = 1;
        if (@buf)
        { my ($det, $lnk, $ttl, $loc, $nam);

          ($det, $lnk, $ttl, $loc, $nam) = split(/\|/, $dat, 5);
          if (defined($nam))
          { $nam =~ s{[\/\\]}{r}g;
          }
          else
          { $nam = $lnk;
          }
          $rpt = $out->add_report('f',$nam);
          $rpt->write(qq{---+!! $ttl\n});
          $rpt->write(q{---## Location:&nbsp;}
            .RDA::Driver::Sgml::encode($loc).qq{\n}) if $loc;
          $rpt->write_lines(RDA::Object::Buffer->new('L', \@buf));
          $rpt->write($TOP);
          $toc->write($det.q{:[[}.$rpt->get_report.qq{][rda_report][$lnk]]\n});
          $out->end_report($rpt);
        }
      }
      elsif ($cmd eq 'END SECTION')
      { $cut = 1;
        if ($toc)
        { if (defined($dat) && $dat =~ m/^\d+$/)
          { $val = $dat + 1;
            foreach my $grp (sort keys(%idx))
            { $toc->write($dat.q{:}.RDA::Driver::Sgml::encode($grp).qq{\n});
              foreach my $fil (sort keys(%{$idx{$grp}}))
              { $toc->write($val.$idx{$grp}->{$fil});
              }
            }
          }
          $toc->pop_line(1);
        }
        %idx = ();
      }
      elsif ($cmd eq 'SET TITLE')
      { $toc->write(qq{$dat\n}) if $toc;
      }
      elsif ($cmd eq 'SET TIMEOUT')
      { @buf = ($dat);
      }
      elsif ($cmd eq 'SET VARIABLE')
      { if (defined($dat))
        { my ($grp, $tbl);

          $grp = ($dat =~ s/^(\w+)://) ? uc($1) : q{?};
          if ($dat =~ m/^(.*?)="(.*)"/)
          { $slf->{'_var'}->{$grp}->{$1} = $2;
          }
          elsif ($dat =~ m/^(.*?)=\((.*)\)/)
          { $slf->{'_var'}->{$grp}->{$1} = $tbl = [];
            $dat = $2;
            while ($dat =~ s/^"(.*?)"(,)?//)
            { push (@{$tbl}, $1);
              last unless $2;
            }
          }
        }
      }
    }
    else
    { push(@buf, $_) unless $cut;
      push(@{$slf->{'_buf'}->{$buf}}, $_) if $buf;
    }
  }
  return;
}

=head1 REMOTE COLLECTION MANAGEMENT METHODS

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

This method collects all the step changes accumulated in the remote log file,
updates settings appropriately, and removes the remote log file. This is not
performed inside a thread. It returns 1 on successful completion. Otherwise,
it returns 0.

=cut

sub end_steps
{ my ($slf) = @_;

  # Check if it can be done
  return 0 if $slf->{'col'}->get_info('job') || !exists($slf->{'_rlg'});

  # Close the remote log file
  delete($slf->{'_rfh'})->close if exists($slf->{'_rfh'});

  # Review all steps present in the remote log file
  $slf->_load_steps($slf->{'col'}->find('REMOTE', 1), $slf->{'_rlg'});

  # Remove the remote log file
  1 while unlink($slf->{'_rlg'});
  delete($slf->{'_rlg'});

  # Indicate the successful completion
  return 1;
}

# Load steps from the remote log file
sub _load_steps
{ my ($slf, $def, $pth) = @_;
  my ($ifh, %stp);

  $ifh = IO::File->new;
  if ($ifh->open("<$pth"))
  { # Read the remote log file
    while (<$ifh>)
    { my ($key, $nod, $stp, $val, @tbl);

      ($nod, $stp, @tbl) = split(/\|/);
      pop(@tbl);
      $slf->{'_stp'}->{$nod} = $stp{$nod} = $stp;
      foreach my $itm (@tbl)
      { ($key, $val) = split(/=/, $itm, 2);
        $def->set_value("$nod.$key", $val,
          exists($tb_set{$key}) ? $tb_set{$key} : undef);
      }
    }
    $ifh->close;

    # Save the last steps
    foreach my $nod (keys(%stp))
    { $def->set_value("$nod.T_STEP", $stp{$nod},
        'Remote node execution step');
    }
  }
  return;
}

=head2 S<$h-E<gt>get_step($node,$default)>

This method returns the current step for the specified node. Otherwise, it
returns the default value when the node step is not yet defined.

=cut

sub get_step
{ my ($slf, $nod, $val) = @_;

  # Get the step information when not yet initialized
  init_steps($slf) unless exists($slf->{'_rfh'});

  # Get the step information
  $val = $slf->{'_stp'}->{$nod} if exists($slf->{'_stp'}->{$nod});
  return $val;
}

=head2 S<$h-E<gt>init_steps($flag)>

This method gets the steps from the settings. Unless the flag is set, it
recovers steps from an aborted session and opens the remote log file. It
creates the remote directory if it does not exist already. It returns 1 on
successful completion. Otherwise, it returns 0.

You should run this macro before the first C<get_step> or C<set_step>, and
especially before starting any thread.

=cut

sub init_steps
{ my ($slf, $flg) = @_;
  my ($col, $def, $pth, $rfh);

  # Check if it can be done
  return 0 if exists($slf->{'_rlg'});

  # Create the remote directory when needed
  $col = $slf->{'col'};
  $def = $col->find('REMOTE', 1);

  # Recover steps present in an existing remote log file
  $slf->{'_rlg'} = $pth = RDA::Object::Rda->cat_file($col->get_dir('J', 1),
    $col->get_oid.'.rem');
  $slf->_load_steps($def, $pth) unless $flg;

  # Extract steps from the settings
  $slf->{'_stp'} = {};
  foreach my $nod ($def->grep('^T_STEP$','rw'))
  { $slf->{'_stp'}->{$nod} = $def->get_first("$nod.T_STEP")
  }

  # Open the remote log file
  unless ($flg)
  { $rfh = IO::File->new;
    $rfh->open($pth, $APPEND, $FIL_PERMS)
      or die get_string('ERR_RLOG', $pth, $!);
    $slf->{'_rfh'} = $rfh;
  }

  # Indicate the successful completion
  return 1;
}

=head2 S<$h-E<gt>set_step($node,$step[,...])>

This method sets the current step for the specified node and saves it in the
remote log file. You can specify additional setting directives as extra
arguments in a 'key=value' format.

=cut

sub set_step
{ my ($slf, $nod, $stp, @arg) = @_;
  my ($buf, $col, $key, $val);

  # Get the step information when not yet initialized
  init_steps($slf) unless exists($slf->{'_rfh'});

  # Save the step information in the remote log file
  $buf = join(q{|}, $nod, $stp, @arg, qq{\n});
  $slf->{'_rfh'}->syswrite($buf, length($buf));

  # Also apply the setting directives in the local context
  $col = $slf->{'col'};
  foreach my $itm (@arg)
  { ($key, $val) = split(/=/, $itm, 2);
    $key = "REMOTE.$nod.$key" if $key =~ m/^[A-Z]_/;
    $col->set_value($key, $val);
  }

  # Set the step information
  return $slf->{'_stp'}->{$nod} = $stp;
}

=head1 REMOTE COLLECTION MANAGEMENT METHODS

=head2 S<$h-E<gt>edit_setup($node,$edit)>

This methods edits the local copy of remote result set definition files. The
edit directives are provided as a hash reference. It ignores the keys that
does not correspond to existing item properties. It returns the number of
modifications done in the definition file.

=cut

sub edit_setup
{ my ($slf, $nod, $edt) = @_;
  my ($cnt, $col, $def, $dir, $oid);

  $col = $slf->{'col'};
  $dir = $col->get_dir('P');
  $oid = lc($nod).q{_}.$col->get_oid;
  if (-f RDA::Object::Rda->cat_file($dir, "$oid.cfg") && ref($edt) eq 'HASH')
  { # Load the remote definition
    $def = RDA::Object::Item->new($col->get_agent, $oid,
      "$nod Result Set Definition")->load_content($dir);

    # Apply the changes
    $cnt = 0;
    foreach my $key (keys(%{$edt}))
    { next unless $def->is_defined($key);
      $def->set_value($key, $edt->{$key});
      ++$cnt;
    }

    # Save the definition file
    $def->save_content($dir) if $cnt;
  }

  # Return the number of modifications done in the definition file.
  return $cnt;
}

=head2 S<$h-E<gt>gen_setup($node,[$typ,$grp...])>

This method locally generates the result set definition file for the specified
remote node. It returns the local name.

=cut

sub gen_setup
{ my ($slf, $nod, $typ, $req) = @_;
  my ($col, $dat, $def, $dst, $ref, $src);

  # Prepare the setup
  $col = $slf->{'col'};
  $def = RDA::Object::Item->new($col->get_agent, lc($nod).q{_}.$col->get_oid,
    "$nod Result Set Definition");

  # Merge the prepared properties
  if (ref($req) eq 'HASH')
  { foreach my $key (keys(%{$req}))
    { $dst = $def->find($key, 1);
      $ref = ref($dat = $req->{$key});
      if ($ref eq 'ARRAY')
      { foreach my $nam (@{$dat})
        { $dst->merge($src) if ($src = $col->find("PREPARE.$typ.$nam"));
        }
      }
      elsif ($ref eq 'HASH')
      { foreach my $nam (keys(%{$dat}))
        { $dst->set_raw($nam, $dat->{$nam});
        }
      }
      elsif ($ref)
      { die get_string('BAD_SETUP', $key);
      }
      elsif (defined($dat))
      { $dst->merge($src) if ($src = $col->find($dat));
      }
    }
  }

  # Generate the result set definition file and return the path to it
  return $def->save_content($col->get_dir('P'));
}

=head2 S<$h-E<gt>load_setup($node)>

This method loads a remote node result set definition file and returns a
reference to its definition. It returns an undefined value when it does not
find the corresponding definition file.

=cut

sub load_setup
{ my ($slf, $nod) = @_;
  my ($col, $dir, $oid);

  $col = $slf->{'col'};
  $dir = $col->get_dir('P');
  $oid = lc($nod).q{_}.$col->get_oid;
  return (-f RDA::Object::Rda->cat_file($dir, "$oid.cfg"))
    ? RDA::Object::Item->new($col->get_agent, $oid,
        "$nod Result Set Definition")->load_content($dir)
    : undef;
}

=head2 S<$h-E<gt>get_setup($node)>

This method returns the name of the remote node result set definition file.

=cut

sub get_setup
{ my ($slf, $nod) = @_;

  return lc($nod).q{_}.$slf->{'col'}->get_oid.'.cfg';
}

=head1 OPERATING SYSTEM-RELATED METHODS

These methods are available at session level and are adapted to the remote host
operating system family.

=head2 S<$h-E<gt>basename($file[,@suf])>

This method extracts the base name of the file specification and  removes the
suffix when it belongs to the suffix list. It matches each element of this list
as a string against the end of the name.

When treating existing files from systems that are not case-sensitive, the
pattern matching for suffix removal ignores case.

=head2 S<$h-E<gt>cat_dir([$dir...,]$dir)>

This method concatenates directory names to form a complete path ending with a
directory. It removes the trailing slash from the resulting string, except for
the root directory.

It discards undefined values and references from the argument list.

=head2 S<$h-E<gt>cat_file([$dir...,]$file)>

This method concatenates directory names and a file name to form a complete
path ending with a file name.

It discards undefined values and references from the argument list.

=head2 S<$h-E<gt>clean_path($path[,$flag])>

This method performs a logical cleanup of a path. When the flag is set, it
performs additional platform-specific simplifications.

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

This method returns a string representation of the current directory (C<.> for
UNIX).

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

This method returns a string representation of the null device.

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

This method returns a string representation of the terminal device.

=head2 S<$h-E<gt>dirname($file)>

This method returns the directory portion of the input file specification.

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

This method returns the character used as the separator.

=head2 S<$h-E<gt>is_absolute($path)>

This method indicates whether or not the argument is an absolute path.

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

This method returns a true value when the operating system associated to the
view is Cygwin.

=head2 S<$h-E<gt>is_path($string)>

This method verifies that the string does not contain characters invalid in a
path.

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

This method returns a true value when the operating system associated to the
view belongs to the UNIX family.

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

This method returns a true value when the operating system associated to the
view is VMS.

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

This method returns a true value when the operating system associated to the
view belongs to the Windows family.

=head2 S<$h-E<gt>parse_path($path[,@suf])>

This method divides a file path into the directories, its file name, and
optionally the file suffix. The directory part contains everything up to and
including the last directory separator in the $path including the volume, when
applicable. The remainder of the path is the file name.

=head2 S<$h-E<gt>quote($string[,$flag])>

This method encodes a string to be considered as a single argument by a command
shell. Unless the flag is set, variable substitution is disabled.

=head2 S<$h-E<gt>quote2($string[,$flag])>

This method is similar to the C<quote> method but the result does not contain
the leading and trailing quotation marks.

=head2 S<$h-E<gt>re($str)>

This method converts a string containing wild cards into a Perl regular
expression.

=head2 S<$h-E<gt>split_dir($path)>

This method returns the list of directories contained in the specified
path. Unlike just splitting the directories on the separator, empty directory
names (C<''>) can be returned, because these are significant on some operating
systems. The first element can contain volume information.

For UNIX,

    $h->split_dir("/a/b//c/");

Yields:

    ('', 'a', 'b', '', 'c', '')

=head2 S<$h-E<gt>split_volume($path)>

This method separates the volume from the other path information.

=head2 S<$h-E<gt>unquote($str)>

This method removes the quoting characters from a string.

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

This method returns a string representation of the parent directory (C<..> for
UNIX).

=cut

sub AUTOLOAD  ## no critic (Autoload)
{ my ($slf, @arg) = @_;
  my ($cmd);

  ($cmd) = $AUTOLOAD =~ m/::(\w+)$/;
  set_family($slf, 'Unix') unless ref($slf->{'_cfg'});
  return unless $slf->{'_cfg'}->can($cmd);
  return $slf->{'_cfg'}->$cmd(@arg);
}

# --- Alarm routines ----------------------------------------------------------

# Get the alarm duration
sub _get_alarm
{ my ($slf, $val) = @_;

  return $slf->{'lim'} unless defined($val);
  return 0 unless $slf->{'lim'} > 0 && $val > 0;  ## no critic (Unless)
  $val *= $slf->{'lim'};
  return ($val > 1) ? int($val) : 1;
}

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

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

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

# Get the access control object
sub _get_access
{ my ($slf) = @_;

  return $slf->{'_pwd'} if exists($slf->{'_pwd'});
  return $slf->{'_pwd'} = $slf->{'col'}->get_access;
}

# Provide the local session manager
sub _get_local
{ my ($slf) = @_;
  my ($cls, $top);

  # Determine the driver manager on first usage
  $top = $slf->get_top;
  unless (exists($top->{'_mgr'}->{'local'}))
  { $cls = 'RDA::Driver::Local';
    eval "require $cls";
    die get_string('BAD_PACKAGE', $cls, $@) if $@;
    eval {$top->{'_mgr'}->{'local'} = $cls->new($top->{'col'}, $slf->{'lim'})};
    die get_string('CANNOT_LOCAL', $@) if $@;
  }

  # Return the local session manager
  return $top->{'_mgr'}->{'local'};
}

# Provide the corresponding driver manager
sub _get_manager
{ my ($slf, $typ) = @_;
  my ($cls, $top);

  # Determine the driver manager on first usage
  $top = $slf->get_top;
  unless (exists($top->{'_mgr'}->{$typ}))
  { $top->{'_mgr'}->{$typ} = undef;
    unless ($top->{'col'}->get_first($tb_cap{$typ}->[1]))
    { $cls = $tb_cap{$typ}->[0];
      eval "require $cls";
      die get_string('BAD_PACKAGE', $cls, $@) if $@;
      eval {$top->{'_mgr'}->{$typ} = $cls->new($top->{'col'}, $slf->{'lim'})};
      die get_string('CANNOT_TYPE', $typ, $@) if $@;
    }
  }

  # Return the driver manager
  return $top->{'_mgr'}->{$typ};
}

# Get the session password
sub _get_password
{ my ($slf, $drv) = @_;
  my ($acc);

  return (($acc = $drv->get_access)
    && $acc->has_password('host', $slf->{'_hst'}, $slf->{'_usr'}))
    ? $acc->get_password('host', $slf->{'_hst'}, $slf->{'_usr'})
    : undef;
}

# Parse the continuation pattern(s)
sub _parse_next
{ my ($nxt, $ors, $pwd) = @_;
  my ($ack, $str, @nxt, @pwd, @tbl);

  return _parse_prompt($nxt) unless ref($nxt) eq 'ARRAY';
  @tbl = @{$nxt};
  while (($str, $ack) = splice(@tbl, 0, 2))
  { if (ref($ack) eq 'ARRAY')
    { ($ack, @pwd) = @{$ack};
      $ack = sprintf($ack, $pwd ? $pwd->get_password(@pwd) : q{});
    }
    else
    { $ack = _parse_string($ack, 1, $ors);
    }
    push(@nxt, [$str, $ack]) if defined(_parse_prompt($str));
  }
  return @nxt ? [@nxt] : undef;
}

sub _parse_prompt
{ my ($pat, $dft) = @_;
  my ($buf, $slf, @msg);

  return $dft unless defined($pat);
  die get_string('BAD_PATTERN', $pat)
    unless $pat =~ m{^\s*/} || $pat =~ m{^\s*m\s*\W};
  { local $^W = 1;
    local $SIG{'__WARN__'} = sub {push(@msg, @_)};

    $slf = {eof => 1, _buf => q{}};
    eval $TEST_BEG_PAT.$pat.$TEST_END_PAT; ## no critic (Eval)
  }
  die get_string('ERR_PATTERN', $pat, $@)                       if $@;
  die join(qq{\n}, get_string('WARN_PATTERN', $pat), @msg, q{}) if @msg;
  return $pat;
}

# Parse the skip mode
sub _parse_skip_mode
{ my ($mod, $dft) = @_;

  return $dft unless defined($mod);
  return $1   if $mod =~ /^\s*(auto|\d+)\s*$/i;
  die get_string('BAD_SKIP', $mod);
}

# Parse a string
sub _parse_string
{ my ($str, $min, $dft) = @_;

  return
    ref($str)                               ? $dft :
    (defined($str) && length($str) >= $min) ? $str :
                                              $dft;
}

# Parse the timeout value
sub _parse_timeout
{ my ($lim, $dft) = @_;

  return $dft unless defined($lim);
  die get_string('BAD_TIMEOUT', $lim) unless $lim =~ m/^-?\d+$/;
  return ($lim > 0) ? $lim : 0;
}

# Update the execution status
sub _update_status
{ my ($slf, $sta) = @_;

  if ($sta < 0)
  { $slf->{'msg'} = $slf->{'_drv'}->get_message;
    if ($slf->{'_drv'}->is_skipped)
    { $slf->{'skp'} = 1;
      ++$slf->{'_skp'};
    }
    elsif ($slf->{'_drv'}->has_timeout)
    { $slf->{'out'} = 1;
      ++$slf->{'_out'};
    }
    else
    { ++$slf->{'_err'};
    }
  }
  return $sta;
}

# --- SDCL extensions ---------------------------------------------------------

# Initialize the remote session manager
sub _begin_remote
{ my ($pkg) = @_;

  $pkg->set_top('REM', $pkg->get_collector->get_remote->new($pkg));
  return;
}

# Close all active remote sessions
sub _end_remote
{ my ($pkg) = @_;

  $pkg->set_top('REM')->delete_object;
  return;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Alarm|RDA::Alarm>,
L<RDA::Driver::Da|RDA::Driver::Da>,
L<RDA::Driver::Jsch|RDA::Driver::Jsch>,
L<RDA::Driver::Local|RDA::Driver::Local>,
L<RDA::Driver::Rsh|RDA::Driver::Rsh>,
L<RDA::Driver::Sgml|RDA::Driver::Sgml>,
L<RDA::Driver::Ssh|RDA::Driver::Ssh>,
L<RDA::Object::Buffer|RDA::Object::Buffer>,
L<RDA::Object::Inline|RDA::Object::Inline>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Java|RDA::Object::Java>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::View|RDA::Object::View>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::Value::List|RDA::Value::List>,
L<RDA::Value::Scalar|RDA::Value::Scalar>,
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