#!/usr/bin/perl -w

=head1 NAME

xen-create-image - Create a new Xen instance

=cut

=head1 SYNOPSIS


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

  Size / General options:
   --boot        Boot the new instance after creating it.
   --cache       Cache .deb files on the host when using B<--debootstrap>
   --force       Force overwriting existing images.
   --fs          Specify the filesystem type to use.
   --initrd      Specify the initial ramdisk
   --kernel      Set the path to the kernel to use for dom U.
   --memory      Setup the amount of memory allocated to the instance.
   --passwd      Ask for a root password during setup.
   --size        Set the size of the primary disk image.
   --swap        Set the size of the swap partition.
   --ide         Use IDE names for virtual devices (hda not sda)

  Installation options:
   --copy        Install the new image by copying from the given directory.
   --dist        Specify the distribution you wish to install
   --debootstrap Use debootstrap to install the distribution B<--dist>
   --mirror      Setup the mirror to use when installing with B<--debootstrap>.
   --rpmstrap    Use rpmstrap to install the distribution B<--dist>
   --tar         Install the new image by untarring the given file.

  Networking options:
   --dhcp      Setup the image to get an IP address via DHCP
   --gateway   Setup the iamge's network gateway.
   --ip	       Setup the ip
   --netmask   Setup the netmask

  Mandatory options:

   --dir       Specify where the output images should go.
   --lvm       Specify the volume group to save images within.
   --hostname  Set the images hostname.

=cut


=head1 OPTIONS

=over 8

=item B<--boot>
Start the new virtual instance as soon as the installation has finished.

=item B<--cache>
Cache the .deb files in /var/cache/apt/archives upon the host system when installing a new image with B<--debootstrap> for a large speed improvement. [Defaults to yes.]

=item B<--copy>
Install a new system by copying files recursively from the given directory.  This is significantly faster than using B<--rpmstrap> or B<--debootstrap>, but it does require that you have installed a distribution "slowly" at least once.

=item B<--debug>
Show the commands this script executes as an aid to debugging.

=item B<--debootstrap>
Use debootstrap to install the distribution B<--dist>.  When specifying B<--debootstrap> you should choose a local mirror with B<--mirror>

=item B<--dhcp>
Specify that the virtual image should use DHCP to obtain its networking information.  Conflicts with B<--ip>.

=item B<--dir>
Specify the root directory beneath which the image should be saved.  Subdirectories will be created for each virtual image.  If you do not wish to use loopback files instead specify an LVM volume group with B<--lvm>.

=item B<--dist>
Specify the distribution to install, defaults to 'sarge'.

=item B<--force>
Force the script to overwrite any existing swap or disk images.  By default existing images will cause the script to abort.

=item B<--fs>
Specify the filesystem the image should be given.  Valid options are 'ext3',
'xfs', or 'reiserfs'.

=item B<--gateway>
Specify the gateway address for the virtual image, only useful if DHCP is not used.

=item B<--help>
Show the brief help information.

=item B<--hostname>
Set the hostname of the new instance.

=item B<--ide>
Use IDE style device names for the virtual devices.

=item B<--initrd>
Specify the initial ramdisk.

=item B<--ip>
Set the IP address for the virtual image.  Conflicts with B<--dhcp>.  This argument may be specified multiple times to give your new instance multiple IP addresses.

=item B<--kernel>
Set the path to the kernel to use for the image.

=item B<--manual>
Read the manual, with examples.

=item B<--memory>
Specify the amount of memory the virtual image should be allocated.  Defaults
to 96Mb.

=item B<--mirror>
Specify the mirror to use when installing distributions with the debootstrap tool.  This defaults to http://ftp.us.debian.org/debian

=item B<--netmask>
Set the netmask the virtual image should use.

=item B<--passwd>
Setup a password for the root account of the virtual machine.

=item B<--size>
Specify the size of the primary drive to give the virtual image.  The size may be suffixed with either Mb, or Gb.

=item B<--swap>
Specify the size of the virtual swap partition to create.  The size may be
suffixed with either Mb, or Gb.

