# COPYRIGHT_NOTICE_START
# Licensed Materials - Property of IBM
# "Restricted Materials of IBM" -- 5746-SM2
# (C) Copyright IBM Corp. 2007, 2008 All Rights Reserved.
# US Government Users Restricted Rights - Use, duplication or disclosure
# restricted by GSA ADP Schedule Contract with IBM Corp.
# COPYRIGHT_NOTICE_END

package Maiken;

=head1 NAME

  Maiken - installation and configuration of binary translation technology

=head1 SYNOPSIS

  use Maiken;
  my $installer = Maiken->new(product => 'RO');
  $installer->run_interactively;

=head1 DESCRIPTION

Maiken is a class hierarchy that facilitates installation and
configuration of binary translation technology.

=cut

use strict;
use warnings;

# Here's a little Perlism - chop off the "in Foo.pm line 123" from the
# end of any warnings generated by Perl itself (rather than silencing
# them altogether, which would be bad).
BEGIN {
  $SIG{__WARN__} = sub {
    my $msg = shift;
    $msg =~ s/ at .*? line \d+\.?$//;
    warn $msg;
  };
}

use Carp ();
use Data::Dumper ();
use File::Basename ();
use File::Spec ();
use File::Temp ();
use I18N::Langinfo ();
use Term::ReadLine ();

use base 'Maiken::UtilFunctions';

# Default configuration
sub ROOT          { File::Basename::dirname(__FILE__).'/..' }
sub PRODUCT_NAME  { 'OVERRIDE_ME' }
sub OLD_PRODUCT_NAMES { [] }
sub PRODUCT_NAME_FRIENDLY  { 'OVERRIDE_ME' }
sub PRODUCT_NAME_FRIENDLY_LONG { $_[0]->PRODUCT_NAME_FRIENDLY }
sub SW_NAME       { 'OVERRIDE_ME' }
sub CONFIG_DIR    { '/etc/opt/'.($_[1] || $_[0]->PRODUCT_NAME) }
sub CONFIG_FILE   { 'config' }
sub LOG_DIR       { '/var/opt/'.($_[1] || $_[0]->PRODUCT_NAME).'/log' }
sub SUPPORT_EMAIL { 'lx86@us.ibm.com' }
sub SUPPORT_NAME  { $_[0]->SUPPORT_EMAIL }
sub QT_ROOT_PATH  { '/opt/'.($_[1] || $_[0]->PRODUCT_NAME) }
sub SW_ROOT_PATH  { 'OVERRIDE_ME' }
sub BIN_DIR       { '/usr/local/bin' }

sub MAIKEN_VERSION_FILE { $_[0]->ROOT . '/resources/doc/version' }

# Override this if you want different config file settings to be
# overridden by default - default is a subroutine *name* for
# introspective reasons
sub CONFIG_DEFAULTS {
  [
   {
    key => 'qt_root_path',
    var => 'POWERVM_LX86_LOCATION',
    old_var_names => ['FU_OPT_P_AVE', 'FU_OPT_POWERVM_LX86'],
    default => 'QT_ROOT_PATH',
    question => ["Install [_1] to:", $_[0]->PRODUCT_NAME],
    askif => sub { $_[0]->{config}{install_qt} },
    path => 1,
   },
   {
    key => 'logfile_path',
    var => 'LOGFILE_PATH',
    default => 'LOG_DIR',
    question => ["Log files created by [_1] will be stored in:",
		 $_[0]->PRODUCT_NAME],
    askif => sub { $_[0]->{config}{install_qt} },
    path => 1,
   },
   {
    key => 'sw_root_path',
    var => 'SUBJECT_WORLD_ROOT',
    old_var_names => ['FU_OPT_SUBJECT_WORLD_ROOT'],
    default => 'SW_ROOT_PATH',
    question => ["Install [_1] to:", $_[0]->SW_NAME],
    askif => sub { $_[0]->{config}{install_sw} },
    path => 1,
   },
  ]
}

=head1 METHODS

=over 4

=item B<new>

  my $installer = Maiken->new(product => 'RO');

Initialize the installer. You must provide a 'product' argument that
is the code for the general product you are installing.

