#!/usr/bin/perl -w

=head1 NAME

xen-list-images - List all the created and configured Xen images.

=head1 SYNOPSIS

  xen-list-image [options]


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

  General Options:
   --dir      Specify where the output images are located.

  Testing options:
   --test     List an image even if there is no configuration file in /etc/xen

=head1 OPTIONS

=over 8

=item B<--dir>
Specify the output directory where images were saved.

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

=item B<--manual>
Read the manual.

=item B<--test>
This flag causes an image to be listed even if the configuration file in /etc/xen doesn't exist.  It is soley used for the test script.

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

=back


=head1 DESCRIPTION

  xen-list-images is a simple script which will display all the
 images which have been created in a given directory.

  The script follows the same pattern as the other scripts, it
 assumes that all images are stored beneath a prefix directory
 in a layout such as this:

   $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

  For each subdirectory found beneath $dir/domains the image will
 be tested if:

   1.  The disk.img file exists.
   2.  The swap.img file exists.
   3.  A configuration file /etc/xen/$name.cfg exists.

  If these conditions are met the name will be output, along with
 networking information.


=head2 NOTES

  If the script is run by a non-root user the networking information
 will not be displayed.  This is because a non-user may not mount
 the disk images to read the configuration.

  If you wish to see the networking details you must execute this
 script as root.

=cut



=head1 AUTHOR


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

 $Id: xen-list-images,v 1.13 2006/01/07 23:23:12 steve Exp $

=cut


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


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

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



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



#
#  Get the directory which holds the images.
#
my $dir = $CONFIG{'dir'}  . "/domains/";


#
# Get the name of the image.
#
foreach my $entry ( glob( $dir . "*" ) )
{
   if ( $entry =~ /(.*)\/domains\/(.*)/ )
   {	
       $entry = $2;
   }

   #
   # Xen configuration file.
   #
   if ( $CONFIG{'test'} or ( -e "/etc/xen/" . $entry . ".cfg" ) )
   {
       my $image = $CONFIG{'dir'} . "/domains/$entry/disk.img";
       my $swap  = $CONFIG{'dir'} . "/domains/$entry/swap.img";

       #
       #  Disk && Swap files.
       #
       if ( ( -e $image ) &&
	    ( -e $swap ) )
       {

	   if ( $EFFECTIVE_USER_ID != 0 )
	   {
	       print "Image: $entry\n";
	   }
	   else
	   {
	       print "Image: $entry ";

	       showNetworkingDetails( $image );
	   }
       }
   }
}



#
#  All done.
#
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(
	       "dir=s",      \$CONFIG{'dir'},
	       "test",       \$CONFIG{'test'},
	       "help",       \$HELP,
	       "manual",     \$MANUAL,
	       "version",    \$VERSION
	      );
    
    pod2usage(1) if $HELP;
    pod2usage(-verbose => 2 ) if $MANUAL;


    if ( $VERSION )
    {
	my $REVISION      = '$Id: xen-list-images,v 1.13 2006/01/07 23:23:12 steve Exp $';
	$VERSION = join (' ', (split (' ', $REVISION))[2]);
	$VERSION =~ s/,v\b//;
	$VERSION =~ s/(\S+)$/$1/;

	print "xen-list-images release $RELEASE - CVS: $VERSION\n";
	exit;

    }
}


=head2 showNetworkingDetails

  Mount the given disk image and read the networking details from it.

=cut

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


    #
    # Mount the image securely
    #
    my $dir = tempdir( CLEANUP => 1 );
    my $mount_cmd = "mount -t auto -o loop $image $dir";
    `$mount_cmd`;
    
    
    #
    #  Read /etc/network/interfaces
    #
    my $found = 0;
    open( IN, "<", $dir . "/etc/network/interfaces" );
    foreach my $line ( <IN> )
    {
	if ( ( $line =~ /dhcp/ ) &&
	     ( $line =~ /eth/ ) )
	{
	    print " DHCP\n";
	    $found = 1;
	}
	if ( $line =~ /address ([0-9\.]+)/ )
	{
	    print $1 . "\n";
	    $found = 1;
	}
    }
    close( IN );
    if ( ! $found ) { print "Unknown IP address\n"; }

    #
    # Unmount the image.
    #
    `umount $dir`;
}
