#!/usr/bin/perl # Copyright (C) 2009 Neil Williams # # 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 . use IO::File; use Config::Auto; use File::Basename; use Parse::Debian::Packages; use strict; use warnings; use vars qw/ $progname $ourversion $dstrap $extra @aptsources @archives $deb $cachedir $config_str %packages $retval $str $retries $dir $include $arch $foreign $suite $url $unpack $sourcedir @e $sourcesname $libdir $dpkgdir @debootstrap %suites $mirror $etcdir $repo @dirs @touch %sources $section %keys $host $key $value $type $file $config $tidy $noauth $keyring %keyrings /; $progname = basename($0); $ourversion = "0.0.6"; $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++; } elsif (/^(--source-dir)$/) { $sourcedir = shift (@ARGV); $sourcedir .= ($sourcedir =~ m:/$:) ? '' : "/"; $sourcedir = (-d $sourcedir) ? $sourcedir : undef; } elsif (/^(--no-auth)$/) { $noauth++; } 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=(); %keyrings=(); @aptsources=(); 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'}) 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'})); @debootstrap = split(' ', lc($keys{$section}{'debootstrap'})); @aptsources = split (' ', lc($keys{$section}{'aptsources'})); } else { $sources{$section}=$keys{$section}{'source'}; $packages{$section}=$keys{$section}{'packages'}; $suites{$section}=$keys{$section}{'suite'}; $keyrings{$section}=$keys{$section}{'keyring'}; } } print "$progname $ourversion using $file\n"; $host = `dpkg-architecture -qDEB_BUILD_ARCH`; chomp ($host); $foreign++ if ($host ne $arch); print "$progname building '$arch' multistrap on '$host'\n"; $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/ 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"; } unlink ("${dir}etc/apt/sources.list.d/multistrap.sources.list") if (-f "${dir}etc/apt/sources.list.d/multistrap.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"; } } foreach my $aptsrc (@aptsources) { if (-d "${dir}etc/apt/") { open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap.sources.list") or die "Cannot open sources list $!"; $mirror = $sources{$aptsrc}; $suite = $suites{$aptsrc}; print SOURCES<${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=; 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=; 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"; unlink ("${dir}etc/apt/sources.list") if (-f "${dir}etc/apt/sources.list"); 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$/); (defined $sourcedir) ? system ("mv ${dir}${cachedir}archives/$file $sourcedir/$file") : 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"; my $e=`printenv`; my $str = ($e =~ /\nUSER=root\n/) ? "" : "sudo"; $str = (-f "/usr/bin/sudo") ? "$str" : ""; system ("$str 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 <