#!/usr/bin/perl -w

=head1 NAME

xen-create-image - Create a new virtual Debian installation for Xen.

=head1 SYNOPSIS

  xen-create-image [options]

  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 upon the host for speed improvement.
   --debootstrap Pass anything named here onto debootstrap.
   --dist        Specify the distribution you wish to install: Sarge/Etch/Sid.
   --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.
   --mirror      Setup the mirror to use when installing Sarge.
   --no-swap     Don't create a swap image.
   --passwd      Ask for a root password during setup.
   --role        Run a role-specific script, post-install.
   --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)


  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.
   --volume    Specify the LVM 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 for a large speed improvement. [Defaults to yes.]

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

=item B<--debootstrap>
Anything specified after this will be passed onto the debootstrap command executed.

=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<--volume>.

=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 - usually 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<--initrd>
Specify the initial ramdisk.

=item B<--ip>
Set the IP address for the virtual image.  Conflicts with B<--dhcp>

=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 to the installation of Sarge, defaults to http://ftp.us.debian.org/debian

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

=item B<--no-swap>
Don't create a swap device.

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

=item B<--role>
Run a single, specific, role-script once the image has been setup.

=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<--ide>
Use IDE style device names for the virtual devices.

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

=item B<--volume>
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 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' 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

  To save typing these command line options may be specified in the
 configuration file discussed later.

  The directory specified for the output will be used to store the files
 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 EXAMPLES

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

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

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

   ${hostname}-swap
   ${hostname}-root

=cut


=head1 DESCRIPTION


  xen-create-image is a simple script which allows you to create new
 Xen instances of Debian GNU/Linux.  The new image will be comprised
 of two seperate images:

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

  These images will either be created as new LVM volumes, or as local
 loopback files.

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


=head1 CONFIGURATION

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

  The script will check a global configuration file for options, the
 file 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 to use.
  #
  # volume = myvolume

  #
  #  Disk and Sizing options.
  #
  size       = 2Gb      # Disk image size.
  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-1-xen-686
  kernel     = /boot/vmlinuz-2.6.16-1-xen-686

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

=for example end

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

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


=head1 CACHING

  Because the virtual systems are installed with the debootstrap
 tool there can be a lot 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 the configuration file setting 'cache = no'.)


=head1 CUSTOMIZATION

  There are four different types of customization which may be applied
 to the Xen domains which are produced by this script.  These different
 approachs allow you to change the generated images in several ways.

  The available options are:

=over 8

=item debootstrap customization
This allows you to make additions to the debootstrap command which is executed to install Debian within the image.

=item the hook directory
The hook scripts allow you to run customization scripts for each generated image.

=item the role directory
The role directory allows you to customise a group of images in a special manner.

=item the skellington directory
This directory allows you to copy a collection of custom files to each generated image easily.


=back

=cut



=head1 DEBOOTSTRAP CUSTOMIZATION

  If you wish to add new packages to the image automatically you may
 take advantage of the '--debootstrap' option which allows you to
 pass flags to the debootstrap command which is invoked to install
 a basic Debian setup within the primary disk image of your guest.

  For example the following command causes three new packages to be
 added to the installed image:

      xen-create-image --debootstrap='--include=screen,sudo,less'

  For more details of available options to use with debootstrap please
 see its manpage.

=head1 HOOKS

  After the installation of your chosen GNU/Linux distribution
 there is the chance for you to run arbitary scripts upon the new host
 before it is unmounted.

  To do this place executable scripts inside the "hook directory"
 /etc/xen-tools/hook.d/.

  Each executable script in this directory will be executed in turn
 and given two arguments:

=over 8

=item The directory where the installed image is currently mounted.

=item The name of the distribution which is being installed.

=back

  The scripts will also have a complete copy of the configuration
 options set in its environment.  For example the IP address would
 be set in ${ip}, the mirror in ${mirror}, etc.

  A script could copy some the kernel modules to the new system, and
 install a package, for example:

=for example start

 #!/bin/sh

 prefix=$1
 dist=$2

 # Copy modules
 mkdir -p ${prefix}/lib/modules
 cp -R /lib/modules/2.6.12.6-xen/ ${prefix}/lib/modules

 # Install the package 'module-init-tools'
 DEBIAN_FRONTEND=noninteractive chroot $prefix /usr/bin/apt-get --yes --force-yes install module-init-tools

