#!/usr/bin/perl -w

=head1 NAME

xen-create-image - Easily create new Xen instances with networking and OpenSSH.

=cut

=head1 SYNOPSIS


  Help Options:

   --help        Show the help information for this script.

   --manual      Read the manual, and examples, for this script.

   --verbose     Show useful debugging information.

   --version     Show the version number and exit.



  Size / General options:

   --accounts    Copy all non-system accounts to the guest image

   --boot        Boot the new instance after creating it.

   --cache       Cache .deb files on the host when installing the new guest
                with the debootstrap tool.

   --force       Force overwriting existing images.
                 This will remove existing images or LVM volumes which match
                 those which are liable to be used by the new invocation.

   --fs          Specify the filesystem type to use for the new guest.
                 Valid choices are 'ext3', 'reiserfs', or 'xfs'.

   --image       Specify whether to create "sparse" or "full" disk images.
                 Full images are mandatory when using LVM, so this setting
                 is ignored in that case.

   --initrd      Specify the initial ramdisk
                 If an image is specified it must exist.

   --kernel      Set the path to the kernel to use for domU.
                 This image must exist on the host system.

   --memory      Setup the amount of memory allocated to the new instance.

   --passwd      Ask for a root password during setup.
                 This is done interactively.

   --role        Run a specific role command post-install.
                 These role scripts are discussed in the manpage later.

   --roledir     Specify the directory which contains the role scripts.
                 This defaults to /etc/xen-tools/role.d/

   --size        Set the size of the primary disk image.

   --swap        Set the size of the swap partition.

   --noswap      Do not create a swap partition.
                 When this option is used the system will not have a swap
                 entry added to its /etc/fstab file either.

   --ide         Use IDE names for virtual devices (hda not sda)


  Installation options:

   --arch        Pass the given architecture to debootstrap or rpm strap.
                 This argument is ignored if you install with a different
                 installation type.

   --copy        Install a new image by copying a directory recursively,
                 this is assumed to be a previously installed system.
                 This is much faster than installing from scratch.

   --copy-cmd    This allows you to specify the command actually used for
                 installation when using "--copy"
                 NOTE This option is *only* valid in the configuration file.

   --dist        Specify the distribution you wish to install.

   --debootstrap Use debootstrap to install the guest system.
                 --dist should be used to specify a distribution debootstrap
                 understands.

   --mirror      Setup the mirror to use when installing via debootstrap.

   --rpmstrap    Use rpmstrap to install the guest distribution.
                 --dist should be used to specify a distribution rpmstrap
                 understands.

   --tar         Install the new image by untarring the specified file.
                 Similar to --copy this is signficantly faster than
                 installing via rpmstrap or debootstrap.

   --tar-cmd     This allows you to specify the command actually used for
                 installation when using "--tar".
                 NOTE This option is *only* valid in the configuration file.

   --template    Specify which template file to use when creating the
                 Xen configuration file.



  Networking options:
   --dhcp        The guest will fetch its networking details via DHCP.

   --gateway     Setup the network gateway for the new instance.

   --ip          Setup the IP address of the machine, multiple IPs
                 are allowed.   When specifying more than one IP the
                 first one is setup as the "system" IP, and the additional
                 ones are added as aliases.
                 Note that Xen 3.x supports a maximum of three IP addresses
                 per guest.
                 This option conflicts with --dhcp.

   --netmask     Setup the netmask for the new instance.

  Mandatory options:

   --dir         Specify where the output images should go.
                 Subdirectories will be created for each guest
                 If you do not wish to use loopback images specify --lvm
                 or --evms.  (These three options are mutually exclusive.)

   --lvm         Specify the volume group to save images within.
                 If you do not wish to use LVM specify --dir or --evms.
                 (These three options are mutually exclusive.)

   --evms        Specify the container to save images within, i.e. '--evms
                 lvm2/mycontainer'.  If you do not wish to use EVMS specify
                 --dir or --lvm.  (These three options are mutually exclusive.)

   --hostname    Set the hostname of the new guest system.
                 Ideally this will be fully-qualified since several
                 of the hook scripts will expect to be able to parse
                 a domain name out of it for various purposes.

=cut


=head1 NOTES

  This script is a simple wrapper around three external tools

=over 8

=item B<xt-install-image>
Install a new distribution.

=item B<xt-customize-image>
Run a collection of hook scripts to customise the freshly installed system.

=item B<xt-create-xen-config>
Create a configuration file in /etc/xen so that xm can create the new image.

=back

  The result of invoking these three scripts, and some minor glue between
 them is a simple means of creating new Xen guest domains.

=cut


=head1 DESCRIPTION

  xen-create-image is a simple script which allows you to create new
 Xen instances easily.  The new image will be given two volumes.  These
 volumes will be stored upon the host as either loopback files, or
 LVM logical volumes:

   1.  An image for the systems root disk.
   2.  An image for the systems swap device.

  The new virtual installations will be configured with networking,
 have OpenSSH installed upon it, and have most of its basic files
 setup correctly.

=cut

=head1 CONFIGURATION

  To reduce the length of the command line each of the supported options
 may be specified inside a configuration file.

  The global configuration file read for options is:

     /etc/xen-tools/xen-tools.conf

  The configuration file may contain comments which begin with the
 hash '#' character.  Otherwise the format is 'key = value'.

  A sample configuration file would look like this:

