multistrap/em_multistrap

#!/usr/bin/perl

# Copyright (C) 2009  Neil Williams <codehelp@debian.org>
#
# This package is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use IO::File;
use Config::Auto;
use File::Basename;
use Parse::Debian::Packages;
use strict;
use vars qw/ $progname $ourversion %scripts $dstrap $script $extra 
 @archives $deb $cachedir $config_str %packages $retval $str $retries
 $dir $include $arch $foreign $suite $url $unpack $option %options
 @e $sourcesname $libdir $dpkgdir @debootstrap %suites $mirror $etcdir
 $repo @dirs @touch %sources $section %keys $host $key $value $type
 $file $config $tidy /;
$progname = basename($0);
$ourversion = "0.0.4";
$unpack = "true";

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
	&usageversion();
		exit( 0 );
	}
	elsif (/^(-f|--file)$/) {
		$file = shift(@ARGV);
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(-d|--dir)$/) {
		$dir = shift(@ARGV);
		$dir .= ($dir =~ m:/$:) ? '' : "/";
	}
	elsif (/^(--tidy-up)$/) {
		$tidy++;
	}
	else {
		die "$progname: Unknown option $_.\n";
	}
}
die ("Need a configuration file - use $progname -f\n")
	if (not defined $file);
$config = Config::Auto::parse("$file");
%keys=();
foreach $key (%$config)
{
	$type = lc($key) if (ref $key ne "HASH");
	$value = $key if (ref $key eq "HASH");
	$keys{$type} = $value;
}
%sources=();
%packages=();
%suites=();
%options=();
%scripts=();
foreach $section (sort keys %keys)
{
	if ($section eq "general")
	{
		$arch = $keys{$section}{'arch'} if (not defined $arch);
		$dir = $keys{$section}{'directory'} if (not defined $dir);
		# support the original value but replace by new value.
		$unpack = lc($keys{$section}{'unpack'})
			if (defined $keys{$section}{'forceunpack'});
		$unpack = lc($keys{$section}{'unpack'})
			if (defined $keys{$section}{'unpack'});
		$tidy++ if (defined $keys{$section}{'cleanup'});
		@debootstrap = split(' ', lc($keys{$section}{'debootstrap'}));
	}
	else
	{
		$sources{$section}=$keys{$section}{'source'};
		$packages{$section}=$keys{$section}{'packages'};
		$suites{$section}=$keys{$section}{'suite'};
		$scripts{$section}=$keys{$section}{'script'};
	}
}
print "$progname $ourversion using $file\n";
$host = `dpkg-architecture -qDEB_BUILD_ARCH`;
chomp ($host);
$foreign++ if ($host ne $arch);
$cachedir = "var/cache/apt/"; # archives
$libdir = "var/lib/apt/";     # lists
$etcdir = "etc/apt/";         # sources
$dpkgdir = "var/lib/dpkg/";   # state

mkdir ("$dir") if (not -d "$dir");
system ("mkdir -p ${dir}${cachedir}");
system ("mkdir -p ${dir}${libdir}");
system ("mkdir -p ${dir}${dpkgdir}");
system ("mkdir -p ${dir}etc/apt/sources.list.d/");
@dirs = qw/ alternatives info parts updates/;
@touch = qw/ diversion statoverride status lock/;
foreach my $dpkgd (@dirs) {
	if (not -d "${dir}${dpkgdir}$dpkgd") {
		mkdir "${dir}${dpkgdir}$dpkgd";
	}
}
foreach my $file (@touch) {
	utime(time, time, "${dir}${dpkgdir}/$file") or (
		open(F, ">${dir}${dpkgdir}/$file") && close F )
}
unlink ("${dir}etc/apt/sources.list.d/sources.list")
	if (-f "${dir}etc/apt/sources.list.d/sources.list");
unlink ("${dir}etc/apt/sources.list")
	if (-f "${dir}etc/apt/sources.list");