The actual class of installer to run will be autodetected.

=cut

sub new {
  my ($class, %args) = @_;

  # Set up the encoding of STDOUT to match the user's output
  my $encoding = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
  # If the encoding is one of the ANSI standards, bump it up to
  # UTF-8 so we don't get ugly messages from Perl for 0xF???????
  $encoding = 'UTF-8' if $encoding =~ /ANSI_X3/;
  # If it's unsupported encoding, bump up to UTF-8. This isn't ideal
  # but at least the installer will work.
  if (not Encode::find_encoding($encoding)) {
    $encoding = 'UTF-8';
  }
  binmode STDOUT, ":encoding($encoding)";

  $class->croak("Maiken->new called without a 'product' parameter")
    unless $args{product};
  # Create $self by calling initialize_delegate from the appropriate
  # product subclass.
  my $self = eval qq{
                      require Maiken::$args{product};
                      Maiken::$args{product}->initialize_delegate;
                    };
  if ($@) {
    $class->croak("Error loading [_1]: [_2]", $args{product}, $@);
  }

  $self->{product} = $args{product};
  $self->{quiet} = $args{quiet};
  $self->{encoding} = $encoding;
  $self->_initialize_all;
  $self->initialize;

  # If the initialize* functions added delayed_messages, log them now
  if ($self->{delayed_messages}) {
    $self->log(@$_) for @{$self->{delayed_messages}};
    delete $self->{delayed_messages};
  }

  # Print the command line used to invoke Maiken
  if ($args{argv}) {
    $self->log_only_to_file(Data::Dumper->Dump([[$0, @{$args{argv}}]],
					       ['cmdline']));
  }

  # Log any useful information to file
  $self->log_system_information;

  return $self;
}

=item B<_initialize_all>

This function is run on all subclasses of Maiken when they are
initialized.

=cut

sub _initialize_all {
  my ($self) = @_;

  # Check we're running as root
  if ($> != 0) {
    $self->croak("Superuser privileges are required for this script");
  }

  # Chdir to / in case we do something like remove the pwd while we're
  # running.
  chdir '/' or $self->croak("Couldn't chdir");

  # Initialize important variables
  $self->{config} = {};
  $self->{transactions} = [];

  # Look not just for the CONFIG_DIR but also for old ones
  if (-d $self->CONFIG_DIR) {
    $self->{config}{config_dir} = $self->CONFIG_DIR;
  }

  # Also, generate an error if we have both the old and the new
  foreach my $old (@{$self->OLD_PRODUCT_NAMES}) {
    if (-d $self->CONFIG_DIR($old)) {
      if ($self->{config}{config_dir}) {
	$self->croak("Both [_1] and [_2] exist. Please remove one of these directories and restart the installer.", $self->CONFIG_DIR($old), $self->{config}{config_dir});
      }
      $self->{config}{config_dir} = $self->CONFIG_DIR($old);
      last;
    }
    $self->{config}{config_dir} ||= $self->CONFIG_DIR;
  }

  # Get a terminal handle
  if (-t STDIN) {
    $self->{rl} = Term::ReadLine->new('Maiken');
    $self->{rl}->ornaments(0); # Remove the horrid decorations
    my $attribs = $self->{rl}->Attribs;
    # Tab complete filenames in all cases
    if ($self->{rl}->can('completion_matches')) {
      $attribs->{completion_function} = sub {
	$self->{rl}->completion_matches
	  (
	   shift,
	   $attribs->{filename_completion_function}
	  )
	};
    }
    # Turn on autoflushing
    $| = 1;
  }

  # Create a logfile
  $self->{logfile} =
    File::Temp->new(
		    TEMPLATE => $self->PRODUCT_NAME.'_install_XXXXXX',
		    DIR      => File::Spec->tmpdir,
		    SUFFIX   => '.log',
		    UNLINK   => 0,
		   );
  binmode $self->{logfile}, ':utf8'; # This is a unicode filehandle
  $self->log_only_to_file("\x{FEFF}"); # The BOM
  $self->log_only_to_file("Installer log begins ".scalar(localtime)."\n\n");
  $self->log_only_to_file("The LANG environment variable is ".($ENV{LANG} || 'undefined').".\n");
  $self->log_only_to_file("User's encoding is assumed to be $self->{encoding}.\n\n");
}

