multistrap/multistrap

#!/usr/bin/perl

# Copyright (C) 2009, 2010  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 strict;
use warnings;
use IO::File;
use Config::Auto;
use File::Basename;
use Parse::Debian::Packages;
use POSIX qw(locale_h);
use Locale::gettext;

use vars qw/ $progname $ourversion $dstrap $extra @aptsources $mirror
 @archives $deb $cachedir $config_str %packages $retval $str $retries
 $dir $include $arch $foreign $suite $url $unpack $sourcedir $msg $etcdir
 @e $sourcesname $libdir $dpkgdir @debootstrap %suites %components $chk
 $component $repo @dirs @touch %sources $section %keys $host $key $value
 $type $file $config $tidy $noauth $keyring %keyrings $deflist $cfgdir
 @extrapkgs @includes %source $setupsh $configsh $omitrequired $dryrun
 $omitpreinst @reinstall $tgzname %uniq %required $check @check %uniq
 $explicit_suite $allow_recommends %omitdebsrc @dsclist @sectoutput
 %flatfile /;

setlocale(LC_MESSAGES, "");
textdomain("multistrap");
$progname = basename($0);
$ourversion = &our_version();
$unpack = "true";
%omitdebsrc=();

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++;
	}
	elsif (/^(--source-dir)$/) {
		$sourcedir = shift (@ARGV);
		$sourcedir .= ($sourcedir =~ m:/$:) ? '' : "/";
		$sourcedir = (-d $sourcedir) ? $sourcedir : undef;
	}
	elsif (/^(--no-auth)$/) {
		$noauth++;
	}
	elsif (/^(--dry-run|--simulate)$/) {
		$dryrun++;
	}
	else {
		die "$progname: "._g("Unknown option")." $_.\n";
	}
}
$msg = sprintf (_g("Need a configuration file - use %s -f\n"), $progname);
die ($msg)
	if (not defined $file);

$cachedir = "var/cache/apt/"; # archives
$libdir = "var/lib/apt/";     # lists
$etcdir = "etc/apt/";         # sources
$dpkgdir = "var/lib/dpkg/";   # state

$cfgdir=dirname($file);
cascade($file);

foreach my $inc (@includes)
{
	# look for the full filepath or try same directory as current conf.
	if (not -f $inc ) {
		$chk = `realpath $cfgdir/$inc 2>/dev/null`;
		next if ($chk =~ /^\n?$/);
		chomp ($chk);
	} else {
		$chk = $inc;
	}
	printf (_g("%s %s using %s\n"), $progname, $ourversion, $chk);
	cascade($chk);
}
%uniq=();
foreach my $line (@debootstrap) {
	$uniq{$line}++;
}
@debootstrap=sort keys %uniq;
%uniq=();
foreach my $line (@aptsources) {
	$uniq{$line}++;
}
@aptsources=sort keys %uniq;

&dump_config if (defined $dryrun);
if (not defined $dir or not defined $arch) {
	&dump_config;
	exit 3;
}

# Translators: fields are: programname, versionstring, configfile.
printf (_g("%s %s using %s\n"), $progname, $ourversion, $file);
$host = `dpkg --print-architecture`;
chomp ($host);
if ((not defined $arch) or ($arch eq "")) {
	$arch = $host;
	printf (_g("Defaulting architecture to native: %s\n"),$arch);
} elsif ($arch eq $host) {
	printf (_g("Defaulting architecture to native: %s\n"),$arch);
} else {
	printf (_g("Using foreign architecture: %s\n"), $arch);
}
$foreign++ if ($host ne $arch);