=for example cut

  The hooks are used extensively by the xen-create-image script to
 setup the environment of the new GNU/Linux system.  If you're looking
 at modifying the creation of new images it is recommended you examine
 the default hooks.

=cut



=head1 ROLES

  The scripts which are included in the hook directory are executed
 for every single image you create.  This can allow you to make global
 changes to the generated image very easily, however they don't allow
 you to do different things for different types of images.

  Instead the "role" scripts are used for that purpose.  If you
 give an argument "--role=foo" then the script /etc/xen-tools/role.d/foo
 will be executed after the image has been created and after any hooks
 have finished executing.

  This allows you to create different customizations for particular
 image types.  Several role scripts have been included to provide
 examples of different customizations:

=over 8

=item builder
Setup the new virtual images with commonly used packages for rebuilding Debian packages from 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



=head1 THE SKELLINGTON 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 ADVANCED USAGE

 With the current release of xen-tools it is possible to install several
 non-Debian distributions of GNU/Linux.

 To do so you'll need to run with the '--rpmstrap' argument, as follows:

    xen-create-image --rpmstrap --dist=centos4 --hostname=test


=head1 AUTHOR


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

 $Id: xen-create-image,v 1.129 2006-06-07 09:19:52 steve Exp $

=cut


=head1 CONTRIBUTORS

  Contributors to this code:

=over 8

=item  Radu Spineanu

=item  Justin Azoff

=back


=head1 LICENSE

Copyright (c) 2005 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 diagnostics;
use English;
use File::Copy;
use File::Temp qw/ tempdir /;
use Getopt::Long;
use IPC::Open3;
use Pod::Usage;




#
#  Global configuration options.
#
#  Initially our options are read from the configuration file into this
# hash.  Later they may be overridden by the command line.
#
#  Command line flags *always* take precedence over the configuration files.
#
#
my %CONFIG;

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



#
#  The dimensions of the current terminal, used for line-wrapping.
#
my ( $TERMINAL_WIDTH, $TERMINAL_HEIGHT ) = getTerminalSize();


#
#  These hashes contain information used for the creation of different
# fileystems.
#
my %FILESYSTEM_BINARY;
my %FILESYSTEM_CREATE;
my %FILESYSTEM_MOUNT;

#
#  The program to run to create a filesystem - used in the next hash.
#
$FILESYSTEM_BINARY{'ext3'}     = '/sbin/mkfs.ext3';
$FILESYSTEM_BINARY{'xfs'}      = '/sbin/mkfs.xfs';
$FILESYSTEM_BINARY{'reiserfs'} = '/sbin/mkfs.reiserfs';

#
#  The command to use to create a filesystem.  The disk image
# filename is appended to these commands to generate what is
# ultimately executed.
#
$FILESYSTEM_CREATE{'ext3'}     = $FILESYSTEM_BINARY{'ext3'}. ' -F ';
$FILESYSTEM_CREATE{'xfs'}      = $FILESYSTEM_BINARY{'xfs'}. ' -d name=';
$FILESYSTEM_CREATE{'reiserfs'} = $FILESYSTEM_BINARY{'reiserfs'}. ' -f -q ';

#
#  Flags to pass to "mount" to mount our image.  Kinda redundent and may
# go away - seems to me that just using '-t $CONFIG{'fs'}' is sufficient.
#
$FILESYSTEM_MOUNT{'ext3'}      = '-t ext3';
$FILESYSTEM_MOUNT{'xfs'}       = '-t xfs';
$FILESYSTEM_MOUNT{'reiserfs'}  = '-t reiserfs';



#
#  Setup defaults:
#
#  Memory = 96M, Image = 2000Mb, Swap = 128Mb, and filesystem is ext3.
#
#  These may be overriden by settings in the configuration file or by
# command line arguments.
#
$CONFIG{'memory'}      = '96Mb';
$CONFIG{'size'}	       = '2000Mb';
$CONFIG{'swap'}	       = '128M';
$CONFIG{'fs'}	       = 'ext3';
$CONFIG{'mirror'}      = 'http://ftp.us.debian.org/debian';
$CONFIG{'dist'}	       = 'sarge';
$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';
$CONFIG{'debootstrap'} = '';
$CONFIG{'hook_dir'}    = '/etc/xen-tools/hook.d/';
$CONFIG{'role_dir'}    = '/etc/xen-tools/role.d/';
$CONFIG{'cache'}       = 'yes';
$CONFIG{'force'}       = 0;
$CONFIG{'rpmstrap'}    = 0;
$CONFIG{'no-swap'}     = 0;



