You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1287 lines
44 KiB
Perl

#!/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;
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;
# Our two global variables must come before we call main() or they will end up
# being empty.
our $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,
default => [],
help => ''
},
bootstrap => {
type => 'section',
list => 1,
default => [],
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 => ''
},
aptpreferences => {
type => 'string',
list => 1,
help => ''
},
multiarch => {
type => 'stringlist',
list => 1,
default => [],
help => ''
},
allowrecommends => {
type => 'bool',
default => 0,
help => ''
},
aptdefaultrelease => {
type => 'string',
help => ''
},
setupscript => {
type => 'string',
help => ''
},
hookdir => {
type => 'string',
list => 1,
default => [],
help => ''
},
tarballname => {
type => 'string',
help => ''
},
debconfseed => {
type => 'string',
list => 1,
default => [],
help => ''
},
omitpreinst => {
type => 'bool',
default => 0,
help => ''
},
};
our $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 => ''
},
component => {
type => 'string',
help => ''
},
omitdebsrc => {
type => 'bool',
default => 0,
help => ''
},
architecture => {
type => 'string',
help => ''
},
markauto => {
type => 'bool',
default => 0,
help => ''
},
additional => {
type => 'stringlist',
list => 1,
default => [],
help => ''
},
reinstall => {
type => 'stringlist',
list => 1,
default => [],
help => ''
},
};
# 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();
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)
#
# FIXME: allow passing configuration variables on the command line. Maybe
# like: -o general/noauth=true
GetOptions ($options, 'help|h', 'man', 'simulate|dry-run', 'shortcut|s=s',
'file|f=s', 'arch|a=s', 'directory|d=s', 'tidy-up!', 'auth!'
) or pod2usage(2);
if ($options->{help}) {
pod2usage(1);
}
if ($options->{man}) {
pod2usage(-exitval => 0, -verbose => 2);
}
if (!exists $options->{file} && !exists $options->{shortcut}) {
if (scalar(@ARGV) == 0) {
pod2usage(-message => "Mandatory argument -f or --file is missing.\n",
-exitval => 1, -verbose => 1)
} elsif (scalar(@ARGV) == 1) {
pod2usage(-message => "Target directory is missing.\n",
-exitval => 1, -verbose => 1)
} elsif (scalar(@ARGV) > 3) {
pod2usage(-message => "Too many positional arguments.\n",
-exitval => 1, -verbose => 1)
}
} else {
if (scalar(@ARGV) > 0) {
pod2usage(-message => "No positional arguments allowed with -f and -s.\n",
-exitval => 1, -verbose => 1)
}
}
if (exists $options->{directory} && scalar(@ARGV) > 0) {
pod2usage(-message => "Argument --directory is not allowed if positional arguments are used.\n",
-exitval => 1, -verbose => 1)
}
if (exists $options->{shortcut} && exists $options->{file}) {
die (g_("Options --shortcut and --file are mutually exclusive\n"));
}
# figure out the configuration file to use
my $file;
if ((exists $options->{shortcut} && defined $options->{shortcut}) || scalar(@ARGV) > 0) {
my $short;
if (exists $options->{shortcut} && defined $options->{shortcut}) {
$short = $options->{shortcut};
} else {
$short = $ARGV[0];
}
my $xdgconfig = $ENV{XDG_CONFIG_HOME} || "$ENV{HOME}/.config";
# Now go through all the search paths
for my $p ("$xdgconfig/multistrap", '/etc/multistrap.d', '/usr/share/multistrap') {
if (-f "$p/$short.conf") {
$file = "$p/$short.conf";
last;
}
}
} if (exists $options->{file} && defined $options->{file}) {
$file = $options->{file};
}
# 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 $settings = settings_from_config_tree($config_tree);
# 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->{auth}) {
$settings->{general}{noauth} = !$options->{auth};
}
if (scalar @ARGV > 0) {
$settings->{general}{directory} = $ARGV[1];
}
my $host = `dpkg --print-architecture`;
chomp($host);
if ($settings->{general}{omitrequired} and $settings->{general}{addimportant}) {
die("\n".g_("Cannot set 'add Priority: important' when packages ".
"of 'Priority: required' are being omitted.\n"));
}
if (defined $options->{simulate}) {
&dump_settings($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.
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 $dir = $settings->{general}{directory};
if (not defined $dir) {
die "Unpack directory not defined";
}
if (not defined $arch) {
die "Architecture not defined";
}
# 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:/$:) ? '' : "/";
my $cachedir = "var/cache/apt/"; # archives
my $libdir = "var/lib/apt/"; # lists
my $etcdir = "etc/apt/"; # sources
my $dpkgdir = "var/lib/dpkg/"; # state
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 ($settings->{general}{aptpreferences}) {
my $preffile = $settings->{general}{aptpreferences};
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 (@{$settings->{general}{multiarch}}) > 0) {
open (VMA, ">${dir}${dpkgdir}arch");
print VMA "$host\n";
foreach my $farch (@{$settings->{general}{multiarch}}) {
print VMA "$farch\n";
}
close (VMA);
}
system_fatal ("rm -rf " . shellescape("${dir}etc/apt/sources.list.d") . "/*");
unlink ("${dir}etc/apt/sources.list")
if (-f "${dir}etc/apt/sources.list");
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) {
foreach my $mirror (@{$settings->{$aptsrc}{source}}) {
open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap-${aptsrc}.list")
or die g_("Cannot open sources list"). $!;
my $suite = $settings->{$aptsrc}{suite};
if (!$suite) {
die "Section $aptsrc is missing the suite entry";
}
my $component = $settings->{$aptsrc}{component};
if (!$component) {
die "Section $aptsrc is missing the component entry";
}
if (scalar (@{$settings->{general}{multiarch}}) == 0) {
print SOURCES "deb [arch=$arch] $mirror $suite $component\n";
} else {
foreach my $farch (@{$settings->{general}{multiarch}}) {
print SOURCES "deb [arch=$farch] $mirror $suite $component\n";
}
}
print SOURCES "deb-src $mirror $suite $component\n" if (not $settings->{$aptsrc}{omitdebsrc});
close SOURCES;
}
}
if (!$settings->{general}{noauth}) {
# Flatten the list of keyrings per section into a single list
my @keyrings = ();
foreach my $aptsrc (@debootstrap) {
# Use realpath to allow removing duplicates
foreach my $k (@{$settings->{$aptsrc}{keyring}}) {
my $r = realpath $k;
if ($r eq "") {
die "Cannot resolve using realpath(): $k";
}
push @keyrings, $r;
}
}
@keyrings = uniq_sort(@keyrings);
my @resolved_keyrings = ();
# Resolve all directories in the list to .gpg or .asc files
foreach my $k (@keyrings) {
if (-f $k) {
push @resolved_keyrings, $k;
} elsif (-d $k) {
opendir(KEYDIR, $k);
foreach my $f (readdir KEYDIR) {
my $fl = realpath("$k/$f");
if ($fl eq "") {
die "Cannot resolve using realpath(): $k/$f";
}
# realpath() will resolve symlinks but we must still make sure
# that we get regular files and no directories
if (not -f $fl) {
next;
}
# We check the extension of the original file (which might've
# been a symlink) instead of the file the link resolved to.
if ($f !~ /\.gpg/ && $f !~ /\.asc/) {
next;
}
push @resolved_keyrings, $fl;
}
closedir(KEYDIR);
} elsif (! -e $k) {
die "keyring does not exist: $k";
} else {
die "keyring is neither directory nor file: $k";
}
}
@resolved_keyrings = uniq_sort(@resolved_keyrings);
foreach my $k (@resolved_keyrings) {
File::Copy::copy $k, "${dir}${etcdir}trusted.gpg.d/";
}
}
# Apt reads the configuration file before it parses the command line
# arguments. Thus, at the point where the -o option tells it to parse a
# different configuration file, it already read in settings from the host.
# To prevent apt from ever reading the hosts configuration, we have to
# pass our custom apt directory through a config file passed via the
# APT_CONFIG environment variable.
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 ($settings->{general}{noauth});
$config_str .= " -o Apt::Get::Download-Only=true";
$config_str .= " -o Apt::Install-Recommends=false"
if (!$settings->{general}{allowrecommends});
$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($settings->{general}{aptdefaultrelease}) if ($settings->{general}{aptdefaultrelease});
# if (not defined $preffile);
$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 @packages = ();
if (!$settings->{general}{omitrequired}) {
print g_("I: Calculating required packages.\n");
# 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 @essential=();
my @required=();
my @important=();
my %listfiles=();
# FIXME: use apt-get indextargets --format '$(FILENAME)' "Created-By: Packages" | xargs --delimiter=\\\\n /usr/lib/apt/apt-helper cat-file
my $dir = $settings->{general}{directory};
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 $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 ((defined $package{'Essential'}) && $package{'Essential'} eq 'yes') {
push @essential, $package{'Package'};
}
next if (not defined $package{'Priority'});
if ($package{'Priority'} eq "required") {
push @required, $package{'Package'};
} elsif ($package{'Priority'} eq "important") {
push @important, $package{'Package'};
}
}
}
@essential = uniq_sort(@essential);
@required = uniq_sort(@required);
@important = uniq_sort(@important);
push @packages, @essential, @required;
if ($settings->{general}{addimportant}) {
printf(g_("I: Adding 'Priority: important': %s\n"), (join " ", @important));
push @packages, @important
}
}
foreach my $aptsrc (@debootstrap) {
my @pkgs = @{$settings->{$aptsrc}{packages}};
if ($settings->{$aptsrc}{architecture}) {
my $foreign = $settings->{$aptsrc}{architecture};
@pkgs = map {"$_:$foreign"} @pkgs;
}
if ($settings->{general}{explicitsuite} && $settings->{$aptsrc}{suite}) {
my $suite = $settings->{$aptsrc}{suite};
@pkgs = map {"$_/$suite"} @pkgs;
}
push @packages, @pkgs;
}
@packages = uniq_sort(@packages);
print "$apt_get -y install " . (join ' ', @packages) . "\n";
$retval = 0;
$retval = system ("$apt_get -y install " . (join ' ', @packages));
$retval >>= 8;
die (sprintf (g_("apt download failed. Exit value: %d\n"),$retval))
if ($retval != 0);
#&force_unpack($settings, $cachedir, $libdir, $dpkgdir) if ($settings->{general}{unpack});
#foreach my $seed (@{$settings->{general}{debconfseed}}) {
# if (not -f $seed) {
# die "Cannot find $seed\n";
# }
# 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);
#}
#if ($settings->{general}{markauto}) {
# printf (g_("Marking automatically installed packages... please wait\n"));
# my $dir = $settings->{general}{directory};
# 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/, @packages} @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"));
#}
system ("touch " . shellescape("${dir}${libdir}lists/lock"));
# run setupscript
#my $setupsh = $settings->{general}{setupscript};
#if ((defined $setupsh) and (-x $setupsh)) {
# $retval = 0;
# $retval = system (shellescape($setupsh) . " " . shellescape($dir) . " $arch");
# $retval >>= 8;
# if ($retval != 0) {
# die sprintf(g_("setupscript '%s' returned %d.\n"), $setupsh, $retval);
# }
#}
# run first set of hooks - probably unnecessary re setupscript.
#&run_hooks($settings, "download");
#if ($settings->{general}{arch} eq $host and $settings->{general}{unpack}) {
# &native($settings);
#}
my @sections = uniq_sort (
@{$settings->{general}{debootstrap}},
@{$settings->{general}{bootstrap}},
@{$settings->{general}{aptsources}});
foreach my $section (@sections) {
if (scalar @{$settings->{$section}{additional}} > 0) {
my $str = join (' ', @{$settings->{$section}{additional}});
print "$apt_get -y install $str\n";
system ("$apt_get -y install $str");
#&force_unpack ($settings, $cachedir, $libdir, $dpkgdir, @{$settings->{$section}{additional}}) if ($settings->{general}{unpack});
my $dir = $settings->{general}{directory};
system ("touch " . shellescape("${dir}${libdir}lists/lock"));
my $host = `dpkg --print-architecture`;
if ($settings->{general}{arch} ne $host || $settings->{general}{ignorenative}) {
&native($settings);
}
}
}
if ($settings->{general}{cleanup}) {
&tidy_apt($settings, $cachedir, $libdir);
} else {
system ("$apt_get update")
}
# 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) {
open (SOURCES, ">>${dir}etc/apt/sources.list.d/multistrap-${aptsrc}.list")
or die g_("Cannot open sources list"). $!;
my $mirror = $settings->{$aptsrc}{source};
my $suite = $settings->{$aptsrc}{suite};
my $component = $settings->{$aptsrc}{component};
if (defined $mirror and defined $suite) {
if (scalar (@{$settings->{general}{multiarch}}) == 0) {
print SOURCES "deb [arch=$arch] $mirror $suite $component\n";
} else {
foreach my $farch (@{$settings->{general}{multiarch}}) {
print SOURCES "deb [arch=$farch] $mirror $suite $component\n";
}
}
print SOURCES "deb-src $mirror $suite $component\n" if (!$settings->{$aptsrc}{omitdebsrc});
close SOURCES;
}
}
# altered the sources, so get apt to update.
if ($settings->{general}{cleanup}) {
&tidy_apt($settings, $cachedir, $libdir);
} else {
system ("$apt_get update");
}
# run second set of hooks
#&run_hooks($settings, "cleanup");
unlink $tmp_apt_conf;
printf (g_("\nMultistrap system installed successfully in %s.\n"), $dir);
#my $tgzname = $settings->{general}{tarballname};
#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;
# my $final_path=realpath ("$dir/../$tgzname");
# printf (g_("\nMultistrap system packaged successfully as '%s'.\n"), $final_path);
#}
print "\n";
exit 0;
}
# 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 run_hooks {
my $settings = shift;
my $type = shift;
my @args = @_;
my @hooks = ();
foreach my $p (@{$settings->{general}{hookdir}}) {
if ( -d $p ) {
opendir (HOOKS, $p) or die "cannot Cannot open directory $p: $!";
foreach my $f (readdir HOOKS) {
my $fl = realpath("$p/$f");
if (not -f $fl or not -x $fl) {
next;
}
if ($f !~ /^$type/) {
next;
}
push @hooks, $fl;
}
closedir(HOOKS);
} elsif ( -f $p ) {
}
}
if (scalar @hooks == 0) {
return;
}
return if (scalar @hooks == 0);
# Translators: the plural is followed by a single repeat for each
printf(g_("I: Running %d hooks\n"), scalar @hooks);
foreach my $hookscript (@hooks) {
# Translators: this is a single instance, naming the hook
printf (g_("I: Running %s hook: '%s'\n"), $type, (join " ", ($hookscript, @args)));
my $dir = $settings->{general}{directory};
my $hookret = system (shellescape($hookscript) . " " . shellescape($dir) . " " . (join " ", @args));
$hookret >>= 8;
if ($hookret != 0) {
die (g_("E: hook '%s' reported an error: %d\n"), $hookscript, $hookret);
}
}
}
sub get_includegraph_from_config_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 settings_from_config_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}) {
die("unknown property in section $section: $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 { $_ eq lc($b) } @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 { $_ eq $s } ('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("\n[$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} && $type eq "bool") {
$t .= "\n";
if ($v == $spec->{$k}{default}) {
print(wrap('# ', '# ', $t));
print "#";
} else {
$t .= " (default: ";
$t .= value_formatter($spec->{$k}{default}, $type);
$t .= ")";
$t .= "\n";
print(wrap('# ', '# ', $t));
}
} else {
$t .= "\n";
print(wrap('# ', '# ', $t));
}
if (ref $v eq 'ARRAY' && $type ne 'stringlist') {
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 SUITE TARGET [MIRROR]
multistrap [-a ARCH] [-d DIR] [-f /path/to/multistrap.conf|-s shortcut]
multistrap [--simulate] [-f /path/to/multistrap.conf|-s shortcut]
multistrap -?|-h|--help
=head1 OPTIONS
=head2 General Options
=over 8
=item B<-?|-h|--help>
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
=back
=head1 DESCRIPTION
blubber
=cut