foreach $repo (sort keys %suites)
{
	if (not -e "${dir}${cachedir}") {
		mkdir "${dir}${cachedir}";
	}
	if (not -e "$dir/${libdir}lists") {
		mkdir "$dir/${libdir}lists";
	}
	if (not -e "$dir/${libdir}lists/partial") {
		mkdir "$dir/${libdir}lists/partial";
	}
	if (not -e "$dir/${cachedir}archives") {
		mkdir "$dir/${cachedir}archives";
	}
	if (not -e "$dir/${cachedir}archives/partial") {
		mkdir "$dir/${cachedir}archives/partial";
	}
	if (-d "${dir}etc/apt/")
	{
		open (SOURCES, ">>${dir}etc/apt/sources.list.d/sources.list") 
			or die "Cannot open sources list $!";
		$mirror = $sources{$repo};
		$suite = $suites{$repo};
		print SOURCES<<END;
deb $mirror $suite main
deb-src $mirror $suite main
END
		close SOURCES;
	}
}

$config_str = '';
$config_str .= " -o Apt::Architecture=$arch";
$config_str .= " -o Apt::Get::AllowUnauthenticated=true";
$config_str .= " -o Apt::Get::Download-Only=true";
$config_str .= " -o Apt::Install-Recommends=false";
$config_str .= " -o Dir=$dir";
$config_str .= " -o Dir::Etc=${dir}${etcdir}";
$sourcesname = "sources.list.d/$repo.sources.list";
$config_str .= " -o Dir::Etc::SourceList=${dir}${etcdir}$sourcesname";
$config_str .= " -o Dir::State=${dir}${libdir}";
$config_str .= " -o Dir::State::Status=${dir}${dpkgdir}/status";
$config_str .= " -o Dir::Cache=${dir}${cachedir}";
system ("apt-get $config_str update");
$str = join (' ', values %packages);
chomp($str);
$str .= " ";
my $required = &get_required_debs;
$str .= join (' ', @$required);
chomp($str);
print "apt-get -y $config_str install $str\n";
$retval = system ("apt-get -y $config_str install $str");
die ("apt download failed. Exit value: ".($retval/256)."\n")
	if ($retval != 0);

&force_unpack if ($unpack eq "true");
system ("touch ${dir}${libdir}lists/lock");
(not defined $tidy) ? system ("apt-get $config_str update") : &tidy_apt;
system ("rm -rf ${dir}debootstrap");
&native if (not defined ($foreign));
print "\nMultistrap system installed successfully in $dir.\n\n";
exit 0;