unless (keys %sources and @aptsources) {
	my $msg = sprintf(_g("No sources defined for a foreign multistrap.
	Using your existing apt sources. To use different sources,
	list them with aptsources= in '%s'."), $file);
	warn ("$progname: $msg\n");
	$deflist = prepare_sources_list();
}

# Translators: fields are: programname, architecture, host architecture.
printf (_g("%s building %s multistrap on '%s'\n"), $progname, $arch, $host);

if (not -d "$dir") {
	my $ret = system ("mkdir -p $dir");
	$ret /= 256 if (defined $ret);
	my $msg = sprintf (_g("Unable to create directory '%s'"),$dir);
	die "$progname: $msg\n" if ($ret != 0);
}
$dir = `realpath $dir`;
chomp ($dir);
$dir .= ($dir =~ m:/$:) ? '' : "/";
system ("mkdir -p ${dir}${cachedir}") if (not -d "${dir}${cachedir}");
system ("mkdir -p ${dir}${libdir}") if (not -d "${dir}${libdir}");
system ("mkdir -p ${dir}${dpkgdir}") if (not -d "${dir}${dpkgdir}");
system ("mkdir -p ${dir}etc/apt/sources.list.d/")
	if (not -d "${dir}etc/apt/sources.list.d/");
system ("mkdir -p ${dir}etc/apt/trusted.gpg.d/")
	if (not -d "${dir}etc/apt/trusted.gpg.d/");
system ("mkdir -p ${dir}etc/apt/preferences.d/")
	if (not -d "${dir}etc/apt/preferences.d/");
system ("mkdir -p ${dir}usr/share/info/")
	if (not -d "${dir}usr/share/info/");
system ("touch ${dir}usr/share/info/dir");
my $msg = sprintf(_g("Unable to create directory '%s'\n"), "${dir}etc/apt/preferences.d/");
die ($msg)
	if (not -d "${dir}etc/apt/preferences.d/");

@dirs = qw/ alternatives info parts updates/;
@touch = qw/ diversions 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 );
}
utime(time, time, "${dir}etc/shells") or 
	(open(F, ">${dir}etc/shells") && close F );

if (not -d "${dir}etc/network") {
	mkdir "${dir}etc/network";
}

if (not -d "${dir}dev") {
	mkdir "${dir}dev";
}

# prevent the absolute symlink in libc6 from allowing
# writes outside the multistrap root dir. See: #553599
if (-l "${dir}lib64" ) {
	my $r = readlink "${dir}lib64";
	if ($r =~ m:^/:)
	{
		my $old = `pwd`;
		chomp ($old);
		unlink "${dir}lib64";
		chdir ("$dir");
		print _g("INF: ./lib64 -> /lib symbolic link reset to ./lib.\n");
		symlink "./lib", "lib64";
		chdir ("${old}");
	}
} else {
		my $old = `pwd`;
		chomp ($old);
		chdir ("$dir");
		print _g("INF: Setting ./lib64 -> ./lib symbolic link.\n");
		symlink "./lib", "lib64";
		chdir ("${old}");
}

system ("rm -rf ${dir}etc/apt/sources.list.d/*");
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";
	}
}
foreach my $aptsrc (@debootstrap) {
	if (defined $deflist) {
		open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap.sources.list") 
			or die _g("Cannot open sources list"). $!;
		print SOURCES $deflist;
		close SOURCES;
	} elsif (-d "${dir}etc/apt/") {
		open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap-${aptsrc}.list") 
			or die _g("Cannot open sources list"). $!;
		$mirror = $sources{$aptsrc};
		$suite = (exists $flatfile{$aptsrc}) ? "" : $suites{$aptsrc};
		$component = (exists $flatfile{$aptsrc}) ? "" 
			: (defined $components{$aptsrc}) ? $components{$aptsrc} : "main";
		if (defined $mirror and defined $suite) {
			print SOURCES "deb $mirror $suite $component\n";
			print SOURCES "deb-src $mirror $suite $component\n" if (not defined $omitdebsrc{$aptsrc});
			close SOURCES;
		}
	}
}
my $k;
foreach my $pkg (values %keyrings) {
	next if (not defined $pkg);
	next if ("" eq "$pkg");
	$k .= "$pkg ";
}
if ((defined $k) and (not defined $noauth)) {
	printf (_g("I: Installing %s\n"), $k);
	system ("apt-get -y -d --reinstall install $k");
	foreach my $keyring_pkg (values %keyrings) {
		my @files=();
		my $file = `find /var/cache/apt/archives/ -name "$keyring_pkg*"`;
		chomp ($file);
		my $xdir = `mktemp -d -t keyring.XXXXXX`;
		chomp ($xdir);
		system ("dpkg -X $file $xdir >/dev/null");
		if (-d "${xdir}/usr/share/keyrings") {
			opendir (DIR, "${xdir}/usr/share/keyrings");
			@files=grep(!m:\.\.?$:,readdir DIR);
			closedir (DIR);
		}
		foreach my $gpg (@files) {
			next if ($gpg =~ /removed/);
			system ("gpg --no-default-keyring ".
				"--homedir=${dir}/etc/apt/trusted.gpg.d/ ".
				"--keyring=multistrap.gpg ".
				" --import ${xdir}/usr/share/keyrings/${gpg} 2>/dev/null");
		}
		system ("rm -rf ${xdir}");
	}
}
$config_str = '';
$config_str .= " -o Apt::Architecture=$arch";
$config_str .= " -o Dir::Etc::TrustedParts=${dir}${etcdir}trusted.gpg.d";
$config_str .= " -o Dir::Etc::Trusted=${dir}${etcdir}trusted.gpg";
$config_str .= " -o Apt::Get::AllowUnauthenticated=true"
	if (defined $noauth);