=for example begin

  #
  #  Output directory.  Images are stored beneath this directory, one
  # subdirectory per hostname.
  #
  dir = /home/xen

  #
  #  LVM users should disable the 'dir' setting above, and instead
  # specify the name of the volume group to use.
  #
  # lvm = myvolume

  #
  #  EVMS users should disable the dir setting above and instead specify
  # a container.  For example, if you have an lvm2 container named box,
  # put lvm2/box.  This is how it is named in the evms interface.
  #
  #  Warning... this has not been tested with anything but lvm2 but should
  # be generalizable.
  #
  # evms= lvm2/myvolume

  #
  #  Disk and Sizing options.
  #
  size       = 2Gb      # Disk image size.
  image      = full     # Allocate the full disk size immediately.
  memory     = 128Mb    # Memory size
  swap       = 128Mb    # Swap size
  fs         = ext3     # use EXT3 filesystems
  dist       = sarge    # Default distribution to install.

  #
  # Kernel options.
  #
  initrd     = /boot/initrd.img-2.6.16-2-xen-686
  kernel     = /boot/vmlinuz-2.6.16-2-xen-686

  #
  # Networking options.
  #
  gateway   = 192.168.1.1
  netmask   = 255.255.255.0

  #
  # Installation options.
  #
  # copy = /path/to/pristine/image
  debootstrap = 1
  # rpmstrap = 1
  # tar = /path/to/img.tar

=for example end

  Using this configuration file a new image may be created with the
 following command:

      xen-create-image --hostname=vm03.my.flat --ip=192.168.1.201

  This makes use of loopback images stored beneath /home/xen and
 will be installed via the debootstrap command.

=cut


=head1 XEN CONFIGURATION FILE

  Once a new image has been created an appropriate configuration file
 for Xen will be saved in the directory /etc/xen.

  The configuration file is built up using the template file
 /etc/xen-tools/xm.tmpl - which is a file processed via
 the Text::Template perl module.

  If you wish to modify the files which are generated please make your
 changes to that input file.

  Alternatively you can create multiple configuration files and
 specify the one to use with the --template option.

=cut


=head1 LOOPBACK EXAMPLES

  The following will create a 2Gb disk image, along with a 128Mb
 swap file with Debian Sarge setup and running via DHCP.

     xen-create-image --size=2Gb --swap=128Mb --dhcp \
          --dir=/home/xen --hostname=vm01.my.flat

  This next example sets up a host which has the name 'vm02.my.flat' and
 IP address 192.168.1.200, with the gateway address of 192.168.1.1

     xen-create-image --size=2Gb --swap=128Mb \
          --ip=192.168.1.200 \
          --netmask=255.255.255.0
          --gateway=192.168.1.1 \
          --dir=/home/xen --hostname=vm02.my.flat

  The directory specified for the output will be used to store the volumes
 which are produced.  To avoid clutter each host will have its images
 stored beneath the specified directory, named after the hostname.

  For example the images created above will be stored as:

   $dir/domains/vm01.my.flat/
   $dir/domains/vm01.my.flat/disk.img
   $dir/domains/vm01.my.flat/swap.img

   $dir/domains/vm02.my.flat/
   $dir/domains/vm02.my.flat/disk.img
   $dir/domains/vm02.my.flat/swap.img

  The '/domains/' subdirectory will be created if necessary.

=cut


=head1 LVM EXAMPLE

  If you wish to use an LVM volume group instead of a pair of loopback
 images as shown above you can instead use the --lvm argument to
 specify one.

     xen-create-image --size=2Gb --swap=128Mb --dhcp \
          --lvm=myvolumegroup --hostname=vm01.my.flat

  The given volume group will have two new logical volumes created within it:

   ${hostname}-swap
   ${hostname}-disk

  The disk image may be mounted, as you would expect, with the following
 command:

    mkdir -p /mnt/foo
    mount /dev/myvolumegroup/vm01.my.flat-disk /mnt/foo

=cut

=head1 EVMS EXAMPLE

  If you wish to use an EVMS storage container instead of a pair of loopback
 images as shown above you can instead use the --evms argument to
 specify one.  The below example assumes an lvm2 container.

     xen-create-image --size=2Gb --swap=128Mb --dhcp \
          --evms=lvm2/myvolumegroup --hostname=vm01.my.flat

  The given storage container will have two new EVMS volumes created within it:

   ${hostname}-swap
   ${hostname}-disk

  The disk image may be mounted, as you would expect, with the following
 command:

    mkdir -p /mnt/foo
    mount /dev/evms/vm01.my.flat-disk /mnt/foo

=cut


=head1 INSTALLATION METHODS

  The new guest images may be installed in several different ways:

  1.  Using the debootstrap command, which must be installed and present.
  2.  Using the rpmstrap command, which must be installed and present.
  3.  By copying an existing installation.
  4.  By untarring a file containing a previous installation.

  These different methods can be selected by either the command line
 arguments, or settings in the configuration file.  Only one installation
 method may be specified at a time; they are mutually-exclusive.

=cut

=head1 INSTALLATION SPEEDUPS

  After performing your first installation you can customize it, or
 use it untouched, as a new installation source.  By doing this you'll
 achieve a significant speedup, even above using the debootstrap caching
 support.

  There are two different ways you can use the initial image as source
 for a new image:

  1.  By tarring it up and using the tar-file as an installation source.
  2.  By mounting the disk image of the first system and doing a literal copy.

  Tarring up a pristine, or customised, image will allow you to install
 with a command such as:

     xen-create-image --size=2Gb --swap=128Mb --dhcp \
          --lvm=myvolumegroup --hostname=vm01.my.flat \
          --tar=/path/to/tar.file.tar

  The advantage of the tarfile approach is that you'll not need to
 keep a disk image mounted if you were to use the --copy argument
 to create a new image using the old one as source:

     xen-create-image --size=2Gb --swap=128Mb --dhcp \
          --lvm=myvolumegroup --hostname=vm01.my.flat \
          --copy=/path/to/copy/from

=cut


=head1 DEBOOTSTRAP CACHING

  When installing new systems with the debootstrap tool there is
 a fair amount of network overhead.

  To minimize this the .deb files which are downloaded into the
 new instance are cached by default upon the host, in the directory
 /var/cache/apt/archives.

  When a new image is created these packages are copied into the new
 image - before the debootstrap process runs - this should help avoid
 expensive network reading.

  If you wish to clean the cache upon the host you may do so with
 apt-get, as you'd expect:

  apt-get clean

  (This feature can be disabled with the command line flag --cache=no,
 or by the matching setting in the configuration file.)

