From a9eef11119023191e2a50b03802d4186d5622044 Mon Sep 17 00:00:00 2001
From: steve <none@none>
Date: Sun, 18 Dec 2005 21:28:50 +0000
Subject: [PATCH] 2005-12-18 21:28:50 by steve   Added to repository.

---
 xen-delete-image | 265 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 265 insertions(+)
 create mode 100755 xen-delete-image

diff --git a/xen-delete-image b/xen-delete-image
new file mode 100755
index 0000000..fe77435
--- /dev/null
+++ b/xen-delete-image
@@ -0,0 +1,265 @@
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+  xen-delete-image - Delete a previously created Xen instance.
+
+=head1 SYNOPSIS
+
+  xen-delete-image [options]
+
+   --dir       Specify where the output image was saved.
+   --hostname  Set the images hostname.
+
+=cut
+
+
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<--dir>
+Specify the output directory image was saved.
+
+=item B<--help>
+Show the script help
+
+=item B<--hostname>
+Specify the name of the image to remove.
+
+=item B<--manual>
+Read the manual
+
+
+
+=back
+
+=cut
+
+
+=head1 DESCRIPTION
+
+
+  xen-delete-image is a simple script which allows you to delete
+ a Xen instances of Debian Sarge which has been created with
+ xen-create-image.
+
+
+=cut
+
+
+=head1 AUTHOR
+
+
+ Steve
+ --
+ http://www.steve.org.uk/
+
+ $Id: xen-delete-image,v 1.1 2005-12-18 21:28:50 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 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;
+
+
+
+
+#
+#  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();
+
+
+
+#
+#  Delete the configuration file.
+#
+if ( -e "/etc/xen/" . $CONFIG{'hostname'} . ".cfg" )
+{
+    unlink( "/etc/xen/" . $CONFIG{'hostname'} . ".cfg" );
+}
+else
+{
+    print "Xen configuration file not found ";
+    print "/etc/xen/" . $CONFIG{'hostname'} . ".cfg" . "\n";
+}
+
+
+#
+#  Now the swap
+#
+if ( -e $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} . "/swap.img" )
+{ 
+    unlink( $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} . "/swap.img" );
+}
+else
+{
+    print "Swap file not found : ";
+    print  $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} . "/swap.img\n";
+
+}
+
+
+
+#
+#  Now the disk image
+#
+if ( -e $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} . "/disk.img" )
+{ 
+    unlink( $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} . "/disk.img" );
+}
+else
+{
+    print "Disk image file not found : ";
+    print  $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} . "/disk.img\n";
+
+}
+
+
+#
+#  Now remove the directory.
+#
+if ( -d $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} )
+{
+    rmdir ( $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} );
+}
+else
+{
+    print "Domain directory not found : ";
+    print $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} . "\n";
+}
+
+
+#
+#  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;
+
+    #  Parse options.
+    #
+    GetOptions(
+	       "hostname=s", \$CONFIG{'hostname'},
+	       "dir=s",      \$CONFIG{'dir'},
+	       "help",       \$HELP,
+	       "manual",     \$MANUAL
+	      );
+    
+    pod2usage(1) if $HELP;
+    pod2usage(-verbose => 2 ) if $MANUAL;
+}
+
+