340 lines
5.7 KiB
Perl
Executable File
340 lines
5.7 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
=head1 NAME
|
|
|
|
xen-delete-image - Delete previously created Xen instances.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
xen-delete-image [options] imageName1 imageName2 ... imageNameN
|
|
|
|
Help Options:
|
|
--help Show help information.
|
|
--manual Read the manual for this script.
|
|
--version Show the version information and exit.
|
|
|
|
General options:
|
|
--dir Specify the output directory where images were previously saved.
|
|
--volume Specify the LVM volume to use.
|
|
|
|
Testing options:
|
|
--test Don't complain if we're not invoked by root.
|
|
|
|
=cut
|
|
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 8
|
|
|
|
=item B<--dir>
|
|
Specify the output directory where images were previously saved.
|
|
|
|
=item B<--help>
|
|
Show help information.
|
|
|
|
=item B<--manual>
|
|
Read the manual for this script.
|
|
|
|
=item B<--test>
|
|
Don not complain, or exit, if the script is not executed by the root user.
|
|
|
|
=item B<--version>
|
|
Show the version number and exit.
|
|
|
|
=item B<--volume>
|
|
Specify the LVM volume where images were previously saved.
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
xen-delete-image is a simple script which allows you to delete
|
|
Xen instances which have previously been created.
|
|
|
|
You must be root to run this script as it removes the Xen configuration
|
|
file from /etc/xen. (When invoked with the '--test' flag the script will
|
|
continue running, but will fail to remove anything which the user does
|
|
not have permission to delete.)
|
|
|
|
=cut
|
|
|
|
|
|
=head1 EXAMPLES
|
|
|
|
Assuming that you have three images 'foo', 'bar', and 'baz', stored
|
|
beneath /home/xen the first two may be deleted via:
|
|
|
|
xen-delete-image --dir=/home/xen foo bar
|
|
|
|
=cut
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
Steve
|
|
--
|
|
http://www.steve.org.uk/
|
|
|
|
$Id: xen-delete-image,v 1.25 2006-02-18 20:11:00 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 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.1';
|
|
|
|
|
|
|
|
|
|
#
|
|
# 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;
|
|
}
|
|
|
|
|
|
#
|
|
# Abort if non-root user.
|
|
#
|
|
if ( (!$CONFIG{'test'}) && ( $EFFECTIVE_USER_ID != 0 ) )
|
|
{
|
|
print <<E_O_ROOT;
|
|
|
|
This script is not running with root privileges, so the configuration
|
|
file(s) beneath /etc/xen will not be removed.
|
|
|
|
E_O_ROOT
|
|
|
|
exit;
|
|
}
|
|
|
|
|
|
|
|
#
|
|
# Loop over the supplied arguments, and attempt to delete each
|
|
# image.
|
|
#
|
|
while( my $name = shift )
|
|
{
|
|
deleteXenImage( $name );
|
|
}
|
|
|
|
|
|
#
|
|
# 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.25 $';
|
|
|
|
if ( $REVISION =~ /1.([0-9.]+) / )
|
|
{
|
|
$REVISION = $1;
|
|
}
|
|
|
|
print "xen-delete-image release $RELEASE - CVS: $REVISION\n";
|
|
exit;
|
|
|
|
}
|
|
}
|
|
|
|
|
|
|
|
=head2 deleteXenImage
|
|
|
|
Delete the named image, and the corresponding configuration file
|
|
from /etc/xen.
|
|
|
|
=cut
|
|
|
|
sub deleteXenImage
|
|
{
|
|
my ($hostname) = ( @_ );
|
|
|
|
#
|
|
# Delete the configuration file.
|
|
#
|
|
if ( -e "/etc/xen/" . $hostname . ".cfg" )
|
|
{
|
|
unlink( "/etc/xen/" . $hostname . ".cfg" );
|
|
}
|
|
|
|
|
|
#
|
|
# Now the swap image
|
|
#
|
|
if ( -e $CONFIG{'dir'} . "/domains/" . $hostname . "/swap.img" )
|
|
{
|
|
unlink( $CONFIG{'dir'} . "/domains/" . $hostname . "/swap.img" );
|
|
}
|
|
|
|
#
|
|
# Now the disk image
|
|
#
|
|
if ( -e $CONFIG{'dir'} . "/domains/" . $hostname . "/disk.img" )
|
|
{
|
|
unlink( $CONFIG{'dir'} . "/domains/" . $hostname . "/disk.img" );
|
|
}
|
|
|
|
|
|
#
|
|
# Now remove the directory.
|
|
#
|
|
if ( -d $CONFIG{'dir'} . "/domains/" . $hostname )
|
|
{
|
|
rmdir ( $CONFIG{'dir'} . "/domains/" . $hostname );
|
|
}
|
|
}
|
|
|