# Agent.pm: Class Used for Objects to Interface with a Boot Agent

package RDA::Agent::Boot;

# $Id: Boot.pm,v 1.3 2015/10/19 05:16:43 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Agent/Boot.pm,v 1.3 2015/10/19 05:16:43 RDA Exp $
#
# Change History
# 20151019  MSC  Add driver type control.

=head1 NAME

RDA::Agent::Boot - Class Used for Objects to Interface with a Boot Agent

=head1 SYNOPSIS

 require RDA::Agent::Boot;

=head1 DESCRIPTION

The objects of the C<RDA::Agent::Boot> class are used to interface with a
boot agent. It is a subclass of L<RDA::Agent|RDA::Agent>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Agent;
  use RDA::Driver::Agent;
  use RDA::Handle::Agent;
  use RDA::Local::Unix;
  use RDA::Object::Message;
  use RDA::Object::Rda;
  use RDA::Trace;
}

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

# Define the global private constants
my $EOD = q{___End_of_Data___};
my $EOP = q{Agent pipe broken};

my $LF = qq{\012};

# Define the global private variables

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

=head2 S<$h = RDA::Agent::Boot-E<gt>new($agt,$oid)>

The object constructor. This method enables you to specify the reference to
the agent object and the control object identifier as parameters.

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

=over 16

=item S<    B<'brk' > > Treatment break request

=item S<    B<'drv' > > Reference to the communication driver object

=item S<    B<'ifh' > > Communication channel input file handle

=item S<    B<'loc' > > Do local usage tracking

=item S<    B<'lvl' > > Trace level

=item S<    B<'nod' > > Node name

=item S<    B<'ofh' > > Communication channel output file handle

=item S<    B<'oid' > > Agent identifier

=item S<    B<'par' > > Reference to the parent agent

=item S<    B<'pid' > > Execution agent process identifier

=item S<    B<'pre' > > Trace prefix

=item S<    B<'upd' > > Usage update command

=item S<    B<'use' > > Agent usage overview

=item S<    B<'_kil'> > Kill indicator

=item S<    B<'_ses'> > Reference to the session object

=back

Internal keys are prefixed by an underscore.

=cut

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

  # Create the boot control agent and return its reference
  return bless {
    brk  => 'AGENT.EXIT',
    loc  => 0,
    lvl  => $agt->{'lvl'},
    nod  => uc($oid),
    oid  => $oid,
    par  => $agt,
    pre  => "C:$oid",
    upd  => 'AGENT.GET_USAGE',
    use  => {},
    _kil => 0,
    }, ref($cls) || $cls;
}

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

This method deletes the control agent.

=cut

sub delete_object
{ $_[0]->close_session;
  $_[0]->SUPER::delete_object;
  return;
}

=head2 S<$h-E<gt>start($def,$att)>

This method starts the local agent and returns a reference to the
initialization response message.

=cut