#
#  Read the global configuration file if it exists.
#
if ( -e "/etc/xen-tools/xen-tools.conf" )
{
    readConfigurationFile( "/etc/xen-tools/xen-tools.conf" );
}


#
#  Parse command line arguments.  These override the values from the
# configuration file.
#
parseCommandLineArguments();


#
#  Check that the arguments the user has supplied are both
# valid, and complete.
#
checkArguments();


#
#  Avoid non-root users after this point.  We allowed them up till
# now so they could read the manual, see help/version info, etc.
#
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;
}


#
# 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";
$CONFIG{'role'} && print "Role           :  $CONFIG{'role'}\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";


#
#  If the output directories don't exist then create them.
#
if ( ! $CONFIG{'volume'} )
{
    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'} - $!" ;
    }
}


#
# The two images we'll use, one for the disk image, one for swap.
#
my $image     = "";
my $swap      = "";
my $image_vbd = "";
my $swap_vbd  = "";


if ( $CONFIG{'volume'} )
{
    #
    # Images upon the LVM system.
    #
    $image = "/dev/" . $CONFIG{'volume'} . "/" . $CONFIG{'hostname'} . '-root';
    $swap  = "/dev/" . $CONFIG{'volume'} . "/" . $CONFIG{'hostname'} . '-swap';

    #
    # Images as presented to Xen.
    #
    $image_vbd = "phy:${CONFIG{'volume'}}/${CONFIG{'hostname'}}-root";
    $swap_vbd  = "phy:${CONFIG{'volume'}}/${CONFIG{'hostname'}}-swap";
}
elsif ( $CONFIG{'dir'} )
{
    #
    # Images upon the filesystem.
    #
    $image = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/disk.img" ;
    $swap  = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/swap.img" ;

    #
    # Images as presented to Xen.
    #
    $image_vbd = "file:" . $image;
    $swap_vbd  = "file:" . $swap;
}
else
{
    print "ERROR: Cant find the image / swap to use\n";
    exit;
}



#
#  Create either a swap image, or a swap volume
#
my $swap_cmd;
if ( $CONFIG{'volume'} )
{
    $swap_cmd = "/sbin/lvcreate $CONFIG{'volume'} -L $CONFIG{'swap'}M -n $CONFIG{'hostname'}-swap";
}
else
{
    if ( ( -e $swap ) && ( !$CONFIG{'force'} ) )
    {
	print "\nERROR: The swap file we're trying to create already exists: $swap\n";
	print "Add --force to create the file anyway\n";
	exit;
    }
    $swap_cmd = "/bin/dd if=/dev/zero of=$swap bs=1024k count=$CONFIG{'swap'}";
}


#
#  Create swapfile and initialise it.
#
if ( ! $CONFIG{'no-swap'} )
{
    print "\n\nCreating swapfile : $swap\n";
    runCommand( $swap_cmd );
    runCommand( "/sbin/mkswap $swap" );
    print "Done\n";
}



#
#  Create disk file and initialise it.
#
print "\nCreating disk image: $image\n";

#
#  Create either a swap image, or a swap volume
#
my $image_cmd;

if ( $CONFIG{'volume'} )
{
    #
    # LVM
    $image_cmd = "/sbin/lvcreate $CONFIG{'volume'} -L $CONFIG{'size'} -n $CONFIG{'hostname'}-root";
}
else
{
    #
    # Loopback
    if ( ( -e $image ) && ( !$CONFIG{'force'} ) )
    {
	print "\nERROR: The image file we're trying to create already exists: $image\n";
	print "Add --force to create the file anyway\n";
	exit;
    }

    $image_cmd = "/bin/dd if=/dev/zero of=$image bs=$CONFIG{'size'} count=0 seek=1024";
}

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

#
#  Make the correct filesystem.
#
print "\nCreating $CONFIG{'fs'} filesystem\n";
my $create = $FILESYSTEM_CREATE{lc( $CONFIG{'fs'} ) } . $image ;
runCommand( $create );
print "Done\n";


