#!/usr/bin/perl -w

=head1 NAME

xt-install-image - Install a fresh copy of GNU/Linux into a directory

=cut

=head1 SYNOPSIS

  xt-install-image [options]

  Help Options:
   --help     Show this scripts help information.
   --manual   Read this scripts manual.
   --version  Show the version number and exit.

  Debugging Options:
   --verbose  Be verbose in our execution.

  Mandatory Options:
   --location The location to use for the new installation
   --dist     The name of the distribution which has been installed.

  Exclusive Options:
   --untar
   --debootstrap  + --mirror
   --rpmstrap
   --copy

  All other options from B<xen-create-image> will be passed as environmental
 variables.

=cut

=head1 NOTES

  This script is invoked by B<xen-create-image> after to create a new
 distribution of Linux. 

  There are several available methods of installation, depending upon the
 users choice:

  The command line arguments which are mandatory are:

   --location  - The installation root to use.
   --dist      - The distribution which is to be installed.

  Once those mandatory arguments are parsed the installation method will
 be selected.  This could be one of :

* tar
  Untar the given file.  Assume this contains a complete installation.

* copy
  Copy from the given directory.  Assume this contains a complete installation.

* rpmstrap
  Install using rpmstrap the named dist

* debootstrap
  Install using debootstrap the named dist.

=cut


=head1 AUTHOR

 Steve
 --
 http://www.steve.org.uk/

 $Id: xt-install-image,v 1.6 2006-06-09 17:29:05 steve Exp $

=cut


=head1 LICENSE

Copyright (c) 2005-2006 by Steve Kemp.  All rights reserved.

This module is free software;
you can redistribute it and/or modify it under
the same terms as Perl itself.
The LICENSE file contains the full text of the license.

=cut


use strict;
use Env;
use Getopt::Long;
use Pod::Usage;


#
#  Configuration values read from the command line.
#
#  We do not need to read any configuration file.
#
my %CONFIG;

#
# Release number.
#
my $RELEASE = '2.0';


#
#  Parse the command line arguments.
#
parseCommandLineArguments();


#
#  Check our arguments
#
checkArguments();



#
#  Work out how to install:
#

#
#  Simplest cases first.
#
if ( $CONFIG{'copy'} )
{
    #
    #  Run a command to copy an installed system into the new root.
    #
    runCommand( "/bin/cp -a $CONFIG{'copy'}/* $CONFIG{'location'}" );
}
elsif ( $CONFIG{'untar'} )
{
    #
    #  Run a command to copy an installed system into the new root.
    #
    runCommand( "cd $CONFIG{'location'} && tar -xvf $CONFIG{'untar'}" );
}
elsif ( $CONFIG{'debootstrap'} )
{
    print "TODO: rpmstrap\n";
}
elsif ( $CONFIG{'rpmstrap'} )
{
    print "TODO: rpmstrap\n";
}
else
{
    #
    # error
    #
    # return a code so that xen-create-image can abort.
}



#
#  Exit cleanly - any errors which have already occurred will result
# in "exit 1".
#
exit 0;



=head2 parseArguments

  Parse the command line arguments this script was given.

=cut

sub parseCommandLineArguments
{
    my $HELP	= 0;
    my $MANUAL	= 0;
    my $VERSION	= 0;

    #
    #  Parse options.
    #
    GetOptions(
	       # Mandatory
	       "location=s",     \$CONFIG{'location'},
	       "dist=s",         \$CONFIG{'dist'},

	       # Exclusive.
	       "tar=s",          \$CONFIG{'tar'},
	       "copy=s",         \$CONFIG{'copy'},
	       "rpmstrap",       \$CONFIG{'rpmstrap'},
	       "debootstrap",    \$CONFIG{'debootstrap'},

	       # Misc
	       "mirror=s",       \$CONFIG{'mirror'},

	       # Help.
	       "verbose",        \$CONFIG{'verbose'},
	       "help",           \$HELP,
	       "manual",         \$MANUAL,
	       "version",        \$VERSION
	      );

    pod2usage(1) if $HELP;
    pod2usage(-verbose => 2 ) if $MANUAL;


    if ( $VERSION )
    {
	my $REVISION      = '$Revision: 1.6 $';

	if ( $REVISION =~ /1.([0-9.]+) / )
	{
	    $REVISION = $1;
	}

	print "xt-install-image release $RELEASE - CVS: $REVISION\n";
	exit;

    }
}



=head2 checkArguments

  Test that the command line arguments we were given make sense.

=cut

sub checkArguments
{
    #
    #  We require a location.
    #
    if ( ! defined( $CONFIG{'location'} ) )
    {
	print "The '--location' argument is mandatory\n";
	exit 1;
    }


    #
    #  Test that the location we've been told contains
    # a fresh installation of Linux exists
    #
    if ( ! -d $CONFIG{'location'} )
    {
	print "The installation directory we've been given doesn't exist\n";
	print "We tried to use : $CONFIG{'location'}\n";
	exit 1;
    }


    #
    #  We require a distribution name.
    #
    if ( ! defined( $CONFIG{'dist'} ) )
    {
	print "The '--dist' argument is mandatory\n";
	exit 1;
    }


    #
    #  Test that the distribution name we've been given
    # to configure has a collection of hook scripts.
    #
    #  If there are no scripts then we clearly cannot
    # customise it!
    #
    my $dir = "/usr/lib/xen-tools/"  . $CONFIG{'dist'} .  ".d";

    if ( ! -d $dir )
    {
	print <<E_OR;

  We're trying to configure an installation of $CONFIG{'dist'} in
 $CONFIG{'location'} - but there is no hook directory for us to use.

  This means we won't know how to configure this installation.

  We'd expect the hook directory to be : $dir

  Aborting.
E_OR
	exit 1;
    }


    ##
    # Now check the mutually distinct arguments
    ##
    my $count = 0;
    foreach my $key ( qw(copy debootstrap rpmstrap tar ) )
    {
	if ( defined( $CONFIG{$key} ) )
	{
	    $count += 1;
	}
    }

    #
    # If count == 0 we had no recognised installation methods
    #
    if ( $count == 0 )
    {
	print <<EOF;
 You did not specify an installation method.

 One of the following must be given.  (Run "xt-install-image --manual" for details)

   --copy
   --debootstrap
   --rpmstrap
   --tar

 Aborting.
EOF

        exit 1;
    }
    elsif ( $count > 1 )
    {
	print <<EOF;
 You specify multiple installation methods.

 Only one of the following must be given:

   --copy
   --debootstrap
   --rpmstrap
   --tar

 Aborting.
EOF
	exit 1;
    }

}




=head2 runCommand

  A utility method to run a system command.  We will capture the return
 value and exit if the command files.

  When running verbosely we will also display any command output.

=cut

sub runCommand
{
    my ( $cmd ) = (@_ );

    #
    #  Header.
    #
    $CONFIG{'verbose'} && print "Executing : $cmd\n";

    #
    #  Hide output unless running with --debug.
    #
    $cmd .= " >/dev/null 2>/dev/null" unless $CONFIG{'verbose'};

    #
    #  Run it.
    #
    my $output = `$cmd`;

    if ( $? != 0 )
    {
	print "Running command '$cmd' failed.\n";
	print "Aborting\n";
	exit;
    }


    #
    # All done.
    #
    $CONFIG{'verbose'} && print "Output\n";
    $CONFIG{'verbose'} && print "======\n";
    $CONFIG{'verbose'} && print $output . "\n";
    $CONFIG{'verbose'} && print "Finished : $cmd\n";

    return( $output );
}