9e5068c8f2
Allow the --arch setting to be propogated to either debootstrap or rpmstrap. See: #383041
611 lines
12 KiB
Perl
Executable File
611 lines
12 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
=head1 NAME
|
|
|
|
xt-install-image - Install a fresh copy of GNU/Linux into a directory
|
|
|
|
=cut
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
xt-install-image [options]
|
|
|
|
Help Options:
|
|
--help Show this scripts help information.
|
|
--manual Read this scripts manual.
|
|
--version Show the version number and exit.
|
|
|
|
Debugging Options:
|
|
--verbose Be verbose in our execution.
|
|
|
|
Mandatory Options:
|
|
--location The location to use for the new installation
|
|
--dist The name of the distribution which has been installed.
|
|
|
|
Misc Options:
|
|
--arch Pass the given arch setting to debootstrap or rpmstrap.
|
|
--mirror The mirror to use when installing with 'debootstrap'.
|
|
|
|
Installation Options:
|
|
--tar Untar the given file.
|
|
--debootstrap Install a new system via the debootstrap tool
|
|
--rpmstrap Install a new system via the rpmstrap.
|
|
--copy Copy the given directory recursively.
|
|
|
|
All other options from xen-create-image will be passed as environmental
|
|
variables.
|
|
|
|
=cut
|
|
|
|
|
|
=head1 NOTES
|
|
|
|
This script is invoked by xen-create-image after to create a new
|
|
distribution of Linux. Once the script has been created the companion
|
|
script xt-customize-image will be invoked to perform the network
|
|
configuration, etc.
|
|
|
|
|
|
=cut
|
|
|
|
=head1 INSTALLATION METHODS
|
|
|
|
There are several available methods of installation, depending upon the
|
|
users choice. Only one option may be chosen at any given time.
|
|
|
|
The methods available are:
|
|
|
|
=over 8
|
|
|
|
=item B<--tar>
|
|
Untar a .tar file into the new installation location. This tarfile is assumed to contain a complete archived system.
|
|
|
|
=item B<--copy>
|
|
Copy the given directory recursively. This local directory is assumed to contain a complete installation.
|
|
|
|
=item B<--rpmstrap>
|
|
Install the distribution specified by B<--dist> using the rpmstrap command.
|
|
|
|
=item B<--debootstrap>
|
|
Install the distribution specified by the B<--dist> argument using the debootstrap. If you use this option you must specify a mirror with B<--mirror>.
|
|
|
|
=back
|
|
|
|
=cut
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
Steve
|
|
--
|
|
http://www.steve.org.uk/
|
|
|
|
$Id: xt-install-image,v 1.22 2006-08-15 21:17:28 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 Env;
|
|
use File::Copy;
|
|
use Getopt::Long;
|
|
use Pod::Usage;
|
|
|
|
|
|
#
|
|
# Configuration values read from the command line.
|
|
#
|
|
my %CONFIG;
|
|
|
|
#
|
|
# Release number.
|
|
#
|
|
my $RELEASE = '2.2';
|
|
|
|
|
|
#
|
|
# Parse the command line arguments.
|
|
#
|
|
parseCommandLineArguments();
|
|
|
|
|
|
#
|
|
# Check our arguments
|
|
#
|
|
checkArguments();
|
|
|
|
|
|
#
|
|
# Install the new system.
|
|
#
|
|
# Simplest cases first.
|
|
#
|
|
if ( $CONFIG{'copy'} )
|
|
{
|
|
#
|
|
# Run a command to copy an installed system into the new root.
|
|
#
|
|
runCommand( "/bin/cp -a $CONFIG{'copy'}/* $CONFIG{'location'}" );
|
|
}
|
|
elsif ( $CONFIG{'tar'} )
|
|
{
|
|
#
|
|
# Run a command to copy an installed system into the new root.
|
|
#
|
|
runCommand( "cd $CONFIG{'location'} && tar -xvf $CONFIG{'tar'}" );
|
|
}
|
|
elsif ( $CONFIG{'debootstrap'} )
|
|
{
|
|
installDebootstrapImage();
|
|
}
|
|
elsif ( $CONFIG{'rpmstrap'} )
|
|
{
|
|
installRPMStrapImage();
|
|
}
|
|
else
|
|
{
|
|
#
|
|
# error
|
|
#
|
|
print "No recognised installation method was discovered.";
|
|
print "Aborting\n";
|
|
exit 1;
|
|
}
|
|
|
|
|
|
#
|
|
# At this point we should have a freshly installed system.
|
|
#
|
|
# However errors have been known to happen ;)
|
|
#
|
|
# Test that we have some standard files.
|
|
#
|
|
foreach my $file ( qw( /bin/ls /bin/cp ) )
|
|
{
|
|
if ( ! -x $CONFIG{'location'} . $file )
|
|
{
|
|
print "The installation of the new system appears to have failed.\n";
|
|
print "\n";
|
|
print "There is no '$file' installed in the new installation directory\n"; exit 1;
|
|
}
|
|
}
|
|
|
|
|
|
#
|
|
# Exit cleanly - any errors which have already occurred will result
|
|
# in "exit 1".
|
|
#
|
|
exit 0;
|
|
|
|
|
|
|
|
=begin doc
|
|
|
|
Parse the command line arguments this script was given.
|
|
|
|
=cut
|
|
|
|
sub parseCommandLineArguments
|
|
{
|
|
my $HELP = 0;
|
|
my $MANUAL = 0;
|
|
my $VERSION = 0;
|
|
|
|
#
|
|
# Parse options.
|
|
#
|
|
GetOptions(
|
|
# Mandatory
|
|
"location=s", \$CONFIG{'location'},
|
|
"dist=s", \$CONFIG{'dist'},
|
|
|
|
# Exclusive.
|
|
"tar=s", \$CONFIG{'tar'},
|
|
"copy=s", \$CONFIG{'copy'},
|
|
"rpmstrap", \$CONFIG{'rpmstrap'},
|
|
"debootstrap", \$CONFIG{'debootstrap'},
|
|
|
|
# Misc
|
|
"arch=s", \$CONFIG{'arch'},
|
|
"cache=s", \$CONFIG{'cache'},
|
|
"mirror=s", \$CONFIG{'mirror'},
|
|
|
|
# Help.
|
|
"verbose", \$CONFIG{'verbose'},
|
|
"help", \$HELP,
|
|
"manual", \$MANUAL,
|
|
"version", \$VERSION
|
|
);
|
|
|
|
pod2usage(1) if $HELP;
|
|
pod2usage(-verbose => 2 ) if $MANUAL;
|
|
|
|
|
|
if ( $VERSION )
|
|
{
|
|
my $REVISION = '$Revision: 1.22 $';
|
|
|
|
if ( $REVISION =~ /1.([0-9.]+) / )
|
|
{
|
|
$REVISION = $1;
|
|
}
|
|
|
|
print "xt-install-image release $RELEASE - CVS: $REVISION\n";
|
|
exit;
|
|
|
|
}
|
|
}
|
|
|
|
|
|
|
|
=begin doc
|
|
|
|
Test that the command line arguments we were given make sense.
|
|
|
|
=cut
|
|
|
|
sub checkArguments
|
|
{
|
|
#
|
|
# We require a location.
|
|
#
|
|
if ( ! defined( $CONFIG{'location'} ) )
|
|
{
|
|
print "The '--location' argument is mandatory\n";
|
|
exit 1;
|
|
}
|
|
|
|
|
|
#
|
|
# Test that the location we've been given exists
|
|
#
|
|
if ( ! -d $CONFIG{'location'} )
|
|
{
|
|
print "The installation directory we've been given doesn't exist\n";
|
|
print "We tried to use : $CONFIG{'location'}\n";
|
|
exit 1;
|
|
}
|
|
|
|
|
|
#
|
|
# We require a distribution name.
|
|
#
|
|
if ( ! defined( $CONFIG{'dist'} ) )
|
|
{
|
|
print "The '--dist' argument is mandatory\n";
|
|
exit 1;
|
|
}
|
|
|
|
|
|
#
|
|
# Test that the distribution name we've been given
|
|
# to configure has a collection of hook scripts.
|
|
#
|
|
# If there are no scripts then we clearly cannot
|
|
# customise it!
|
|
#
|
|
my $dir = "/usr/lib/xen-tools/" . $CONFIG{'dist'} . ".d";
|
|
|
|
if ( ! -d $dir )
|
|
{
|
|
print <<E_OR;
|
|
|
|
We're trying to configure an installation of $CONFIG{'dist'} in
|
|
$CONFIG{'location'} - but there is no hook directory for us to use.
|
|
|
|
This means we won't know how to configure this installation.
|
|
|
|
We'd expect the hook directory to be : $dir
|
|
|
|
Aborting.
|
|
E_OR
|
|
exit 1;
|
|
}
|
|
|
|
|
|
##
|
|
# Now check the mutually distinct arguments
|
|
##
|
|
my $count = 0;
|
|
foreach my $key ( qw(copy debootstrap rpmstrap tar ) )
|
|
{
|
|
if ( defined( $CONFIG{$key} ) )
|
|
{
|
|
$count += 1;
|
|
}
|
|
}
|
|
|
|
#
|
|
# If count == 0 we had no recognised installation method.
|
|
#
|
|
if ( $count == 0 )
|
|
{
|
|
print <<EOF;
|
|
You did not specify an installation method.
|
|
|
|
One of the following must be given. (Run "xt-install-image --manual" for details)
|
|
|
|
--copy
|
|
--debootstrap
|
|
--rpmstrap
|
|
--tar
|
|
|
|
Aborting.
|
|
EOF
|
|
|
|
exit 1;
|
|
}
|
|
elsif ( $count > 1 )
|
|
{
|
|
print <<EOF;
|
|
You specify multiple installation methods.
|
|
|
|
Only one of the following must be given:
|
|
|
|
--copy
|
|
--debootstrap
|
|
--rpmstrap
|
|
--tar
|
|
|
|
Aborting.
|
|
EOF
|
|
exit 1;
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
=begin doc
|
|
|
|
Install a new image of Debian using 'debootstrap'.
|
|
|
|
=cut
|
|
|
|
sub installDebootstrapImage
|
|
{
|
|
#
|
|
# Cache from host -> new installation if we've got caching
|
|
# enabled.
|
|
#
|
|
if ( $CONFIG{'cache'} eq "yes" )
|
|
{
|
|
print "\nCopying files from host to image.\n";
|
|
runCommand( "mkdir -p $CONFIG{'location'}/var/cache/apt/archives" );
|
|
copyDebFiles( "/var/cache/apt/archives", "$CONFIG{'location'}/var/cache/apt/archives" );
|
|
print( "Done\n" );
|
|
}
|
|
|
|
#
|
|
# Propogate --verbose appropriately.
|
|
#
|
|
my $EXTRA = '';
|
|
if ( $CONFIG{'verbose'} )
|
|
{
|
|
$EXTRA = ' --verbose';
|
|
}
|
|
|
|
#
|
|
# Propogate the --arch argument
|
|
#
|
|
if ( $CONFIG{'arch'} )
|
|
{
|
|
$EXTRA .= " --arch $CONFIG{'arch'}"
|
|
}
|
|
|
|
|
|
#
|
|
# This is the command we'll run
|
|
#
|
|
my $command = "/usr/sbin/debootstrap --keep-debootstrap-dir $ARCH $CONFIG{'dist'} $CONFIG{'location'} $CONFIG{'mirror'}";
|
|
|
|
#
|
|
# Run the command.
|
|
#
|
|
# NOTE: runCommand has special logic to display the debootstrap log
|
|
# if the command files it will be displayed.
|
|
#
|
|
runCommand( $command );
|
|
|
|
#
|
|
# Since we used the '--keep-debootstrap-dir' argument we'll have
|
|
# a /debootstrap/ directory maintained on the new guest.
|
|
#
|
|
# If we got this far then the debootstrap command invokation succeeded
|
|
# and we can remove it.
|
|
#
|
|
system( "/bin/rm", "-rf", $CONFIG{'location'} . "/debootstrap" );
|
|
|
|
|
|
#
|
|
# Cache from host -> new installation if we've got caching
|
|
# enabled.
|
|
#
|
|
if ( $CONFIG{'cache'} eq "yes" )
|
|
{
|
|
print "\nCopying files from new installation to host.\n";
|
|
copyDebFiles( "$CONFIG{'location'}/var/cache/apt/archives",
|
|
"/var/cache/apt/archives" );
|
|
print( "Done\n" );
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
|
|
=begin doc
|
|
|
|
Install a new distribution of GNU/Linux using the rpmstrap tool.
|
|
|
|
=cut
|
|
|
|
sub installRPMStrapImage
|
|
{
|
|
|
|
#
|
|
# Make sure we have the rpmstrap binary present.
|
|
#
|
|
if ( ! -x '/usr/bin/rpmstrap' )
|
|
{
|
|
print "You've chosen to use the rpmstrap program, but it isn't installed.\n";
|
|
exit;
|
|
}
|
|
|
|
#
|
|
# Propogate the verbosity setting.
|
|
#
|
|
my $EXTRA='';
|
|
if ( $CONFIG{'verbose'} )
|
|
{
|
|
$EXTRA .= " --verbose";
|
|
}
|
|
|
|
#
|
|
# Propogate any arch setting we might have.
|
|
#
|
|
if ( $CONFIG{'arch'} )
|
|
{
|
|
$EXTRA .= " --arch $CONFIG{'arch'}";
|
|
}
|
|
#
|
|
# The command we're going to run.
|
|
#
|
|
my $command = "rpmstrap $EXTRA $CONFIG{'dist'} $CONFIG{'location'}";
|
|
runCommand( $command );
|
|
}
|
|
|
|
|
|
|
|
=begin doc
|
|
|
|
A utility method to run a system command. We will capture the return
|
|
value and exit if the command fails.
|
|
|
|
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";
|
|
|
|
#
|
|
# Show output from debootstrap
|
|
#
|
|
#
|
|
# If the user installed via debootstrap show the log.
|
|
#
|
|
if ( ( $CONFIG{'debootstrap'} ) &&
|
|
( -e $CONFIG{'location'} . "/debootstrap/debootstrap.log" ) &&
|
|
( $cmd =~ /debootstrap/ ) )
|
|
{
|
|
print "\nDebootstrap Output:\n";
|
|
open( LOG, "<", "$CONFIG{'location'}/debootstrap/debootstrap.log" );
|
|
while( <LOG> )
|
|
{
|
|
print;
|
|
}
|
|
close( LOG );
|
|
print "\n\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 );
|
|
}
|
|
|
|
|
|
|
|
|
|
=begin doc
|
|
|
|
This function will copy all the .deb files from one directory
|
|
to another as a caching operation which will speed up installations via
|
|
debootstrap.
|
|
|
|
=cut
|
|
|
|
sub copyDebFiles
|
|
{
|
|
my ( $source, $dest ) = ( @_ );
|
|
|
|
print "Copying files from $source -> $dest\n";
|
|
|
|
#
|
|
# Loop over only .deb files.
|
|
#
|
|
foreach my $file ( sort ( glob( $source . "/*.deb" ) ) )
|
|
{
|
|
my $name = $file;
|
|
if ( $name =~ /(.*)\/(.*)/ )
|
|
{
|
|
$name = $2;
|
|
}
|
|
|
|
#
|
|
# Only copy if the file doesn't already exist.
|
|
#
|
|
if ( ! ( -e $dest . "/" . $name ) )
|
|
{
|
|
File::Copy::cp( $file, $dest );
|
|
}
|
|
}
|
|
|
|
print "Done\n";
|
|
}
|