sub start  ## no critic (Complex)
{ my ($slf, $def, $att) = @_;
  my ($agt, $bkp, $bld, $buf, $cmd, $drv, $dsc, $oid, $opt, $rem, $req, $rsp,
      $typ, $val);

  # Determine the usage directives
  if ($att->{'no_usage'})
  { delete($slf->{'upd'});
    $slf->{'loc'} = 1;
  }
  elsif ($val = delete($att->{'usage_request'}))
  { $slf->{'upd'} = $val;
  }

  # Start the child process
  $agt = $slf->{'par'};
  $oid = $slf->{'oid'};
  $rem = $agt->get_remote;
  $dsc = {cmd  => ['/bin/sh'],
          opt  => [],
          trc  => $agt->is_slave ? '>&=2' : '>&=1',
          _opt => ["-XAgent,AGENT,$oid,-iInstalled"],
         };
  unshift(@{$dsc->{'_opt'}}, '-u'.$agt->{'str'}) if $agt->{'str'};
  unshift(@{$dsc->{'_opt'}}, '-t'.$agt->{'lvl'}) if $agt->{'lvl'};
  $opt = q{};
  $opt .= 'b' unless $agt->{'bkp'};
  $opt .= 'n' if $agt->{'new'};
  $opt .= 'q' if $agt->{'out'};
  $opt .= 'v' if $agt->{'vrb'};
  $opt .= 'y' if $agt->{'yes'};
  unshift(@{$dsc->{'_opt'}}, "-$opt") if $opt;
  $dsc->{'ses'} = $slf->{'_ses'} =
    $rem->add_remote($slf->{'nod'},
                     delete($att->{'host'}),
                     delete($att->{'user'}),
                     delete($att->{'password'}));
  $slf->{'_ses'}->set_type($val) if defined($val = $att->{'driver'});
  $dsc->{'_cmd'} =
    (!exists($att->{'rda'})) ?
      [$agt->{'cfg'}->get_value('T_SELF')] :
    (!exists($att->{'perl'})) ?
      [RDA::Local::Unix->cat_file($att->{'rda'}, 'sdci.sh')] :
    $att->{'taint'} ?
      [$att->{'perl'}, '-T',
       RDA::Local::Unix->cat_file($att->{'rda'}, 'sdci.pl')] :
    [$att->{'perl'},
     RDA::Local::Unix->cat_file($att->{'rda'}, 'sdci.pl')];
  $dsc->{'wrk'} = $att->{'work'} if exists($att->{'work'});
  $att->{'next'} = [@{$dsc->{'_cmd'}}, @{$dsc->{'_opt'}}];
  eval {
    $slf->{'ifh'} =
    $slf->{'ofh'} = $val = RDA::Handle::Agent->new($dsc);
    $slf->{'pid'} = $val->getinfo('pid')
      or die get_string('NOT_STARTED', $oid);
  };
  if ($@ =~ m/^exec_command: Cannot (exec|spawn) /)
  { syswrite(STDOUT, $@, length($@));
    exit(0);
  }
  $agt->add_error($slf->{'_ses'}->get_message, $@)->abort if $@;

  eval {
    local $SIG{'PIPE'} = sub { die "$EOP\n" };

    # Check if remote shell is available
    $typ = 'S';
    $agt->trace(get_string('Available'))
      unless $slf->{'lvl'} < 10;  ## no critic (Unless)
    $buf = "echo Started \$\$$LF";
    $slf->{'ofh'}->syswrite($buf, length($buf));
    $typ = 'D';
    die "Not connected\n" unless $slf->{'ifh'}->sysread($buf, 1024);

    # Check if RDA is already operational
    $typ = 'I';
    $agt->trace(get_string('Operational'))
      unless $slf->{'lvl'} < 10;  ## no critic (Unless)
    $buf = join(q{ }, map {RDA::Local::Unix->quote($_)} @{$dsc->{'_cmd'}})
      .' -eCFG/B_NO_CHECK=1 -vXRda check -fU'
      .$agt->get_config->check_engine
      ." 2>/dev/null || echo Bootstrap$LF";
    $slf->{'ofh'}->syswrite($buf, length($buf));
    die "Interrupted\n" unless $slf->{'ifh'}->sysread($buf, 1024);
    $agt->trace(get_string('State', $buf))
      unless  $slf->{'lvl'} < 10;  ## no critic (Unless)
    ($typ, $bld) = ('U', $1) if $buf =~ m/^Version (\d{8}) OK/;
    };

  # Install the bootstrap
  if ($typ eq 'I')
  { local $SIG{'PIPE'} = sub { die "$EOP\n" };

    $att->{'pure_perl'}
      ? _boot_perl($slf, $agt, $att)
      : _boot_exe($slf, $agt, $att, $dsc->{'_opt'});

    # Transfer the control to the bootstrap program
    $agt->trace(get_string('T_SwitchBoot'))
      unless $slf->{'lvl'} < 20;  ## no critic (Unless)
    $agt->add_changes($slf->{'nod'});
    $slf->{'drv'} = $drv =
      RDA::Driver::Agent->new($slf, $slf->{'ifh'}, $slf->{'ofh'});
    $req = RDA::Object::Message->new('AGENT.BOOT', %{$att});
    $req->set_id($agt);
    $bkp = _switch_context($slf, {loc => 1,
                                  upd => undef});
    $rsp = $drv->exec_request($req);
    _switch_context($slf, $bkp);

    # Stop the agent in case of initialisation error
    if ($rsp->is_error($agt, get_string('ERR_BOOT', $oid)))
    { $slf->kill_agent;
      $slf->merge_usage;
      $agt->trace(get_string('Stopped', $oid))
        unless $slf->{'lvl'} < 10;  ## no critic (Unless)
      $slf->delete_object;
      $agt->abort;
    }
  }
  elsif ($typ eq 'U')
  { local $SIG{'PIPE'} = sub { die "$EOP\n" };

    $agt->trace(get_string('UseCurrent', $bld))
      unless $slf->{'lvl'} < 10;  ## no critic (Unless)

    # Start the remote agent
    $agt->trace(get_string('T_ExecAgent'))
      unless $slf->{'lvl'} < 20;  ## no critic (Unless)
    $buf = join(q{ }, 'exec',
      map {RDA::Local::Unix->quote($_)} @{$att->{'next'}}).$LF;
    $slf->{'ofh'}->syswrite($buf, length($buf));

    # Create the communication channel
    $agt->trace(get_string('T_SetChannel'))
      unless $slf->{'lvl'} < 20;  ## no critic (Unless)
    $agt->add_changes($slf->{'nod'});
    $slf->{'drv'} = $drv =
      RDA::Driver::Agent->new($slf, $slf->{'ifh'}, $slf->{'ofh'});
  }
  else
  { $agt->abort($@, get_string('ERR_LAUNCH', $oid, $typ));
  }

  # Initialize the agent
  $req = RDA::Object::Message->new('AGENT.INIT', %{$att});
  $req->set_id($agt);
  $rsp = $drv->exec_request($req);

  # Stop the agent in case of initialisation error
  if ($rsp->is_error($agt, get_string('ERR_START', $oid)))
  { $slf->kill_agent;
    $slf->merge_usage;
    $agt->trace(get_string('Stopped', $oid))
      unless $slf->{'lvl'} < 10;  ## no critic (Unless)
    $slf->delete_object;
    $agt->abort;
  }

  # Modify agent behavior
  $slf->{'_kil'} = 1 if $rsp->set_value('no_exit');
  delete($agt->{'_chg'}->{uc($oid)}) if $rsp->set_value('no_proxy');
  $drv->set_eol($val) if defined($val = $rsp->set_value('eol'));
  if ($rsp->set_value('no_usage'))
  { delete($slf->{'upd'});
    $slf->{'loc'} = 1;
  }
  elsif ($val = $rsp->set_value('usage_request'))
  { $slf->{'upd'} = $val;
  }
  $slf->{'_ses'}->set_family($rsp->get_first('family'));

  # Return a reference to the response message
  return $rsp;
}