=cut


=head1 ROLES

  Currently there are some roles scripts included which work for
 the Debian Sarge and Etch distrubtions only.   They are included
 primarily as examples of the kind of things you could accomplish.

  The supplied scripts are:

=over 8

=item builder
Setup the new virtual images with commonly used packages for rebuilding Debian packages from their source.

=item gdm
Install an X11 server, using VNC and GDM

=item minimal
Customise the generated images to remove some packages.

=item xdm
Install an X11 server, using VNC and XDM

=back

  If you'd like to include your own role scripts you'll need to
 create a file in /etc/xen-tools/role.d, and then specify the
 name of that file with "--role=filename".

  For example the script /etc/xen-tools/role.d/gdm would be used
 by executing with "--role=gdm".

  Role scripts are invoked with a single argument -  the directory
 where the installed system is mounted.

=cut



=head1 THE SKELETON DIRECTORY

  Any files present in the directory /etc/xen-tools/skel will be copied
 across to each new guest image.  The role of this directory is analogous
 to the /etc/skel directory.

  A typical use for this would be to copy a public key across to each
 new system.  You could do this by running:

=for example start

    mkdir -p /etc/xen-tools/skel/root/.ssh
    chmod -R 700 /etc/xen-tools/skel/root
    cp /root/.ssh/id_rsa.pub /etc/xen-tools/skel/root/.ssh/authorized_keys2
    chmod 644 /etc/xen-tools/skel/root/.ssh/authorized_keys2

=for example cut


=head1 AUTHOR

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

 $Id: xen-create-image,v 1.100 2006-10-12 23:08:21 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.7';







#
#  Setup default options.
#
setupDefaultOptions();


#
#  Read the global configuration file.
#
readConfigurationFile( "/etc/xen-tools/xen-tools.conf" );


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


#
#  Check the environment - after parsing arguments.
#
#  This is required so that the "--help" flag will work even if our support
# scripts are not installed.
#
checkSystem();


#
#  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();


#
#  Make sure we have a log directory
#
mkdir( "/var/log/xen-tools", 0777 ) if ( ! -d "/var/log/xen-tools" );

#
#  Trash any existing for this run logfile.
#
open( TRASH, ">", "/var/log/xen-tools/$CONFIG{'hostname'}.log" );
print TRASH "";
close(TRASH);



#
#  Check we have binaries installed which we expect to use.
#
checkBinariesPresent();


#
#  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'} )
{
    #
    #  Test to see if "loop" module is loaded.  This is probably
    # not required, except for paranoia.
    #
    testLoopbackModule();

    #
    #  Create disk + swap images.
    #
    createLoopbackImages();
}
elsif ( $CONFIG{'lvm'} )
{
    #
    #  Create our LVM partitions.
    #
    createLVMBits();
}
elsif ( $CONFIG{'evms'} )
{
    #
    #  Create our evms partitions.
    #
    createEVMSBits();
}
else
{
    # Can't happen we didn't get an installation type.
    logprint( "Error:  No recognised installation type.\n" );
    exit;
}


#
#  Mount the image.
#
mountImage();


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


#
#  Make sure the installation succeeded.
#
if ( ! -x $MOUNT_POINT . "/bin/ls" )
{
    logprint( "System installation failed.  Aborting\n");
    exit;
}



#
#  Call xt-customise-image to setup networking, and run any
# distributuion-specific hooks.
#
runCustomisationHooks();


#
#  Run the user specified role script, if any.
#
runRoleScript();


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


#
#  Setup the password if the user wanted that.
#
setupRootPassword() if ( $CONFIG{'passwd'} );


#
#  Report success.
#
logprint( "All done\n");


#
#  If we're supposed to start the new instance do so - note here we
# have to unmount the image first.
#
if ( $CONFIG{'boot'} )
{
    #
    #  Unmount the image and any subsequent mounts.
    #
    unMountImage( $MOUNT_POINT );

    #
    #  Mark us as unmounted.
    #
    $MOUNT_POINT = undef;

    #
    #  Start the image
    #
    my $pid = fork();
    if ( $pid )
    {
        # Parent.
        exit;
    }
    else
    {
        # Child.
        system( "$CONFIG{'xm'} create $CONFIG{'hostname'}.cfg >/dev/null 2>/dev/null" );

        logprint( "Started new Xen instance.\n" );
    }
}


#
#  Finished.
#
exit;



=begin doc

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

  This means that the the companion scripts xt-* are present on the
 host and executable.

=end doc

=cut

sub checkSystem
{
    my @required = qw ( /xt-customize-image xt-install-image xt-create-xen-config / );

    foreach my $bin ( @required )
    {
        if ( ! -x "/usr/bin/" . $bin )
        {
            logprint("The script '$bin' was not found.\n");
            logprint( "Aborting\n\n" );
            exit;
        }
    }
}



=begin doc

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

=end doc

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

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

    #
    # Misc. options.
    #
    $CONFIG{'mirror'}      = 'http://ftp.us.debian.org/debian';
    $CONFIG{'arch'}        = '';
    $CONFIG{'dist'}        = 'sarge';
    $CONFIG{'fs'}          = 'ext3';
    $CONFIG{'force'}       = 0;
    $CONFIG{'template'}    = '';
    $CONFIG{'roledir'}     = '/etc/xen-tools/role.d';

    #
    #  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....
    #
    # NOTE 2:  Each of these scripts will "force" the creation of a new
    #         filesystem, even if it exists.  This script must detect
    #         prior existance itself.
    #
    $CONFIG{'make_fs_ext3'}      = '/sbin/mkfs.ext3 -F ';
    $CONFIG{'make_fs_xfs'}       = '/sbin/mkfs.xfs -f -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 since '-t auto' should do
    #        the right thing.
    #
    $CONFIG{'mount_fs_ext3'}      = '-t ext3';
    $CONFIG{'mount_fs_xfs'}       = '-t xfs';
    $CONFIG{'mount_fs_reiserfs'}  = '-t reiserfs';

}