=item B<--tar>
Install a new system by untarring the given file.  This is significantly faster than using B<--rpmstrap> or B<--debootstrap>, but it does require that you have installed a distribution "slowly" at least once.

=item B<--version>
Show the version number and exit.

=item B<--lvm>
Specify the LVM volume group to store images within.  If you wish to use loopback files please specify an output directory with B<--dir>.

=back

=cut

=head1 NOTES


=cut


=head1 AUTHOR

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

 $Id: xen-create-image,v 1.18 2006-06-10 14:00:19 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 English;
use Env;
use File::Temp qw/ tempdir /;
use Getopt::Long;
use Pod::Usage;


#
#  Configuration values read initially from the global configuration
# file, then optionally overridden by the command line.
#
my %CONFIG;

#
#  Global variable containing the temporary file where our image
# is mounted for installation purposes.
#
#  Why is this here?
#
#  Well it makes sure that the magic "END" section can unmount it
# if there are errors.
#
#
my $MOUNT_POINT = undef;


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





#
#  Check the environment
#
checkSystem();


#
#  Setup default options.
#
setupDefaultOptions();


#
#  Read the global configuration file.
#
readConfigurationFile();


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


#
#  Ensure we're started by root at this point.  This is required
# to make sure we can create new LVM volumes, or mount loopback images.
#
testRootUser();


#
#  Check our arguments
#
checkArguments();


#
#  Show a summery of what we're going to do.
#
showSummery();



#
#  Create and format the images if we're using loopback filesystems.
#
if ( $CONFIG{'dir'} )
{
    createLoopbackImages();
}

#
#  Create and format the LVM partitions if we're using LVM.
#
if ( $CONFIG{'lvm'} )
{
    createLVMBits();
}


#
#  Mount the image.
#
mountImage();


#
#  Call xt-install-image to do the install.
#
installSystem();


#
#  If that worked call xt-customise-image to setup networking, and
# run distro-specific hooks.
#
runCustomisationHooks();


#
#  Create the Xen configuration file.
#
runXenConfigCreation();

#
#  Unmount the disk image, and remove the temporary directory.
#
# skipped: this is handled in END


#
#  Create xen configuration file.
#


#
#  Report success.
#
print "All done\n";



=head2 checkSystem

  Test that this system is fully setup for the new xen-create-image
 script.

  This means that the two binaries xt-install-image and xt-customize-image
 are present.

=cut

sub checkSystem
{
    if ( ! -x "/usr/bin/xt-customize-image" )
    {
	print "The script 'xt-customize-image' was not found.";
	print "\nAborting\n\n";
    }
    if ( ! -x "/usr/bin/xt-install-image" )
    {
	print "The script 'xt-install-image' was not found.";
	print "\nAborting\n\n";
    }
}



=head2 setupDefaultOptions

  Setup the default options we'd expect into our global CONFIG hash.

=cut

sub setupDefaultOptions
{

    #
    # Paths and files.
    #
    $CONFIG{'dir'}         = '';
    $CONFIG{'xm'}	   = '/usr/sbin/xm';
    $CONFIG{'kernel'}	   = '/boot/vmlinuz-2.6.16-1-xen-686';
    $CONFIG{'initrd'}	   = '/boot/initrd.img-2.6.16-1-xen-686';

    #
    # Sizing options.
    #
    $CONFIG{'memory'}	   = '96Mb';
    $CONFIG{'size'}	   = '2000Mb';
    $CONFIG{'swap'}	   = '128M';
    $CONFIG{'cache'}	   = 'yes';

    #
    # Misc. options.
    #
    $CONFIG{'mirror'}	   = 'http://ftp.us.debian.org/debian';
    $CONFIG{'dist'}	   = 'sarge';
    $CONFIG{'fs'}	   = 'ext3';
    $CONFIG{'force'}	   = 0;

    #
    #  Installation methods
    #
    $CONFIG{'rpmstrap'}	   = 0;
    $CONFIG{'debootstrap'} = 0;
    $CONFIG{'copy'}        = '';
    $CONFIG{'tar'}         = '';


    #
    #  The program to run to create a filesystem.
    #
    # NOTE: These commands end in a trailing slash.  The last parameter is
    #       added as the loopback file/LVM volume to create the fs on....
    #
    $CONFIG{'make_fs_ext3'}	= '/sbin/mkfs.ext3 -F ';
    $CONFIG{'make_fs_xfs'}	= '/sbin/mkfs.xfs -d name=';
    $CONFIG{'make_fs_reiserfs'}	= '/sbin/mkfs.reiserfs -f -q ';

    #
    #  Flags to pass to "mount" to mount our image.
    #
    #  NOTE: Kinda redundent and may go away.
    #
    $CONFIG{'mount_fs_ext3'}      = '-t ext3';
    $CONFIG{'mount_fs_xfs'}       = '-t xfs';
    $CONFIG{'mount_fs_reiserfs'}  = '-t reiserfs';
}