#
#  Now mount the image, in a secure temporary location.
#
my $dir;
if ( $CONFIG{'rpmstrap'} )
{
    $dir = tempdir( CLEANUP => 0 );
}
else
{
    $dir = tempdir( CLEANUP => 1 );
}

my $mount_cmd;
if ( $CONFIG{'volume'} )
{
    $mount_cmd = "mount " . $FILESYSTEM_MOUNT{lc($CONFIG{'fs'})} . " $image $dir";
}
else
{
    $mount_cmd = "mount " . $FILESYSTEM_MOUNT{lc($CONFIG{'fs'})} . " -o loop $image $dir";
}
runCommand( $mount_cmd );


#
# Test that the mount worked
#
my $mount = runCommand( "/bin/mount" );
if ( ! $mount =~ /$image/)
{
    print "Something went wrong trying to mount the new filesystem\n";
    exit;
}

#
#  Install the base system - with a simple sense of progress.
#
installBaseSystem();


#
#  Now run any hook scripts post-install.  These will be the ones
# we ship to setup the new image, or any local additions.
#
if ( -d $CONFIG{'hook_dir'} )
{
    print "\n\nRunning hooks from : $CONFIG{'hook_dir'}\n";
    runHooks( $CONFIG{'hook_dir'}, $dir );
    print "Done\n";
}


#
#  If we have a role to execute then do that now, after the hooks
# have finished.
#
#  NOTE:  Roles don't apply to rpmstrap'd systems.
#
if ( ( $CONFIG{'role'} ) && ( ! $CONFIG{'rpmstrap'} ) )
{
    print "\n\nRunning role command : $CONFIG{'role'}\n";
    my $role_cmd = $CONFIG{'role_dir'} . "/" . $CONFIG{'role'};
    runCommand( $role_cmd . " " . $dir );
    print "Done\n";
}




#
#  We can not run this through hooks since it's interactive
#

if ( $CONFIG{'passwd'} )
{
    print "\nSetting root passwd:\n";
    my $passwd_cmd = `chroot $dir /usr/bin/passwd`;
}


#
#  Unmount the image; we're done.
#
runCommand( "umount -l $dir" );

#
#  Make sure the mount succeeded.
#
$mount = runCommand( "/bin/mount" );
if ( ! $mount =~ /$image/)
{
    print "Something went wrong trying to unmount the new image\n";
    die;
}

#
#  Clear screen before printing success message, unless
# we're running under '--debug'.
#
$TERMINAL_HEIGHT *= 2;
while( $TERMINAL_HEIGHT )
{
    printWideMessage( "\n" ) unless $CONFIG{'debug'};
    $TERMINAL_HEIGHT -= 1;
}


#
#  Now we've finished.
#


if ( $CONFIG{'boot'} )
{
    #
    #  Start the new instance if the user specified '--boot'.
    #
    startNewInstance();
}
else
{
    #
    # The user didn't specify the new instance should automatically
    # boot - so we'll show them instructions.
    #
    if ( $CONFIG{'dir'} )
    {
	showFinishedInstructions( loopback => 1 );
    }
    else
    {
	showFinishedInstructions( loopback => 0 );
    }
}


#
#  End of script.
#
exit;




=head2 readConfigurationFile

  Read the configuration file specified.

=cut

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

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

    my $line       = "";

    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 arguments specified upon the command line.

=cut

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

    #  Parse options.
    #
    GetOptions(
	       "hostname=s",   \$CONFIG{'hostname'},
	       "ip=s@",        \$CONFIG{'ip'},
	       "gateway=s",    \$CONFIG{'gateway'},
	       "netmask=s",    \$CONFIG{'netmask'},
	       "dir=s",        \$CONFIG{'dir'},
	       "volume=s",     \$CONFIG{'volume'},
	       "dhcp",         \$CONFIG{'dhcp'},
	       "mirror=s",     \$CONFIG{'mirror'},
	       "size=s",       \$CONFIG{'size'},
	       "swap=s",       \$CONFIG{'swap'},
	       "memory=s",     \$CONFIG{'memory'},
	       "fs=s",         \$CONFIG{'fs'},
	       "boot",         \$CONFIG{'boot'},
	       "dist=s",       \$CONFIG{'dist'},
	       "debootstrap=s",\$CONFIG{'debootstrap'},
	       "debug" ,       \$CONFIG{'debug'},
	       "kernel=s",     \$CONFIG{'kernel'},
	       "initrd=s",     \$CONFIG{'initrd'},
	       "passwd",       \$CONFIG{'passwd'},
	       "role=s",       \$CONFIG{'role'},
	       "cache=s",      \$CONFIG{'cache'},
               "ide",          \$CONFIG{'ide'},
               "force",        \$CONFIG{'force'},
               "rpmstrap",     \$CONFIG{'rpmstrap'},
               "no-swap",      \$CONFIG{'no-swap'},
	       "help",         \$HELP,
	       "manual",       \$MANUAL,
	       "version",      \$VERSION
	      );

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


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

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

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

}



