josch/multistrap
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity
multistrap/multistrap
Johannes 'josch' Schauer ff96767b2f General rewrite of the codebase 
0. Overview
===========

This commit message contains the following sections:

 * Rationale
 * Removed features
 * Changed behaviour
 * New features
 * Regressions
 * Code quality improvements

1. Rationale
============

The old code base suffered from:

 * The overuse of global variables (80) which were freely used by
   functions to store their results in as side-effects of their actual
   computation.
 * Underdocumented configuration file settings. Some values are only
   mentioned in the passing while documenting other things in the man
   page. Some values are not mentioned at all.
 * Repetition of code snippets. Some functions only differed slightly
   but were copy-pasted to create new versions. Configuration parsing
   and dumping copy-pasted value conversion multiple times instead of
   working with value types.
 * Abuse of system() and backticks without escaping special shell
   characters instead of passing an array to system().
 * Missing error checks when system() or backticks are used.
 * Non-existence of unit tests.
 * rm -rf your whole filesystem with the right configuration parameters

This commit *reduces* the lines of code in the main program from 1390
down to FIXME while at the same time *increasing* the ratio of comments
to lines of code from 0.06 to FIXME and *adding* additional features and
fixing the problems listed above.

2. Removed features
===================

 * The --source-dir command line option and retainsources configuration
   variable have been removed as the feature of downloading source
   packages corresponding to the installed binary packages was deemed
   out of scope for multistrap
 * The workarounds for dash not configuring (#546528) and absolute
   /lib64 symlinks (#553599) were dropped as they are not needed anymore
 * Removed support for dpkg without multiarch

3. Changed behaviour
====================

 * They keyring setting does not accept packages anymore but either
   keyring files or directories with .gpg files in them. This is so that
   multistrap does not have to install a package on the host system (which
   requires superuser privileges) nor is it anymore required that the apt
   sources of the host system contain the right mirrors to retrieve the
   desired keyring packages nor is it anymore required that the selected
   keyring package stores the keyring at the location where sbuild expects
   them.
 * Any additional keyring package now has to be manually listed in the
   packages setting as they are no longer installed automatically. This
   now also makes it possible to bootstrap a system without the keyring
   packages that were required to install it.
 * Die if setupscripts, configscripts or hook produce an error instead
   of continuing.
 * Die if the specified debconf seed file does not exist.
 * Be more unforgiving about problems. Previous to this commit,
   multistrap would
    - skip loop iterations with invalid values
    - print a warning if errors happen but continue anyways
   Now we die with an appropriate error message immediately.
 * The component now has to be passed explicitly in each section

4. New features
===============

 * Configuration files can now be nested arbitrarily deeply.
 * All configuration variables are documented together with their
   default values and data types.
 * Dumping the configuration settings creates another valid
   configuration file. This can be used to merge multiple configuration
   files into a single one containing the resulting settings.

5. Regressions
==============

 * The translations need updating for the new and changed strings.

6. Code quality improvements
============================

6.1. General
------------

 * Replaced 80 global variables by 2 which are only used for reading.
 * Removed unused variables.
 * Removed unused or superfluous code.
 * Functions have no side-effects on variables anymore. Everything they
   compute is part of their return value.
 * Instead of using "." and join() to create a whitespace delimitered
   string which is then split(), push to an array in the first place.
 * Make file a modulino to let it be used as a program and module at the
   same time. This allows the unit tests to import functions from it.
 * Use Getopt::Long for option parsing.
 * Use Pod::Usage for --help and man output.

6.2. Less dependencies
----------------------

 * Drop dependency on Config::Auto for Config::IniFiles. The latter
   comes with support for all sorts of configuration file formats which
   we do not need. The later offers features not exposed by the former
   (like automatically ignoring case) which in turn simplifies the code.
 * Replace Locale::gettext by Dpkg::Gettext which makes the availability
   of gettext optional. Dpkg::Gettext is available anyway because we
   plan to use Dpkg::Index instead of Parse::Debian::Packages.

6.3. Unit tests
---------------

Add tests:
 - t/config.t for the recursive ini file reader
 - t/critic.t for perlcritic
 - t/perltidy.t for perltidy
2017-01-02 11:31:42 +01:00

1746 lines
58 KiB
Perl
Executable file
Raw Blame History

#!/usr/bin/perl
# vim: tabstop=4:shiftwidth=4:softtabstop=4:expandtab
# Copyright (C) 2009-2015 Neil Williams <codehelp@debian.org>
# Copyright (C) 2015-2017 Johannes Schauer <josch@mister-muffin.de>
#
# 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/>.
package multistrap;
# This allows one to use this file as an application with main() as the entry
# point as well as a module to allow unit testing
__PACKAGE__->main() unless caller();
use strict;
use warnings;
use IO::File;
use Config::IniFiles;
use Cwd qw (realpath getcwd);
use File::Basename;
use Parse::Debian::Packages; # FIXME: use Dpkg::Index instead
use POSIX qw(locale_h);
use Dpkg::Gettext;
use File::Copy;
use List::Util qw(any all none);
use Text::Wrap;
use Getopt::Long;
use Pod::Usage;
sub main {
setlocale(LC_MESSAGES, "");
textdomain("multistrap");
my $progname = basename($0);
my $options = {};
# The long option must come before the short option because the first
# option will become the key in the $options hash.
#
# --man is a hidden option (not documented)
GetOptions ($options, 'help|h', 'man', 'simulate|dry-run', 'shortcut|s=s',
'file|f=s', 'arch|a=s', 'directory|d=s', 'tidy-up!', 'source-dir=s', 'auth!'
) or pod2usage(2);
pod2usage(1) if ($options->{help});
pod2usage(-exitval => 0, -verbose => 2) if ($options->{man});
pod2usage(-message => "Mandatory argument -f or --file is missing.\n",
-exitval => 1, -verbose => 1) if (! exists $options->{file});
if (exists $options->{shortcut} && exists $options->{file}) {
die (_g("Options --shortcut and --file are mutually exclusive\n"));
}
my $file;
if (exists $options->{shortcut} && defined $options->{shortcut}) {
# FIXME: use ~/.config/multistrap and XDG paths as well
my $short = "/usr/share/multistrap/".$options->{shortcut}.".conf";
$file = $short if (-f $short);
$short = "/etc/multistrap.d/".$options->{shortcut}.".conf";
$file = $short if (-f $short);
} elsif (exists $options->{file} && defined $options->{file}) {
}
if (not defined $file) {
die (sprintf (_g("Need a configuration file - use %s -f\n"), $progname));
}
my $cachedir = "var/cache/apt/"; # archives
my $libdir = "var/lib/apt/"; # lists
my $etcdir = "etc/apt/"; # sources
my $dpkgdir = "var/lib/dpkg/"; # state
# The "config" is read from configuration files.
# The "options" come from the command line.
# The "settings" are the config and options together.
my $config_tree = parse_ini($file);
my $config = get_config_from_tree($config_tree);
my $settings = resolve_settings();
# Overwrite settings from the configuration file with settings from the
# command line
if (exists $options->{arch}) {
$settings->{general}{arch} = $options->{arch};
}
if (exists $options->{directory}) {
$settings->{general}{directory} = $options->{directory};
}
if (exists $options->{'tidy-up'}) {
$settings->{general}{cleanup} = $options->{'tidy-up'};
}
if (exists $options->{'source-dir'}) {
$settings->{general}{retainsources} = $options->{'source-dir'};
}
if (exists $options->{auth}) {
$settings->{general}{noauth} = !$options->{auth};
}
# Translators: fields are programname, include file.
my $host = `dpkg --print-architecture`;
chomp($host);
if ($settings->{general}{omitrequired} and $settings->{general}{addimportant}) {
warn("\n"._g("Error: Cannot set 'add Priority: important' when packages ".
"of 'Priority: required' are being omitted.\n"));
if (defined $options->{simulate}) {
warn("\n");
&dump_settings;
exit 0;
}
exit (7);
}
if (defined $options->{simulate}) {
&dump_settings;
exit 0;
}
my @debootstrap = uniq_sort (@{$settings->{general}{debootstrap}}, @{$settings->{general}{bootstrap}});
my @aptsources = uniq_sort (@{$settings->{general}{aptsources}});
# Translators: fields are: programname, configfile.
printf (_g("%s using %s\n"), $progname, $file);
my $arch = $settings->{general}{arch};
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);
}
my $foreign;
$foreign++ if (($host ne $arch) or ($settings->{general}{ignorenative}));
my $dir = $settings->{general}{directory};
if (not defined $dir or not defined $arch) {
&dump_settings;
exit 3;
}
unless (keys %sources) {
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");
$warn_count++;
my $l = prepare_sources_list();
$deflist = join ("", @$l);
}
# Translators: fields are: programname, architecture, host architecture.
printf (_g("%s building %s multistrap on '%s'\n"), $progname, $arch, $host);
if ($dir =~ /^$/) {
my $msg = _g("No directory specified!");
die "$progname: $msg\n";
}
&mkdir_fatal ($dir);
$dir = realpath ($dir);
$dir .= ($dir =~ m:/$:) ? '' : "/";
system_fatal ("mkdir -p " . shellescape("${dir}${cachedir}")) if (not -d "${dir}${cachedir}");
system_fatal ("mkdir -p " . shellescape("${dir}${libdir}")) if (not -d "${dir}${libdir}");
system_fatal ("mkdir -p " . shellescape("${dir}${dpkgdir}")) if (not -d "${dir}${dpkgdir}");
system_fatal ("mkdir -p " . shellescape("${dir}etc/apt/sources.list.d/"))
if (not -d "${dir}etc/apt/sources.list.d/");
system_fatal ("mkdir -p " . shellescape("${dir}etc/apt/trusted.gpg.d/"))
if (not -d "${dir}etc/apt/trusted.gpg.d/");
system_fatal ("mkdir -p " . shellescape("${dir}etc/apt/preferences.d/"))
if (not -d "${dir}etc/apt/preferences.d/");
system_fatal ("mkdir -p " . shellescape("${dir}usr/share/info/"))
if (not -d "${dir}usr/share/info/");
system_fatal ("touch " . shellescape("${dir}usr/share/info/dir"));
if (defined $preffile) {
open (PREF, "$preffile") or die ("$progname: $preffile $!");
my @prefs=<PREF>;
close (PREF);
my $name = basename($preffile);
open (MPREF, ">${dir}etc/apt/preferences.d/$name") or die ("$progname: $name $!");
print MPREF @prefs;
close (MPREF);
}
my @dirs = qw/ alternatives info parts updates /;
my @touch = qw/ arch diversions statoverride status lock/;
foreach my $dpkgd (@dirs) {
if (not -d "${dir}${dpkgdir}$dpkgd") {
mkdir_fatal ("${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_fatal ("${dir}etc/network");
}
if (not -d "${dir}dev") {
mkdir_fatal ("${dir}dev");
}
if (scalar (@foreignarches) > 0) {
open (VMA, ">${dir}${dpkgdir}arch");
print VMA "$host\n";
foreach my $farch (@foreignarches) {
print VMA "$farch\n";
}
close (VMA);
}
&guard_lib64($dir);
system_fatal ("rm -rf " . shellescape("${dir}etc/apt/sources.list.d") . "/*");
unlink ("${dir}etc/apt/sources.list")
if (-f "${dir}etc/apt/sources.list");
foreach my $repo (sort keys %suites) {
if (not -e "${dir}${cachedir}") {
mkdir_fatal ("${dir}${cachedir}");
}
if (not -e "$dir/${libdir}lists") {
mkdir_fatal ("$dir/${libdir}lists");
}
if (not -e "$dir/${libdir}lists/partial") {
mkdir_fatal ("$dir/${libdir}lists/partial");
}
if (not -e "$dir/${cachedir}archives") {
mkdir_fatal ("$dir/${cachedir}archives");
}
if (not -e "$dir/${cachedir}archives/partial") {
mkdir_fatal ("$dir/${cachedir}archives/partial");
}
if (not -e "${dir}${etcdir}apt.conf.d") {
mkdir_fatal ("${dir}${etcdir}apt.conf.d");
}
}
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"). $!;
my $mirror = $sources{$aptsrc};
my $suite = (exists $flatfile{$aptsrc}) ? "" : $suites{$aptsrc};
my $component = (exists $flatfile{$aptsrc}) ? ""
: (defined $components{$aptsrc}) ? $components{$aptsrc} : "main";
if (defined $mirror and defined $suite) {
if (scalar (@foreignarches) == 0) {
print SOURCES "deb [arch=$arch] $mirror $suite $component\n";
} else {
foreach my $farch (@foreignarches) {
print SOURCES "deb [arch=$farch] $mirror $suite $component\n";
}
}
print SOURCES "deb-src $mirror $suite $component\n" if (not defined $omitdebsrc{$aptsrc});
close SOURCES;
}
}
}
my $k;
# FIXME: remove duplicates from %keyrings
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: Downloading %s\n"), $k);
system ("apt-get -y download $k");
foreach my $keyring_pkg (values %keyrings) {
next if (not defined $keyring_pkg);
my @files=();
my $file = `find ./ -name "${keyring_pkg}_*_all.deb"|grep -m1 $keyring_pkg`;
chomp ($file);
if ($file eq "") {
my $msg = sprintf (_g("Unable to download keyring package: '%s'"),$dir);
die "$progname: $msg\n";
}
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/);
File::Copy::copy "${xdir}/usr/share/keyrings/${gpg}", "${dir}${etcdir}trusted.gpg.d/";
}
system ("rm -rf ${xdir}");
# FIXME: if the globbing was too aggressive, then this
# will remove files that are needed later
unlink ($file);
}
}
my $pre_config_str = '';
$pre_config_str .= "Dir::Etc \"${dir}${etcdir}\";\n";
$pre_config_str .= "Dir::Etc::Parts \"${dir}${etcdir}apt.conf.d/\";\n";
$pre_config_str .= "Dir::Etc::PreferencesParts \"${dir}${etcdir}preferences.d/\";\n";
my $tmp_apt_conf = `mktemp -t multistrap.XXXXXX`;
chomp ($tmp_apt_conf);
open CONFIG, ">$tmp_apt_conf";
print CONFIG $pre_config_str;
close CONFIG;
my $config_str = '';
$config_str .= " -o Apt::Architecture=" . shellescape($arch);
$config_str .= " -o Dir::Etc::TrustedParts=" . shellescape("${dir}${etcdir}trusted.gpg.d");
$config_str .= " -o Dir::Etc::Trusted=" . shellescape("${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"
if (not defined $allow_recommends);
$config_str .= " -o Dir=" . shellescape($dir);
$config_str .= " -o Dir::Etc=" . shellescape("${dir}${etcdir}");
$config_str .= " -o Dir::Etc::Parts=" . shellescape("${dir}${etcdir}apt.conf.d/");
$config_str .= " -o Dir::Etc::PreferencesParts=" . shellescape("${dir}${etcdir}preferences.d/");
$config_str .= " -o APT::Default-Release=" . shellescape($default_release) if (defined $default_release);
# if (not defined $preffile);
if (defined $deflist) {
my $sourcesname = "sources.list.d/multistrap.sources.list";
$config_str .= " -o Dir::Etc::SourceList=" . shellescape("${dir}${etcdir}$sourcesname");
}
$config_str .= " -o Dir::State=" . shellescape("${dir}${libdir}");
$config_str .= " -o Dir::State::Status=" . shellescape("${dir}${dpkgdir}status");
$config_str .= " -o Dir::Cache=" . shellescape("${dir}${cachedir}");
my $apt_get = "APT_CONFIG=" . shellescape($tmp_apt_conf) . " apt-get $config_str";
my $apt_mark = "APT_CONFIG=" . shellescape($tmp_apt_conf) . " apt-mark $config_str";
printf (_g("Getting package lists: %s update\n"), $apt_get);
my $retval = system ("$apt_get update");
$retval >>= 8;
die (sprintf (_g("apt update failed. Exit value: %d\n"), $retval))
if ($retval != 0);
my @s = ();
$str = "";
if (not defined $omitrequired) {
print _g("I: Calculating required packages.\n");
my %required = &get_required_debs($libdir);
$str .= join (' ', keys %required);
if (defined $addimportant) {
my $imps = join (' ', sort keys %important);
printf(_g("I: Adding 'Priority: important': %s\n"), $imps);
$str .= " ".$imps;
}
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);
foreach my $keystr (values %keyrings) {
next if (not defined $keystr);
$str .= " " . $keystr . " ";
}
chomp($str);
@s = split (/ /, $str);
@s = uniq_sort (@s);
$str = join (' ', @s);
print "$apt_get -y install $str\n";
$retval = 0;
$retval = system ("$apt_get -y install $str");
$retval >>= 8;
die (sprintf (_g("apt download failed. Exit value: %d\n"),$retval))
if ($retval != 0);
&force_unpack($cachedir, $libdir, $dpkgdir) if ($unpack eq "true");
&mark_manual_install ($apt_mark, $cachedir, $str) if (defined $markauto);
system ("touch " . shellescape("${dir}${libdir}lists/lock"));
if ((defined $setupsh) and (-x $setupsh)) {
$retval = 0;
$retval = system (shellescape($setupsh) . " " . shellescape($dir) . " $arch");
$retval >>= 8;
if ($retval != 0) {
warn sprintf(_g("setupscript '%s' returned %d.\n"), $setupsh, $retval);
$warn_count++;
}
}
# run first set of hooks - probably unnecessary re setupscript.
&run_download_hooks(sort @{$hooks{'D'}}) if (defined $hooks{'D'});
my $err = &native if (not defined ($foreign) and $unpack eq "true");
if (defined $err and $err != 0) {
warn (_g("Native mode configuration reported an error!\n"));
$warn_count++;
}
&add_extra_packages($apt_get, $cachedir, $libdir, $dpkgdir);
system ("cp " . shellescape($configsh) . " " . shellescape("$dir/")) if ((defined $configsh) and (-f $configsh));
&handle_source_packages($apt_get, $cachedir, $dpkgdir);
(not defined $tidy) ? system ("$apt_get update") : &tidy_apt($cachedir, $libdir);
&guard_lib64($dir);
# cleanly separate the bootstrap 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:^multistrap-.*\.list$:, 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"). $!;
my $mirror = $sources{$aptsrc};
my $suite = (exists $flatfile{$aptsrc}) ? "" : $suites{$aptsrc};
my $component = (exists $flatfile{$aptsrc}) ? ""
: (defined $components{$aptsrc}) ? $components{$aptsrc} : "main";
if (defined $mirror and defined $suite) {
if (scalar (@foreignarches) == 0) {
print SOURCES "deb [arch=$arch] $mirror $suite $component\n";
} else {
foreach my $farch (@foreignarches) {
print SOURCES "deb [arch=$farch] $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 update") : &tidy_apt($cachedir, $libdir);
# run second set of hooks
&run_completion_hooks(sort @{$hooks{'A'}}) if (defined ($hooks{'A'}));
unlink $tmp_apt_conf;
if (not defined $warn_count) {
printf (_g("\nMultistrap system installed successfully in %s.\n"), $dir);
} else {
my $plural = sprintf(ngettext ("\nMultistrap system reported %d error in %s.\n",
"\nMultistrap system reported %d errors in %s.\n", $warn_count), $warn_count, $dir);
warn ($plural);
$warn_count++;
}
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 " . shellescape("../$tgzname ."));
$retval >>= 8;
if ($retval == 0) {
printf (_g("\nRemoving build directory: '%s'\n"), $dir);
system ("rm -rf " . shellescape($dir) . "/*");
}
my $final_path=realpath ("$dir/../$tgzname");
if (not defined $warn_count) {
printf (_g("\nMultistrap system packaged successfully as '%s'.\n"), $final_path);
} else {
warn sprintf(_g("\nMultistrap system packaged as '%s' with warnings.\n"), $final_path);
}
}
print "\n";
if (not defined $warn_count) {
exit 0;
} else {
exit $warn_count;
}
}
# avoid dependency on String::ShellQuote by implementing the mechanism
# from python's shlex.quote function
sub shellescape {
my $string = shift;
if (length $string == 0) {
return "''";
}
# search for occurrences of characters that are not safe
# the 'a' regex modifier makes sure that \w only matches ASCII
if ($string !~ m/[^\w@\%+=:,.\/-]/a) {
return $string;
}
# wrap the string in single quotes and handle existing single quotes by
# putting them outside of the single-quoted string
$string =~ s/'/'"'"'/g;
return "'$string'";
}
sub add_extra_packages {
my $apt_get = shift;
my $cachedir = shift;
my $libdir = shift;
my $dpkgdir = shift;
if (scalar @extrapkgs > 0) {
$str = join (' ', @extrapkgs);
print "$apt_get -y install $str\n";
system ("$apt_get -y install $str");
&force_unpack ($cachedir, $libdir, $dpkgdir, @extrapkgs) if ($unpack eq "true");
system ("touch " . shellescape("${dir}${libdir}lists/lock"));
&native if (not defined ($foreign));
}
}
sub mark_manual_install {
my $apt_mark = shift;
my $cachedir = shift;
my @manual = split(/ +/, $_[0]);
printf (_g("Marking automatically installed packages... please wait\n"));
opendir (DEBS, "${dir}${cachedir}archives/")
or die (_g("Cannot read apt archives directory.\n"));
my @archives=grep(/.*\.deb$/, readdir DEBS);
closedir (DEBS);
my @all = map {
my $escaped_path = shellescape("${dir}${cachedir}archives/$_");
`LC_ALL=C dpkg -f $escaped_path Package`;
} @archives;
chomp (@all);
my @auto = grep {my $pkg = $_; ! grep /$pkg/, @manual} @all;
printf(ngettext ("Found %d package to mark.\n",
"Found %d packages to mark.\n", scalar @auto), scalar @auto);
system ("$apt_mark auto " . join (" ", sort @auto)) if (scalar @auto > 0);
printf (_g("Marking automatically installed packages completed.\n"));
}
sub force_unpack {
my $cachedir = shift;
my $libdir = shift;
my $dpkgdir = shift;
my (@limits) = @_;
my %unpack=();
my %filter = ();
opendir (DEBS, "${dir}${cachedir}archives/")
or die (_g("Cannot read apt archives directory.\n"));
my @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 my $deb (sort @archives) {
my $escaped_path = shellescape("${dir}${cachedir}archives/$deb");
my $version = `LC_ALL=C dpkg -f $escaped_path Version`;
my $package = `LC_ALL=C dpkg -f $escaped_path Package`;
chomp ($version);
chomp ($package);
if (exists $unpack{$package}) {
my $test=system("dpkg --compare-versions ". shellescape($unpack{$package}) . " '<<' " . shellescape($version));
$test >>= 8;
# 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 my $deb (sort @archives) {
printf (_g("I: Extracting %s...\n"), $deb);
my $escaped_path = shellescape("./${cachedir}archives/$deb");
my $ver=`LC_ALL=C dpkg -f $escaped_path Version`;
my $pkg=`LC_ALL=C dpkg -f $escaped_path Package`;
my $src=`LC_ALL=C dpkg -f $escaped_path Source`;
my $multi=`LC_ALL=C dpkg -f $escaped_path Multi-Arch`;
chomp ($ver);
chomp ($pkg);
chomp ($src);
chomp ($multi);
if (($multi eq "foreign") or ($multi eq "allowed")) {
$multi = '';
} elsif ($multi eq "same") {
# actually need dpkg multi-arch support implemented before this can be active.
#$multi=":".`LC_ALL=C dpkg -f ./${cachedir}archives/$deb Architecture`;
#chomp ($multi);
$multi = '';
if ($multi eq ":all") {
# Translators: imagine "Architecture: all" in quotes.
my $msg = sprintf(_g("Warning: invalid value '%s' for Multi-Arch field in Architecture: all package: %s. "), $multi, $deb);
warn ("$msg\n");
$multi = '';
}
} elsif ($multi ne '') {
# Translators: Please do not translate 'same', 'foreign' or 'allowed'
my $msg = sprintf(_g("Warning: unrecognised value '%s' for Multi-Arch field in %s. ".
"(Expecting 'same', 'foreign' or 'allowed'.)"), $multi, $deb);
warn ("$msg\n");
$multi = '';
}
$src =~ s/ \(.*\)//;
$src = $pkg if ($src eq "");
push @dsclist, $src;
mkdir_fatal ("./tmp");
my $tmpdir = `mktemp -p ./tmp -d -t multistrap.XXXXXX`;
chomp ($tmpdir);
my $escaped_path1 = shellescape("./${cachedir}archives/$deb");
my $escaped_path2 = shellescape($dir);
my $datatar = `LC_ALL=C dpkg -X $escaped_path1 $escaped_path2`;
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}${multi}.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${multi}.$mscript";
if ( $mscript eq "control" ) {
open (MSCRIPT, "./${dpkgdir}info/$pkg${multi}.$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/$pkg${multi}.$mscript");
}
}
close (AVAIL);
if ( -f "./${dpkgdir}info/$pkg${multi}.conffiles") {
print STATUS "Conffiles:\n";
printf (_g(" -> Processing conffiles for %s\n"), $pkg);
open (CONF, "./${dpkgdir}info/$pkg${multi}.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}");
&guard_lib64 ($dir);
}
chdir ("$old");
# update-alternatives helper / preinst helper
if (not -d "${dir}usr/share/man/man1") {
&mkdir_fatal ("${dir}usr/share/man/man1");
}
print _g("I: Unpacking complete.\n");
foreach my $seed (@debconf) {
next if (not -f $seed);
open (SEED, "$seed") or next;
my @s=<SEED>;
close (SEED);
my $sfile = basename($seed);
printf (_g("I: Copying debconf preseed data to %s.\n"), $sfile);
mkdir_fatal ("${dir}/tmp/preseeds");
open (SEED, ">${dir}tmp/preseeds/$sfile");
print SEED @s;
close (SEED);
}
}
sub run_download_hooks {
my (@hooks) = @_;
return if (scalar @hooks == 0);
# Translators: the plural is followed by a single repeat for each
printf(ngettext("I: Running %d post-download hook\n",
"I: Running %d post-download hooks\n", scalar @hooks), scalar @hooks);
foreach my $hookscript (@hooks) {
# Translators: this is a single instance, naming the hook
printf (_g("I: Running post-download hook: '%s'\n"), basename($hookscript));
my $hookret = system (shellescape($hookscript) . " " . shellescape($dir));
$hookret >>= 8;
if ($hookret != 0) {
printf (_g("I: post-download hook '%s' reported an error: %d\n"), basename($hookscript), $hookret);
$warn_count += abs($hookret);
}
}
}
sub run_native_hooks_start {
my (@hooks) = @_;
return if (scalar @hooks == 0);
# Translators: the plural is followed by a single repeat for each
printf(ngettext("I: Starting %d native hook\n",
"I: Starting %d native hooks\n", scalar @hooks), scalar @hooks);
foreach my $hookscript (@hooks) {
# Translators: this is a single instance, naming the hook
printf (_g("I: Starting native hook: '%s'\n"), basename($hookscript));
my $hookret = system (shellescape($hookscript) . " " . shellescape($dir) . " start");
$hookret >>= 8;
if ($hookret != 0) {
printf (_g("I: run-native hook start '%s' reported an error: %d\n"), basename($hookscript), $hookret);
$warn_count += abs($hookret);
}
}
}
sub run_native_hooks_end {
my (@hooks) = @_;
return if (scalar @hooks == 0);
# Translators: the plural is followed by a single repeat for each
printf(ngettext("I: Stopping %d native hook\n",
"I: Stopping %d native hooks\n", scalar @hooks), scalar @hooks);
foreach my $hookscript (@hooks) {
# Translators: this is a single instance, naming the hook
printf (_g("I: Stopping native hook: '%s'\n"), basename($hookscript));
my $hookret = system (shellescape($hookscript) . " " . shellescape($dir) . " end");
$hookret >>= 8;
if ($hookret != 0) {
printf (_g("I: run-native hook end '%s' reported an error: %d\n"), basename($hookscript), $hookret);
$warn_count += abs($hookret);
}
}
}
sub run_completion_hooks {
my (@hooks) = @_;
return if (scalar @hooks == 0);
# Translators: the plural is followed by a single repeat for each
printf(ngettext("I: Running %d post-configuration hook\n",
"I: Running %d post-configuration hooks\n", scalar @hooks), scalar @hooks);
foreach my $hookscript (@hooks) {
# Translators: this is a single instance, naming the hook
printf (_g("I: Running post-configuration hook: '%s'\n"), basename($hookscript));
my $hookret = system (shellescape($hookscript) . " " . shellescape($dir));
$hookret >>= 8;
if ($hookret != 0) {
printf (_g("I: run-completion hook '%s' reported an error: %d\n"), basename($hookscript), $hookret);
$warn_count += abs($hookret);
}
}
}
# prevent the absolute symlink in libc6 from allowing
# writes outside the multistrap root dir. See: #553599
sub guard_lib64 {
my $dir = shift;
my $old = `pwd`;
chomp ($old);
unlink "${dir}lib64" if (-f "${dir}lib64");
if (-l "${dir}lib64" ) {
my $r = readlink "${dir}lib64";
chomp ($r);
if ($r =~ m:^/lib$:) {
printf (_g("I: Unlinking unsafe %slib64 -> /lib symbolic link.\n"), $dir);
unlink "${dir}lib64";
}
} elsif (not -d "${dir}lib64") {
chdir ("$dir");
my $host = `dpkg --print-architecture`;
chomp($host);
if ($host eq 'i386' and $arch eq 'amd64') {
printf (_g("I: Replaced ./lib64 -> /lib symbolic link with new %slib64 directory.\n"), $dir);
mkdir_fatal ("${dir}lib64");
} else {
printf (_g("I: Setting %slib64 -> %slib symbolic link.\n"), $dir, $dir);
symlink "./lib", "lib64";
}
}
chdir ("${old}");
}
sub check_bin_sh {
$dir = shift;
my $old = `pwd`;
chomp ($old);
my $host = `dpkg --print-architecture`;
chomp($host);
# 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");
unlink ("$dir/var/lib/dpkg/info/dash:${host}.postinst");
# now ensure that a usable shell is available as /bin/sh
if (not -l "$dir/bin/sh") {
print (_g("I: ./bin/sh symbolic link does not exist.\n"));
if (-f "$dir/bin/dash") {
print (_g("I: Setting ./bin/sh -> ./bin/dash\n"));
chdir ("$dir/bin");
symlink ("dash", "sh");
chdir ("$old");
} elsif (-f "$dir/bin/bash") {
print (_g("I: ./bin/dash not found. Setting ./bin/sh -> ./bin/bash\n"));
chdir ("$dir/bin");
symlink ("bash", "sh");
chdir ("$old");
}
}
if (-l "$dir/bin/sh") {
printf (_g("I: Shell found OK in %s:\n"), "${dir}bin/sh");
system ("(cd " . shellescape($dir) . " ; ls -lh bin/sh)");
} else {
die ("No shell in $dir.");
}
}
sub handle_source_packages {
my $apt_get = shift;
my $cachedir = shift;
my $dpkgdir = shift;
return if (not defined $sourcedir);
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) {
my $escaped_path = shellescape("${dir}${cachedir}archives/$file");
my $srcname = `LC_ALL=C dpkg -f $escaped_path Source`;
chomp ($srcname);
$srcname =~ s/ \(.*\)//;
if ($srcname eq "") {
my $srcname = `LC_ALL=C dpkg -f $escaped_path Package`;
chomp ($srcname);
}
push @dsclist, $srcname;
}
}
}
print "Checking ${dir}${dpkgdir}status\n";
if (-f "${dir}${dpkgdir}status") {
open (STATUS, "${dir}${dpkgdir}status");
my @lines=<STATUS>;
close (STATUS);
my $pkg;
my $src;
foreach my $line (@lines) {
if ($line =~ /^Package: (.*)$/) {
$pkg = $1;
}
if ($line =~ /^Source: (.*)$/) {
my $c = $1;
$c =~ s/\(.*\)$//;
$c =~ s/ //g;
push @dsclist, $c;
$src = $c;
}
if ($line =~ /^$/) {
push @dsclist, $pkg if (not defined $src and defined $pkg);
undef $pkg;
undef $src;
}
}
}
@dsclist = uniq_sort (@dsclist);
my $olddir = getcwd();
chdir ($sourcedir);
if (scalar @dsclist > 0) {
print "$apt_get -d source " . join (" ", @dsclist) . "\n";
foreach my $srcpkg (@dsclist) {
system ("$apt_get -d source $srcpkg");
}
}
chdir ($olddir);
}
sub tidy_apt {
my $cachedir = shift;
my $libdir = shift;
print _g("I: Tidying up apt cache and list data.\n");
if ($unpack eq "true") {
# FIXME: use apt-get clean instead
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 " . shellescape("${dir}${cachedir}archives/$file") . " " . shellescape("$sourcedir/$file"));
} else {
unlink ("${dir}${cachedir}archives/$file");
}
}
$sourcedir=undef;
}
# FIXME: use apt-get update -o Dir::Etc::SourceList= -o Dir::Etc::SourceParts=
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");
}
# FIXME: why are there .bin files in /var/cache/apt?
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 native arch, do a few tasks just because we can and probably should.
sub native {
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 (exists $ENV{FAKEROOTKEY}) {
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 ($ENV{USER} eq 'root') {
$str = "sudo" if (-f "/usr/bin/sudo");
}
# check that we have a workable shell inside the chroot
&check_bin_sh("$dir");
# pre-populate debconf
if (-d "${dir}/tmp/preseeds/") {
opendir (SEEDS, "${dir}/tmp/preseeds/") or return;
my @seeds=grep(!m:\.\.?$:, readdir SEEDS);
closedir (SEEDS);
foreach my $s (@seeds) {
printf (_g("I: Running debconf for seed file: %s\n"), $s);
system ("$str $env chroot " . shellescape($dir) . " debconf-set-selections /tmp/preseeds/$s");
}
}
&run_native_hooks_start(sort @{$hooks{'N'}}) if (defined ($hooks{'N'}));
if (not defined $omitpreinst) {
opendir (PRI, "${dir}/var/lib/dpkg/info") or return;
my @preinsts=grep(/\.preinst$/, readdir PRI);
closedir (PRI);
printf (_g("I: Running preinst scripts with 'install' 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 " . shellescape($dir) . " /var/lib/dpkg/info/$script install");
}
}
my $retval = 0;
$retval = system ("$str $env chroot " . shellescape($dir) . " dpkg --configure -a");
$retval >>=8;
if ($retval != 0) {
warn (_g("ERR: dpkg configure reported an error.\n"));
}
# reinstall set
foreach my $reinst (sort @reinstall) {
system ("$str $env chroot " . shellescape($dir) . " apt-get --reinstall -y install $reinst");
}
&run_native_hooks_end(sort @{$hooks{'N'}}) if (defined $hooks{'N'});
return $retval;
}
sub get_required_debs {
my $libdir = shift;
# 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 %listfiles=();
# FIXME: use apt-get indextargets --format '$(FILENAME)' "Created-By: Packages" | xargs --delimiter=\\\\n /usr/lib/apt/apt-helper cat-file
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) {
# FIXME: instead of requiring libparse-debian-packages-perl, use
# Dpkg::Index
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'});
if ($package{'Priority'} eq "required") {
$required{$package{'Package'}}++;
} elsif ($package{'Priority'} eq "important") {
$important{$package{'Package'}}++;
}
}
}
return %required;
}
# 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 {
my $progname = basename($0);
printf STDERR (_g("
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
# enable MultiArch for the specified architectures
# default is empty
multiarch=
# 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=Debian
# 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://http.debian.net/debian
keyring=debian-archive-keyring
suite=stable
This will result in a completely normal bootstrap of Debian stable 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 bootstap 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, $progname, $progname)
or die ("$progname: ". _g("failed to write usage:") . "$!\n");
}
my $general_spec = {
arch => {
type => 'string',
help => 'Native architecture'},
directory => {
type => 'string',
help => 'Output directory'
},
cleanup => {
type => 'bool',
default => 1,
help => 'remove apt cache data'
},
noauth => {
type => 'bool',
default => 0,
help => 'Allow the use of unauthenticated repositories'
},
unpack => {
type => 'bool',
default => 1,
help => 'Extract all downloaded archives'
},
explicitsuite => {
type => 'bool',
default => 0,
help => 'Suite explicitly selected instead of using latest versions.'
},
aptsources => {
type => 'section',
list => 1,
help => ''
},
bootstrap => {
type => 'section',
list => 1,
help => ''
},
omitrequired => {
type => 'bool',
default => 0,
help => ''
},
addimportant => {
type => 'bool',
default => 0,
help => ''
},
debootstrap => {
type => 'section',
list => 1,
default => [],
help => ''
},
bootstrap => {
type => 'section',
list => 1,
default => [],
help => ''
},
ignorenative => {
type => 'bool',
default => 0,
help => ''
},
retainsources => {
type => 'string',
help => ''
},
};
my $section_spec = {
packages => {
type => 'stringlist',
list => 1,
default => [],
help => ''
},
source => {
type => 'string',
list => 1,
help => ''
},
keyring => {
type => 'string',
list => 1,
default => [],
help => ''
},
suite => {
type => 'string',
help => ''
},
omitdebsrc => {
type => 'bool',
default => 0,
help => ''
},
};
sub get_inclduegraph_from_tree {
my $config_tree = shift;
if (!exists $config_tree->{general}{include}) {
return [];
}
# Traverse the tree in depth-first-search order.
#
# If the same file occurs in multiple branches of the tree, then the
# resulting graph will be a directed acyclic graph and not a tree
# anymore.
my $includegraph = [];
sub visit {
my $acc = shift;
my $n = shift;
# The origin of the includes in this file must exactly be one file
# and not the result of a merge of two or more files.
if (scalar @{$n->[2]} != 1) {
die "Include statements were merged but that is forbidden";
}
# Add an edge from the filename of this node to all files that it
# included.
my $f = $n->[2]->[0];
for my $i (@{$n->[0]}) {
# Make the filename absolute instead of relative to the
# current file
push @{$acc}, [$f, dirname($f) . '/' . $i];
}
# Recurse.
for my $c (@{$n->[1]}) {
visit($acc, $c);
}
};
visit($includegraph, $config_tree->{general}{include});
return $includegraph;
}
sub get_config_from_tree {
my $config_tree = shift;
my $config = {};
foreach my $section (keys %{$config_tree}) {
my $spec;
if ($section eq "general") {
$spec = $general_spec;
} else {
$spec = $section_spec;
}
# First fill the default with the configuration from the spec.
while (my ($k, $v) = each %{$spec}) {
# Do not set values from the spec that do not have a default
if (! exists $v->{default}) {
next;
}
$config->{$section}{$k} = $v->{default};
}
# Then overwrite the default values with what was read from the config.
while (my ($k, $v) = each %{$config_tree->{$section}}) {
if (! exists $spec->{$k}) {
printf("unknown property: $k\n");
next;
}
# The "include" parameter of the "general" section is the only one
# where we are interested in more values than from the root node of
# the config tree. We do not handle it here.
if ($section eq 'general' && $k eq 'include') {
next;
}
# Make sure that non-list-type values contain no more than one element
if (scalar @{$v->[0]} > 1 && $spec->{$k}{list} != 1) {
die "property $k must not be a list";
}
my @value;
# Convert and validate config settings.
if ($spec->{$k}{type} eq 'string') {
@value = @{$v->[0]};
} elsif ($spec->{$k}{type} eq 'bool') {
my @valid_bool = ('true', 'false', 'yes', 'no', '1', '0');
# Check if the given value can be interpreted as a boolean.
foreach my $b (@{$v->[0]}) {
if (none {lc($b) eq $_} @valid_bool) {
die "property $k is not a valid boolean";
}
}
# Check if the given value evaluates to true.
sub is_true {
my $s = shift;
return any { $s eq $_ } ('true', 'yes', '1');
}
@value = map { is_true(lc($_)) } @{$v->[0]};
} elsif ($spec->{$k}{type} eq 'section') {
# Check if the given section name matches an existing section.
foreach my $s (@{$v->[0]}) {
foreach my $t (split /\s+/, $s) {
if (lc($t) eq "general") {
die "section name $t forbidden";
}
if (! exists $config_tree->{lc($t)}) {
die "case-insensitive section name $t not found";
}
}
}
@value = map { lc } (map { split /\s+/ } @{$v->[0]});
} elsif ($spec->{$k}{type} eq 'stringlist') {
@value = map { split /\s+/ } @{$v->[0]};
} else {
die "invalid type: $spec->{$k}{type}";
}
if (exists $spec->{$k}{list} && $spec->{$k}{list} == 1) {
# If this is a list-type value, store it as an array reference
$config->{$section}{$k} = [@value];
} else {
# If this is a non-list value, store its first (and only) value as
# a simple scalar
$config->{$section}{$k} = $value[0];
}
}
}
return $config;
}
# Write a representation of the include graph in dot format to standard output
sub dump_includegraph {
my $includegraph = shift;
print "digraph g {\n";
my %mapping = ();
my $num_verts = 0;
foreach my $e (@{$includegraph}) {
my ($v1, $v2) = @{$e};
if (! exists $mapping{$v1}) {
$mapping{$v1} = $num_verts;
$num_verts += 1;
}
if (! exists $mapping{$v2}) {
$mapping{$v2} = $num_verts;
$num_verts += 1;
}
}
foreach my $v (sort keys %mapping) {
my $i = $mapping{$v};
print " $i [label=\"$v\"];\n";
}
foreach my $e (@{$includegraph}) {
my ($v1, $v2) = @{$e};
my $i1 = $mapping{$v1};
my $i2 = $mapping{$v2};
print " $i1 -> $i2;\n";
}
print "}\n";
return $includegraph;
}
sub dump_settings {
my $settings = shift;
# Get a representation of the configuration sections such that the
# "general" section comes first and is followed by the others in sorted
# order.
my @sections = sort grep !/^general$/ (keys %{$settings})
if (exists $settings->{general}) {
unshift @sections, "general";
}
sub value_formatter {
my $val = shift;
my $type = shift;
if ($type eq "bool") {
if ($val) {
return "true";
} else {
return "false";
}
} elsif ($type eq "section") {
return lc($val);
} elsif ($type eq "stringlist") {
return join " ", @{$val};
} else {
return $val;
}
};
foreach my $section (@sections) {
my $spec;
if ($section eq "general") {
$spec = $general_spec;
} else {
$spec = $section_spec;
}
print("[$section]\n");
foreach my $k (sort keys %{$settings->{$section}}) {
my $v = $settings->{$section}{$k};
my $type = $spec->{$k}{type};
my $t = $spec->{$k}{help};
if (exists $spec->{$k}{default}) {
$t .= " (default: ";
$t .= value_formatter($spec->{$k}{default}, $type);
$t .= ")";
}
$t .= "\n";
print(wrap('# ', '# ', $t));
if (ref $v eq 'ARRAY') {
foreach my $e (@{$v}) {
print("$k=" . value_formatter($e, $type) . "\n");
}
} else {
print("$k=" . value_formatter($v, $type) . "\n");
}
}
}
}
# Given a config.ini, recursively traverses all included ini files and returns
# a hash which represents a merge of the included ini file tree.
#
# Note, that the resulting data structure will even be a tree if the same ini
# is included by multiple siblings.
#
# The first argument is the ini file to parse.
#
# To prevent cycles, the remaining arguments are the set of ini files that
# make the path of the current config to the root to prevent cycles.
#
# The merging is done such that all configuration values that are specified in
# more than one descendant, are represented as nested array refs representing
# the transitive reduction of the configuration file tree that they appeared
# in. We don't use nested hash refs because those would not remain in order.
#
# Nodes in the tree are represented as tuples (array refs) where the first
# element is the list of values stored in the current node and the second
# element is its list of children.
#
# Example:
#
# complex.ini:
# [general]
# include=blub.ini
# include=bla.ini
# property=1
#
# branch1.ini:
# [general]
# include=shared.ini
# property=2
#
# branch2.ini
# [general]
# include=intermediate.ini
# property=3
#
# intermediate.ini
# [general]
# include=shared.ini
# foo=bar
#
# shared.ini
# [general]
# property=4
#
# Result:
#
# my %config = {
# general => {
# include => [
# [ 'branch1.ini', 'branch2.ini' ],
# [
# [ ['shared.ini'], [] ],
# [ ['intermediate.ini'], [
# [ ['shared.ini'], [] ]
# ] ]
# ]
# ],
# property => [
# [ '1' ],
# [
# [ ['2'], [ [ [ '4' ], [] ] ] ],
# [ ['3'], [ [ [ '4' ], [] ] ] ],
# ]
# ],
# foo => [ [ 'bar' ], [] ]
# }
# }
#
# Observations:
#
# - The full include tree is seen in $config{'global'}{'include'}.
# - Part of the tree is seen in $config{'global'}{'property'}. There is no
# "node" for intermediate.ini because it didn't contain the property.
# - $config{'global'}{'foo'} is a simple scalar because it only occurred once
sub parse_ini {
my $file = shift;
my @seen_includes = @_;
# if this is the first call, then seen_includes might be empty. Then
# add ourselves
if (scalar @seen_includes == 0) {
@seen_includes = ($file);
}
my $progname = basename($0);
printf STDERR (_g("%s using %s\n"), $progname, $file);
tie (my %ini, 'Config::IniFiles', (
-file => $file,
-nocase => 1,
-allowedcommentchars => '#',
-handle_trailing_comment => 1))
|| die sprintf(_g("Failed to parse '%s'!\n"), $file);
# Go through all included configs, parse them and put the values from
# the results into the SECOND tuple element (the children of this
# config)
my $config;
if (exists $ini{'general'}{'include'}) {
my @includes;
if (ref ($ini{'general'}{'include'}) eq 'ARRAY') {
@includes = @{$ini{'general'}{'include'}};
} else {
@includes = ($ini{'general'}{'include'});
}
foreach my $include (@includes) {
if (any { $_ eq $include } @seen_includes) {
die "$include was included already. Cyclic or duplicate includes detected.";
}
my $newini = parse_ini(dirname($file).'/'.$include, uniq_sort(@seen_includes, $include));
# merge this configuration into the ones that were read so far
foreach my $section (keys %{$newini}) {
# FIXME: we would like to use "each" but there is
# #849298
foreach my $parameter (keys %{$newini->{$section}}) {
my $value = $newini->{$section}{$parameter};
if (exists $config->{$section}{$parameter}) {
push @{$config->{$section}{$parameter}[1]}, $value;
push @{$config->{$section}{$parameter}[2]}, $include;
} else {
# parameter doesn't exist, so just copy it
$config->{$section}{$parameter} = [ undef, [$value], [$include] ];
}
}
}
}
}
# Go through this config and put the read values into the FIRST tuple
# element
foreach my $section (keys %ini) {
foreach my $parameter (keys %{$ini{$section}}) {
my $value = $ini{$section}{$parameter};
if (ref $value ne 'ARRAY') {
$value = [$value];
}
if (exists $config->{$section}{$parameter}) {
$config->{$section}{$parameter}[0] = $value;
$config->{$section}{$parameter}[2] = [$file];
} else {
$config->{$section}{$parameter} = [ $value, [], [$file] ];
}
}
}
# Go through all config parameters at this level (we don't recurse
# here) and apply a transformation on nodes that were not filled by
# this config file
foreach my $section (keys %{$config}) {
foreach my $parameter (keys %{$config->{$section}}) {
my $value = $config->{$section}{$parameter};
# only operate on this node if its value is not set
if (defined $value->[0]) {
next;
}
if (scalar @{$value->[1]} == 1) {
# if this node only has a single child, replace this node
# by the child
$config->{$section}{$parameter} = $value->[1]->[0];
} else {
# concatenate the values of all leave nodes to the value of
# this node
my @leaves = grep {scalar @{$_->[1]} == 0} @{$value->[1]};
my @nonleaves = grep {scalar @{$_->[1]} != 0} @{$value->[1]};
$config->{$section}{$parameter} = [
# make sure to dereference the leave values so
# that we do not get a nested list
[map({@{$_->[0]}} @leaves)],
[@nonleaves],
[map({@{$_->[2]}} @leaves)]
]
}
}
}
return $config;
}
sub system_fatal {
my $cmd = shift;
my $retval = system ("$cmd");
my $err = $!;
$retval >>= 8;
return if ($retval == 0);
my $msg = sprintf(_g("ERR: system call failed: '%s' %s"), $cmd, $err);
die ("$msg\n");
}
sub mkdir_fatal {
my $progname = basename($0);
my $d = shift;
if (not -d "$d") {
my $ret = system ("mkdir -p " . shellescape($d));
$ret >>= 8 if (defined $ret);
my $msg = sprintf (_g("Unable to create directory '%s'"),$d);
die "$progname: $msg\n" if ($ret != 0);
}
}
sub uniq_sort {
my %uniq;
@uniq{@_} = ();
return sort keys %uniq;
}
__END__
=head1 NAME
multistrap - multiple repository bootstraps
=head1 SYNOPSIS
multistrap [-a ARCH] [-d DIR] -f CONFIG_FILE
multistrap [--simulate] -f CONFIG_FILE
multistrap -?|-h|--help|--version
=head1 OPTIONS
=head2 General Options
=over 8
=item B<-?|-h|--help|--version>
output the help text and exit successfully.
=item B<--dry-run> B<--simulate>
collate all the configuration settings and output a bare summary.
=back
=head2 Configuration Options
These options overwrite values from the given configuration file which is
documented in L<multistrap.conf(5)>.
=over 8
=item B<-a|--arch>
architecture of the packages to put into the multistrap.
=item B<-d|--dir>
directory into which the bootstrap will be installed.
=item B<-f|--file>
configuration file for multistrap [required]
=item B<-s|--shortcut>
shortened version of -f for files in known locations without the .conf suffix.
Searched locations are F</usr/share/multistrap/>, F</etc/multistrap.d/> and
F<~/.config/multistrap>.
=item B<--tidy-up>
remove apt cache data, downloaded Packages files and the apt package cache.
Same as cleanup=true.
=item B<--no-auth>
allow the use of unauthenticated repositories. Same as noauth=true
=item B<--source-dir> DIR
move the contents of var/cache/apt/archives/ from inside the chroot to the
specified external directory, then add the Debian source packages for each
used binary. Same as retainsources=DIR If the specified directory does not
exist, nothing is done. Requires --tidy-up in order to calculate the full list
of source packages, including dependencies.
=back
=head1 DESCRIPTION
blubber
=cut
Reference in a new issue View git blame Copy permalink