sub force_unpack
{
	my %unpack=();
	opendir (DEBS, "${dir}${cachedir}archives/")
		or die ("Cannot read apt archives directory.\n");
	@archives=grep(/.*\.deb$/, readdir DEBS);
	closedir (DEBS);
	print "I: Calculating obsolete packages\n";
	foreach $deb (sort @archives)
	{
		my $version = `dpkg -f ${dir}${cachedir}archives/$deb Version`;
		my $package = `dpkg -f ${dir}${cachedir}archives/$deb Package`;
		chomp ($version);
		chomp ($package);
		if (exists $unpack{$package})
		{
			my $test=system("dpkg --compare-versions $unpack{$package} '<<' $version");
			$test /= 256;
			# unlink version in $unpack if 0
			# unlink $deb (current one) if 1
			if ($test == 0)
			{
				my $old = $deb;
				$old =~ s/$version/$unpack{$package}/;
				print "I: Removing $old\n";
				unlink "${dir}${cachedir}archives/$old";
				next;
			}
			else
			{
				print "I: Removing $deb\n";
				unlink "${dir}${cachedir}archives/$deb";
			}
		}
		$unpack{$package}=$version;
	}
	open (LOCK, ">${dir}${libdir}lists/lock");
	close (LOCK);
	opendir (DEBS, "${dir}${cachedir}archives/")
		or die ("Cannot read apt archives directory.\n");
	@archives=grep(/.*\.deb$/, readdir DEBS);
	closedir (DEBS);
	my $old = `pwd`;
	chomp ($old);
	chdir ("${dir}");
	foreach $deb (sort @archives)
	{
		print "I: Extracting $deb...\n";
		system ("ar -p \"./${cachedir}archives/$deb\" data.tar.gz | zcat | tar -xf -");
		my $ver=`dpkg -f ./${cachedir}archives/$deb Version`;
		my $pkg=`dpkg -f ./${cachedir}archives/$deb Package`;
		chomp ($ver);
		chomp ($pkg);
		mkdir ("./tmp");
		my $tmpdir = `mktemp -p ./tmp -d -t multistrap.XXXXXX`;
		chomp ($tmpdir);
		mkdir ("./${tmpdir}/listing");
		system ("ar -p \"./${cachedir}archives/$deb\" data.tar.gz > ./${tmpdir}/listing/data.tar.gz");
		my $datatar = `tar -tzf ./${tmpdir}/listing/data.tar.gz`;
		my @lines = split("\n", $datatar);
		open (LIST, ">>./${dpkgdir}info/${pkg}.list");
		foreach my $l (@lines)
		{
			chomp ($l);
			$l =~ s:^\.::;
			$l =~ s:^/$:/\.:;
			$l =~ s:/$::;
			print LIST "$l\n";
		}
		close (LIST);
		system ("rm -rf ./${tmpdir}/listing");
		system ("dpkg -e ./${cachedir}archives/$deb ${tmpdir}/");
		opendir (MAINT, "./${tmpdir}");
		my @maint=grep(!m:\.\.?:, readdir (MAINT));
		closedir (MAINT);
		open (AVAIL, ">>./${dpkgdir}available");
		open (STATUS, ">>./${dpkgdir}status");
		foreach my $mscript (@maint)
		{
			rename "./${tmpdir}/$mscript", "./${dpkgdir}info/$pkg.$mscript";
			if ( $mscript eq "control" )
			{
				open (MSCRIPT, "./${dpkgdir}info/$pkg.$mscript");
				my @scr=<MSCRIPT>;
				close (MSCRIPT);
				my @avail = grep(!/^$/, @scr);
				print AVAIL @avail;
				print STATUS @avail;
				print AVAIL "\n";
				print STATUS "Status: install ok unpacked\n";
				unlink ("./${dpkgdir}info/$mscript");
			}
		}
		close (AVAIL);
		if ( -f "./${dpkgdir}info/$pkg.conffiles")
		{
			print STATUS "Conffiles:\n";
			print " -> Processing conffiles for $pkg\n";
			open (CONF, "./${dpkgdir}info/$pkg.conffiles");
			my @lines=<CONF>;
			close (CONF);
			foreach my $line (@lines)
			{
				chomp ($line);
				my $md5=`md5sum ./$line | cut -d" " -f1`;
				chomp ($md5);
				print STATUS " $line $md5\n";
			}
		}
		print STATUS "\n";
		close (STATUS);
		system ("rm -rf ./${tmpdir}");
	}
	chdir ("$old");
	print "I: Unpacking complete.\n";
}

sub tidy_apt
{
	print "I: Tidying up apt cache and list data.\n";
	opendir (DEBS, "${dir}${libdir}lists/")
		or die ("Cannot read apt lists directory.\n");
	my @lists=grep(!m:\.\.?$:, readdir DEBS);
	closedir (DEBS);
	foreach my $file (@lists)
	{
		next if (-d $file);
		unlink ("${dir}${libdir}lists/$file");
	}
	opendir (DEBS, "${dir}${cachedir}/")
		or die ("Cannot read apt cache directory/.\n");
	my @files=grep(!m:\.\.?$:, readdir DEBS);
	closedir (DEBS);
	foreach my $file (@files)
	{
		next if (-d $file);
		next unless ($file =~ /\.bin$/);
		unlink ("${dir}${cachedir}$file");
	}
	if ($unpack eq "true")
	{
		opendir (DEBS, "${dir}${cachedir}/archives/")
			or die ("Cannot read apt archives directory/.\n");
		my @files=grep(!m:\.\.?$:, readdir DEBS);
		closedir (DEBS);
		foreach my $file (@files)
		{
			next if (-d $file);
			next unless ($file =~ /\.deb$/);
			unlink ("${dir}${cachedir}archives/$file");
		}
	}
}

# if native arch, do a few tasks just because we can and probably should.
sub native
{
	print "I: Native mode - configuring unpacked packages . . .\n";
	system ("sudo chroot $dir dpkg --configure -a");
}

