#!/usr/bin/perl -w

=head1 NAME

  xen-create-image - Create a new Xen instance of Debian Sarge.

=head1 SYNOPSIS

  xen-create-image [options]

  Help Options:
   --help     Show this scripts help information.
   --manual   Read this scripts manual.

  Size / General options:
   --dir      Specify where the output images should go.
   --fs       Specify the filesystem type to use.
   --memory   Setup the amount of memory allocated to the instance.
   --size     Set the size of the primary disk image.
   --swap     Set the size of the swap partition.   

  Networking options:
   --dhcp      Setup the image to get an IP address via DHCP
   --network   Setup the network the host is upon.
   --gateway   Setup the iamge's network gateway.
   --broadcast Setup the image's network broadcast address.
   --mirror    Setup the mirror to use when installing Sarge.

  Mandatory options:

   --hostname  Set the images hostname.

=cut



=head1 OPTIONS

=over 8

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

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

=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<--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<--network>
Specify the network the virtual image is living upon.  Only useful if DHCP is not used.
=item B<--size>  
Specify the size of the virtual images primary drive.  The size may be
suffixed with either Mb, or Gb.

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


=back

=cut


=head1 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 --network=192.168.1.0 \
          --gateway=192.168.1.1 \
          --dir=/home/xen --hostname=vm02

  To save time 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 DESCRIPTION


  xen-create-image is a simple script which allows you to create new
 Xen instances of Debian Sarge.  The new images conmprise of two
 files:

   1.  One disk image which will be treated as the primary disk drive.
   2.  One swap image.

  The image will also have an OpenSSH server installed upon it, and
 an appropriate /etc/inittab file created, along with copies of the
 hosts password and shadow files.


=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 three files for options:

   1. /etc/xen-tools/xen-tools.conf
   2. ~/.xen-tools.conf
   3. ./etc/xen-tools.conf

  The files may contain comments, which begin with the hash '#' character
 and are otherwise of the format 'key = value.

  A sample configuration file would look like this:


=for example begin

#
# General options.
#
dir    = /home/xen   # Ouptut directory
memory = 128Mb       # 128Mb for each new image.

#
#  Images
#
fs   = ext3      # We like EXT3
swap = 128mb     # 128Mb of swap.
size = 2Gb       # 2Gb images.

#
# Networking options.
#
network   = 192.168.1.0
gateway   = 192.168.1.1
broadcast = 255.255.255.0

=for example end

  This allows a new image to be created with only two command line flags:

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


=head1 AUTHOR


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

 $Id: xen-create-image,v 1.21 2005-12-18 23:45:17 steve Exp $

=cut


=head1 CONTRIBUTORS

  Radu Spineanu

=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 English;
use File::Copy;
use File::Temp qw/ tempdir /;
use Getopt::Long;
use Pod::Usage;



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.)

E_O_ROOT

    exit;
}

#
#  Configuration options, initially read from the configuration files
# but may be overridden by the command line.
#
#  Command line flags *always* take precedence over the configuration files(s).
#
my %CONFIG;




#
# Constants for filesystem usage.
#
my %FILESYSTEM_CREATE;
my %FILESYSTEM_MOUNT;

$FILESYSTEM_CREATE{'ext3'}     = '/sbin/mkfs.ext3 -F ';
$FILESYSTEM_CREATE{'xfs'}      = '/sbin/mkfs.xfs -d name=';
$FILESYSTEM_CREATE{'reiserfs'} = '/sbin/mkfs.reiserfs -f -q ';

$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 one of the configuration files, or by the
# command line arguments.
#
$CONFIG{'memory'} = '96Mb';
$CONFIG{'size'}   = '2000Mb';
$CONFIG{'swap'}   = '128M';
$CONFIG{'fs'}     = 'ext3';
$CONFIG{'mirror'} = 'http://ftp.us.debian.org/debian';