=begin doc

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

=end doc

=cut

sub readConfigurationFile
{
    my ($file) = ( @_ );

    # Don't read the file if it doesn't exist.
    return if ( ! -e $file );


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



=begin doc

  Parse the command line arguments this script was given.

=end doc

=cut

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

    #
    #  We record the installation method here because we want
    # to ensure that we allow the method supplied upon the command line
    # to overwrite the one we might have ready read from the configuration
    # file.
    #
    my %install;
    $install{'debootstrap'} = 0;
    $install{'rpmstrap'}    = 0;
    $install{'evms'}        = undef;
    $install{'copy'}        = undef;
    $install{'tar'}         = undef;
    $install{'dir'}         = undef;
    $install{'lvm'}         = undef;

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

               # Size options.
               "size=s",       \$CONFIG{'size'},
               "swap=s",       \$CONFIG{'swap'},
               "noswap",       \$CONFIG{'noswap'},
               "image=s",      \$CONFIG{'image'},
               "memory=s",     \$CONFIG{'memory'},

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

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

               # Exclusive
               #
               #  NOTE:  We set the local variable here, not the global.
               #
               "copy=s",       \$install{'copy'},
               "copy-cmd=s",   \$CONFIG{'copy-cmd'},   # NOP - IGNORED.
               "debootstrap",  \$install{'debootstrap'},
               "rpmstrap",     \$install{'rpmstrap'},
               "tar=s",        \$install{'tar'},
               "tar-cmd=s",    \$CONFIG{'tar-cmd'},   # NOP - IGNORED.

               # Misc. options
               "accounts",     \$CONFIG{'accounts'},
               "arch=s",       \$CONFIG{'arch'},
               "fs=s",         \$CONFIG{'fs'},
               "boot",         \$CONFIG{'boot'},
               "cache=s",      \$CONFIG{'cache'},
               "ide",          \$CONFIG{'ide'},
               "passwd",       \$CONFIG{'passwd'},
               "role=s",       \$CONFIG{'role'},
               "roledir=s",    \$CONFIG{'roledir'},
               "force",        \$CONFIG{'force'},
               "template=s",   \$CONFIG{'template'},

               # 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.100 $';
        if ( $REVISION =~ /1.([0-9.]+) / )
        {
            $REVISION = $1;
        }

        logprint( "xen-create-image release $RELEASE - CVS: $REVISION\n" );
        exit;
    }


    #
    #  If we have had one of the local installation methods specified,
    # and *only* one of them the we'll reset the global option(s) which
    # came from the configuration file.
    #
    #  Count the number which wer supplied
    #
    my $count = 0;
    foreach my $key ( qw/debootstrap rpmstrap copy tar/ )
    {
        if ( $install{$key} )
        {
            $count += 1;
        }
    }

    #
    #  If we had exactly one specified then we can proceed.
    #
    if ( $count == 1 )
    {
        foreach my $key ( qw/debootstrap rpmstrap copy tar/ )
        {
            $CONFIG{$key} = $install{$key};
        }
    }
    elsif ( $count > 1 )
    {
        my $err =<<E_O_ERROR;

  Please specify an installation method using only *one* of the following
 command line options:

   --debootstrap     =  Install the system using the deboostrap command.
   --rpmstrap        =  Install the system using the rpmstrap command.
   --copy /path      =  Install by copying the specified directory recursively.
   --untar file.tar  =  Install by untarring the given file.

  (You could specify one of these options as the default in the configuration
 file /etc/xen-tools/xen-tools.conf.)

E_O_ERROR

        logprint( $err );
    }
    else
    {
        #
        # count == 0;
        # OK.
        #
        #  That means that the configuration file is ok.
        #
    }


    #
    #  Now do a similar thing so that the command line setting of
    # '--lvm', '--evms' and '--dir=x' override anything in the
    # configuration file.
    #
    if ( $install{'dir'} )
    {
        $CONFIG{'dir'}  = $install{'dir'};
        $CONFIG{'evms'} = undef;
        $CONFIG{'lvm'}  = undef;
    }
    if ( $install{'evms'} )
    {
        $CONFIG{'dir'}  = undef;
        $CONFIG{'evms'} = $install{'evms'};
        $CONFIG{'lvm'}  = undef;
    }
    if ( $install{'lvm'} )
    {
        $CONFIG{'dir'}  = undef;
        $CONFIG{'evms'} = undef;
        $CONFIG{'lvm'}  = $install{'lvm'};
    }
}


=begin doc

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

=end doc

=cut

sub testRootUser
{
    if ( $EFFECTIVE_USER_ID != 0 )
    {
        my $err =<<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

        logprint( $err );
        exit;
    }
}



=begin doc

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

  Here we make sure that mutually exclusive options are not selected
 for the installation method, etc.

  We also warn when some variables are not set.

=end doc