$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}";
if (defined $deflist) {
	$sourcesname = "sources.list.d/multistrap.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}";
printf (_g("Getting package lists: apt-get %s update\n"), $config_str);
$retval = system ("apt-get $config_str update");
die (sprintf (_g("apt update failed. Exit value: %d\n"), ($retval/256)))
	if ($retval != 0);
my @s = ();
$str = "";
if ((not defined $omitrequired) or ($omitrequired eq "false")) {
	print _g("I: Calculating required packages.\n");
	&get_required_debs;
	$str .= join (' ', keys %required);
	chomp($str);
}
$str .= " ";
foreach my $sect (sort keys %packages) {
	my @list = split (' ', $sect);
	foreach my $pkg (@list) {
		next if ($packages{$pkg} =~ /^\s*$/);
		next if (!(grep(/^$sect$/i, @debootstrap)));
		my @long=split (/ /, $packages{$sect});
		foreach my $l (@long) {
			chomp ($l);
			if (defined $explicit_suite and $suites{$sect}) {
				# instruct apt to get packages from the specified
				# suites (when the package exists in more than one).
				$str .= " $l/$suites{$sect}" if ((defined $l) and ($l !~ /^\s*$/));
			} else {
				$str .= " $l" if ((defined $l) and ($l !~ /^\s*$/));
			}
		}
	}
}
chomp($str);
$str .= " " . join (' ', values %keyrings) . " "; 
chomp($str);
%uniq=();
@s = split (/ /, $str);
foreach my $a (@s) {
	$uniq{$a}++;
}
$str = join (' ', sort keys %uniq);
@dsclist = sort keys %uniq;
my $forceyes="";
$forceyes="--force-yes" if (defined $noauth);
print "apt-get $forceyes -y $config_str install $str\n";
$retval = system ("apt-get -y $config_str install $str");
die (sprintf (_g("apt download failed. Exit value: %d\n"),($retval/256)))
	if ($retval != 0);
&force_unpack if ($unpack eq "true");
system ("touch ${dir}${libdir}lists/lock");
system ("$setupsh $dir $arch") if ((defined $setupsh) and (-x $setupsh));
&native if (not defined ($foreign));
&add_extra_packages;
system ("cp $configsh $dir/") if ((defined $configsh) and (-f $configsh));
(not defined $tidy) ? system ("apt-get $config_str update") : &tidy_apt;
if (-l "${dir}lib64" ) {
	my $r = readlink "${dir}lib64";
	if ($r =~ m:^/:)
	{
		print _g("ERR: ./lib64 -> /lib symbolic link reset to ./lib after unpacking.\n");
		printf (_g("ERR: Some files may have been unpacked outside %s!\n"), $dir);
	}
}
# cleanly separate the debootstrap sources from the final apt sources.
unlink ("${dir}etc/apt/sources.list.d/multistrap.sources.list")
	if (-f "${dir}etc/apt/sources.list.d/multistrap.sources.list");
opendir (LISTS, "${dir}etc/apt/sources.list.d/")
	or die (_g("Cannot read apt sources list directory.\n"));
my @sources=grep(!m:\.\.?$:, readdir LISTS);
closedir (LISTS);
foreach my $filelist (@sources) {
	next if (-d $filelist);
	unlink ("${dir}etc/apt/sources.list.d/$filelist");
}
foreach my $aptsrc (@aptsources) {
	if (defined $deflist) {
		open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap.sources.list") 
			or die _g("Cannot open sources list"). $!;
		print SOURCES $deflist;
		close SOURCES;
	} elsif (-d "${dir}etc/apt/") {
		open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap-${aptsrc}.list") 
			or die _g("Cannot open sources list"). $!;
		$mirror = $sources{$aptsrc};
		$suite = (exists $flatfile{$aptsrc}) ? "" : $suites{$aptsrc};
		$component = (defined $components{$aptsrc}) ? $components{$aptsrc}
			: (exists $flatfile{$aptsrc}) ? "" : "main";
		if (defined $mirror and defined $suite) {
			print SOURCES "deb $mirror $suite $component\n";
			print SOURCES "deb-src $mirror $suite $component\n" if (not defined $omitdebsrc{$aptsrc});
			close SOURCES;
		}
	}
}
# altered the sources, so get apt to update.
(not defined $tidy) ? system ("apt-get $config_str update") : &tidy_apt;
printf (_g("\nMultistrap system installed successfully in %s.\n"), $dir);
if (defined $tgzname) {
	printf (_g("\nCompressing multistrap system in '%s' to a tarball called: '%s'.\n"), $dir, $tgzname);
	chdir ("$dir");
	unlink $tgzname if (-f $tgzname);
	my $retval = system ("tar -czf ../$tgzname .");
	$retval /= 256;
	if ($retval == 0) {
		printf (_g("\nRemoving build directory: '%s'\n"), $dir);
		system ("rm -rf $dir/*");
	}
	my $final_path=`realpath $dir/../$tgzname`;
	chomp ($final_path);
	printf (_g("\nMultistrap system packaged successfully as '%s'.\n"), $final_path);
}
print "\n";
exit 0;

sub our_version {
	my $query = `dpkg-query -W -f='\${Version}' multistrap`;
	(defined $query) ? return $query : return "2.1.5";
}

sub add_extra_packages {
	$str = join (' ', @extrapkgs);
	if (@extrapkgs) {
		print "apt-get -y $config_str install $str\n";
		$retval = system ("apt-get -y $config_str install $str");
		&force_unpack (@extrapkgs) if ($unpack eq "true");
		system ("touch ${dir}${libdir}lists/lock");
		&native if (not defined ($foreign));
	}
}

sub force_unpack {
	my (@limits) = @_;
	my %unpack=();
	my %filter = ();
	opendir (DEBS, "${dir}${cachedir}archives/")
		or die (_g("Cannot read apt archives directory.\n"));
	@archives=grep(/.*\.deb$/, readdir DEBS);
	closedir (DEBS);
	if (@limits) {
		foreach my $l (@limits) {
			foreach my $file (@archives) {
				if ($file =~ m:$l:) {
					$filter{$l} = "$file";
				}
			}
		}
		@archives = sort values %filter;
	}
	print _g("I: Calculating obsolete packages\n");
	foreach $deb (sort @archives) {
		my $version = `LC_ALL=C dpkg -f ${dir}${cachedir}archives/$deb Version`;
		my $package = `LC_ALL=C 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}/;
				printf (_g("I: Removing %s\n"), $old);
				unlink "${dir}${cachedir}archives/$old";
				next;
			} else {
				printf (_g("I: Removing %s\n"), $deb);
				unlink "${dir}${cachedir}archives/$deb";
			}
		}
		$unpack{$package}=$version;
	}
	if (not @limits) {
		open (LOCK, ">${dir}${libdir}lists/lock");
		close (LOCK);
		opendir (DEBS, "${dir}${cachedir}archives/")
			or die (_g("Cannot read apt archives directory.\n"));
		@archives=grep(/.*\.deb$/, readdir DEBS);
		closedir (DEBS);
	}
	my $old = `pwd`;
	chomp ($old);
	chdir ("${dir}");
	printf (_g("Using directory %s for unpacking operations\n"), $dir);
	foreach $deb (sort @archives) {
		printf (_g("I: Extracting %s...\n"), $deb);
		my $ver=`LC_ALL=C dpkg -f ./${cachedir}archives/$deb Version`;
		my $pkg=`LC_ALL=C dpkg -f ./${cachedir}archives/$deb Package`;
		chomp ($ver);
		chomp ($pkg);
		push @dsclist, $pkg;
		mkdir ("./tmp");
		my $tmpdir = `mktemp -p ./tmp -d -t multistrap.XXXXXX`;
		chomp ($tmpdir);
		my $datatar = `LC_ALL=C dpkg -X ./${cachedir}archives/$deb ${dir}`;
		my $exit = `echo $?`;
		chomp ($exit);
		if ($exit ne "0") {
			printf(_g("dpkg -X failed with error code %s\nSkipping...\n"), $exit);
			next;
		}
		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 ("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";
			printf (_g(" -> Processing conffiles for %s\n"), $pkg);
			open (CONF, "./${dpkgdir}info/$pkg.conffiles");
			my @lines=<CONF>;
			close (CONF);
			foreach my $line (@lines) {
				chomp ($line);
				my $md5=`LC_ALL=C md5sum ./$line | cut -d" " -f1`;
				chomp ($md5);
				print STATUS " $line $md5\n";
			}
		}
		print STATUS "\n";
		close (STATUS);
		system ("rm -rf ./${tmpdir}");
		if (-l "${dir}lib64" ) {
			my $r = readlink "${dir}lib64";
			if ($r =~ m:^/:) {
				my $old = `pwd`;
				chomp ($old);
				printf (_g("ERR: lib64 -> ./lib symbolic link clobbered by %s\n"), $pkg);
				unlink "${dir}lib64";
				chdir ("$dir");
				print _g("INF: lib64 -> /lib symbolic link reset to ./lib.\n");
				symlink "./lib", "lib64";
				chdir ("${old}");
			}
		}
	}
	chdir ("$old");
	print _g("I: Unpacking complete.\n");
}

sub check_bin_sh {
	$dir = shift;
	my $old = `pwd`;
	chomp ($old);
	# dash refuses to configure if no existing shell is found.
	# (always expects a diversion to already exist).
	# (works OK in subsequent upgrades.) #546528
	unlink ("$dir/var/lib/dpkg/info/dash.postinst");
	# now ensure that a usable shell is available as /bin/sh
	if (not -l "$dir/bin/sh") {
		print (_g("ERR: ./bin/sh symbolic link does not exist.\n"));
		if (-f "$dir/bin/dash") {
			print (_g("INF: Setting ./bin/sh -> ./bin/dash\n"));
			chdir ("$dir/bin");
			symlink ("dash", "sh");
			chdir ("$old");
		} elsif (-f "$dir/bin/bash") {
			print (_g("INF: ./bin/dash not found. Setting ./bin/sh -> ./bin/bash\n"));
			chdir ("$dir/bin");
			symlink ("bash", "sh");
			chdir ("$old");
		}
	}
	if (-l "$dir/bin/sh") {
		print ("${dir}bin/sh found OK:\n");
		system ("(cd $dir ; ls -lh bin/sh)");
	} else {
		die ("No shell in $dir.");
	}
}

sub tidy_apt {
	print _g("I: Tidying up apt cache and list data.\n");
	if (defined $sourcedir) {
		my %uniqdsc=();
		foreach my $a (@dsclist) {
			$uniqdsc{$a}++;
		}
		my $str = join (" ", sort keys %uniqdsc);
		print "(cd $sourcedir; apt-get -d $config_str source $str)";
		system ("(cd $sourcedir; apt-get -d $config_str source $str)");
	}
	unlink ("${dir}etc/apt/sources.list")
		if (-f "${dir}etc/apt/sources.list");
	opendir (DEBS, "${dir}${libdir}lists/")
		or die (_g("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 (_g("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 (_g("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$/);
			if (defined $sourcedir) {
				system ("mv ${dir}${cachedir}archives/$file $sourcedir/$file");
			} else {
				unlink ("${dir}${cachedir}archives/$file");
			}
		}
		$sourcedir=undef;
	}
}

# if native arch, do a few tasks just because we can and probably should.
sub native {
	my $e=`LC_ALL=C printenv`;
	my $env = "DEBIAN_FRONTEND=noninteractive ".
	"DEBCONF_NONINTERACTIVE_SEEN=true ".
	"LC_ALL=C LANGUAGE=C LANG=C";
	printf (_g("I: dpkg configuration settings:\n\t%s\n"), $env);
	if ($e =~ /\nFAKEROOTKEY=[0-9]+\n/) {
		warn (_g("W: Cannot use 'chroot' when fakeroot is in use. Skipping package configuration.\n"));
		return;
	}
	print _g("I: Native mode - configuring unpacked packages . . .\n");
	my $str = "";
	if ($e =~ /\nUSER=root\n/) {
		$str = "sudo" if (-f "/usr/bin/sudo");
	}
	# check that we have a workable shell inside the chroot
	&check_bin_sh("$dir");
	system ("$str $env chroot $dir dpkg --configure -a");
	opendir (PRI, "${dir}/var/lib/dpkg/info") or return;
	my @preinsts=grep(/\.preinst$/, readdir PRI);
	closedir (PRI);
	printf (_g("I: Running preinst scripts with 'upgrade' argument.\n"));
	my $f = join (" ", @reinstall);
	foreach my $script (sort @preinsts) {
		my $t = $script;
		$t =~ s/\.preinst//;
		next if ($t =~ /$f/);
		next if ($script =~ /bash/);
		system ("$str $env chroot $dir /var/lib/dpkg/info/$script upgrade");
	}
	# reinstall set
	foreach my $reinst (sort @reinstall) {
		system ("$str $env chroot $dir apt-get --reinstall -y $forceyes install $reinst");
	}
}

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
	%required=();
	my %listfiles=();
	opendir (PKGS, "${dir}${libdir}lists/")
		or die sprintf(_g("Cannot open %s directory. %s\n"),
			"${dir}${libdir}lists/", $!);
	my @lists=grep(/_Packages$/, readdir (PKGS));
	closedir (PKGS);
	foreach my $strap (@debootstrap) {
		my $s = lc($strap);
		foreach my $l (@lists) {
			$listfiles{$l}++;
		}
	}
	foreach my $file (keys %listfiles) {
		my $fh = IO::File->new("${dir}${libdir}lists/$file");
		my $parser = Parse::Debian::Packages->new( $fh );
		while (my %package = $parser->next) {
			if (not defined $package{'Priority'} and (defined $package{'Essential'})) {
				$required{$package{'Package'}}++;
				next;
			}
			next if (not defined $package{'Priority'});
			next unless $package{'Priority'} eq "required";
			$required{$package{'Package'}}++;
		}
	}
}

# inherited from apt-cross
sub prepare_sources_list {
	my @source_list=();
	# collate all available/configured sources into one list
	if (-e "/etc/apt/sources.list") {
		open (SOURCES, "/etc/apt/sources.list")
			or die _g("cannot open apt sources list. %s",$!);
		@source_list = <SOURCES>;
		close (SOURCES);
	}
	if (-d "/etc/apt/sources.list.d/") {
		opendir (FILES, "/etc/apt/sources.list.d/")
			or die _g("cannot open apt sources.list directory %s\n",$!);
		my @files = grep(!/^\.\.?$/, readdir FILES);
		foreach my $f (@files) {
			next if ($f =~ /\.ucf-old$/);
			open (SOURCES, "/etc/apt/sources.list.d/$f") or
				die _g("cannot open /etc/apt/sources.list.d/%s %s",$f, $!);
			while(<SOURCES>) {
				push @source_list, $_;
			}
			close (SOURCES);
		}
		closedir (FILES);
	}
	return \@source_list;
}

sub usageversion {
	printf STDERR (_g("
%s version %s

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

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

Options:
 -a|--arch ARCHITECTURE: override the configuration file architecture.
 -d|--dir PATH:          override the configuration file directory.
    --no-auth:           do not use Secure Apt for any repositories
    --tidy-up:           remove apt cache data and downloaded archives.
    --dry-run:           output the configuration and exit
    --simulate:          output the configuration and exit
 -?|-h|--help:           print this usage message and exit
 --version:              print this usage message and exit

%s replaces 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/
# same as --tidy-up option if set to true
cleanup=true
# same as --no-auth option if set to true
# keyring packages listed in each bootstrap will
# still be installed.
noauth=false
# extract all downloaded archives (default is true)
unpack=true
# aptsources is a list of sections to be used for downloading packages
# and lists and placed in the /etc/apt/sources.list.d/multistrap.sources.list
# of the target. Order is not important
aptsources=Grip Updates
# the order of sections is not important.
# the bootstrap option determines which repository
# is used to calculate the list of Priority: required packages.
bootstrap=Debian

[Debian]
packages=
source=http://cdn.debian.net/debian
keyring=debian-archive-keyring
suite=lenny

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. Dependencies will be calculated by apt so as to use
only the most recent suitable version from all configured repositories.

General settings:

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

"), $progname, $ourversion, $progname, $progname, $progname)
	or die ("$progname: ". _g("failed to write usage:") . "$!\n");
}

sub cascade {
	$file = shift;
	$config = Config::Auto::parse($file);
	foreach $key (%$config) {
		$type = lc($key) if (ref $key ne "HASH");
		$value = $key if (ref $key eq "HASH");
		$keys{$type} = $value;
	}
	foreach $section (sort keys %keys) {
		if ($section eq "general") {
			$arch = $keys{$section}{'arch'}
				if (defined $keys{$section}{'arch'} and (not defined $arch));
			$dir = $keys{$section}{'directory'}
				if (defined $keys{$section}{'directory'} and (not defined $dir));
			# support the original value but replace by new value.
			$unpack = lc($keys{$section}{'unpack'})
				if (defined $keys{$section}{'forceunpack'} and (not defined $unpack));
			$unpack = lc($keys{$section}{'unpack'})
				if (defined $keys{$section}{'unpack'} and (not defined $unpack));
			$configsh = lc($keys{$section}{'configscript'})
				if (defined $keys{$section}{'configscript'} and (not defined $configsh));
			$tgzname = lc($keys{$section}{'tarballname'})
				if (defined $keys{$section}{'tarballname'} and (not defined $tgzname));
			undef $configsh if ((defined $configsh) and (not -x $configsh));
			$setupsh = lc($keys{$section}{'setupscript'})
				if (defined $keys{$section}{'setupscript'} and (not defined $setupsh));
			undef $setupsh if ((defined $setupsh) and (not -x $setupsh));
			$omitrequired = lc($keys{$section}{'omitrequired'})
				if (defined $keys{$section}{'omitrequired'} and (not defined $omitrequired));
			$omitpreinst = lc($keys{$section}{'omitpreinst'})
				if (defined $keys{$section}{'omitpreinst'} and (not defined $omitpreinst));
			$tidy++ if ((defined $keys{$section}{'cleanup'}) and ($keys{$section}{'cleanup'} eq "true"));
			$noauth++ if ((defined $keys{$section}{'noauth'}) and ($keys{$section}{'noauth'} eq "true"));
			$sourcedir = $keys{$section}{'retainsources'}
				if ((defined $keys{$section}{'retainsources'}) and (-d $keys{$section}{'retainsources'}));
			$explicit_suite++ if ((defined $keys{$section}{'explicitsuite'}) and
				($keys{$section}{'explicitsuite'} eq "true"));
			$allow_recommends++ if ((defined $keys{$section}{'allowrecommends'}) and
				($keys{$section}{'allowrecommends'} eq "true"));
			my @d = split(' ', lc($keys{$section}{'debootstrap'}));
			push @debootstrap, @d;
			my @b = split(' ', lc($keys{$section}{'bootstrap'}));
			push @debootstrap, @b;
			my @a = split (' ', lc($keys{$section}{'aptsources'}));
			push @aptsources, @a;
			my @i = split (' ', lc($keys{$section}{'include'}));
			push @includes, @i;
		} else {
			$sources{$section}=$keys{$section}{'source'} if (not exists $source{$section});
			# don't set suite or component if URL is of apt-ftparchive trailing-slash form
		        # regexp is: optional string in '[]', string without '[' or ']', string ending in '/'
			$flatfile{$section}++ if (($sources{$section} =~ /^(\[.*\] )*[^\[\]]+ .+\/$/));
			$packages{$section}=$keys{$section}{'packages'} if (not exists $packages{$section});
			$suites{$section}=$keys{$section}{'suite'}
				if (not exists $suites{$section} and not exists $flatfile{$section});
			$components{$section}=$keys{$section}{'components'}
				if (not exists $components{$section} and not exists $flatfile{$section});
			$omitdebsrc{$section}=$section if ((defined $keys{$section}{'omitdebsrc'})
				and ($keys{$section}{'omitdebsrc'} eq "true"));
			push @reinstall, split (/ /, lc($keys{$section}{'reinstall'}));
			$components{$section}='main' if (not defined $components{$section});
			$keyrings{$section}=$keys{$section}{'keyring'} if (not exists $keyrings{$section});
			push @extrapkgs, split (' ', lc($keys{$section}{'additional'}));
		}
	}
	my %uniq=();
	foreach my $listing (@reinstall) {
		$uniq{$listing}++;
	}
	@reinstall=();
	@reinstall=sort keys %uniq;
	# check for old versions of apt, <= 0.7.20.2+lenny1
	my $aptVer = `dpkg-query -W -f='\${Version}' apt`;
	if (defined $aptVer and ($aptVer ne "")) {
		chomp ($aptVer);
		my $retval = system ("dpkg --compare-versions $aptVer '>>' 0.7.20.2+lenny1");
		$retval /= 256;
		if ($retval == 1) {
			foreach my $key (sort keys %suites) {
				if (($suites{$key} =~ /lenny/)
				or ($suites{$key} =~ /squeeze/)
				or ($suites{$key} =~ /sid/)
				or ($suites{$key} =~ /etch/)) {
					my $msg = sprintf (_g("ERROR: Your version of apt is too old to support ".
					"using a codename like '%s'. You MUST use the suite and multistrap is ".
					"unable to guess which one you meant because suites change over time. " .
					"Use one of: 'oldstable', 'stable', 'stable-proposed-updates', 'testing',".
					" 'unstable' or 'experimental'. Alternatively, upgrade to version of apt ".
					"newer than 0.7.20.2+lenny1.\n"), $suites{$key});
					system ("echo \"$msg\" | fold -s");
					exit 5;
				}
			}
		}
	}
}

sub _g {
	return gettext(shift);
}

sub dump_config {
	if (not defined $dir or not defined $arch) {
		my $msg = sprintf(_g("The supplied configuration file '%s'".
		" cannot be parsed correctly."), $file);
		warn ("\n$msg\n");
	}
	@check=();
	%uniq=();
	push @check, @debootstrap;
	push @check, @aptsources;
	foreach my $sect (@check) { $uniq{$sect}++; }
	@check = sort keys %uniq;
	%uniq=();
	foreach my $sect (@check) {
		if (not exists $keys{$sect}) {
			$msg .= sprintf (_g("ERR: The '%s' section is not defined.\n"), $sect);
		}
	}
	if (scalar @includes > 0) {
		printf ("include:\t"._g("Including configuration file from: ").join (", ", sort @includes)."\n");
	} else {
		printf ("include:\t"._g("No included configuration files.\n"));
	}
	# explain the bootstrap section details explicitly and just refer to
	# those for the apt sources.
	foreach my $sect_name (@check) {
		printf ("Section:\t$sect_name\n");
		print "\tsource:  \t$sources{$sect_name}\n";
		my @sorted = split(/ /, $packages{$sect_name});
		%uniq=();
		foreach my $pkg (@sorted) {
			$uniq{$pkg}++;
		}
		@sorted = sort keys %uniq;
		%uniq=();
		print "\tsuite:  \t$suites{$sect_name}\n" if (not exists $flatfile{$sect_name});
		print "\tcomponents:\t$components{$sect_name}\n" if (not exists $flatfile{$sect_name});
		# only packages can have a list
		next if (not grep(/^$sect_name$/i, @debootstrap));
		print "\tBootstrap:\tpackages: ".join(" ", @sorted)."\n";
	}
	printf ("Bootstrap:\t%s: %s\n", _g("Sections"), join(" ", sort @debootstrap));
	printf ("AptSources:\t%s: %s\n", _g("Sections"), join(" ", sort @aptsources));
	my @srcdump=();
	foreach my $src (sort keys %sources) {
		next if ((!grep(/^$src$/i, @aptsources)) or (!grep(/^$src$/i, @debootstrap)));
		push @srcdump, $sources{$src};
	}
	my $srcmsg="omitdebsrc\t"._g("Omit deb-src from sources.list for sections:");
	foreach my $omit (sort keys %omitdebsrc) {
		$srcmsg .= $omitdebsrc{$omit} if (defined $omitdebsrc{$omit});
	}
	print "$srcmsg\n";
	if (defined $explicit_suite) {
		printf("explicitsuite:\t"._g("Explicit suite selection: Yes\n"));
	} else {
		printf("explicitsuite:\t"._g("Explicit suite selection: No - let apt use latest.\n"));
	}
	if (defined $allow_recommends) {
		printf("allowrecommends:\t"._g("Recommended packages are added to the selection.\n"));
	} else {
		printf("allowrecommends:\t"._g("Recommended packages are ignored.\n"));
	}
	print "Extra Packages: ".join (", ", sort @extrapkgs)."\n"
		if (scalar @extrapkgs > 0);
	print "reinstall: ".join (", ", sort (@reinstall))."\n"
		if (scalar @reinstall > 0);
	if (defined $arch) {
		printf ("arch:   \t"._g("Architecture: %s\n"), $arch);
	} else {
		$msg .= sprintf(_g("Cannot determine architecture from '%s'.\n"), $file);
	}
	if (defined $dir) {
		printf ("dir:    \t"._g("Output directory: '%s'\n"), $dir);
	} else {
		$msg .= sprintf(_g("Cannot determine directory from '%s'.\n"), $file);
	}
	printf ("unpack:   \t"._g("extract all downloaded archives: %s\n"), $unpack) if (defined $unpack);
	print "configscript:\t$configsh\n" if (defined $configsh);
	print "setupscript:\t$setupsh\n" if (defined $setupsh);
	print "omitrequired:\t$omitrequired\n" if (defined $omitrequired);
	if (defined $tidy) {
		printf ("cleanup: \t"._g("remove apt cache data: true\n"));
	} else {
		printf ("cleanup: \t"._g("remove apt cache data: false\n"));
	}
	if (defined $noauth) {
		printf ("noauth:   \t"._g("allow the use of unauthenticated repositories: true\n"));
	} else {
		printf ("noauth:   \t"._g("allow the use of unauthenticated repositories: false\n"));
	}
	if (defined $sourcedir) {
		printf ("retainsources:\t"._g("Sources will be retained in: %s\n"), $sourcedir);
	}
	if (defined $msg) {
		warn ("\n$msg\n");
		exit 1;
	}
	exit 0;
}