sub _boot_exe  ## no critic (Complex)
{ my ($slf, $agt, $att, $opt) = @_;
  my ($buf, $cmd, $dst, $eng, $nam, $put);

  # Detect the type of the remote node
  $buf = "uname -a$LF";
  $slf->{'ofh'}->syswrite($buf, length($buf));
  die "No response\n" unless $slf->{'ifh'}->sysread($buf, 1024);
  $agt->trace(get_string('T_HasEngine', $buf))
    unless $slf->{'lvl'} < 20;  ## no critic (Unless)
  if ($buf =~ m/^AIX\b/i)
  { $nam = 'rda_aix';
    $put = \&_put_exe;
  }
  elsif ($buf =~ m/^Cygwin/i)
  { $nam = 'rda_win32.exe';
    $put = \&_put_exe;
  }
  elsif ($buf =~ m/\bDarwin\b/)
  { $nam = ($buf =~ m/\spowerpc\s/i) ? 'rda_macp' : 'rda_macx';
    $put = \&_put_exe;
  }
  elsif ($buf =~ m/^HP-UX\b/i)
  { $nam = 'rda_hpux';
    $put = \&_put_exe_hp;
  }
  elsif ($buf =~ m/^Linux\b/i)
  { $nam = 'rda_lin32' if $buf =~ m/\b([ix]\d*86|ia64|amd)\b/i;
    $put = \&_put_exe;
  }
  elsif ($buf =~ m/^OSF1\b/i)
  { $nam = 'rda_osf';
    $put = \&_put_exe;
  }
  elsif ($buf =~ m/^SunOS\b/i)
  { $nam = ($buf =~ m/\ssparc(v9)?\s/) ? 'rda_sols' : 'rda_solx';
    $put = \&_put_exe;
  }

  # Switch to a Perl installation if no compiled engine is available
  return _boot_perl($slf, $agt, $att) unless defined($nam)
    && -r ($eng = $agt->get_config->get_file('D_RDA', "engine/$nam"));
  $agt->trace(get_string('UseCompiled'))
    unless $slf->{'lvl'} < 10;  ## no critic (Unless)

  # Create the remote engine directory
  $dst = exists($att->{'rda'})
    ? RDA::Local::Unix->cat_dir($att->{'rda'}, 'engine')
    : 'engine';
  $agt->trace(get_string('T_CreateDir', $dst))
    unless $slf->{'lvl'} < 20;  ## no critic (Unless)
  _mkdir($slf, $dst);

  # Create the engine configuration file
  $agt->trace(get_string('T_SetEngine'))
    unless $slf->{'lvl'} < 20;  ## no critic (Unless)
  _put_data($slf, [$dst, 'rda.cfg'],
    q{RDA_ENG=""},
    q{RDA_EXE="rda.exe"},
    q{D_RDA=".."});
  sleep(1);

  # Transfer the compiled engine
  $agt->trace(get_string('T_SendEngine', $nam))
    unless $slf->{'lvl'} < 20;  ## no critic (Unless)
  $cmd = &$put($slf, [$dst, $nam], $eng);
  sleep(1);

  # Start the bootstrap program
  $agt->trace(get_string('T_ExecBoot'))
    unless $slf->{'lvl'} < 20;  ## no critic (Unless)
  $buf = join(q{ }, 'exec', $cmd, '-eCFG/B_NO_CHECK=1', @{$opt}).$LF;
  $slf->{'ofh'}->syswrite($buf, length($buf));
  return;
}

