#!/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.
   --verbose  Show diagnostic output.

  General options:
   --dir      Specify the output directory where images were previously saved.
   --lvm      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<--lvm>
Specify the LVM volume group 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 by B<xen-create-image>.

  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 LOOPBACK EXAMPLE

  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

  The Xen configuration files will also be removed.

=cut


=head1 LVM EXAMPLE

  Assuming that you have the volume group 'skx-vol' containing three
 Xen instances 'foo', 'bar', and 'baz' the first two may be deleted via:

    xen-delete-image --lvm=skx-vol foo bar

  This will remove the volumes 'foo-disk', 'foo-swap', 'bar-disk',
 and 'bar-swap'.

  The Xen configuration files will also be removed.

=cut


=head1 AUTHOR

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

 $Id: xen-delete-image,v 1.10 2006-06-23 08:56:32 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 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 = '2.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();


#
#  Check that we got valid arguments.
#
checkArguments();


#
#  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'},
              "lvm=s",      \$CONFIG{'lvm'},
              "test",       \$CONFIG{'test'},
              "verbose",    \$CONFIG{'verbose'},
              "help",       \$HELP,
              "manual",     \$MANUAL,
              "version",    \$VERSION
             );

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


    if ( $VERSION )
    {
       my $REVISION      = '$Revision: 1.10 $';

       if ( $REVISION =~ /1.([0-9.]+) / )
       {
           $REVISION = $1;
       }

       print "xen-delete-image release $RELEASE - CVS: $REVISION\n";
       exit;

    }
}



=head2 checkArguments

  Check that we received the arguments we expected.

=cut

sub checkArguments
{
    #
    #  When testing we only care about loopback images, not disk images.
    #
    if ( $CONFIG{'test'} )
    {
        $CONFIG{'lvm'} = undef;
    }

    #
    #  Make sure we have either a volume, or a root.
    #
    if ( $CONFIG{'lvm'} && $CONFIG{'dir'} )
    {
       print "Please only use a volume group or a directory name - not both\n";
       exit;
    }


    #
    #  Make sure we have at least one of the lvm or root specified.
    #
    if ( (!defined( $CONFIG{'dir'} ) ) && ( !defined( $CONFIG{'lvm'} ) ) )
    {
       print "Please specify either a directory root, or an LVM volume group\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" );
    }


    #
    #  If we're working on disk images remove them.
    #
    if ( defined( $CONFIG{'dir'} ) )
    {
       my $prefix = $CONFIG{'dir'} . "/domains/";

       #
       #  The files
       #
       my $swap = $prefix . $hostname . "/swap.img";
       my $disk = $prefix . $hostname . "/disk.img";
       my $log  = $prefix . $hostname . "/install.log";

       #
       # Swap
       #
       if ( -e $swap )
       {
           $CONFIG{'verbose'} && print "Removing swap: $swap\n";
           unlink( $swap );
       }

       #
       # Disk
       #
       if ( -e $disk )
       {
           $CONFIG{'verbose'} && print "Removing disk: $disk\n";
           unlink( $disk );
       }

       #
       #  Install log
       #
       if ( -e $log )
       {
           $CONFIG{'verbose'} && print "Removing log: $log\n";
           unlink( $log );
       }

       #
       #  Now remove the directory.
       #
       if ( -d $prefix . $hostname )
       {
           $CONFIG{'verbose'} && print "Removing directory: $prefix" . $hostname . "\n";
           rmdir ( $prefix . $hostname );
       }
    }
    elsif ( defined( $CONFIG{'lvm'} ) )
    {
       #
       #  LVM volumes
       #
       #
       #  TODO: Check we're not mounted.
       #
       my $swap = "lvremove /dev/$CONFIG{'lvm'}/$hostname-swap --force";
       my $disk = "lvremove /dev/$CONFIG{'lvm'}/$hostname-disk --force";

       runCommand( $swap );
       runCommand( $disk );
    }
    else
    {
       print "Error - neither --dir nor --lvm.\n";
       print "Can't happen\n";
       print "Hostname : $hostname\n";
       exit;
    }
}



=head2 runCommand

  A utility method to run a system command.  We will capture the return
 value and exit if the command files.

  When running verbosely we will also display any command output.

=cut

sub runCommand
{
    my ( $cmd ) = (@_ );

    #
    #  Header.
    #
    $CONFIG{'verbose'} && print "Executing : $cmd\n";

    #
    #  Hide output unless running with --debug.
    #
    if ( $CONFIG{'verbose'} )
    {
       #
       #  Copy stderr to stdout, so we can see it.
       #
       $cmd .= " 2>&1";
    }
    else
    {
       $cmd .= " >/dev/null 2>/dev/null" ;
    }


    #
    #  Run it.
    #
    my $output = `$cmd`;

    if ( $? != 0 )
    {
       print "Running command '$cmd' failed.\n";
       print "Aborting\n";
       exit;
    }


    #
    # All done.
    #
    $CONFIG{'verbose'} && print "Output\n";
    $CONFIG{'verbose'} && print "======\n";
    $CONFIG{'verbose'} && print $output . "\n";
    $CONFIG{'verbose'} && print "Finished : $cmd\n";

    return( $output );
}