xen-tools 4.2.1-1 / usr / bin / xen-list-images

#!/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.

  Testing options:
   --test     Specify an alternate Xen configuration directory.

=head1 OPTIONS

=over 8

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

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

=item B<--test>
This flag causes the script to load the Xen configuration files from a different directory than the default of B</etc/xen>.

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

=back


=head1 DESCRIPTION

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

  This works by iterating over all files matching the pattern
 /etc/xen/*.cfg which is what the xen-create-image script would
 create.

  For each instance which has been created we'll display the name,
 and then either the IP address configured, or "DHCP" to denote
 a dynamic host.

=cut

=head1 TODO

  It should be possible to determine the disk(s) used by the images,
 and then display their sizes.

=cut


=head1 AUTHORS

 Steve Kemp, http://www.steve.org.uk/
 Stéphane Jourdois

=cut

=head1 LICENSE

Copyright (c) 2005-2009 by Steve Kemp, (c) 2010 by The Xen-Tools
Development Team. 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 file.
#
my %CONFIG;

#
#  Default prefix
#
$CONFIG{ 'prefix' } = "/etc/xen";

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



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


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


#
#  Read all the xen configuration files.
#
my @instances = findXenInstances();


#
#  Now process each instance.
#
my $count = 0;
foreach my $instance (@instances)
{
    if ($count) {print "\n";}

    displayInstance($instance);
    $count += 1;
}


#
#  All done.
#
exit;



=begin doc

  Read the configuration file specified.

=end doc

=cut

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

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

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


    while ( defined( my $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+$//;

            # command expansion?
            if ( $val =~ /(.*)`([^`]+)`(.*)/ )
            {

                # store
                my $pre  = $1;
                my $cmd  = $2;
                my $post = $3;

                # get output
                my $output = `$cmd`;
                chomp($output);

                # build up replacement.
                $val = $pre . $output . $post;
            }

            # Store value.
            $CONFIG{ $key } = $val;
        }
    }
    close(FILE);
}



=begin doc

  Parse the arguments specified upon the command line.

=end doc

=cut

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

    #  Parse options.
    #
    GetOptions( "test=s", \$CONFIG{ 'prefix' },
                "help", \$HELP,
                "manual", \$MANUAL,
                "version", \$VERSION );

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


    if ($VERSION)
    {
        my $REVISION = '$Revision: 1.30 $';
        if ( $REVISION =~ /1.([0-9.]+) / )
        {
            $REVISION = $1;
        }

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



=begin doc

  Return an array containing the names of each xen configuration
 file we found.

=end doc

=cut

sub findXenInstances
{
    my @found;

    foreach my $file ( sort( glob( $CONFIG{ 'prefix' } . "/*.cfg" ) ) )
    {
        push @found, $file if ( -e $file );
    }

    return (@found);
}



=begin doc

  Show details about the the Xen instance contained in the given
 configuration file.

=end doc

=cut

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

    #
    #  Read each line.
    #
    open( FILY, "<", $file );
    my @LINES = <FILY>;
    close(FILY);

    #
    #  Is it dynamic?
    #
    my $dhcp = 0;
    my $ip   = '';
    my $mac  = '';
    my $name = '';
    my $mem  = 0;

    foreach my $line (@LINES)
    {
        if ( $line =~ /^\s*dhcp\s*=\s*"dhcp\"/i )
        {
            $dhcp = 1;
        }
        if ( $line =~ /^\s*name\s*=\s*["']([^'"]+)['"]/i )
        {
            $name = $1;
        }
        if ( $line =~ /.*memory[^0-9]*([0-9]+)/i )
        {
            $mem = $1;
        }
        if ( $line =~ /ip=([0-9\.]+)/ )
        {
            $ip = $1;
        }
        if ( $line =~ /mac=['\"]([^'\"]+)['\"]/ )
        {
            $mac = " [MAC: $1]";
        }
    }

    print "Name: $name\n";
    print "Memory: $mem\n";
    print "IP: " . $ip . $mac . "\n" if length($ip);
    print "DHCP" . $mac . "\n" if $dhcp;
}