sub _boot_perl
{ my ($slf, $agt, $att) = @_;
  my ($buf, $cmd, $dst);

  $agt->trace(get_string('UsePerl'))
    unless $slf->{'lvl'} < 10;  ## no critic (Unless)

  # Create the remote directory
  if (exists($att->{'rda'}))
  { $dst = $att->{'rda'};
    $agt->trace(get_string('T_CreateDir', $dst))
      unless $slf->{'lvl'} < 20;  ## no critic (Unless)
    _mkdir($slf, $dst);
  }
  else
  { $dst = RDA::Local::Unix->current_dir;
  }

  # Transfer the bootstrap program
  $agt->trace(get_string('T_SendBoot'))
    unless $slf->{'lvl'} < 20;  ## no critic (Unless)
  $cmd = _put($slf, [$dst, 'sdboot.pl'],
    $agt->get_config->get_file('D_RDA', 'sdboot.pl'), 1);

  # Start the bootstrap program
  $agt->trace(get_string('T_ExecBoot'))
    unless $slf->{'lvl'} < 20;  ## no critic (Unless)
  $buf = 'exec perl '.$cmd.$LF;
  $slf->{'ofh'}->syswrite($buf, length($buf));
  return;
}

sub _mkdir
{ my ($slf, @dir) = @_;
  my ($buf, $dir);

  $dir = RDA::Local::Unix->quote(RDA::Local::Unix->cat_dir(@dir));
  $buf = "mkdir -p $dir$LF"
        ."chmod 755 $dir$LF";
  $slf->{'ofh'}->syswrite($buf, length($buf));
  return $dir;
}

sub _put
{ my ($slf, $dst, $src, $exe) = @_;
  my ($buf, $ifh, $lgt);

  $dst = RDA::Local::Unix->quote(RDA::Local::Unix->cat_dir(@{$dst}));
  $ifh = IO::File->new;
  if ($ifh->open("<$src"))
  { $buf = "rm -f $dst$LF"
          ."cat >$dst <<'$EOD'$LF";
    $slf->{'ofh'}->syswrite($buf, length($buf));
    $slf->{'ofh'}->syswrite($buf, $lgt)
      while ($lgt = $ifh->sysread($buf, 1024));
    $buf = "$EOD${LF}chmod ".($exe ? '555' : '444')." $dst$LF";
    $slf->{'ofh'}->syswrite($buf, length($buf));
    $ifh->close;
  }
  return $dst;
}