=cut

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

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

    #
    #  NOTE: FAKE!
    #
    if ( $CONFIG{'dist'} eq 'fedora-core4' )
    {
        $CONFIG{'dist'} = 'stentz';
    }

    #
    #
    #  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 )
    {
        my $err =<<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
        logprint( $err );
        exit 1;
    }


    #
    #  Image must be 'sparse' or 'full'.
    #
    if ( defined( $CONFIG{'image'} ) )
    {
        if ( ( $CONFIG{'image'} ne "sparse" ) &&
             ( $CONFIG{'image'} ne "full" ) )
        {
            logprint( "Image type must be 'sparse' or 'full'\n" );
            exit;
        }
    }

    #
    #  If using LVM or EVMS then the images may not be sparse
    #
    $CONFIG{'image'} = "full" if ( $CONFIG{'lvm'} ||
                                   $CONFIG{'evms'} );

    #
    #  The kernel + initrd images should exist.
    #
    if ( defined( $CONFIG{'kernel'} ) &&
         length( $CONFIG{'kernel'} )  &&
         ! -e $CONFIG{'kernel'} )
    {
        logprint( "The kernel image we're trying to use does not exist.\n" );
        logprint( "The image is - $CONFIG{'kernel'}\n" );
        logprint( "Aborting\n" );
        exit;
    }

    if ( defined( $CONFIG{'initrd'} ) &&
         length( $CONFIG{'initrd'} )  &&
         ! -e $CONFIG{'initrd'} )
    {
        logprint( "The initial ramdisk we're trying to use does not exist.\n" );
        logprint( "The image is - $CONFIG{'initrd'}\n" );
        logprint( "Aborting\n" );
        exit;
    }

    #
    #  Make sure we have one, and only one, installation method.
    #
    my $count = 0;
    foreach my $key ( qw/debootstrap rpmstrap copy tar/ )
    {
        if ( $CONFIG{$key} )
        {
            $count += 1;
        }
    }

    if ( $count != 1 )
    {
        my $err =<<E_O_ERROR;

  Please specify an installation method using one of the following
 command line options:

   --debootstrap     =  Install the system using the deboostrap command.
   --rpmstrap        =  Install the system using the rpmstrap command.
   --copy /path      =  Install by copying the specified directory recursively.
   --untar file.tar  =  Install by untarring the given file.

  (You could specify one of these options as the default in the configuration
 file /etc/xen-tools/xen-tools.conf.)

E_O_ERROR
        logprint( $err );
        exit;

    }

    #
    #  Make sure that any specified template file exists.
    #
    if ( ( defined( $CONFIG{'template'} ) ) &&
         ( length( $CONFIG{'template'}  ) ) &&
         ( ! -e $CONFIG{'template'} ) )
    {
        logprint( "The specified template file, $CONFIG{'template'}, does not exist.\n" );
        exit 1;
    }


    #
    #  If we've got a role directory specified then it must exist.
    #
    if ( defined( $CONFIG{'roledir'} ) && length( $CONFIG{'roledir'} ) )
    {
        if ( ! -d $CONFIG{'roledir'} )
        {
            logprint( "The specified role directory '$CONFIG{'roledir'}' does not exist\n" );
            exit 1;
        }
    }


    #
    #  The user must choose either DHCP *or* Static IP.  not both
    #
    if ( $CONFIG{'dhcp'} && $CONFIG{'ip'} )
    {
        logprint( "Please choose either DHCP or static usage, not both!\n" );
        exit 1;
    }

    #
    #  The user must specify one or the other.
    #
    if ( ( !$CONFIG{'dhcp'} ) && ( !$CONFIG{'ip'} ) )
    {
        logprint( "Please choose one of:\n" );
        logprint( " --dhcp\n" );
        logprint( " --ip xx.xx.xx.xx\n" );
        exit 1;
    }

    #
    #  If we're using static addresses warn if there are variables
    # missing
    #
    if ( $CONFIG{'ip'} )
    {
        logprint( "WARNING:  No gateway address specified!\n" )
          unless( defined( $CONFIG{'gateway'} ) );

        logprint( "WARNING:  No netmaks address specified!\n" )
          unless( defined( $CONFIG{'netmask'} ) );
    }
}



=begin doc

  Check that we have some required binaries present.

=end doc

=cut

sub checkBinariesPresent
{

    #
    #  Files we demand are present in all cases.
    #
    my @required = qw ( /bin/mount /sbin/mkswap );

    foreach my $file ( @required )
    {
        if ( ! -x $file )
        {
            logprint( "The following binary is required to run this tool\n" );
            logprint( "\t$file\n");
            exit 1;
        }
    }

    #
    # Image type specific binaries
    #
    if ( defined( $CONFIG{'dir'} ) )
    {
        # loopback image
        if ( ! -x '/bin/dd' )
        {
            logprint( "The following binary is required to run this tool\n" );
            logprint( "\t/bin/dd\n");
            logprint( "(This only required for loopback images, which you've selected)\n" );
            exit 1;
        }
    }
    elsif ( defined( $CONFIG{'evms'} ) )
    {
        #
        # EVMS-specific binaries.
        #
        my @evms = qw ( /sbin/evms /bin/echo );

        foreach my $file ( @evms )
        {
            if ( ! -x $file )
            {
                logprint( "The following binary is required to run this tool\n");
                logprint( "\t$file\n" );
                logprint( "(This is only required for EVMS volumes, which you've selected)\n" );
                exit;
            }
        }
    }
    else
    {
        # LVM-specific binaries.
        my @lvm = qw ( /sbin/lvcreate /sbin/lvremove );

        foreach my $file ( @lvm )
        {
            if ( ! -x $file )
            {
                logprint( "The following binary is required to run this tool\n");
                logprint( "\t$file\n" );
                logprint( "(This is only required for LVM volumes, which you've selected)\n" );
                exit;
            }
        }
    }
}




=begin doc

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

=end doc