sub get_required_debs
{
	# emulate required="$(get_debs Priority: required)"
	# from debootstrap/functions
	# needs to be run after the first apt-get install so that
	# Packages files exist
	my @required=();
	my @debs=();
	opendir (PKGS, "${dir}${libdir}lists/")
		or die ("Cannot open ${dir}${libdir}lists/ directory. $!\n");
	my @lists=grep(/_Packages$/, readdir (PKGS));
	closedir (PKGS);
	foreach my $strap (@debootstrap)
	{
		my $s = lc($strap);
		foreach my $l (@lists)
		{
			next unless ($l =~ /$s/);
			push (@required, $l);
		}
	}
	foreach my $file (@required)
	{
		my $fh = IO::File->new("${dir}${libdir}lists/$file");
		my $parser = Parse::Debian::Packages->new( $fh );
		while (my %package = $parser->next)
		{
			next unless $package{'Priority'} eq "required";
			push @debs, $package{'Package'};
		}
	}
	return \@debs;
}

sub usageversion {
	print(STDERR <<END)
$progname version $ourversion

Usage:
 $progname [-a ARCH] [-d DIR] -f CONFIG_FILE
 $progname -?|-h|--help|--version

Command:
 -f|--file CONFIG_FILE:  path the the multistrap configuration file.

Options:
 -a|--arch ARCHITECTURE: override the configuration file architecture.
 -d|--dir PATH:          override the configuration file directory.
 -?|-h|--help:           print this usage message and exit
 --version:              print this usage message and exit

$progname extends debootstrap to provide support for multiple
repositories, using a configuration file to specify the relevant suites,
architecture, extra packages and the mirror to use for each repository.

Example configuration:
[General]
arch=armel
directory=/opt/multistrap/
# extract all downloaded archives (default is true)
unpack=true
# the order of sections is not important.
debootstrap=Debian

[Debian]
packages=
source=http://ftp.uk.debian.org/debian
suite=lenny
script=

This will result in a completely normal debootstrap of Debian lenny from
the specified mirror, for armel in /opt/multistrap/.

'Architecture' and 'directory' can be overridden on the command line.

Specify a package to extend the debootstap to include that package and
all dependencies.

General settings:

'directory' specifies the top level directory where the debootstrap
will be created - it is not packed into a .tgz once complete.

END
        || die "$progname: failed to write usage: $!\n";
}

=pod

=head1 Name

em_multistrap - extends debootstrap for multiple repository support

=head1 Synopsis

 em_multistrap [-a ARCH] [-d DIR] -f CONFIG_FILE
 em_multistrap -?|-h|--help|--version

=head1 Description

em_multistrap extends debootstrap to provide support for multiple
repositories, using a configuration file to specify the relevant suites,
debootstrap options, architecture, extra packages and the mirror to use
for each repository.

Example configuration:

 [General]
 arch=armel
 directory=/opt/multistrap/
 # extract all downloaded archives (default is true)
 unpack=true
 # the order of sections is not important.
 debootstrap=Debian
 
 [Debian]
 packages=
 source=http://ftp.uk.debian.org/debian
 suite=lenny
 script=
 options=

This will result in a completely normal debootstrap of Debian lenny from
the specified mirror, for armel in /opt/multistrap/.

'Architecture' and 'directory' can be overridden on the command line.

Section names are case-insensitive.

Specify a package to extend the multistrap to include that package and
all dependencies.


=head1 General settings:

'directory' specifies the top level directory where the debootstrap
will be created - it is not packed into a .tgz once complete.

Note that em_multistrap deliberately turns off Install-Recommends.

As with debootstrap, em_multistrap will continue after errors although
you may want to purge $directory/var/cache/apt/archives from time to
time.

em_multistrap does not currently implement machine:variant support
used in Emdebian but the build directory is not packed up at the
end of the run so other scripts can be used to implement customisations.

=head1 State

multistrap is stateless - if the directory exists, it will simply
proceed as normal and apt will try to pick up where it left off.

=head1 Native mode - multistrap

em_multistrap was not intended for native support, it was developed for
cross architeeture support. In order for multiple repositories to be
used, em_multistrap sets the --foreign option with debootstrap even if
debootstrap would be able to complete the installation of each single
repository. The reason for this is so that only the packages selected
by apt are actually unpacked.

In native mode, various post-multistrap operations are likely to be
needed that debootstrap would do for you:

 1. copy /etc/hosts into the chroot
 2. clean the environment to unset LANGUAGE, LC_ALL and LANG
    to silence nuisance perl warnings that obscure other errors

(An alternative to unset the localisation variables is to add
locales to your multistrap configuration file in the 'packages'
option.

=cut