=head2 readConfigurationFile

  read the global configuration file /etc/xen-tools/xen-tools.conf

=cut

sub readConfigurationFile
{
    my $file = '/etc/xen-tools/xen-tools.conf';
    my $line = "";


    open( FILE, "<", $file ) or die "Cannot read file '$file' - $!";

    while (defined($line = <FILE>) )
    {
        chomp $line;
	if ($line =~ s/\\$//)
	{
	    $line .= <FILE>;
	    redo unless eof(FILE);
	}

	# Skip lines beginning with comments
	next if ( $line =~ /^([ \t]*)\#/ );

	# Skip blank lines
	next if ( length( $line ) < 1 );

	# Strip trailing comments.
	if ( $line =~ /(.*)\#(.*)/ )
	{
	    $line = $1;
	}

	# Find variable settings
	if ( $line =~ /([^=]+)=([^\n]+)/ )
	{
	    my $key = $1;
	    my $val = $2;

	    # Strip leading and trailing whitespace.
	    $key =~ s/^\s+//;
	    $key =~ s/\s+$//;
	    $val =~ s/^\s+//;
	    $val =~ s/\s+$//;

	    # Store value.
	    $CONFIG{ $key } = $val;
	}
    }

    close( FILE );
}



=head2 parseCommandLineArguments

  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
	       "dist=s",      \$CONFIG{'dist'},

	       # Locations
	       "dir=s",        \$CONFIG{'dir'},
	       "kernel=s",     \$CONFIG{'kernel'},
	       "initrd=s",     \$CONFIG{'initrd'},
	       "lvm=s",        \$CONFIG{'lvm'},

	       # Networking options
	       "dhcp",         \$CONFIG{'dhcp'},
	       "gateway=s",    \$CONFIG{'gateway'},
	       "hostname=s",   \$CONFIG{'hostname'},
	       "ip=s@",        \$CONFIG{'ip'},
	       "netmask=s",    \$CONFIG{'netmask'},

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

	       # Misc. options
	       "boot",         \$CONFIG{'boot'},
	       "cache=s",      \$CONFIG{'cache'},
               "ide",          \$CONFIG{'ide'},
	       "passwd",       \$CONFIG{'passwd'},
	       "force",        \$CONFIG{'force'},

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

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


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

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

	print "xen-create-image release $RELEASE - CVS: $REVISION\n";
	exit;

    }
}


=head2 testRootUser

  Make sure this script is being run by a user with UID 0.

=cut

sub testRootUser
{
    if ( $EFFECTIVE_USER_ID != 0 )
    {
	print <<E_O_ROOT;

  In order to use this script you must be running with root privileges.

  (This is necessary to mount the disk images which are created.)

E_O_ROOT

	exit;
    }
}



=head2 checkArguments

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

=cut

sub checkArguments
{
    #
    #  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{'dir'} - but there is no hook directory for us to use.

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

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

  Aborting.
E_OR
	exit 1;
    }

}


=head2 showSummery

  Show the user a summery of what is going to be created for them

=cut