=cut

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

    logprint( "\nSize Information\n" );
    logprint( "----------------\n" );
    logprint( "Image size     :  $CONFIG{'size'}\n") ;
    logprint( "Swap size      :  $CONFIG{'swap'}\n" ) unless ( $CONFIG{'noswap' } );
    logprint( "Image type     :  $CONFIG{'image'}\n" );
    logprint( "Memory size    :  $CONFIG{'memory'}\n" );
    logprint( "Kernel path    :  $CONFIG{'kernel'}\n" );

    if ( defined( $CONFIG{'initrd'} ) &&
         length( $CONFIG{'initrd'} ) )
    {
        logprint( "Initrd path    :  $CONFIG{'initrd'}\n" );
    }

    logprint( "\nNetworking Information\n" );
    logprint( "----------------------\n" );

    #
    # Show each IP address added.
    #
    # Note we only allow the first IP address to have a MAC address specified.
    #
    my $ips   = $CONFIG{'ip'};
    my $mac   = $CONFIG{'mac'};
    my $count = 1;

    #
    #  Print out each network address, and if there is a mac address
    # associated with it then use it too.
    #
    foreach my $i ( @$ips )
    {
        my $m = undef;

        if ( ( $count == 1 ) && ( defined( $mac ) ) )
        {
            $m = $mac;
        }

        logprint( "IP Address $count   : $i" );
        if ( defined( $m ) )
        {
            logprint( " [MAC: $m]" );
        }
        logprint( "\n" );

        $count += 1;
    }

    #
    # mac address setting still works even for DHCP, but in that
    # case only the first one works.
    #
    if ( $CONFIG{'dhcp'} )
    {
        if ( defined( $CONFIG{'mac'} ) )
        {
            logprint( "IP Address     : DHCP [MAC: $CONFIG{'mac'}]\n" );
        }
        else
        {
            logprint( "IP Address     : DHCP\n" );
        }
    }

    $CONFIG{'netmask'}   && logprint( "Netmask        : $CONFIG{'netmask'}\n" );
    $CONFIG{'gateway'}   && logprint( "Gateway        : $CONFIG{'gateway'}\n" );
    $CONFIG{'p2p'}       && logprint( "Point to Point : $CONFIG{'p2p'}\n" );
    print "\n";

}




=begin doc

  Test that the user has the "loop" module loaded and present,
 this is just a warning useful to newcomers.

=end doc

=cut

sub testLoopbackModule
{
    if ( -e "/proc/modules" )
    {
        my $modules = `cat /proc/modules`;

        if ( $modules !~ m/loop/ )
        {
            logprint( "WARNING\n" );
            logprint( "-------\n" );
            logprint( "Loopback module not loaded and you're using loopback images\n" );
            logprint( "Run the following to load the module:\n\n" );
            logprint( "modprobe loop loop_max=255\n\n" );
        }
    }
}



=begin doc

  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.

=end doc