=item B<initialize>

Override this function to create constructors for your classes. Don't
forget to call $self->SUPER::initialize in your overridden method.

=cut

sub initialize {
  my ($self) = @_;
}

=item B<log_system_information>

This function is a convenient place to log useful bits of system information to
file to help support to diagnose problems.

=cut

sub log_system_information {
  my ($self) = @_;
}

=item B<version>

Return the version on the installer in use.

=cut

sub version {
  my ($pkg) = @_;
  my $ver = $pkg->slurp( $pkg->MAIKEN_VERSION_FILE );
  chomp $ver;
  return $ver;
}

=item B<run_interactively>

Override this function only if you want to change the default
behaviour of the installer when running in interactive mode.

=cut

sub run_interactively {
  my ($self) = @_;
  $self->{interactive_mode} = 1;
  $self->{quiet} = 0;
  $self->welcome;
  $self->set_up_environment;
  $self->check_environment;
  if ($self->get_initial_config_interactively) {
    while ((my $action = $self->prompt_user_for_action) ne 'quit') {
      $self->{config} = {
			 # Special variable we mustn't clear
			 config_dir => $self->{config}{config_dir},
			};
      $self->{cleanup_dirs} = [];
      $self->check_environment;
      if ($action eq 'install') {
	if ($self->get_install_config_interactively) {
	  $self->install;
	}
	else {
	  $self->cleanup_cleanup_dirs;
	}
      }
      elsif ($action eq 'upgrade') {
	if ($self->get_upgrade_config_interactively) {
	  $self->upgrade;
	}
	else {
	  $self->cleanup_cleanup_dirs;
	}
      }
      elsif ($action eq 'uninstall') {
	if ($self->get_uninstall_config_interactively) {
	  $self->uninstall;
	}
	else {
	  $self->cleanup_cleanup_dirs;
	}
      }
      elsif ($action eq 'show') {
	$self->show_installed_products;
      }
      elsif ($action eq 'configure') {
	my $config_options = $self->get_configure_config_interactively;
	$self->configure($config_options)
	  if $config_options and %$config_options;
      }
      else {
	$self->croak("Unknown action '[_1]'", $action);
      }
    }
  }
  $self->quit;
}

=item B<run_noninteractively>

Takes an action (eg. 'install') as its first argument.

Takes an hash of modifiers to the action
(eg. {products => [qw/Lx86 x86world/]}) as the second argument.

Override this function only if you want to change the default
behaviour of the installer when running in non-interactive mode.

=cut

sub run_noninteractively {
  my ($self, $action, $modifiers) = @_;
  $self->welcome;
  $self->set_up_environment;
  $self->check_environment;
  $self->get_all_config_from_file($modifiers->{config});
  $self->sanity_initial_config($modifiers) or $self->croak;
  if ($action eq 'install') {
    if ($self->sanity_install_config($modifiers)) {
       $self->install;
    }
    else {
      $self->cleanup_cleanup_dirs;
      $self->croak("[_1] failed. Please check the messages above.", 'Install');
    }
  }
  elsif ($action eq 'upgrade') {
    if ($self->sanity_upgrade_config($modifiers)) {
       $self->upgrade;
    }
    else {
      $self->cleanup_cleanup_dirs;
      $self->croak("[_1] failed. Please check the messages above.", 'Upgrade');
    }
  }
  elsif ($action eq 'uninstall') {
    if ($self->sanity_uninstall_config($modifiers)) {
       $self->uninstall;
    }
    else {
      $self->cleanup_cleanup_dirs;
      $self->croak("[_1] failed. Please check the messages above.", #
		   'Uninstall');
    }
  }
  elsif ($action eq 'show') {
    $self->show_installed_products;
  }
  elsif ($action eq 'configure') {
    if (my $config_options = $self->get_configure_config_noninteractively($modifiers)) {
      $self->configure($config_options)	if %$config_options;
    }
    else {
      $self->croak("[_1] failed. Please check the messages above.",
		   'Configure');
    }
  }
  $self->quit;
}