=head2 checkArguments

  Check that the arguments the user has specified are complete and
 make sense.

=cut

sub checkArguments
{

    if (!defined( $CONFIG{'hostname'} ) )
    {
	print<<EOF

  You should set a hostname with '--hostname=foo'.

  This option is mandatory.  See the manual by running:

xen-create-image --manual
EOF
      ;
	exit;
    }

    #
    #  Make sure we have either --dir or --volume
    #
    if ( ( ! $CONFIG{'dir'} ) &&
	 ( ! $CONFIG{'volume'} ) )
    {
	print<<EOF

  You should set an output directory with '--dir=/my/path', or
 specify an LVM volume with '--volume=foo'.

EOF
	  ;
	exit;
    }


    #
    #  Make sure the directory exists.
    #
    if ( $CONFIG{'volume' } )
    {
	#
	#  Test the volume?
	#

	#
	#  Make sure we don't have both lvm + loopback.
	#
	if ( $CONFIG{'dir'} )
	{
	    print "Please choose either LVM or loopback, not both\n";
	    exit;
	}
    }
    else
    {
	if ( ! -d $CONFIG{'dir'} )
	{
	    print "Output directory '$CONFIG{'dir'}' doesn't exist\n";
	    exit;
	}

	if ( ! -w $CONFIG{'dir'} )
	{
	    print "Output directory '$CONFIG{'dir'}' isn't writable.\n";
	    exit;
	}
    }



    #
    #  Make sure we have every binary we need
    #
    if ( ! -x $CONFIG{'xm'} )
    {
	print "Could not find " .$CONFIG{'xm'}. ".\n";
	exit;
    }

    #
    #  Make sure the filesystem the user selects is valid.
    #
    if ( !defined( $FILESYSTEM_CREATE{lc( $CONFIG{'fs'} ) } ) ||
	 !defined( $FILESYSTEM_MOUNT{lc( $CONFIG{'fs'} ) } ) )
    {
	print "Unknown filesystem '$CONFIG{'fs'}'.  Valid choices are:\n";
	foreach my $key (sort keys %FILESYSTEM_MOUNT )
	{
	    print "\t" . $key . "\n";
	}
	exit;
    }

    #
    #  Now ensure we have the binary to create the image
    #
    my $binpath = $FILESYSTEM_BINARY{lc( $CONFIG{'fs'} ) };
    if ( ! -x $binpath ) {
  	  print "$binpath : required to create a $CONFIG{'fs'} filesystem is missing.\nAborting\n";
	  exit;
    }

    #
    #  Make sure we have a valid size
    #
    if ( !(($CONFIG{'size'} =~ /^\d+[GM]b*$/i) && ($CONFIG{'swap'} =~ /^\d+[GM]b*$/i)) )
    {
        print "Invalid size formats.  Please use something like:\n";
	print " --size=128Mb\n";
	print " --size=2Gb\n";
        exit;
    }


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

    #
    # Strip trailing Mb from the memory size.
    #
    if ( $CONFIG{'memory'} =~ /^(\d+)Mb*$/i )
    {
	$CONFIG{'memory'} = $1;
    }

    #
    #  Convert the image size to k.
    #
    # Fails for LVM ?
    #
    if ( $CONFIG{'dir'} )
    {
	$CONFIG{'size'} =~ s/Mb*$/k/i;
    }


    #
    # Now strip the trailing 'Mb' from the swap size.
    #
    if ( $CONFIG{'swap'} =~ /^(\d+)Mb*$/i )
    {
	$CONFIG{'swap'} = $1;
    }


    #
    #  Check mirror format
    #
    if (!($CONFIG{'mirror'} =~ /^http/i))
    {
	print "Please enter a valid mirror.\n";
	exit;
    }

    #
    #  Only one of DHCP / IP is required.
    #
    if ( scalar($CONFIG{'ip'}) && $CONFIG{'dhcp'})
    {
	print "You've chosen both DHCP and an IP address.\n";
	print "Only one is supported\n";
	exit;
    }

    if ( $CONFIG{'dhcp'} )
    {
	$CONFIG{'gateway'}   = '';
	$CONFIG{'netmask'}   = '';
	$CONFIG{'ip'}	     = ();
    }

    #
    #  Check --cache option
    #
    if ( ($CONFIG{'cache'} ne 'yes') && ($CONFIG{'cache'} ne 'no') ) {
	print "Valid options for --cache are yes/no.\n";
	exit;
    }


    #
    #  If the user is executing a role-script make sure it exists.
    #
    if ( $CONFIG{'role'} )
    {
	if ( ! -e $CONFIG{'role_dir'} . "/" . $CONFIG{'role'} )
	{
	    print "The role you've chosen '$CONFIG{'role'}' doesn't have a script.\n";
	    print "Available roles are:\n\n";
	    foreach my $file ( glob $CONFIG{'role_dir'} . "/*" )
	    {
		if ( $file =~ /(.*)\/(.*)/ ) { $file = $2; }

		print "\t" . $file . "\n";
	    }
	    exit;
	}
    }

    #
    #  If the user has chosen to use the rpmstrap tool make sure it is
    # available and disable caching.
    #
    if ( $CONFIG{'rpmstrap'} )
    {
	if ( ! -x '/usr/bin/rpmstrap' )
	{
	    print "You've chosen to use the rpmstrap program, but it isn't installed.\n";
	    exit;
	}

	#
	# RPMStrap implies no caching
	#
	$CONFIG{'cache'} = 'no';
    }


    #
    #  If the user is using rpmstrap then only allow the dist=xxx to be
    # taken from the supported rpmstrap distributions
    #
    if ( $CONFIG{'rpmstrap'} )
    {
	my $found = 0;
	my @avail = ();

	foreach my $file ( glob "/usr/lib/rpmstrap/scripts/*" )
	{
	    if ( $file =~ /(.*)\/(.*)/ ) { $file = $2; }

	    if ( lc($CONFIG{'dist'}) eq lc( $file ) )
	    {
		$found = 1;
	    }

	    push @avail, $file;
	}

	if ( ! $found )
	{
	    print " The distribution you've chosen isn't supported by rpmstrap.\n";
	    print " Please choose one of :\n";
	    foreach my $a ( sort @avail )
	    {
		print "\t$a\n";
	    }
	    print "\n";
	    exit;
	}
    }
}