#
#  Read configuration file(s) if they exist.
#
if ( -e "etc/xen-tools.conf" )
{
    readConfigurationFile( "etc/xen-tools.conf" );
}
if ( -e "/etc/xen-tools/xen-tools.conf" )
{
    readConfigurationFile( "/etc/xen-tools/xen-tools.conf" );
}
if ( -e $ENV{'HOME'} . ".xen-tools.conf" )
{
    readConfigurationFile( $ENV{'HOME'} . ".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();

print "\n";
print "Hostname :  $CONFIG{'hostname'}\n";
print "Image size: $CONFIG{'size'}\n";
print "Swap size:  $CONFIG{'swap'}\n";
print "Fileystem:  $CONFIG{'fs'}\n";

if ( $CONFIG{'dhcp'} ) 
{
    print "DHCP\n";
}
else
{
   $CONFIG{'ip'}        && print "IP       : $CONFIG{'ip'}\n";
   $CONFIG{'network'}   && print "Network  : $CONFIG{'network'}\n";
   $CONFIG{'broadcast'} && print "Broadcast: $CONFIG{'broadcast'}\n";
   $CONFIG{'gateway'}   && print "Gateway  : $CONFIG{'gateway'}\n";
}
print "---\n";

#
#  If the output directories don't exist then create them.
#
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 = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/disk.img" ;
my $swap  = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/swap.img" ;

#
#  Create swapfile and initialise it.
#
print "Creating swapfile : $swap\n";
$CONFIG{'swap'} =~ s/Mb*$//i;
`/bin/dd if=/dev/zero of=$swap bs=1024k count=$CONFIG{'swap'} >/dev/null 2>/dev/null`;
print "Initializing swap file\n";
`/sbin/mkswap $swap`;
print "Done\n";

#
#  Create disk file and initialise it.
#
print "Creating disk image: $image\n";
$CONFIG{'size'} =~ s/Mb*$/k/i;
`/bin/dd if=/dev/zero of=$image bs=$CONFIG{'size'} count=1 seek=1024 >/dev/null 2>/dev/null`;
print "Creating $CONFIG{'fs'} filesystem\n";

my $create = $FILESYSTEM_CREATE{lc( $CONFIG{'fs'} ) } . $image;
`$create`;
print "Done\n";


#
#  Now mount the image, in a secure temporary location.
#
my $dir = tempdir( CLEANUP => 1 );
my $mount_cmd = "mount " . $FILESYSTEM_MOUNT{lc($CONFIG{'fs'})} . " -o loop $image $dir";
`$mount_cmd`;


# Test that the mount worked

my $mount = `/bin/mount`;

if ( ! $mount =~ /$image/) {
    print "Something went wrong trying to mount the new filesystem\n";
    exit;
}

#
#  Copy any local .deb files into the debootstrap archive as a potential
# speedup.
#
`mkdir -p $dir/var/cache/apt/archives`;
foreach my $file ( glob( "/var/cache/apt/archives/*.deb" ) )
{
    File::Copy::cp( $file, "$dir/var/cache/apt/archives" );
}

#
#  Install the base system.
#
print "Running debootstrap to install the system.   This will take a while!\n";
`debootstrap sarge $dir $CONFIG{'mirror'}`;
print "Done\n";

#
#  Copy these files as a speed boost for the next run.
#
foreach my $file ( glob( "$dir/var/cache/apt/archives/*.deb" ) )
{
    File::Copy::cp( $file, "/var/cache/apt/archives" );
}

#
#  If the debootstrap failed then we'll setup the output directories
# for the configuration files here.
#
`mkdir -p $dir/etc/apt`;
`mkdir -p $dir/etc/network`;

#
#  OK now we can do the basic setup.
#
print "Setting up APT sources .. ";
open( APT, ">", $dir . "/etc/apt/sources.list" );
print APT<<E_O_APT;
#
#  /etc/apt/sources.list
#


# Stable
deb $CONFIG{'mirror'}     sarge main contrib non-free

# 
#  Security updates
#
deb     http://security.debian.org/ stable/updates  main contrib non-free


E_O_APT
close( APT );

print "Done\n";



#
#  Copy some files from the host system, after setting up the hostname.
#
#
my @hostFiles = ( "/etc/resolv.conf",
		  "/etc/hosts",
		  "/etc/passwd",
		  "/etc/group",
		  "/etc/shadow",
		  "/etc/gshadow" );

foreach my $file ( @hostFiles )
{
    File::Copy::cp( $file, $dir . "/etc" );
}


#
#  Disable TLS
#
if ( -d $dir . "/lib/tls" ) 
{
    `mv $dir/lib/tls $dir/lib/tls.disabled`;
}



#
#  Now setup the fstab
#
print "Setting up /etc/fstab .. ";
open( TAB, ">", $dir . "/etc/fstab" );
print TAB<<E_O_TAB;
/dev/sda1     /     $CONFIG{'fs'}     errors=remount-ro     0     1
/dev/sda2     none  swap     sw                    0     0
proc          /proc proc     defaults              0     0
E_O_TAB
close( TAB );

print "Done\n";


#
#  Setup the /etc/network/interfaces file upon the guest image
#
setupNetworking( $dir );


#
#  Install OpenSSH
#
installOpenSSH( $dir );

#
#  Fixup Inittab file
#
fixupInittab( $dir );



#
#  Now unmount the image.
#
`umount $dir`;


#
# Finally setup Xen to allow us to create the image.
#
print "Setting up Xen configuration file .. ";
open( XEN, ">", "/etc/xen/$CONFIG{'hostname'}.cfg" );
print XEN<<E_O_XEN;
kernel = "/boot/vmlinuz-2.6.12-xenU"
memory = $CONFIG{'memory'}
name   = "$CONFIG{'hostname'}"
disk   = [ 'file:$image,sda1,w','file:$swap,sda2,w' ]
root   = "/dev/sda1 ro"
E_O_XEN
if ( $CONFIG{'dhcp'} )
{
    print XEN "dhcp=\"dhcp\"\n";
}
else
{
    print XEN "#dhcp=\"dhcp\"\n";
}
close( XEN );

print "Done\n";


#
#  Give status message
#
print <<EOEND;

  To finish the setup of your new host $CONFIG{'hostname'} please run:

    mkdir /mnt/tmp
    mount -t $CONFIG{'fs'} -o loop $image /mnt/tmp

    chroot /mnt/tmp /bin/bash

    # Get security upgrades.
    apt-get upgrade

    # setup passwords, etc.
    passwd root

    # Cleanup.
    exit
    umount /mnt/tmp

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

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

EOEND



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

    #  Parse options.
    #
    GetOptions(
	       "hostname=s", \$CONFIG{'hostname'},
	       "ip=s",       \$CONFIG{'ip'},
	       "gateway=s",  \$CONFIG{'gateway'},
	       "mask=s",     \$CONFIG{'netmask'},
	       "broadcast=s",\$CONFIG{'broadcast'},
	       "network=s",  \$CONFIG{'network'},
	       "dir=s",      \$CONFIG{'dir'},
	       "dhcp",       \$CONFIG{'dhcp'},
	       "mirror=s",   \$CONFIG{'mirror'},
	       "size=s",     \$CONFIG{'size'},
	       "swap=s",     \$CONFIG{'swap'},
	       "memory=s",   \$CONFIG{'memory'},
	       "fs=s",       \$CONFIG{'fs'},
	       "help",       \$HELP,
	       "manual",     \$MANUAL
	      );
    
    pod2usage(1) if $HELP;
    pod2usage(-verbose => 2 ) if $MANUAL;
}



=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 required.
EOF
      ;
	exit;
    }


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

  You should set an output directory with '--dir=/my/path'.

  This option is required.  Subdirectories will be created
 beneath the directory you name.

