Update of /cvsroot/leaf/src/bering-uclibc4/buildtool
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv11477
Added Files:
buildimage.pl
Log Message:
Initial commit of buildimage.pl
--- NEW FILE: buildimage.pl ---
#!/usr/bin/perl
#
# Script to create a Bering-uClibc disk image from existing packages
#
# Copyright (C) 2010 David M Brooke, [email protected]
# Based on buildpacket.pl by Martin Hejl
#
# This software is distributed under the GNU General Public Licence,
# please see the file COPYING
#
# $Header: /cvsroot/leaf/src/bering-uclibc4/buildtool/buildimage.pl,v 1.1
2010/09/25 19:52:54 davidmbrooke Exp $
#
use strict;
use warnings;
use Config::General;
use Getopt::Long;
use Date::Format;
use File::Spec;
use File::Temp;
use File::Copy;
use Carp;
my %configHash = ( );
my $label;
my $image;
my $verbose;
my $debug;
my $Usage =
qq{Usage: $0 --image=ImgDir --relver=VersionLabel [--verbose]
image Parent directory for buildimage.cfg, under buildtool/image
e.g. Bering-uClibc-isolinux-std
relver String to append to image name to show release version
e.g. 4.0beta1
verbose [Optional] Report progress during execution
};
sub createTempDir( );
sub cleanTempDir( );
sub system_exec( $;$$ );
sub createDirUnlessItExists( $ );
sub copyFilesToTempDir( $$ );
sub copyFilesWithSearchAndReplace( $$@ );
# Process command line arguments
GetOptions( "verbose!" => \$verbose,
"image=s" => \$image,
"relver=s" => \$label,
"debug!" => \$debug ) or die $Usage;
die $Usage unless defined( $image );
die $Usage unless defined( $label );
$configHash{ '{VERSION}' } = $label;
my $baseDir = File::Spec->rel2abs( File::Basename::dirname( $0 ) );
# Fetch the buildtool config
my $btConfig = new Config::General(
"-ConfigFile" => File::Spec->catfile(
$baseDir,
'conf',
'buildtool.conf' ),
"-LowerCaseNames" => 1,
"-ExtendedAccess" => 1 );
# Fetch the global config (e.g. conf/sources.cfg)
my $glConfig = new Config::General(
"-ConfigFile" => File::Spec->catfile(
$baseDir,
$btConfig->value( 'globalconffile' ) ),
"-LowerCaseNames" => 1,
"-ExtendedAccess" => 1 );
# Fetch the image specific config
my $imConfig = new Config::General(
"-ConfigFile" => File::Spec->catfile(
$baseDir,
$btConfig->value( 'image_dir' ),
$image,
$btConfig->value( 'buildimage_config' ) ),
"-LowerCaseNames" => 1,
"-ExtendedAccess" => 1 );
my $sourceDir = File::Spec->canonpath(
File::Spec->catdir(
$baseDir,
$btConfig->value('source_dir') ) );
my $stagingDir = File::Spec->canonpath(
File::Spec->catdir(
$baseDir,
$btConfig->value('staging_dir') ) );
# Generate date label
$configHash{ '{DATE}' } = time2str( "%Y-%m-%d", time );
print "Build Date is:\t\t$configHash{ '{DATE}' }\n" if $verbose;
# Extract kernel version from source tree
my $kver;
open( FH, "<".$sourceDir."/linux/linux/.config" );
while ( <FH> )
{ if ( /version: (.*)/ ) { $kver = $1; last; } }
close( FH );
print "Kernel Version is:\t$kver\n" if $verbose;
# Create directory to hold image contents
my $tmpDir = createTempDir( );
# Always create full modules.tgz
print "Creating modules.tgz...\n" if $verbose;
system_exec( "cd $stagingDir/lib/modules/$kver ; tar -czf $tmpDir/modules.tgz *
--exclude=build --exclude=source", "Error building modules.tgz" );
## Extract name of image to build from config file
#my @names = keys( %{ $imConfig->value( 'image' ) } );
#if ( scalar @names < 1 || scalar @names > 1 )
#{
#die "Exactly one Image name required in config file";
#}
#my $imgName = $names[0];
# Extract name and type of image to build from config file
my $imageStruc = $imConfig->value( 'image' );
my $imgName = $imageStruc->{ 'imagename' };
die "ImageName is not specified in config file" unless defined $imgName;
print "Image name:\t\t$imgName\n" if $verbose;
my $imgType = $imageStruc->{ 'imagetype' };
die "ImageType is not specified in config file" unless defined $imgType;
print "Image type:\t\t$imgType\n" if $verbose;
# Extract configuration variables from config file
# Populate global configHash with Search-And-Replace Key:Value
while ( my ( $key, $value ) = each( %{ $imageStruc->{ 'config' } } ) )
{
my $ucKey = $key;
$ucKey =~ tr/[a-z]/[A-Z]/;
$configHash{ $ucKey } = $value;
}
# Process <Contents> block from config file
my $imageContents = $imageStruc->{ 'contents' };
# Should be exactly one <Kernel> block
my $imageKernel = $imageContents->{ 'kernel' };
die "<Kernel> entry not present in config file" unless defined $imageKernel;
copyFilesToTempDir(
$imageKernel->{ 'source' },
$imageKernel->{ 'filename' } );
# Capture path to kernel to use in sys/isolinux.cfg
$configHash{ '{KERNEL}' } = "/".$imageKernel->{ 'filename' } ;
# Should be multiple <File> blocks
# Don't even bother coping with the case of a single <File> block
foreach my $fileStruc ( @{ $imageContents->{ 'file' } } )
{
print "DEBUG - Processing block for <File> ",$fileStruc->{ 'filename'
},"\n" if $debug;
# Do we need to Search-And-Replace strings in this file?
if ( defined( $fileStruc->{ 'searchandreplace' } ) )
{
# Yes; need to Search-And-Replace for this file entry
# We have an ARRAY if there is >1 SearchAndReplace entry for this file
if ( ref( $fileStruc->{ 'searchandreplace' } ) eq 'ARRAY' )
{
print "DEBUG - Processing multiple S&R strings\n" if $debug;
my @sAndR = @{ $fileStruc->{ 'searchandreplace' } };
copyFilesWithSearchAndReplace(
$fileStruc->{ 'source' },
$fileStruc->{ 'filename' },
@sAndR );
}
# We have a SCALAR if there is 1 SearchAndReplace entry for this file
else
{
print "DEBUG - Processing single S&R strings\n" if $debug;
my @sAndR = ( $fileStruc->{ 'searchandreplace' } );
copyFilesWithSearchAndReplace(
$fileStruc->{ 'source' },
$fileStruc->{ 'filename' },
@sAndR );
}
}
else
{
# No; no need to Search-And-Replace for this entry - just copy file
copyFilesToTempDir(
$fileStruc->{ 'source' },
$fileStruc->{ 'filename' } );
}
}
# Complete the processing depending on the image type specified
if ( $imgType eq "syslinux" )
{
print "Performing SYSLINUX processing...\n" if $verbose;
my $fileName = File::Spec->catfile(
$baseDir,
$btConfig->value( 'image_dir' ),
$image,
$imgName."_".$label.".tar.gz" );
system_exec( "cd $tmpDir ; tar -czf $fileName .", "Error creating image
tarfile: $!" );
}
elsif ( $imgType eq "isolinux" )
{
print "Performing ISOLINUX processing...\n" if $verbose;
my $fileName = File::Spec->catfile(
$baseDir,
$btConfig->value( 'image_dir' ),
$image,
$imgName."_".$label.".iso" );
# Summary of mkisofs arguments:
# -o Name of generated image file
# -v Verbose messages
# -b El Torito boot image filename
# -no-emul-boot CD-ROM is not a disk image; do not emulate a disk
# -c Name of boot catalog file to be generated by mkisofs
# -boot-load-size Number of 512-byte sectors to load in no-emul mode
# -boot-info-table Include a table of the image file layout
# -l Allow long (31-character) filenames
# -R Use Rock Ridge extensions
# -r Use standard values for file ownership and permissions
# . Create image of current directory
system_exec( "cd $tmpDir ; mkisofs -o $fileName -v -b isolinux/isolinux.bin
-c isolinux/boot.cat -no-emul-boot -boot-load-size 4 -boot-info-table -l -R -r
.", "Error running mkisofs: $!" );
}
else
{
die "Unsupported image type $imgType\n";
}
# Tidyup
cleanTempDir( );
# End of main
sub createTempDir( )
{
my $tempDIR;
eval
{
$tempDIR = File::Temp::tempdir(
'BUILDIMAGE_STAGING_XXXX',
'TMPDIR' => 1 );
};
if ( $@ ne '' )
{
confess( "Unable to create temporary directory. $@" );
}
print "Temporary directory:\t$tempDIR\n" if $verbose;
return( $tempDIR );
}
sub cleanTempDir( )
{
print "Cleaning up dir $tmpDir\n" if $verbose;
confess( "Temp dir undefined" ) unless defined( $tmpDir );
confess( "Will not delete root dir" ) if File::Spec->canonpath( $tmpDir )
eq File::Spec->rootdir( );
system( "rm -rf $tmpDir" );
rmdir( $tmpDir );
}
sub system_exec( $;$$ )
{
my ( $command, $error_message, $no_cleanup ) = @_;
$no_cleanup = 0 unless defined( $no_cleanup );
$error_message = "$command failed " unless defined( $error_message );
print "Executing $command\n" if $verbose;
my $retVal = system( $command );
if ( $retVal>>8 != 0 )
{
cleanTempDir( ) unless $no_cleanup;
confess( "$error_message $!" );
}
}
sub createDirUnlessItExists( $ )
{
my ( $path ) = @_;
while ( ! ( -e $path ) )
{
my @dirs = File::Spec->splitdir( $path );
my $dirToCreate = "";
foreach my $dir ( @dirs )
{
$dirToCreate = File::Spec->catdir( $dirToCreate, $dir );
if ( ! ( -e $dirToCreate ) )
{
print "Creating directory $dirToCreate\n" if $verbose;
mkdir( $dirToCreate ) or confess( "creating dir " . $path . "
failed. $!" );
}
}
}
}
sub copyFilesToTempDir( $$ )
{
my ( $source, $target ) = @_;
my $absSource = File::Spec->catdir( $baseDir, $source );
my $absTarget = File::Spec->catdir( $tmpDir, $target );
# Check for '*' in Source
if ( $absSource =~ /\*/ )
{
# Source contains '*' so Target _must_ be a directory
createDirUnlessItExists( $absTarget );
system_exec( "cp -r $absSource $absTarget", "Failed to copy files: $!"
);
}
else
{
# Source does not contain '*' so Target is a file
# Might still need to create the directory for that file
my $destDir = File::Basename::dirname( $absTarget );
createDirUnlessItExists( $destDir );
system_exec( "cp -r $absSource $absTarget", "Failed to copy files: $!"
);
}
}
sub copyFilesWithSearchAndReplace( $$@ )
{
my ( $source, $target, @sAndR ) = @_;
my $absSource = File::Spec->catdir( $baseDir, $source );
my $absTarget = File::Spec->catdir( $tmpDir, $target );
# Check for '*' in Source
if ( $absSource =~ /\*/ )
{
# Source contains '*' so Target _must_ be a directory
createDirUnlessItExists( $absTarget );
die "Copying multiple files with SearchAndReplace is not currently
supported. Sorry.";
}
else
{
# Source does not contain '*' so Target is a file
# Might still need to create the directory for that file
my $destDir = File::Basename::dirname( $absTarget );
createDirUnlessItExists( $destDir );
open( IFH, "<".$absSource ) or confess( "Error: $!" );
open( OFH, ">".$absTarget ) or confess( "Error: $!" );
while ( <IFH> )
{
foreach my $string ( @sAndR )
{
s/$string/$configHash{ $string }/;
}
print OFH;
}
close( OFH );
close( IFH );
}
}
exit;
__END__
=pod
=head1 NAME
buildimage.pl - create a Bering-uClibc disk image
=head1 SYNOPSIS
B<buildimage.pl> --image=ImgDir --relver=VersionLabel [--verbose]
image Parent directory for buildimage.cfg, under buildtool/image
e.g. Bering-uClibc-isolinux-std
relver String to append to image name to show release version
e.g. 4.0beta1
verbose [Optional] Report progress during execution
=head1 DESCRIPTION
B<buildimage.pl> creates a Bering-uClibc disk image based on parameter
settings defined in a configuration file (buildimage.cfg) located within a
sub-directory of buildtool/image. The name of this sub-directory is specified
with the "--image" command-line argument.
The disk image can be for SYSLINUX (suitable for writing to a flash drive)
or can use ISOLINUX. The choice between these is specified in buildimage.cfg.
For SYSLINUX, the "image" is a .tar.gz file which needs to be extracted
onto suitably prepared media.
For ISOLINUX the "image" is a .iso file which can be burned to a CD-R.
Note that the name of the image file is based on the ImageName field in the
configuration file which may be different from the --image argument.
=head1 SEE ALSO
http://sourceforge.net/apps/mediawiki/leaf/index.php?title=Bering-uClibc_4.x_-_Developer_Guide_-_Building_an_Image
=cut
# vi: set ai sw=4 wm=5 fo=cql:
------------------------------------------------------------------------------
Start uncovering the many advantages of virtual appliances
and start using them to simplify application deployment and
accelerate your shift to cloud computing.
http://p.sf.net/sfu/novell-sfdev2dev
_______________________________________________
leaf-cvs-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/leaf-cvs-commits