=head2 installBaseSystem

  Install the base operating system into the specified directory
 and ensure it succeeded.

=cut

sub installBaseSystem
{

    print "\n\nInstalling the base system.   This will take a while!\n";


    #
    #  Copy any local .deb files into the right location on the virtual image
    # so that "debootstrap" will use them - rather than fetching from the network.
    #
    #  This is a big caching speedup.
    #
    if ( $CONFIG{'cache'} eq "yes" )
    {
	print "\nCopying files from host to image.\n";
	runCommand( "mkdir -p $dir/var/cache/apt/archives" );
	copyDebFiles( "/var/cache/apt/archives", "$dir/var/cache/apt/archives" );
	printWideMessage( "\rDone" );
    }

    my $command = '';

    #
    # Location of the installation log.
    #
    my $logfile = $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} . "/install.log";

    #
    #  Install with debootstrap, or rpmstrap.
    #
    if ( $CONFIG{'rpmstrap' } )
    {
	$command = "rpmstrap --verbose $CONFIG{'dist'} $dir | tee $logfile";
    }
    else
    {
	$command = "debootstrap $CONFIG{'debootstrap'} $CONFIG{'dist'} $dir $CONFIG{'mirror'} | tee $logfile";
    }

    runCommandWithProgress( $command );

    #
    #  Ensure the debootstrap command succeeded.
    #
    if ( ! -x $dir . "/bin/ls" )
    {
	print "Something went wrong with the debootstrap installation\n";
	print "(The generated system is missing '/bin/ls' which is odd!\n";
	print "If you'd like to investigate try mounting the volume by hand\n";
	print "Aborting\n";

	runCommand( "umount $dir" );

	print "You should examing '$logfile' to see why this failed.\n";
	exit;
    }


    #
    #  Copy the newly installed files from the virtual image to the host,
    # these will then be copied back the next time an image is created.
    #
    #  Big win.
    #
    #  NOTE: We do before running any hook or role scripts.  This might
    # not be ideal, but it avoids problems if any of those scripts run
    # "apt-get clean" inside the new instance.
    #
    if ( $CONFIG{'cache'} eq "yes" )
    {
	print "\n\nCaching debootstrap files to the host system\n";
	copyDebFiles( "$dir/var/cache/apt/archives", "/var/cache/apt/archives/" );
	printWideMessage( "\rDone" );
    }

}