sub showSummery
{
    #
    # Show the user what to expect.
    #
    print "\nGeneral Infomation\n";
    print "--------------------\n";
    print "Hostname       :  $CONFIG{'hostname'}\n";
    print "Distribution   :  $CONFIG{'dist'}\n";
    print "Fileystem Type :  $CONFIG{'fs'}\n";

    print "\nSize Information\n";
    print "----------------\n";
    print "Image size     :  $CONFIG{'size'}\n";
    print "Swap size      :  $CONFIG{'swap'}\n" unless ( $CONFIG{'no-swap' } );
    print "Memory size    :  $CONFIG{'memory'}\n";
    print "Kernel path    :  $CONFIG{'kernel'}\n";
    print "initrd path    :  $CONFIG{'initrd'}\n";

    print "\nNetworking Information\n";
    print "----------------------\n";

    #
    # Show each IP address added.
    #
    my $ips = $CONFIG{'ip'};
    my $count = 1;

    foreach my $i ( @$ips )
    {
	print "IP Address $count   : $i\n";
	$count += 1;
    }

    $CONFIG{'dhcp'}      && print "IP Address     : DHCP\n";
    $CONFIG{'netmask'}   && print "Netmask        : $CONFIG{'netmask'}\n";
    $CONFIG{'gateway'}   && print "Gateway        : $CONFIG{'gateway'}\n";
    print "\n";

}




=head2 createLoopbackImages

  Create the two images "swap.img" and "disk.img" in the directory
 we've been given.

  We also will call the filesystem creation routine to make sure we
 have a valid filesystem.

=cut

sub createLoopbackImages
{
    #
    #  The two files we need to test.
    #
    my $disk = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/disk.img" ;
    my $swap = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/swap.img" ;

    #
    #  Make sure we have the relevant output directory.
    #
    if (  ! -d $CONFIG{'dir'} . "/domains/" )
    {
        mkdir $CONFIG{'dir'} . '/domains', 0777
          || die "Cannot create $CONFIG{'dir'}/domains - $!";
    }
    if ( ! -d $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} )
    {
        mkdir $CONFIG{'dir'}. '/domains/' . $CONFIG{'hostname'}, 0777
          || die "Cannot create $CONFIG{'dir'}/domains/$CONFIG{'hostname'} - $!" ;
    }


    #
    # Only proceed overwritting if we have --force specified.
    #
    if ( ( -e $disk ) && ! $CONFIG{'force'} )
    {
	print "The disk image already exists.  Aborting.\n";
	print "Specify '--force' to overwrite, or remove the following file\n";
	print $disk . "\n";
	exit;
    }
    if ( ( -e $swap ) && ! $CONFIG{'force'} )
    {
	print "The swap image already exists.  Aborting.\n";
	print "Specify '--force' to overwrite, or remove the following file\n";
	print $swap . "\n";
	exit;
    }


    #
    #  Modify the sizes to something reasonable
    #
    my $disk_size = $CONFIG{'size'};
    my $swap_size = $CONFIG{'swap'};

    #
    # Convert Gb -> Mb for the disk image size, and swap size.
    #
    if ( $disk_size =~ /^(\d+)Gb*$/i )
    {
	$disk_size = $1 * 1024 . "M";
    }
    if ( $swap_size =~ /^(\d+)Gb*$/i )
    {
	$swap_size = $1 * 1024 . "M";
    }

    #
    #  Final adjustments to sizing.
    #
    $disk_size =~ s/Mb*$/k/i;
    if ( $swap_size =~ /^(\d+)Mb*$/i )
    {
	$swap_size = $1;
    }


    #  Use dd to create the swap
    #
    print "\nCreating swap image: $swap\n";
    my $swap_cmd = "/bin/dd if=/dev/zero of=$swap bs=1024k count=$swap_size";
    runCommand( $swap_cmd );
    print "Done\n";


    #
    #  Use dd to create the disk image.
    #
    print "\nCreating disk image: $disk\n";
    my $image_cmd = "/bin/dd if=/dev/zero of=$disk bs=$disk_size count=0 seek=1024";
    runCommand( $image_cmd );
    print "Done\n";


    #
    #  Finally create the filesystem
    #
    createFilesystem( $disk );
}


