449 lines
7.9 KiB
Perl
Executable File
449 lines
7.9 KiB
Perl
Executable File
#!/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.
|
|
--volume Specify the LVM volume where 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.
|
|
|
|
=item B<--volume>
|
|
Specify the LVM volume where images are located
|
|
|
|
=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.29 2006-06-09 09:27:33 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 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;
|
|
|
|
#
|
|
# Release number.
|
|
#
|
|
my $RELEASE = '1.6';
|
|
|
|
|
|
|
|
#
|
|
# 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();
|
|
|
|
#
|
|
# Make sure we have either a volume, or a root.
|
|
#
|
|
if ( $CONFIG{'volume'} && $CONFIG{'dir'} )
|
|
{
|
|
print "Please only use a volume or a directory name - not both\n";
|
|
exit;
|
|
}
|
|
|
|
|
|
#
|
|
# Volumes are not supported yet :(
|
|
#
|
|
if ( $CONFIG{'volume'} )
|
|
{
|
|
print "LVM Volumes are not supported yet\n";
|
|
exit;
|
|
}
|
|
|
|
|
|
|
|
#
|
|
# 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 ";
|
|
|
|
#
|
|
# Don't show the networking details if running with '--test'
|
|
#
|
|
if ( $CONFIG{'test'} )
|
|
{
|
|
print "\n";
|
|
}
|
|
else
|
|
{
|
|
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'},
|
|
"volume=s", \$CONFIG{'volume'},
|
|
"test", \$CONFIG{'test'},
|
|
"help", \$HELP,
|
|
"manual", \$MANUAL,
|
|
"version", \$VERSION
|
|
);
|
|
|
|
pod2usage(1) if $HELP;
|
|
pod2usage(-verbose => 2 ) if $MANUAL;
|
|
|
|
|
|
if ( $VERSION )
|
|
{
|
|
my $REVISION = '$Revision: 1.29 $';
|
|
|
|
if ( $REVISION =~ /1.([0-9.]+) / )
|
|
{
|
|
$REVISION = $1;
|
|
}
|
|
|
|
print "xen-list-images release $RELEASE - CVS: $REVISION\n";
|
|
exit;
|
|
|
|
}
|
|
}
|
|
|
|
|
|
=head2 showNetworkingDetails
|
|
|
|
Mount the given disk image and read the networking details from it.
|
|
|
|
This will deal with both Debian images and CentOS4 images. Other
|
|
distributions are not yet recognised.
|
|
|
|
=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`;
|
|
|
|
|
|
if ( -e $dir . "/etc/network/interfaces" )
|
|
{
|
|
showDebianNetworkingDetails( $dir );
|
|
}
|
|
elsif ( -e $dir . "/etc/sysconfig/network-scripts/ifcfg-eth0" )
|
|
{
|
|
showCentosNetworkingDetails( $dir );
|
|
}
|
|
else
|
|
{
|
|
print "Unknown distribution - No networking details.\n";
|
|
}
|
|
|
|
|
|
#
|
|
# Unmount the image.
|
|
#
|
|
`umount $dir`;
|
|
}
|
|
|
|
|
|
|
|
=head2 showCentosNetworkingDetails
|
|
|
|
Read and display the configured network address of a CentOS4 instance.
|
|
|
|
=cut
|
|
|
|
sub showCentosNetworkingDetails
|
|
{
|
|
my ( $dir ) = ( @_ );
|
|
|
|
#
|
|
# Read /etc/network/interfaces
|
|
#
|
|
my $found = 0;
|
|
open( IN, "<", $dir . "/etc/sysconfig/network-scripts/ifcfg-eth0" );
|
|
foreach my $line ( <IN> )
|
|
{
|
|
if ( $line =~ /=[ \t]*dhci/i )
|
|
{
|
|
print " DHCP\n";
|
|
$found = 1;
|
|
}
|
|
if ( $line =~ /IPADDR[ \t]*=[ \t]*([1-9\.]+)/ )
|
|
{
|
|
print $1 . "\n";
|
|
$found = 1;
|
|
}
|
|
}
|
|
close( IN );
|
|
if ( ! $found ) { print "Unknown IP address\n"; }
|
|
|
|
}
|
|
|
|
|
|
|
|
=head2 showDebianNetworkingDetails
|
|
|
|
Read and display the static IP address of a Debian GNU/Linux instance.
|
|
|
|
=cut
|
|
|
|
sub showDebianNetworkingDetails
|
|
{
|
|
my ( $dir ) = ( @_ );
|
|
|
|
#
|
|
# 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"; }
|
|
|
|
}
|