=head2 startNewInstance

  Start the recently created Xen instance.

=cut

sub startNewInstance
{
    #
    #  Should we immediately start the new instance?
    #  If so fork() and do it so that we can return to the user, they can
    # attach to the console via the command : 'xm console $name'.
    #
    #
    print <<E_OF;

 Booting newly created virtual image: $CONFIG{'hostname'} in the background.

 To attach to the console run (as root):

   xm console $CONFIG{'hostname'}

E_OF

    my $pid = fork();
    if ( $pid )
    {
	exit;
    }
    else
    {
	#
	#  Start Xen instance in our forked process.  Avoid annoying
	# output.
	#
	#
	system( "$CONFIG{'xm'} create $CONFIG{'hostname'}.cfg >/dev/null 2>/dev/null" );
    }
}



=head2 showFinishedInstructions

  Show the user instructions on how to manually tweak their new instance,
 along with instructions on starting it up under Xen.

=cut

sub showFinishedInstructions
{
    my ( %params ) = ( @_ );

    my $mountLine = '';

    if ( defined( $params{'loopback'} ) && ( $params{'loopback'} ) )
    {
	$mountLine = "mount -t $CONFIG{'fs'} -o loop $image /mnt/tmp";
    }
    else
    {
	$mountLine = "mount -t $CONFIG{'fs'} $CONFIG{'volume'}/$CONFIG{'hostname'}-root /mnt/tmp";
    }

    print <<EO_MESSAGE;

New Image Created
-----------------

  To make any manual tweaks to the setup of $CONFIG{'hostname'} please run:

    mkdir /mnt/tmp
    $mountLine
    chroot /mnt/tmp /bin/bash

    .. make your changes ..

    exit
    umount /mnt/tmp

 Once completed you may start your new instance of Xen with:

    xm create $CONFIG{'hostname'}.cfg -c

EO_MESSAGE

}


=head2 printWideMessage

  Print a message, ensuring the width is as wide as the console.

=cut

sub printWideMessage
{
    my ( $msg ) = ( @_ );

    while( length( $msg ) < $TERMINAL_WIDTH )
    {
	$msg .= " ";
    }
    print $msg;
}



=head2 runCommand

  Run a command, and if debugging is turned on then display it
 to the user along with output.

  Otherwise hide all output.

=cut

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

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

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

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

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

    return( $output );
}



=head2 runCommandWithProgress

  Run a command whilst immediately writing the output to the console.

  This is a cheap hack to give a sense of 'progress'.

=cut

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

    $CONFIG{'debug'} && print "Executing : $cmd\n";

    my $pid = open3(undef, \*READ,0, $cmd );

    #
    #  A failure to run debootstrap is pretty much fatal to us.
    #
    #  Since without it there will be no installed filesystem.
    #
    #  Abort, after unmounting the directory we're using.
    #
    if ( ! $pid )
    {
	print "Error executing command : '$cmd' - $!";
	runCommand( "umount $dir" );
	exit;
    }


    my $output ='';
    while(1)
    {
	#
	# Wait for input.
	#
	select(undef,undef,undef,.01);

	#
	# Read output from the command, max 1k.
	#
	if( sysread \*READ,$output,1024 )
	{
	    #
	    # Remove newlines to avoid weirdness.
	    $output =~ s/\n//g;

	    #
	    #  If there is more output than our terminal width then
	    # truncate it.
	    #
	    if ( length( $output ) > $TERMINAL_WIDTH )
	    {
	       $output = substr( $output, 0, ( $TERMINAL_WIDTH - 5 ) );
	    }

	    #
	    # Pad to exactly terminal width.
	    while( length( $output ) < $TERMINAL_WIDTH )
	    {
		$output .= " " ;
	    }


	    #
	    # Now rewind cursor to start of line and display
	    # the text.
	    #
	    print STDERR "\r";
	    print STDERR $output;
	}
	else
	{
	    #
	    # command finished.
	    #
	    my $over = "\rFinished";
	    while( length( $over ) < $TERMINAL_WIDTH )
	    {
		$over .= " ";
	    }
	    print STDERR $over . "\n";
	    return;
	}
    }
}