=head2 createLVMBits

  This fucntion is responsible for creating two new logical volumes within
 a given LVM volume group.

=cut

sub createLVMBits
{
    #
    #  The two volumes we will need to use..
    #
    my $disk = $CONFIG{'hostname'} . "-disk" ;
    my $swap = $CONFIG{'hostname'} . "-swap" ;

    #
    #  TODO:  Check whether the volumes exist, and if so abort
    #         unless '--force' is specified.
    #

    #
    #  Modify the sizes to something reasonable
    #
    my $disk_size = $CONFIG{'size'};
    my $swap_size = $CONFIG{'swap'};

    #
    # Convert Gb -> Mb for the disk image size, and swap size.
    #
    if ( $disk_size =~ /^(\d+)Gb*$/i )
    {
	$disk_size = $1 * 1024 . "M";
    }
    if ( $swap_size =~ /^(\d+)Gb*$/i )
    {
	$swap_size = $1 * 1024 . "M";
    }

    #
    #  Final adjustments to sizing.
    #
    $disk_size =~ s/Mb*$/k/i;
    if ( $swap_size =~ /^(\d+)Mb*$/i )
    {
	$swap_size = $1;
    }


    #
    # The commands to create the volumes.
    #
    my $disk_cmd = "/sbin/lvcreate $CONFIG{'lvm'} -L $CONFIG{'size'}M -n $disk";
    my $swap_cmd = "/sbin/lvcreate $CONFIG{'lvm'} -L $CONFIG{'swap'} -n $swap";

    #
    # Create the volumes
    #
    runCommand( $disk_cmd );
    runCommand( $swap_cmd );

    #
    #  Initialise the partition with the relevent filesystem.
    #
    createFilesystem( "/dev/$CONFIG{'lvm'}/$CONFIG{'hostname'}-disk" );
}


=head2 createFilesystem

  Format the given image in the users choice of filesystem.

=cut

sub createFilesystem
{
    my( $image ) = ( @_ );

    #
    #  We have the filesystem the user wanted, make sure that the
    # binary exists.
    #
    my $command = $CONFIG{ "make_fs_" . $CONFIG{'fs'} };

    #
    #  Split the command into "binary" + "args".  Make sure that
    # the binary exists and is executable.
    #
    if ( $command =~ /([^ ]+) (.*)$/ )
    {
	my $binary = $1;
	my $args   = $2;

	if ( ! -x $binary )
	{
	    print "The binary '$binary' required to create the filesystem $CONFIG{'fs'} is missing\n";
	    exit;
	}
    }
    else
    {
	print "The filesystem creation hash is bogus for filesystem : $CONFIG{'fs'}\n";
	exit;
    }


    #
    #  OK we have the command and the filesystem.  Create it.
    #
    print "\nCreating $CONFIG{'fs'} filesystem on $image\n";

    $command .= $image;

    runCommand( $command );
    print "Done\n";
}



=head2 mountImage

  Mount the loopback disk image into a temporary directory.

  Alternatively mount the relevant LVM volume instead.

=cut

sub mountImage
{
    #
    #  Determine what we're to mount
    #
    my $image;

    if ( $CONFIG{'lvm'} )
    {
	$image = "/dev/" . $CONFIG{'lvm'} . "/" . $CONFIG{'hostname'} . '-disk';
    }
    elsif ( $CONFIG{'dir'} )
    {
	$image = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/disk.img" ;
    }
    else
    {
	print "I don't know what to mount!\n";
	exit;
    }


    #
    #  Create a temporary mount-point to use for the image/volume.
    #
    $MOUNT_POINT = tempdir( CLEANUP => 1 );

    #
    #  Lookup the correct arguments to pass to mount.
    #
    my $mount_cmd;
    my $mount_type = $CONFIG{'mount_fs_' . $CONFIG{'fs'} };

    #
    #  LVM partition
    #
    if ( $CONFIG{'lvm'} )
    {
	$mount_cmd = "mount $mount_type $image $MOUNT_POINT";
    }
    else
    {
	$mount_cmd = "mount $mount_type -o loop $image $MOUNT_POINT";
    }
    runCommand( $mount_cmd );


}