=item B<cleanup_cleanup_dirs>

Delete any non-empty directories that have been added to
$self->{cleanup_dirs} during a configuration step. This function is
called if any of the get_*_config_interactively functions for
install/upgrade/uninstall fail.

=cut

sub cleanup_cleanup_dirs {
  my ($self) = @_;
  if ($self->{cleanup_dirs}) {
    # Don't raise an error if it fails
    rmdir $_ for reverse @{$self->{cleanup_dirs}};
  }
  $self->{cleanup_dirs} = [];
}


=item B<set_up_environment>

Override this function if you need to set up anything environmental
for the duration of the install, such as %ENV, chdir, umask.

=cut

sub set_up_environment {
  my ($self) = @_;
}

=item B<check_environment>

After making any changes to the environment in set_up_environment,
this method is called to check that the system is set up ready for
installation.

This method can also be used to ascertain information about the
current setup, eg. if QT is already installed.

The $self->{config} is cleared at the main menu directly before this
method is called so if you want default values for $self->{config} you
should put them in here.

It's perfectly acceptable to croak here if you wish.

=cut

sub check_environment {
  my ($self) = @_;
}	

=item B<get_initial_config_interactively>

Override this function if you need to get configuration information
from the user before the user is asked what he wants to do.

Information should be retrieved using the ask() method and should be
placed in a hash called $self->{config}.

=cut

sub get_initial_config_interactively {
  my ($self) = @_;
}

=item B<prompt_user_for_action>

Ask the user for an action and return it as a string for the
run_interactively method to delegate to another method.

=cut

sub prompt_user_for_action {
  my ($self) = @_;
  my $options = [
		 [install   => "Install Software."],
		 [upgrade   => "Upgrade Software."],
		 [uninstall => "Uninstall Software."],
		 [show      => "Show Installed Products."],
		 [configure => "Configure Software."],
		 [quit      => "Quit."],
		];
  return $self->menu($options);
}

=item B<sanity_initial_config>

Override this function if you need to check things are set in the
$self->{config} or modifiers before calling the main action's sanity
method.

Return true if everything is OK, false otherwise.

=cut

sub sanity_initial_config {
  my ($self, $modifiers) = @_;
  return 1;
}

=item B<get_install_config_interactively>

Override this function so you can get the following information from
the user:

  What they want to install.
  Configuration information about the installation.

Must return a true value or it is assumed the user has given up.

=cut

sub get_install_config_interactively {
  my ($self) = @_;
  return 1;
}

=item B<sanity_install_config>

Override this function to check the contents of $self->{config} are
correct for a non-interactive install.

The contents of $modifiers can be used to determine the config.

The method is allowed to set up extra stuff and modify
$self->{config}.

Should return true if everything is OK or false otherwise.

=cut

sub sanity_install_config {
  my ($self, $modifiers) = @_;
  $self->log("\nSorry. This function is not implemented.");
  return 0;
}

=item B<install>

Override this function to perform the installation based on the
contents of $self->{config}. This function should be fully
non-interactive and should not make any calls to ask().

=cut

sub install {
  my ($self) = @_;
}

=item B<get_upgrade_config_interactively>

As get_install_config_interactively but for upgrades.

=cut

sub get_upgrade_config_interactively {
  my ($self) = @_;
  return 1;
}

=item B<sanity_upgrade_config>

As sanity_install_config for for upgrades.

=cut

sub sanity_upgrade_config {
  my ($self, $modifiers) = @_;
  $self->log("\nSorry. This function is not implemented.");
  return 0;
}

=item B<upgrade>

As install() but for upgrades.

=cut

sub upgrade {
  my ($self) = @_;
}

=item B<get_uninstall_config_interactively>

As get_install_config_interactively but for uninstalls.

=cut

sub get_uninstall_config_interactively {
  my ($self) = @_;
  return 1;
}

=item B<sanity_uninstall_config>

As sanity_install_config for for uninstall.

=cut

sub sanity_uninstall_config {
  my ($self, $modifiers) = @_;
  $self->log("\nSorry. This function is not implemented.");
  return 0;
}