EOF
	  ;
	exit;
    }



    #
    #  Make sure the directory exists.
    #
    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 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
    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;
    }


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

    #
    #  Only one of DHCP / IP is required.
    #
    if ( $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{'broadcast'} = '';
	$CONFIG{'ip'}	     = '';
    }

    #
    #  Ensure we know how to create *and* mount the given filesystem.
    #
    if ( !defined( $FILESYSTEM_CREATE{lc( $CONFIG{'fs'} ) } ) ||
	 !defined( $FILESYSTEM_MOUNT{lc( $CONFIG{'fs'} ) } ) )
    {
	print "Unknown filesystem.  Valid choices are:\n";
	foreach my $key (sort keys %FILESYSTEM_MOUNT ) 
	{
	    print "\t" . $key . "\n";
	}
	exit;
    }
}



=head2 setupNetworking

  Setup the /etc/network/interfaces file, and the hostname 
 upon the virtual instance.

=cut

sub setupNetworking
{
    my ( $prefix ) = ( @_ );

    `echo '$CONFIG{'hostname'}' > $prefix/etc/hostname`;

    open( IP, ">", $prefix . "/etc/network/interfaces" );

    if ( $CONFIG{'dhcp'} )
    {
	print IP<<E_O_DHCP;
# This file describes the network interfaces available on your system
# and how to activate them. For more information, see interfaces(5).

# The loopback network interface
auto lo
iface lo inet loopback
	    
# The primary network interface
auto eth0
iface eth0 inet dhcp

E_O_DHCP
    }
    else
    {
	print IP<<E_O_STATIC_IP;
# This file describes the network interfaces available on your system
# and how to activate them. For more information, see interfaces(5).

# The loopback network interface
auto lo
iface lo inet loopback
	    
# The primary network interface
auto eth0
iface eth0 inet static
 address $CONFIG{'ip'}
 gateway $CONFIG{'gateway'}
 netmask $CONFIG{'netmask'}
 network $CONFIG{'network'}
 broadcast $CONFIG{'broadcast'}

E_O_STATIC_IP
    }

    close( IP );
}



=head2 installOpenSSH

  Install OpenSSH upon the virtual instance via apt-get.

=cut

sub installOpenSSH
{
    my ( $prefix ) = ( @_ );

    `chroot $prefix /usr/bin/apt-get update`;
    `DEBIAN_FRONTEND=noninteractive chroot $prefix /usr/bin/apt-get --yes --force-yes install ssh`;
    `chroot $prefix /etc/init.d/ssh stop`;
}



=head2 fixupInittab

  Copy the host systems /etc/inittab to the virtual installation 
 making a couple of minor changes:

  1. Setup the first console to be "Linux".
  2. Disable all virtual consoles.

=cut 

sub fixupInittab
{
    my ( $prefix ) = ( @_ );


    my @init;
    open( INITTAB, "<", "/etc/inittab" );
    foreach my $line ( <INITTAB> )
    {
	chomp $line;
	if ( $line =~ /:respawn:/ )
	{
	    if ( $line =~ /^1/ )
	    {
            # NOP - leave line unchanged.
	    }
	    else
	    {
            # Otherwise comment out the line, we don't need multiple
            # terminals since we can only access one.
		$line = "#" . $line;
	    }
	}
	push @init, $line;
    }
    close( INITTAB );
    
    
    open( OUTPUT, ">", "$prefix/etc/inittab" );
    foreach my $line ( @init )
    {
	print OUTPUT $line . "\n";
    }
    close( OUTPUT )
}