=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'} )
    {
       logprint( "The disk image already exists.  Aborting.\n" );
       logprint( "Specify '--force' to overwrite, or remove the following file\n" );
       logprint( $disk . "\n" );
       exit;
    }
    if ( ( -e $swap ) && ! $CONFIG{'force'} )
    {
       logprint( "The swap image already exists.  Aborting.\n" );
       logprint( "Specify '--force' to overwrite, or remove the following file\n" );
       logprint( $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
    #
    unless( $CONFIG{'noswap'} )
    {
        logprint( "\nCreating swap image: $swap\n" );
        my $swap_cmd = "/bin/dd if=/dev/zero of=$swap bs=1024k count=$swap_size";
        runCommand( $swap_cmd );
        logprint( "Done\n" );
    }


    #
    #  Use dd to create the disk image.
    #
    logprint( "\nCreating disk image: $disk\n" );
    my $image_cmd;
    if ( $CONFIG{'image'} eq "sparse" )
    {
        $CONFIG{'verbose'} && logprint( "Creating sparse image\n" );
        $image_cmd = "/bin/dd if=/dev/zero of=$disk bs=$disk_size count=0 seek=1024";
    }
    else
    {
        $CONFIG{'verbose'} && logprint( "Creating full-sized image\n" );
        $image_cmd = "/bin/dd if=/dev/zero of=$disk bs=$disk_size count=1024";
    }

    runCommand( $image_cmd );
    logprint( "Done\n" );


    #
    #  Finally create the filesystem + swap
    #
    createFilesystem( $disk );
    createSwap( $swap ) unless( $CONFIG{'noswap'} );
}


=begin doc

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

=end doc

=cut

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

    #
    #  Check whether the disk volume exists already, and if so abort
    #  unless '--force' is specified.
    #
    my $lvm_disk = "/dev/$CONFIG{'lvm'}/$CONFIG{'hostname'}-disk";
    if ( -e $lvm_disk )
    {
        # Delete if forcing
        if ( $CONFIG{'force'} )
        {
            logprint( "Removing $lvm_disk - since we're forcing the install\n" );
            runCommand( "lvremove --force $lvm_disk" );
        }
        else
        {
            logprint( "The LVM disk image already exists.  Aborting.\n" );
            logprint( "Specify '--force' to delete and recreate\n" );
            exit;
        }
    }



    #
    #  Check whether the swap volume exists already, and if so abort
    #  unless '--force' is specified.
    #
    my $lvm_swap = "/dev/$CONFIG{'lvm'}/$CONFIG{'hostname'}-swap";
    if ( -e $lvm_swap )
    {
        # Delete if forcing
        if ( $CONFIG{'force'} )
        {
            logprint( "Removing $lvm_swap - since we're forcing the install\n" );
            runCommand( "lvremove --force $lvm_swap" );
        }
        else
        {
            logprint( "The LVM swap image already exists.  Aborting.\n" );
            logprint( "Specify '--force' to delete and recreate\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;
    }


    #
    # 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 ) unless( $CONFIG{'noswap'} );

    #
    #  Initialise the partitions with the relevant filesystem.
    #
    createFilesystem( "/dev/$CONFIG{'lvm'}/$CONFIG{'hostname'}-disk" );
    createSwap( "/dev/$CONFIG{'lvm'}/$CONFIG{'hostname'}-swap" ) unless ( $CONFIG{'noswap'} );

}



=begin doc

  This function is responsible for creating two new logical volumes within
 a given EVMS container group (which at the moment is either LVM or LVM2), but
 should be compatible with any further extentions of evms.

=end doc

=cut

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

    #
    #  Check whether the disk volume exists already, and if so abort
    #  unless '--force' is specified.  This is two steps with evms,
    #  because two things need to be checked, the volume and the object.
    #

    # Check whether the EVMS volume already exists, abort unless '--force' is specified.
    my $evms_volume_disk = "/dev/evms/$CONFIG{'hostname'}-disk";
    if ( -e $evms_volume_disk )
    {
        # Delete if forcing
        if ( $CONFIG{'force'} )
        {
            logprint( "Removing $evms_volume_disk - since we're forcing the install\n" );
            runCommand( "echo Delete : $evms_volume_disk | evms" );
        }
        else
        {
            logprint( "The EVMS volume $evms_volume_disk already exists.  Aborting.\n" );
            logprint( "Specify '--force' to delete and recreate\n" );
            exit;
        }
    }

    #
    # Check whether the EVMS object exists, abort unless '--force' 
    # is specified.
    #
    # Note: $evms_object_disk is not specified directly as a device
    #
    my $evms_object_disk = "$CONFIG{'evms'}/$CONFIG{'hostname'}-disk";
    if ( -e $evms_object_disk )
    {
        # Delete if forcing
        if ( $CONFIG{'force'} )
        {
            logprint( "Removing $evms_object_disk - since we're forcing the install\n" );
            runCommand( "echo Delete : $evms_object_disk | evms" );
        }
        else
        {
            logprint( "The EVMS object $evms_object_disk already exists.  Aborting.\n" );
            logprint( "Specify '--force' to delete and recreate\n" );
            exit;
        }
    }


    #
    #  Check whether the swap object and EVMS volume exists already, and
    # if so abort unless '--force' is specified.
    #
    #
    # Check whether the EVMS volume for swap already exists, abort
    # unless '--force' is specified.
    #
    my $evms_volume_swap = "/dev/evms/$CONFIG{'hostname'}-swap";
    if ( -e $evms_volume_swap )
    {
        # Delete if forcing
        if ( $CONFIG{'force'} )
        {
            logprint( "Removing $evms_volume_swap - since we're forcing the install\n" );
            runCommand( "echo Delete : $evms_volume_swap | evms" );
        }
        else
        {
            logprint( "The EVMS volume $evms_volume_swap image already exists.  Aborting.\n" );
            logprint( "Specify '--force' to delete and recreate\n" );
            exit;
        }
    }
    # Check whether the evms object for swap exists, abort unless '--force' is specified.
    # note that $evms_object_swap is not specified directly as a device
    my $evms_object_swap = "$CONFIG{'evms'}/$CONFIG{'hostname'}-swap";
    if ( -e $evms_object_swap )
    {
        # Delete if forcing
        if ( $CONFIG{'force'} )
        {
            logprint( "Removing $evms_object_swap - since we're forcing the install\n" );
            runCommand( "echo Delete : $evms_object_swap | evms" );
        }
        else
        {
            logprint( "The EVMS object $evms_object_swap image already exists.  Aborting.\n" );
            logprint( "Specify '--force' to delete and recreate\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;
    }


    #
    # The commands to create the objects and volumes.
    #
    # create the object
    #
    my $disk_cmd_object = "echo allocate : $CONFIG{'evms'}/Freespace, size=$CONFIG{'size'}, name=$disk | evms";

    #
    # these will be piped to evms, but gotta check it first
    ## /sbin/lvcreate $CONFIG{'evms'} -L $CONFIG{'size'}M -n $disk";
    #create the EVMS volume
    #
    my $disk_cmd_volume = "echo create : Volume, $CONFIG{'evms'}/$disk, name=$disk | evms";
    ##/sbin/lvcreate $CONFIG{'evms'} -L $CONFIG{'swap'} -n $swap";
    #repeat the same steps for the swap partition
    my $swap_cmd_object = "echo allocate : $CONFIG{'evms'}/Freespace, size=$CONFIG{'swap'}, name=$swap | evms";
    # these will be piped to evms, but gotta check it first
    ## /sbin/lvcreate $CONFIG{'evms'} -L $CONFIG{'size'}M -n $disk";
    #create the EVMS volume
    my $swap_cmd_volume = "echo create : Volume, $CONFIG{'evms'}/$swap, name=$swap | evms";
    ##/sbin/lvcreate $CONFIG{'evms'} -L $CONFIG{'swap'} -n $swap";


    #
    # Create the volumes
    #
    runCommand( $disk_cmd_object );
    runCommand( $disk_cmd_volume );

    runCommand( $swap_cmd_object ) unless( $CONFIG{'noswap'} );
    runCommand( $swap_cmd_volume ) unless( $CONFIG{'noswap'} );

    #
    #  Initialise the partitions with the relevant filesystem.
    #
    createFilesystem( "/dev/evms/$CONFIG{'hostname'}-disk" );
    createSwap( "/dev/evms/$CONFIG{'hostname'}-swap" ) unless ( $CONFIG{'noswap'} );

}



=begin doc

  Format the given image in the users choice of filesystem.

=end doc

=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 )
       {
           logprint( "The binary '$binary' required to create the filesystem $CONFIG{'fs'} is missing\n" );
           exit;
       }
    }
    else
    {
       logprint( "The filesystem creation hash is bogus for filesystem : $CONFIG{'fs'}\n" );
       exit;
    }

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

    $command .= $image;

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



=begin doc

  Create the swap filesystem on the given device.

=end doc

=cut

sub createSwap
{
    my ( $path ) = ( @_ );

    runCommand( "/sbin/mkswap $path" );
}


=begin doc

  Mount the loopback disk image into a temporary directory.

  Alternatively mount the relevant LVM volume instead.

=end doc

=cut

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

    if ( $CONFIG{'lvm'} )
    {
       $image = "/dev/" . $CONFIG{'lvm'} . "/" . $CONFIG{'hostname'} . '-disk';
    }
    elsif ( $CONFIG{'evms'} )
    {
       $image = "/dev/evms/" . $CONFIG{'hostname'} . '-disk';
    }
    elsif ( $CONFIG{'dir'} )
    {
       $image = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/disk.img" ;
    }
    else
    {
       logprint( "I don't know what to mount!\n" );
       logprint( "Please specify '--dir' or '--lvm' or '--evms'\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";
    }
    elsif ( $CONFIG{'evms'} )
    {
       $mount_cmd = "mount $mount_type $image $MOUNT_POINT";
    }
    else
    {
        $mount_cmd = "mount $mount_type -o loop $image $MOUNT_POINT";
    }
    runCommand( $mount_cmd );


}



=begin doc

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

  The script will be given the appropriate arguments from our environment.
 This means that it will be given one of "--debootstrap", "--rpmstrap",
 "--tar", and "--copy".  There will also be other options passed on
 as appropriate.

=end doc

=cut

sub installSystem
{
    logprint( "\nInstalling your system with " );

    #
    #  Basic command
    #
    my $cmd = "/usr/bin/xt-install-image --hostname=$CONFIG{'hostname'} --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'}";
        logprint( "copy from $CONFIG{'copy'}\n" );
    }
    if ( $CONFIG{'debootstrap'} )
    {
        $cmd .= " --debootstrap";
        $cmd .= " --mirror=$CONFIG{'mirror'}";
        logprint( "debootstrap mirror $CONFIG{'mirror'}\n" );
    }
    if ( $CONFIG{'rpmstrap'} )
    {
        $cmd .= " --rpmstrap";
        logprint( "rpmstrap\n");
    }
    if ( $CONFIG{'tar'} )
    {
        $cmd .= " --tar=$CONFIG{'tar'}";
        logprint( "tarfile $CONFIG{'tar'}\n" );
    }


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

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


    #
    #  Run the command.
    #
    runCommand( $cmd );
    logprint( "Done\n" );
}