=item B<uninstall>

As install() but for upgrades.

=cut

sub uninstall {
  my ($self) = @_;
}

=item B<show_installed_products>

Override this method only if you want to change the behaviour of the
"show installed products" menu option.

If you want to provide a list of products to this method, you should
override get_installed_products below.

=cut

sub show_installed_products {
  my ($self) = @_;
  $self->log;
  {
    local $self->{quiet} = 0;
    $self->log("You have the following software products installed:");
    $self->log;
    my @products = $self->get_installed_products;
    if (@products) {
      for (@products) {
	$self->log_no_trans('  - ');
	$self->log(@$_);
      }
    }
    else {
      $self->log_no_trans('  ');
      $self->log("No software products installed");
    }
  }
}

=item B<get_installed_products>

If you are using the default behaviour of show_installed_products
above, override this method to return an array of arrayrefs (to pass
to log()) describing the currently installed products.

=cut

sub get_installed_products {
  my ($self) = @_;
  my @products;
  return @products;
}

=item B<get_configure_config_interactively>

This function should return a hashref to pass to configure(), below.

If it returns an empty hashref it will be assumed that no
configuration has been asked for.

The default behaviour is to tell the user that no configuration
options are available.

=cut

sub get_configure_config_interactively {
  my ($self) = @_;
  $self->log;
  $self->log("No configuration options are currently available.");
  return {};
}

=item B<get_configure_config_noninteractively>

This function should acquire the same data as
get_configure_config_interactively but from non-interactive sources
(such as the config file).

If it returns undef, it will be assumed that it is unsuccessful.

If it returns an empty hashref it will be assumed that no
configuration has been asked for.

The default behaviour is to tell the user that no configuration
options are available.

=cut

sub get_configure_config_noninteractively {
  my ($self, $modifiers) = @_;
  $self->log;
  $self->log("No configuration options are currently available in noninteractive mode.");
  return {};
}

=item B<configure>

Override this with the actual configuration of software specified in
the passed $config hashref.

Remember this is a non-interactive function.

=cut

sub configure {
  my ($self, $config) = @_;
  return;
}

=item B<quit>

Override this function if you want different behaviour when the user
chooses to quit.

=cut

sub quit {
  my ($self) = @_;
  $self->{quitting} = 1; # so check_environment knows we're quitting
  #Make sure the environment details are up to date
  $self->check_environment() ;
  $self->goodbye;
  $self->umount_all;
  exit 0;
}

=item B<welcome>

Welcome the user. Override this if you like.

=cut

sub welcome {
  my ($self) = @_;
  my $welcome = q{
Welcome to the [_1] Installer
};
  $self->log($welcome, $self->PRODUCT_NAME_FRIENDLY_LONG);
}

=item B<goodbye>

Say goodbye to the user. Override this if you like.

Default includes a list of transactions from the $self->{transactions}
log.

=cut

sub goodbye {
  my ($self) = @_;
  if ($self->{config}{accepted_license_terms}) {
    $self->log;
    $self->log("License text saved in [_1]. You may print this file for your records.", $self->LICENSE_FILE);
  }
  if ($self->{interactive_mode}) {
    $self->log;
    $self->log('Thank you for using the [_1] Installer', $self->PRODUCT_NAME_FRIENDLY);
    $self->log;
    $self->log('Today you performed the following transactions:');
    my @transactions = @{$self->{transactions}};
    if (not @transactions) {
      $self->log_no_trans("  ");
      $self->log("Nothing");
    }
    else {
      for (@transactions) {
	my ($first, @rest) = (ref() ? @$_ : $_);
	$self->log_no_trans("  ");
	$self->log("$first", @rest);
    }
  }
    $self->log;
    $self->log("End of Transaction log.");
    if ($self->{config}{rpm_installed} and $self->{config}{sw_installed}) {
      $self->log;
      $self->log("To start a translated [_1] shell, run [_2]",
		 $self->SW_NAME, $self->BIN_DIR.'/'.$self->RUNX86);
    }
  }
  $self->log;
  $self->log("The full log of your session is in [_1]",
	     $self->{logfile}->filename);
}

=back 4

=cut

1;