sub _put_data
{ my ($slf, $dst, @dat) = @_;
  my ($buf);

  $dst = RDA::Local::Unix->quote(RDA::Local::Unix->cat_dir(@{$dst}));
  $buf = join($LF,
    "rm -f $dst",
    "cat >$dst <<'$EOD'",
    @dat,
    $EOD,
    "chmod 444 $dst$LF");
  $slf->{'ofh'}->syswrite($buf, length($buf));
  return $dst;
}

sub _put_exe
{ my ($slf, $dst, $src) = @_;
  my ($buf, $ifh, $lgt, $siz);

  $dst = RDA::Local::Unix->quote(RDA::Local::Unix->cat_dir(@{$dst}));
  $siz = (stat($src))[7];

  $ifh = IO::File->new;
  if ($ifh->open("<$src"))
  { # Transfer the file
    $buf = "rm -f $dst$LF"
          ."sh -c 'exec dd ibs=1 count=$siz of=$dst 2>&1'$LF";
    $slf->{'ofh'}->syswrite($buf, length($buf));
    binmode($ifh);
    sleep(1);
    while ($siz > 0  && ($lgt = $ifh->sysread($buf, 1024)))
    { $slf->{'ofh'}->syswrite($buf, $lgt);
      $siz -= $lgt;
    }
    $ifh->close;

    # Wait for transfer completion
    $buf = q{};
    do {
      $slf->{'ifh'}->sysread($buf, 256, length($buf));
    } while $buf !~ m/records out/;

    # Set permissions
    $buf = "chmod 555 $dst$LF";
    $slf->{'ofh'}->syswrite($buf, length($buf));
  }
  return $dst;
}

sub _put_exe_hp
{ my ($slf, $dst, $src) = @_;
  my ($blk, $buf, $cnt, $ifh, $lgt, $siz);

  $blk = 8192;
  $dst = RDA::Local::Unix->quote(RDA::Local::Unix->cat_dir(@{$dst}));
  $siz = (stat($src))[7];
  $cnt = int(($siz + $blk - 1) / $blk);

  $ifh = IO::File->new;
  if ($ifh->open("<$src"))
  { # Transfer the file
    $buf = "rm -f $dst$LF"
          ."sh -c 'exec dd bs=$blk count=$cnt of=$dst 2>&1'$LF";
    $slf->{'ofh'}->syswrite($buf, length($buf));
    binmode($ifh);
    sleep(1);
    while ($siz > 0  && ($lgt = $ifh->sysread($buf, $blk)))
    { $slf->{'ofh'}->syswrite($buf, $lgt);
      $siz -= $lgt;
    }
    $ifh->close;

    # Wait for transfer completion
    $buf = q{};
    do {
      $slf->{'ifh'}->sysread($buf, 256, length($buf));
    } while $buf !~ m/records out/;

    # Set permissions
    $buf = "chmod 555 $dst$LF";
    $slf->{'ofh'}->syswrite($buf, length($buf));
  }
  return $dst;
}

sub _switch_context
{ my ($slf, $hsh) = @_;
  my ($bkp, $val);

  foreach my $key (keys(%{$hsh}))
  { $bkp->{$key} = delete($slf->{$key});
    $slf->{$key} = $val if defined($val = $hsh->{$key});
  }
  return $bkp;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Driver::Agent|RDA::Driver::Agent>,
L<RDA::Error|RDA::Error>,
L<RDA::Handle::Agent|RDA::Handle::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Access|RDA::Object::Access>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Remote|RDA::Object::Remote>,
L<RDA::Object::View|RDA::Object::View>,
L<RDA::Request::AGENT|RDA::Request::AGENT>,
L<RDA::Text|RDA::Text>,
L<RDA::Trace|RDA::Trace>

=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