[leaf-commits] src/bering-uclibc4/buildtool buildimage.pl, NONE, 1.1

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