=head2 installSystem

  Install the system, by invoking the xt-install-system script.

  The script will be given the appropriate arguments from our environment.

=cut

sub installSystem
{

    print "\nInstalling your system with ";

    #
    #  Basic command
    #
    my $cmd = "/usr/bin/xt-install-image --location=$MOUNT_POINT --dist=$CONFIG{'dist'}";

    #
    #  Add on the current cache setting
    #
    $cmd .= " --cache=$CONFIG{'cache'}" if length( $CONFIG{'cache'} );

    #
    #  Installation method
    #
    if ( $CONFIG{'copy'} )
    {
	$cmd .= " --copy=$CONFIG{'copy'}";
	print "copy from $CONFIG{'copy'}\n";
    }
    if ( $CONFIG{'debootstrap'} )
    {
	$cmd .= " --debootstrap";
	$cmd .= " --mirror=$CONFIG{'mirror'}";
	print "debootstrap  from $CONFIG{'mirror'}\n";
    }
    if ( $CONFIG{'rpmstrap'} )
    {
	$cmd .= " --rpmstrap";
	print "rpmstrap\n";
    }
    if ( $CONFIG{'tar'} )
    {
	$cmd .= " --tar=$CONFIG{'tar'}";
	print "tarfile $CONFIG{'tar'}\n";
    }


    #
    #  Propogate --verbose
    #
    if ( $CONFIG{'verbose'} )
    {
	$cmd .= " --verbose";
    }

    runCommand( $cmd );

    print "Done\n";
}



=head2 runCustomisationHooks

  Run the xt-customise-system script to customize our fresh installation.

  Before we do this we must pass all the relevent options into our
 environment.

=cut

sub runCustomisationHooks
{

    #
    #  Setup the environment for the child processes.
    #
    foreach my $key ( keys %CONFIG )
    {
	if ( defined( $CONFIG{$key} ) )
	{
	    $ENV{$key} = $CONFIG{$key};
	}
    }

    #
    # Now update the environment for each defined IP address.
    # these are handled specially since we use arrays.
    #
    # Remove the value we set above.
    delete $ENV{'ip'};

    #
    # Setup a seperate ip$count value for each IP address.
    #
    my $ips   = $CONFIG{'ip'};
    my $count = 1;

    foreach my $i ( @$ips )
    {
	$ENV{'ip' . $count } = $i;
	$count += 1;
    }
    $ENV{'ip_count'} = ($count - 1);


    #
    #  Now show the environment the children get
    #
    if ( $CONFIG{'verbose'} )
    {
	print "=============\n";
	foreach my $key ( sort keys %ENV )
	{
	    print "\t'" . $key . "' = '" . $ENV{$key} . "'\n";
	}
    }


    #
    #  Actually run the appropriate hooks
    #
    my $customize = "xt-customize-image --dist=$CONFIG{'dist'} --location=$MOUNT_POINT";
    if ( $CONFIG{'verbose'} )
    {
	$customize .= " --verbose";
    }
    print "\nRunning hooks\n";
    runCommand( $customize );
    print "Done\n";
}



=head2 runXenConfigCreation

  Create the Xen configuration file.

=cut

sub runXenConfigCreation
{

    my $command = '/usr/bin/xt-create-xen-config --output=/etc/xen';

    print "\nCreating Xen configuration file\n";
    runCommand( $command );
    print "Done\n";
}



=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 );
}




=head2 END

  If we still have the temporary image mounted then make sure
 it is unmounted before we terminate.

=cut

sub END
{
    if ( defined( $MOUNT_POINT ) )
    {
	#
	# Run mount to see if this is still mounted.
	#
	my $mount = `/bin/mount`;
	if ( $mount =~ /$MOUNT_POINT/)
	{
	    runCommand( "umount $MOUNT_POINT" );
	}
    }
}