github.com/xen-tools.xen-tools
1
0
Fork 0
mirror of synced 2026-02-14 11:24:10 +00:00
Code Releases Activity
Files
42cd1dadc3513f9f004a85579ea5ef33b466fc02
xen-tools.xen-tools/xen-create-image
steve 42cd1dadc3 2005-12-21 02:47:41 by steve 
Avoid extra newline when caching files from debootstrap to host,
 and ensure the filenames are displayed in the copying loop.
2005-12-21 02:47:41 +00:00

1225 lines
24 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/perl -w
=head1 NAME
xen-create-image - Create a new Xen instance of Debian Sarge.
=head1 SYNOPSIS
xen-create-image [options]
Help Options:
--debug Show the commandss, and ouptut, which the script creates.
--help Show this scripts help information.
--manual Read this scripts manual.
Size / General options:
--dist Specify the distribution you wish to install: Sarge, Etch, Sid.
--boot Boot the new instance after creating it.
--dir Specify where the output images should go.
--fs Specify the filesystem type to use.
--memory Setup the amount of memory allocated to the instance.
--size Set the size of the primary disk image.
--swap Set the size of the swap partition.
Networking options:
--dhcp Setup the image to get an IP address via DHCP
--network Setup the network the host is upon.
--gateway Setup the iamge's network gateway.
--broadcast Setup the image's network broadcast address.
--mirror Setup the mirror to use when installing Sarge.
Mandatory options:
--hostname Set the images hostname.
=cut
=head1 OPTIONS
=over 8
=item B<--boot>
Start the new virtual instance as soon as the installation has finished.
=item B<--broadcast>
Specify the broadcast address for the virtual image, only useful if DHCP is not used.
=item B<--debug>
Show the commands this script executes as an aid to debugging.
=item B<--dhcp>
Specify that the virtual image should use DHCP to obtain its networking information.
=item B<--dir>
Specify the root directory beneath which the image should be saved. Subdirectories will be created for each virtual image.
=item B<--dist>
Specify the distribution to install, defaults to 'sarge'.
=item B<--fs>
Specify the filesystem the image should be given. Valid options are 'ext3',
'xfs', or 'reiserfs'.
=item B<--gateway>
Specify the gateway address for the virtual image, only useful if DHCP is not used.
=item B<--help>
Show the brief help information.
=item B<--hostname>
Set the hostname of the new instance.
=item B<--manual>
Read the manual, with examples.
=item B<--memory>
Specify the amount of memory the virtual image should be allocated. Defaults
to 96Mb.
=item B<--mirror>
Specify the mirror to use to the installation of Sarge, defaults to http://ftp.us.debian.org/debian
=item B<--netmask>
Set the netmask the virtual image should use.
=item B<--network>
Specify the network the virtual image is living upon. Only useful if DHCP is not used.
=item B<--size>
Specify the size of the virtual images primary drive. The size may be
suffixed with either Mb, or Gb.
=item B<--swap>
Specify the size of the virtual images swap partition. The size may be
suffixed with either Mb, or Gb.
=back
=cut
=head1 EXAMPLES
The following will create a 2Gb disk image, along with a 128Mb
swap file with Debian Sarge setup and running via DHCP.
xen-create-image --size=2Gb --swap=128Mb --dhcp \
--dir=/home/xen --hostname=vm01.my.flat
This next example sets up a host which has the name 'vm02' and
IP address 192.168.1.200, with the gateway address of 192.168.1.1
xen-create-image --size=2Gb --swap=128Mb \
--ip=192.168.1.200 --netmask=255.255.255.0 --network=192.168.1.0 \
--gateway=192.168.1.1 \
--dir=/home/xen --hostname=vm02
To save time these command line options may be specified in the
configuration file discussed later.
The directory specified for the output will be used to store the files
which are produced. To avoid clutter each host will have its images
stored beneath the specified directory, named after the hostname.
For example the images created above will be stored as:
$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
The '/domains/' subdirectory will be created if necessary.
=cut
=head1 DESCRIPTION
xen-create-image is a simple script which allows you to create new
Xen instances of Debian Sarge. The new image will be comprised of
two seperate files:
1. One disk image which will be treated as the primary disk drive.
2. One swap image.
The image will have OpenSSH installed upon it, and an appropriate
/etc/inittab file created, along with copies of the hosts password
and shadow files.
=head1 CONFIGURATION
To reduce the length of the command line each of the options may
be specified inside a configuration file.
The script will check two files for options:
1. /etc/xen-tools/xen-tools.conf
2. ~/.xen-tools.conf
The files may contain comments, which begin with the hash '#' character
and are otherwise of the format 'key = value.
A sample configuration file would look like this:
=for example begin
#
# General options.
#
dir = /home/xen # Ouptut directory
memory = 128Mb # 128Mb for each new image.
#
# Images
#
fs = ext3 # We like EXT3
swap = 128mb # 128Mb of swap.
size = 2Gb # 2Gb images.
#
# Networking options.
#
network = 192.168.1.0
gateway = 192.168.1.1
broadcast = 255.255.255.0
=for example end
This allows a new image to be created with only two command line flags:
xen-create-image --hostname='vm03.my.flat' --ip=192.168.1.201
=head1 AUTHOR
Steve
--
http://www.steve.org.uk/
$Id: xen-create-image,v 1.44 2005-12-21 02:47:41 steve Exp $
=cut
=head1 CONTRIBUTORS
Radu Spineanu
=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 File::Copy;
use File::Temp qw/ tempdir /;
use Getopt::Long;
use IPC::Open3;
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;
#
# The width of the current terminal, used for line-wrapping.
#
my $TERMINAL_WIDTH = getTerminalWidth();
#
# Constants for filesystem usage.
#
my %FILESYSTEM_BINARY;
my %FILESYSTEM_CREATE;
my %FILESYSTEM_MOUNT;
$FILESYSTEM_BINARY{'ext3'} = '/sbin/mkfs.ext3';
$FILESYSTEM_BINARY{'xfs'} = '/sbin/mkfs.xfs';
$FILESYSTEM_BINARY{'reiserfs'} = '/sbin/mkfs.reiserfs';
$FILESYSTEM_CREATE{'ext3'} = $FILESYSTEM_BINARY{'ext3'}. ' -F ';
$FILESYSTEM_CREATE{'xfs'} = $FILESYSTEM_BINARY{'xfs'}. ' -d name=';
$FILESYSTEM_CREATE{'reiserfs'} = $FILESYSTEM_BINARY{'reiserfs'}. ' -f -q ';
$FILESYSTEM_MOUNT{'ext3'} = '-t ext3';
$FILESYSTEM_MOUNT{'xfs'} = '-t xfs';
$FILESYSTEM_MOUNT{'reiserfs'} = '-t reiserfs';
#
# Setup defaults:
#
# Memory = 96M, Image = 2000Mb, Swap = 128Mb, and filesystem is ext3.
#
# These may be overriden by one of the configuration files, or by the
# command line arguments.
#
$CONFIG{'memory'} = '96Mb';
$CONFIG{'size'} = '2000Mb';
$CONFIG{'swap'} = '128M';
$CONFIG{'fs'} = 'ext3';
$CONFIG{'mirror'} = 'http://ftp.us.debian.org/debian';
$CONFIG{'dist'} = 'sarge';
$CONFIG{'xm'} = '/usr/sbin/xm';
#
# Read configuration file(s) if they exist.
#
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();
#
# Check that the arguments the user has supplied are both
# valid, and complete.
#
checkArguments();
if ( $EFFECTIVE_USER_ID != 0 )
{
print <<E_O_ROOT;
In order to use this script you must be running with root privileges.
(This is necessary to mount the disk images.)
E_O_ROOT
exit;
}
print "\n";
print "Hostname : $CONFIG{'hostname'}\n";
print "Distribution : $CONFIG{'dist'}\n";
print "Image size : $CONFIG{'size'}\n";
print "Swap size : $CONFIG{'swap'}\n";
print "Memory size : $CONFIG{'memory'}\n";
print "Fileystem Type : $CONFIG{'fs'}\n";
if ( $CONFIG{'dhcp'} )
{
print "---\n";
print "DHCP\n";
}
else
{
print "---\n";
$CONFIG{'ip'} && print "IP : $CONFIG{'ip'}\n";
$CONFIG{'network'} && print "Network : $CONFIG{'network'}\n";
$CONFIG{'netmask'} && print "Netmask : $CONFIG{'netmask'}\n";
$CONFIG{'broadcast'} && print "Broadcast: $CONFIG{'broadcast'}\n";
$CONFIG{'gateway'} && print "Gateway : $CONFIG{'gateway'}\n";
}
print "---\n";
#
# If the output directories don't exist then create them.
#
if ( ! -d $CONFIG{'dir'} . "/domains/" )
{
mkdir $CONFIG{'dir'} . '/domains', 0777
|| die "Cannot create $CONFIG{'dir'}/domains - $!";
}
if ( ! -d $CONFIG{'dir'} . "/domains/" . $CONFIG{'hostname'} )
{
mkdir $CONFIG{'dir'}. '/domains/' . $CONFIG{'hostname'}, 0777
|| die "Cannot create $CONFIG{'dir'}/domains/$CONFIG{'hostname'} - $!" ;
}
#
# The two images we'll use, one for the disk image, one for swap.
#
my $image = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/disk.img" ;
my $swap = $CONFIG{'dir'} . '/domains/' . $CONFIG{'hostname'} . "/swap.img" ;
#
# Create swapfile and initialise it.
#
print "\n\nCreating swapfile : $swap\n";
#
# Remove any trailing Mb.
#
$CONFIG{'swap'} =~ s/Mb*$//i;
#
# Build up the command, and execute it.
#
my $swap_cmd = "/bin/dd if=/dev/zero of=$swap bs=1024k count=$CONFIG{'swap'}";
runCommand( $swap_cmd );
runCommand( "/sbin/mkswap $swap" );
print "Done\n";
#
# Create disk file and initialise it.
#
print "\nCreating disk image: $image\n";
$CONFIG{'size'} =~ s/Mb*$/k/i;
my $image_cmd = "/bin/dd if=/dev/zero of=$image bs=$CONFIG{'size'} count=1 seek=1024";
runCommand( $image_cmd );
print "Done\n";
print "\nCreating $CONFIG{'fs'} filesystem\n";
my $create = $FILESYSTEM_CREATE{lc( $CONFIG{'fs'} ) } . $image ;
runCommand( $create );
print "Done\n";
#
# Now mount the image, in a secure temporary location.
#
my $dir = tempdir( CLEANUP => 1 );
my $mount_cmd = "mount " . $FILESYSTEM_MOUNT{lc($CONFIG{'fs'})} . " -o loop $image $dir";
runCommand( $mount_cmd );
# Test that the mount worked
my $mount = runCommand( "/bin/mount" );
if ( ! $mount =~ /$image/)
{
print "Something went wrong trying to mount the new filesystem\n";
exit;
}
#
# Copy any local .deb files into the debootstrap archive as a potential
# speedup.
#
print "\nCopying files from host to image.\n";
runCommand( "mkdir -p $dir/var/cache/apt/archives" );
my @files = glob( "/var/cache/apt/archives/*.deb" );
my $count = 1;
my $total = $#files+1;
foreach my $file ( @files )
{
my $t = "\r[$count/$total] : ";
if ( $file =~ /(.*)\/(.*)/ )
{
$t .= $2;
}
#
# Print the status message and do the copy.
#
printWideMessage( $t );
File::Copy::cp( $file, "$dir/var/cache/apt/archives" );
$count += 1;
}
printWideMessage( "\rDone" );
#
# Install the base system - with a simple sense of progress.
#
print "\n\nRunning debootstrap to install the system. This will take a while!\n";
my $debootstrap = "debootstrap $CONFIG{'dist'} $dir $CONFIG{'mirror'}";
runCommandWithProgress( $debootstrap );
#
# Copy these files as a speed boost for the next run.
#
print "\n\nCaching debootstrap files to the host system\n";
@files = glob( "$dir/var/cache/apt/archives/*.deb" );
$count = 1;
$total = $#files + 1;
foreach my $file ( @files )
{
my $t = "\r[$count/$total] : ";
if ( $file =~ /(.*)\/(.*)/ )
{
$t .= $2;
}
#
# Print the status message and do the copy
#
printWideMessage( $t );
File::Copy::cp( $file, "/var/cache/apt/archives" );
$count += 1;
}
printWideMessage( "\rDone" );
#
# If the debootstrap failed then we'll setup the output directories
# for the configuration files here.
#
runCommand( "mkdir -p $dir/etc/apt" );
runCommand( "mkdir -p $dir/etc/network" );
#
# OK now we can do the basic setup.
#
print "\n\nSetting up APT sources\n";
open( APT, ">", $dir . "/etc/apt/sources.list" );
print APT<<E_O_APT;
#
# /etc/apt/sources.list
#
#
# $CONFIG{'dist'}
#
deb $CONFIG{'mirror'} $CONFIG{'dist'} main contrib non-free
deb-src $CONFIG{'mirror'} $CONFIG{'dist'} main contrib non-free
#
# Security updates
#
deb http://security.debian.org/ stable/updates main contrib non-free
deb-src http://security.debian.org/ stable/updates main contrib non-free
E_O_APT
close( APT );
print "Done\n";
#
# Copy some files from the host system, after setting up the hostname.
#
#
my @hostFiles = ( "/etc/resolv.conf",
"/etc/hosts",
"/etc/passwd",
"/etc/group",
"/etc/shadow",
"/etc/gshadow" );
print "\n\nCopying essential files from the host to the guest\n";
foreach my $file ( @hostFiles )
{
printWideMessage( "\r" . $file );
File::Copy::cp( $file, $dir . "/etc" );
}
printWideMessage( "\rDone" );
#
# Disable TLS
#
if ( -d $dir . "/lib/tls" )
{
runCommand( "mv $dir/lib/tls $dir/lib/tls.disabled" );
}
#
# Now setup the fstab
#
print "\n\nSetting up /etc/fstab\n";
open( TAB, ">", $dir . "/etc/fstab" );
print TAB<<E_O_TAB;
/dev/sda1 / $CONFIG{'fs'} errors=remount-ro 0 1
/dev/sda2 none swap sw 0 0
proc /proc proc defaults 0 0
E_O_TAB
close( TAB );
print "Done\n";
#
# Setup the /etc/network/interfaces file upon the guest image
#
print "\n\nSetting up networking\n";
setupNetworking( $dir );
print "Done\n";
#
# Install OpenSSH
#
installOpenSSH( $dir );
#
# Fixup Inittab file
#
print "\n\nSetting up initial console\n";
fixupInittab( $dir );
print "done\n";
#
# Now unmount the image.
#
runCommand( "umount $dir" );
#
# Finally setup Xen to allow us to create the image.
#
print "\n\nCreating Xen configuration file in /etc/xen .. ";
open( XEN, ">", "/etc/xen/$CONFIG{'hostname'}.cfg" );
print XEN<<E_O_XEN;
kernel = "/boot/vmlinuz-2.6.12-xenU"
memory = $CONFIG{'memory'}
name = "$CONFIG{'hostname'}"
disk = [ 'file:$image,sda1,w','file:$swap,sda2,w' ]
root = "/dev/sda1 ro"
E_O_XEN
if ( $CONFIG{'dhcp'} )
{
print XEN "dhcp=\"dhcp\"\n";
}
else
{
print XEN "#dhcp=\"dhcp\"\n";
}
close( XEN );
print "Done\n";
#
# Give status message
#
print <<EOEND;
To make any manual tweaks to the setup of $CONFIG{'hostname'} please run:
mkdir /mnt/tmp
mount -t $CONFIG{'fs'} -o loop $image /mnt/tmp
chroot /mnt/tmp /bin/bash
exit
umount /mnt/tmp
Once completed you may start your new instance of Xen with:
xm create $CONFIG{'hostname'}.cfg -c
EOEND
#
# Should we immediately start the new instance?
# If so fork() and do it so that we can return to the user, they can
# attach to the console via the command : 'xm console $name'.
#
#
if ( $CONFIG{'boot'} )
{
print "\n\nBooting new virtual image: $CONFIG{'hostname'}\n";
print "\n\n";
my $pid = fork();
if ( $pid )
{
exit;
}
else
{
system( "$CONFIG{'xm'} create $CONFIG{'hostname'}.cfg" );
}
}
#
# End of script.
#
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'},
"ip=s", \$CONFIG{'ip'},
"gateway=s", \$CONFIG{'gateway'},
"netmask=s", \$CONFIG{'netmask'},
"broadcast=s",\$CONFIG{'broadcast'},
"network=s", \$CONFIG{'network'},
"dir=s", \$CONFIG{'dir'},
"dhcp", \$CONFIG{'dhcp'},
"mirror=s", \$CONFIG{'mirror'},
"size=s", \$CONFIG{'size'},
"swap=s", \$CONFIG{'swap'},
"memory=s", \$CONFIG{'memory'},
"fs=s", \$CONFIG{'fs'},
"boot", \$CONFIG{'boot'},
"dist=s", \$CONFIG{'dist'},
"debug" , \$CONFIG{'debug'},
"help", \$HELP,
"manual", \$MANUAL
);
pod2usage(1) if $HELP;
pod2usage(-verbose => 2 ) if $MANUAL;
}
=head2 checkArguments
Check that the arguments the user has specified are complete and
make sense.
=cut
sub checkArguments
{
if (!defined( $CONFIG{'hostname'} ) )
{
print<<EOF
You should set a hostname with '--hostname=foo'.
This option is required.
EOF
;
exit;
}
if (!defined( $CONFIG{'dir'} ) )
{
print<<EOF
You should set an output directory with '--dir=/my/path'.
This option is required. Subdirectories will be created
beneath the directory you name.
EOF
;
exit;
}
#
# Make sure the directory exists.
#
if ( ! -d $CONFIG{'dir'} )
{
print "Output directory '$CONFIG{'dir'}' doesn't exist\n";
exit;
}
if ( ! -w $CONFIG{'dir'} )
{
print "Output directory '$CONFIG{'dir'}' isn't writable.\n";
exit;
}
#
# Make sure we have every binary we need
#
if ( ! -x $CONFIG{'xm'} )
{
print "Could not find " .$CONFIG{'xm'}. ".\n";
exit;
}
my $binpath = $FILESYSTEM_BINARY{lc( $CONFIG{'fs'} ) };
if ( ! -x $binpath ) {
print "Unable to find required executable ". $binpath. ".\n";
exit;
}
#
# Make sure we have a valid size
#
if ( !(($CONFIG{'size'} =~ /^\d+[GM]b*$/i) && ($CONFIG{'swap'} =~ /^\d+[GM]b*$/i)) )
{
print "Invalid size formats. Please use something like:\n";
print " --size=128Mb\n";
print " --size=2Gb\n";
exit;
}
# Convert Gb -> Mb
if ( $CONFIG{'size'} =~ /^(\d+)Gb*$/i )
{
$CONFIG{'size'} = $1 * 1024 . "M";
}
if ( $CONFIG{'swap'} =~ /^(\d+)Gb*$/i )
{
$CONFIG{'swap'} = $1 * 1024 . "M";
}
# Strip trailing Mb from the memory size.
if ( $CONFIG{'memory'} =~ /^(\d+)Mb*$/i )
{
$CONFIG{'memory'} = $1;
}
#
# Check mirror format
#
if (!($CONFIG{'mirror'} =~ /^http/i))
{
print "Please enter a valid mirror.\n";
exit;
}
#
# Only one of DHCP / IP is required.
#
if ( $CONFIG{'ip'} && $CONFIG{'dhcp'})
{
print "You've chosen both DHCP and an IP address.\n";
print "Only one is supported\n";
exit;
}
if ( $CONFIG{'dhcp'} )
{
$CONFIG{'gateway'} = '';
$CONFIG{'netmask'} = '';
$CONFIG{'broadcast'} = '';
$CONFIG{'ip'} = '';
}
#
# Ensure we know how to create *and* mount the given filesystem.
#
if ( !defined( $FILESYSTEM_CREATE{lc( $CONFIG{'fs'} ) } ) ||
!defined( $FILESYSTEM_MOUNT{lc( $CONFIG{'fs'} ) } ) )
{
print "Unknown filesystem. Valid choices are:\n";
foreach my $key (sort keys %FILESYSTEM_MOUNT )
{
print "\t" . $key . "\n";
}
exit;
}
}
=head2 setupNetworking
Setup the /etc/network/interfaces file, and the hostname
upon the virtual instance.
=cut
sub setupNetworking
{
my ( $prefix ) = ( @_ );
runCommand ("/bin/echo '$CONFIG{'hostname'}' > $prefix/etc/hostname" );
open( IP, ">", $prefix . "/etc/network/interfaces" );
if ( $CONFIG{'dhcp'} )
{
print IP<<E_O_DHCP;
# This file describes the network interfaces available on your system
# and how to activate them. For more information, see interfaces(5).
# The loopback network interface
auto lo
iface lo inet loopback
# The primary network interface
auto eth0
iface eth0 inet dhcp
E_O_DHCP
}
else
{
print IP<<E_O_STATIC_IP;
# This file describes the network interfaces available on your system
# and how to activate them. For more information, see interfaces(5).
# The loopback network interface
auto lo
iface lo inet loopback
# The primary network interface
auto eth0
iface eth0 inet static
address $CONFIG{'ip'}
gateway $CONFIG{'gateway'}
netmask $CONFIG{'netmask'}
network $CONFIG{'network'}
broadcast $CONFIG{'broadcast'}
E_O_STATIC_IP
}
close( IP );
}
=head2 installOpenSSH
Install OpenSSH upon the virtual instance via apt-get.
=cut
sub installOpenSSH
{
my ( $prefix ) = ( @_ );
print "\n\nInstalling OpenSSH\n";
runCommand( "chroot $prefix /usr/bin/apt-get update" );
runCommand( "DEBIAN_FRONTEND=noninteractive chroot $prefix /usr/bin/apt-get --yes --force-yes install ssh" );
runCommand( "chroot $prefix /etc/init.d/ssh stop" );
print "Done\n";
}
=head2 fixupInittab
Copy the host systems /etc/inittab to the virtual installation
making a couple of minor changes:
1. Setup the first console to be "Linux".
2. Disable all virtual consoles.
=cut
sub fixupInittab
{
my ( $prefix ) = ( @_ );
my @init;
open( INITTAB, "<", "/etc/inittab" );
foreach my $line ( <INITTAB> )
{
chomp $line;
if ( $line =~ /:respawn:/ )
{
if ( $line =~ /^1/ )
{
#
# Leave line unchanged - but change 'tty1' to 'console'.
#
$line = '1:2345:respawn:/sbin/getty 38400 console';
#
# Reference:
# http://wiki.xensource.com/xenwiki/DebianSarge
#
}
else
{
#
# Otherwise comment out the line, we don't need multiple
# terminals since we can only access one.
#
$line = "#" . $line;
}
}
push @init, $line;
}
close( INITTAB );
open( OUTPUT, ">", "$prefix/etc/inittab" );
foreach my $line ( @init )
{
print OUTPUT $line . "\n";
}
close( OUTPUT )
}
=head2 printWideMessage
Print a message, ensuring the width is as wide as the console.
=cut
sub printWideMessage
{
my ( $msg ) = ( @_ );
while( length( $msg ) < $TERMINAL_WIDTH )
{
$msg .= " ";
}
print $msg;
}
=head2 runCommand
Run a command, and if debugging is turned on then display it
to the user along with output.
Otherwise hide all output.
=cut
sub runCommand
{
my ( $cmd ) = ( @_ );
#
# Header.
#
$CONFIG{'debug'} && print "Executing : $cmd\n";
#
# Hide output unless running with --debug.
#
$cmd .= " >/dev/null 2>/dev/null" unless $CONFIG{'debug'};
#
# Run it.
#
my $output = `$cmd`;
#
# All done.
#
$CONFIG{'debug'} && print "Finished : $cmd\n";
return( $output );
}
=head2 runCommandWithProgress
Run a command whilst immediately writing the output to the console.
This is a cheap hack to give a sense of 'progress'.
=cut
sub runCommandWithProgress
{
my ( $cmd ) = ( @_ );
my $pid = open3(undef, \*READ,0, $cmd );
my $output ='';
while(1)
{
#
# Wait for input.
#
select(undef,undef,undef,.01);
#
# Read output from the command, max 1k.
#
if( sysread \*READ,$output,1024 )
{
#
# Remove newlines to avoid weirdness.
$output =~ s/\n//g;
#
# If there is more output than our terminal width then
# truncate it.
#
if ( length( $output ) > $TERMINAL_WIDTH )
{
$output = substr( $output, 0, ( $TERMINAL_WIDTH - 5 ) );
}
#
# Pad to exactly terminal width.
while( length( $output ) < $TERMINAL_WIDTH )
{
$output .= " " ;
}
#
# Now rewind cursor to start of line and display
# the text.
#
print STDERR "\r";
print STDERR $output;
}
else
{
#
# command finished.
#
my $over = "\rFinished";
while( length( $over ) < $TERMINAL_WIDTH )
{
$over .= " ";
}
print STDERR $over . "\n";
return;
}
}
}
=head2 getTerminalWidth
Find and return the width of the current terminal. This makes
use of the optional Term::Size module. If it isn't installed then
we fall back to using 80.
=cut
sub getTerminalWidth
{
my $testModule = "use Term::Size;";
my $width = 80;
#
# Test loading the Cache module, if it fails then
# the cache isn't enabled regardless of what the
# configuration file says.
#
eval( $testModule );
if ( $@ )
{
$width = 80;
}
else
{
($width, undef ) = Term::Size::chars();
}
return( $width );
}
View Git Blame Copy Permalink