=begin doc

  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.

=end doc

=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'} )
    {
        logprint( "Customization Script Environment:\n" );
        logprint( "---------------------------------\n" );
        foreach my $key ( sort keys %ENV )
        {
            logprint( "\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";
    }
    logprint( "\nRunning hooks\n" );
    runCommand( $customize );
    logprint( "Done\n" );
}




=begin doc

  If the user specified a role for the new instance then execute it.

=end doc

=cut

sub runRoleScript
{
    my $roleDir = $CONFIG{'roledir'};
    my $role    = $CONFIG{'role'};

    if ( !defined( $role ) )
    {
        logprint( "\nNo role script specified.  Skipping\n" );
        return;
    }

    #
    #  The complete path to the role script
    #
    my $file = $roleDir . "/" . $role;

    if ( -x $file )
    {
        logprint( "\nRunning role script '$file' for role '$role'\n" );
    }
    else
    {
        logprint( "\nRole script not executable : $file for role '$role'\n" );
        logprint( "Ignoring\n" );
        return;
    }


    #
    #  Our environment is already setup because of the call to
    # runCustomisationHooks.
    #
    #  We just need to run the script with the mountpoint as its
    # single argument.
    #
    runCommand( $file . " " . $MOUNT_POINT );

    logprint( "Done\n" );
}



=begin doc

  Create the Xen configuration file.

  Note that we don't need to do any setup for the environment since
 we did this already before running the hook scripts.

=end doc

=cut

sub runXenConfigCreation
{

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

    if ( ( defined( $CONFIG{'template'} ) ) &&
         ( -e $CONFIG{'template'} ) )
    {
        $command .= " --template=" . $CONFIG{'template'};
    }

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



=begin doc

  chroot() into the new system and setup the password.

=end doc

=cut

sub setupRootPassword
{
    logprint( "Setting up root password\n" );

    if ( -x $MOUNT_POINT . "/usr/bin/passwd" )
    {
        system( "chroot $MOUNT_POINT /usr/bin/passwd" );
    }
    else
    {
        logprint( "/usr/bin/passwd on the new system doesn't exist...\n" );
    }
}



=begin doc

  Print the given string both to our screen, and to the logfile.

=end doc

=cut

sub logprint
{
    my ( $text ) = (@_);

    print $text;

    #
    #  Log.
    #
    if ( $CONFIG{'hostname'} )
    {
        open( LOGFILE, ">>", "/var/log/xen-tools/$CONFIG{'hostname'}.log" )
          or return;
        print LOGFILE $text;
        close( LOGFILE );
    }
}



=begin doc

  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 once
 it has finished.

=end doc

=cut

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

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

    #
    #  Copy stderr to stdout, so we can see it, and make sure we log it.
    #
    $cmd .= " 2>&1 | tee --append /var/log/xen-tools/$CONFIG{'hostname'}.log";

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


    $CONFIG{'verbose'} && print "Finished : $cmd\n";

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

}




=begin doc

  Unmount any mount-points which are below the given path.

  The mountpoints are chosen by looking at /proc/mounts which
 might not be portable, but works for me.  (tm).

=end doc

=cut

sub unMountImage
{
    my ( $point ) = ( @_ );

    #
    #  Open /proc/mount and get a list of currently mounted paths
    # which begin with our mount point.
    #
    my @points;

    open( MOUNTED, "<", "/proc/mounts" )
      or die "Failed to open mount list";
    foreach my $line (<MOUNTED> )
    {
        #
        #  Split into the device and mountpoint.
        #
        my ( $device, $path ) = split( / /, $line );

        if ( $path =~ /\Q$point\E/ )
        {
            push @points, $path;
        }
    }
    close( MOUNTED );

    #
    #  Now we have a list of mounts.  We need to move the
    # longest first, we can do this by sorting and reversing.
    #
    #  (ie. We unmount the children, then the parent.)
    #
    @points = sort @points;
    @points = reverse @points;

    foreach my $path ( @points )
    {
        $CONFIG{'verbose'} && print "Unmounting : $path\n";
        runCommand( "umount $path" );
    }

    $MOUNT_POINT = undef;
}


=begin doc

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

=end doc

=cut

sub END
{
    if ( defined( $MOUNT_POINT ) )
    {
        #
        #  Unmount the image, taking care to remove any child mounts too.
        #
        unMountImage( $MOUNT_POINT );
    }

    if ( ( defined( $CONFIG{'hostname'} ) ) &&
         ( -e "/var/log/xen-tools/$CONFIG{'hostname'}.log" ) )
    {
        print "\n\nLogfile produced at:\n";
        print "\t /var/log/xen-tools/$CONFIG{'hostname'}.log\n";
    }
}