=head2 getTerminalSize

  Find and return the size and width of the current terminal.

  This function makes use of the Term::Size module if available, if
 it is not installed then we return the standard size of 80x25.

=cut


sub getTerminalSize
{

    my $testModule  = "use Term::Size;";

    my $width  = 80;
    my $height = 25;

    #
    #  Test loading the size module.  If this fails
    # then we will use the defaults sizes.
    #
    eval( $testModule );
    if ( $@ )
    {
    }
    else
    {
	#
	# Term::Size is available, so use it to find
	# the current terminal size.
	#
	($width, $height ) = Term::Size::chars();
    }

    return( $width, $height );
}



=head2 runHooks

  When the image has been created, but before the temporary image
 is unmounted, each executable script inside the hook directory will
 be executed.

  The scripts are executed "in order" which might be useful for users
 who wish to ensure some actions occur before others.

  The scripts will each be given two arguments:

  The directory within which the image is currently mounted.
  The name of the distribution being installed.

  The rest of the configuration variables will be passed via
 environmental variables.

=cut

sub runHooks
{
    my ( $HOOK_DIR, $prefix ) = ( @_ );

    #
    #  Setup the environment for the child processes.
    #
    $CONFIG{'debug'} && print "Setting environment for hook scripts:\n";
    foreach my $key ( keys %CONFIG )
    {
	if ( defined( $CONFIG{$key} ) )
	{
	    $ENV{$key} = $CONFIG{$key};
	}
    }

    #
    # Set the image and swap file paths.
    #
    $ENV{'imagevbd'} = $image_vbd;
    $ENV{'swapvbd'}  = $swap_vbd;

    #
    # 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{'debug'} )
    {
	print "=============\n";
	foreach my $key ( sort keys %ENV )
	{
	    print "\t'" . $key . "' = '" . $CONFIG{$key} . "'\n";
	}
    }

    #
    #
    # Make sure that our scripts run in sorted order, as
    # the user would expect.
    #
    foreach my $file ( sort( glob( $HOOK_DIR . "*" ) ) )
    {
        # skip files that end with .dpkg-new, .dpkg-old or '~'
        next if ( $file =~ /\.dpkg-(new|old)/ );
        next if ( $file =~ /~$/ );

	#
	# Only run executable files.
	#
	if ( ( -x $file ) && ( -f $file ) )
	{
	    #
	    # Just display the name - no need to see the full path.
	    #
	    my $name = $file;
	    if ( $file =~ /(.*)\/(.*)/ )
	    {
		$name = $2;
	    }

	    print " Running hook: $name";
	    runCommand( $file . " " . $prefix . " " . $CONFIG{'dist'} );
	    print " - done.\n";
	}
    }
}


=head2 copyDebFiles

  This function will copy all the .deb files from one directory
 to another, giving a "progress indicator" of sorts.

=cut

sub copyDebFiles
{
    my ( $source, $dest ) = ( @_ );

    my @files =  glob( $source . "/*.deb" );
    my $count = 1;
    my $total = $#files+1;

    foreach my $file ( sort @files )
    {
	my $name = $file;
	if ( $name =~ /(.*)\/(.*)/ )
	{
	    $name = $2;
	}
	my $t = "\r[$count/$total] : $name";

	#
	# Print the status message and do the copy.
	#
	printWideMessage( $t );

	#
	#  Only copy if the file doesn't exist.
	#
	if ( ! ( -e $dest . "/" . $name ) )
	{
	    File::Copy::cp( $file, $dest );
	}

	$count += 1;
    }
}