mmdebstrap/mmdebstrap

3233 lines
114 KiB
Perl
Executable file

#!/usr/bin/perl
#
# Copyright: 2018 Johannes Schauer <josch@mister-muffin.de>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
use strict;
use warnings;
our $VERSION = '0.5.1';
use English;
use Getopt::Long;
use Pod::Usage;
use File::Copy;
use File::Path qw(make_path remove_tree);
use File::Temp qw(tempfile tempdir);
use Cwd qw(abs_path);
require "syscall.ph";
use Fcntl qw(S_IFCHR S_IFBLK FD_CLOEXEC F_GETFD F_SETFD);
use List::Util qw(any none);
use POSIX qw(SIGINT SIGHUP SIGPIPE SIGTERM SIG_BLOCK SIG_UNBLOCK);
use Carp;
use Term::ANSIColor;
# from sched.h
use constant {
CLONE_NEWNS => 0x20000,
CLONE_NEWUTS => 0x4000000,
CLONE_NEWIPC => 0x8000000,
CLONE_NEWUSER => 0x10000000,
CLONE_NEWPID => 0x20000000,
CLONE_NEWNET => 0x40000000,
};
# type codes:
# 0 -> normal file
# 1 -> hardlink
# 2 -> symlink
# 3 -> character special
# 4 -> block special
# 5 -> directory
my @devfiles = (
# filename mode type link target major minor
[ "./dev/", 0755, 5, '', undef, undef ],
[ "./dev/console", 0666, 3, '', 5, 1 ],
[ "./dev/fd", 0777, 2, '/proc/self/fd', undef, undef ],
[ "./dev/full", 0666, 3, '', 1, 7 ],
[ "./dev/null", 0666, 3, '', 1, 3 ],
[ "./dev/ptmx", 0666, 3, '', 5, 2 ],
[ "./dev/pts/", 0755, 5, '', undef, undef ],
[ "./dev/random", 0666, 3, '', 1, 8 ],
[ "./dev/shm/", 0755, 5, '', undef, undef ],
[ "./dev/stderr", 0777, 2, '/proc/self/fd/2', undef, undef ],
[ "./dev/stdin", 0777, 2, '/proc/self/fd/0', undef, undef ],
[ "./dev/stdout", 0777, 2, '/proc/self/fd/1', undef, undef ],
[ "./dev/tty", 0666, 3, '', 5, 0 ],
[ "./dev/urandom", 0666, 3, '', 1, 9 ],
[ "./dev/zero", 0666, 3, '', 1, 5 ],
);
# verbosity levels:
# 0 -> print nothing
# 1 -> normal output and progress bars
# 2 -> verbose output
# 3 -> debug output
my $verbosity_level = 1;
sub debug {
if ($verbosity_level < 3) {
return;
}
my $msg = shift;
$msg = "D: $msg";
if ( -t STDERR ) {
$msg = colored($msg, 'clear')
}
print STDERR "$msg\n";
}
sub info {
if ($verbosity_level == 0) {
return;
}
my $msg = shift;
$msg = "I: $msg";
if ( -t STDERR ) {
$msg = colored($msg, 'green')
}
print STDERR "$msg\n";
}
sub warning {
if ($verbosity_level == 0) {
return;
}
my $msg = shift;
$msg = "W: $msg";
if ( -t STDERR ) {
$msg = colored($msg, 'bold yellow')
}
print STDERR "$msg\n";
}
sub error {
if ($verbosity_level == 0) {
return;
}
# if error() is called with the string from a previous error() that was
# caught inside an eval(), then the string will have a newline which we
# are stripping here
chomp (my $msg = shift);
$msg = "E: $msg";
if ( -t STDERR ) {
$msg = colored($msg, 'bold red')
}
if ($verbosity_level == 3) {
croak $msg; # produces a backtrace
} else {
die "$msg\n";
}
}
# tar cannot figure out the decompression program when receiving data on
# standard input, thus we do it ourselves. This is copied from tar's
# src/suffix.c
sub get_tar_compressor($) {
my $filename = shift;
if ($filename eq '-') {
return undef
} elsif ($filename =~ /\.tar$/) {
return undef
} elsif ($filename =~ /\.(gz|tgz|taz)$/) {
return 'gzip';
} elsif ($filename =~ /\.(Z|taZ)$/) {
return 'compress';
} elsif ($filename =~ /\.(bz2|tbz|tbz2|tz2)$/) {
return 'bzip2';
} elsif ($filename =~ /\.lz$/) {
return 'lzip';
} elsif ($filename =~ /\.(lzma|tlz)$/) {
return 'lzma';
} elsif ($filename =~ /\.lzo$/) {
return 'lzop';
} elsif ($filename =~ /\.lz4$/) {
return 'lz4';
} elsif ($filename =~ /\.(xz|txz)$/) {
return 'xz';
} elsif ($filename =~ /\.zst$/) {
return 'zstd';
}
return undef
}
sub test_unshare($) {
my $verbose = shift;
if ($EFFECTIVE_USER_ID == 0) {
my $msg = "cannot use unshare mode when executing as root";
if ($verbose) {
warning $msg;
} else {
debug $msg;
}
return 0;
}
# arguments to syscalls have to be stored in their own variable or
# otherwise we will get "Modification of a read-only value attempted"
my $unshare_flags = CLONE_NEWUSER;
# we spawn a new per process because if unshare succeeds, we would
# otherwise have unshared the mmdebstrap process itself which we don't want
my $pid = fork() // error "fork() failed: $!";
if ($pid == 0) {
my $ret = syscall &SYS_unshare, $unshare_flags;
if ($ret == 0) {
exit 0;
} else {
my $msg = "unshare syscall failed: $!";
if ($verbose) {
warning $msg;
} else {
debug $msg;
}
exit 1;
}
}
waitpid($pid, 0);
if (($? >> 8) != 0) {
return 0;
}
# if newuidmap and newgidmap exist, the exit status will be 1 when
# executed without parameters
system "newuidmap 2>/dev/null";
if (($? >> 8) != 1) {
if (($? >> 8) == 127) {
my $msg = "cannot find newuidmap";
if ($verbose) {
warning $msg;
} else {
debug $msg;
}
} else {
my $msg = "newuidmap returned unknown exit status: $?";
if ($verbose) {
warning $msg;
} else {
debug $msg;
}
}
return 0;
}
system "newgidmap 2>/dev/null";
if (($? >> 8) != 1) {
if (($? >> 8) == 127) {
my $msg = "cannot find newgidmap";
if ($verbose) {
warning $msg;
} else {
debug $msg;
}
} else {
my $msg = "newgidmap returned unknown exit status: $?";
if ($verbose) {
warning $msg;
} else {
debug $msg;
}
}
return 0;
}
return 1;
}
sub read_subuid_subgid() {
my $username = getpwuid $<;
my ($subid, $num_subid, $fh, $n);
my @result = ();
if (! -e "/etc/subuid") {
warning "/etc/subuid doesn't exist";
return;
}
if (! -r "/etc/subuid") {
warning "/etc/subuid is not readable";
return;
}
open $fh, "<", "/etc/subuid" or error "cannot open /etc/subuid for reading: $!";
while (my $line = <$fh>) {
($n, $subid, $num_subid) = split(/:/, $line, 3);
last if ($n eq $username);
}
close $fh;
push @result, ["u", 0, $subid, $num_subid];
if (scalar(@result) < 1) {
warning "/etc/subuid does not contain an entry for $username";
return;
}
if (scalar(@result) > 1) {
warning "/etc/subuid contains multiple entries for $username";
return;
}
open $fh, "<", "/etc/subgid" or error "cannot open /etc/subgid for reading: $!";
while (my $line = <$fh>) {
($n, $subid, $num_subid) = split(/:/, $line, 3);
last if ($n eq $username);
}
close $fh;
push @result, ["g", 0, $subid, $num_subid];
if (scalar(@result) < 2) {
warning "/etc/subgid does not contain an entry for $username";
return;
}
if (scalar(@result) > 2) {
warning "/etc/subgid contains multiple entries for $username";
return;
}
return @result;
}
# This function spawns two child processes forming the following process tree
#
# A
# |
# fork()
# | \
# B C
# | |
# | fork()
# | | \
# | D E
# | | |
# |unshare()
# | close()
# | | |
# | | read()
# | | newuidmap(D)
# | | newgidmap(D)
# | | /
# | waitpid()
# | |
# | fork()
# | | \
# | F G
# | | |
# | | exec()
# | | /
# | waitpid()
# | /
# waitpid()
#
# To better refer to each individual part, we give each process a new
# identifier after calling fork(). Process A is the main process. After
# executing fork() we call the parent and child B and C, respectively. This
# first fork() is done because we do not want to modify A. B then remains
# waiting for its child C to finish. C calls fork() again, splitting into
# the parent D and its child E. In the parent D we call unshare() and close a
# pipe shared by D and E to signal to E that D is done with calling unshare().
# E notices this by using read() and follows up with executing the tools
# new[ug]idmap on D. E finishes and D continues with doing another fork().
# This is because when unsharing the PID namespace, we need a PID 1 to be kept
# alive or otherwise any child processes cannot fork() anymore themselves. So
# we keep F as PID 1 and finally call exec() in G.
sub get_unshare_cmd(&$) {
my $cmd = shift;
my $idmap = shift;
my $unshare_flags = CLONE_NEWUSER | CLONE_NEWNS | CLONE_NEWPID | CLONE_NEWUTS | CLONE_NEWIPC;
if (0) {
$unshare_flags |= CLONE_NEWNET;
}
# fork a new process and let the child get unshare()ed
# we don't want to unshare the parent process
my $gcpid = fork() // error "fork() failed: $!";
if ($gcpid == 0) {
# Create a pipe for the parent process to signal the child process that it is
# done with calling unshare() so that the child can go ahead setting up
# uid_map and gid_map.
pipe my $rfh, my $wfh;
# We have to do this dance with forking a process and then modifying the
# parent from the child because:
# - new[ug]idmap can only be called on a process id after that process has
# unshared the user namespace
# - a process looses its capabilities if it performs an execve() with nonzero
# user ids see the capabilities(7) man page for details.
# - a process that unshared the user namespace by default does not have the
# privileges to call new[ug]idmap on itself
#
# this also works the other way around (the child setting up a user namespace
# and being modified from the parent) but that way, the parent would have to
# stay around until the child exited (so a pid would be wasted). Additionally,
# that variant would require an additional pipe to let the parent signal the
# child that it is done with calling new[ug]idmap. The way it is done here,
# this signaling can instead be done by wait()-ing for the exit of the child.
my $ppid = $$;
my $cpid = fork() // error "fork() failed: $!";
if ($cpid == 0) {
# child
# Close the writing descriptor at our end of the pipe so that we
# see EOF when parent closes its descriptor.
close $wfh;
# Wait for the parent process to finish its unshare() call by
# waiting for an EOF.
0 == sysread $rfh, my $c, 1 or error "read() did not receive EOF";
# The program's new[ug]idmap have to be used because they are
# setuid root. These privileges are needed to map the ids from
# /etc/sub[ug]id to the user namespace set up by the parent.
# Without these privileges, only the id of the user itself can be
# mapped into the new namespace.
#
# Since new[ug]idmap is setuid root we also don't need to write
# "deny" to /proc/$$/setgroups beforehand (this is otherwise
# required for unprivileged processes trying to write to
# /proc/$$/gid_map since kernel version 3.19 for security reasons)
# and therefore the parent process keeps its ability to change its
# own group here.
#
# Since /proc/$ppid/[ug]id_map can only be written to once,
# respectively, instead of making multiple calls to new[ug]idmap,
# we assemble a command line that makes one call each.
my $uidmapcmd = "";
my $gidmapcmd = "";
foreach (@{$idmap}) {
my ($t, $hostid, $nsid, $range) = @{$_};
if ($t ne "u" and $t ne "g" and $t ne "b") {
error "invalid idmap type: $t";
}
if ($t eq "u" or $t eq "b") {
$uidmapcmd .= " $hostid $nsid $range";
}
if ($t eq "g" or $t eq "b") {
$gidmapcmd .= " $hostid $nsid $range";
}
}
my $idmapcmd = '';
if ($uidmapcmd ne "") {
0 == system "newuidmap $ppid $uidmapcmd" or error "newuidmap $ppid $uidmapcmd failed: $!";
}
if ($gidmapcmd ne "") {
0 == system "newgidmap $ppid $gidmapcmd" or error "newgidmap $ppid $gidmapcmd failed: $!";
}
exit 0;
}
# parent
# After fork()-ing, the parent immediately calls unshare...
0 == syscall &SYS_unshare, $unshare_flags or error "unshare() failed: $!";
# .. and then signals the child process that we are done with the
# unshare() call by sending an EOF.
close $wfh;
# Wait for the child process to finish its setup by waiting for its
# exit.
$cpid == waitpid $cpid, 0 or error "waitpid() failed: $!";
my $exit = $? >> 8;
if ($exit != 0) {
error "child had a non-zero exit status: $exit";
}
# Currently we are nobody (uid and gid are 65534). So we become root
# user and group instead.
#
# We are using direct syscalls instead of setting $(, $), $< and $>
# because then perl would do additional stuff which we don't need or
# want here, like checking /proc/sys/kernel/ngroups_max (which might
# not exist). It would also also call setgroups() in a way that makes
# the root user be part of the group unknown.
0 == syscall &SYS_setgid, 0 or error "setgid failed: $!";
0 == syscall &SYS_setuid, 0 or error "setuid failed: $!";
0 == syscall &SYS_setgroups, 0, 0 or error "setgroups failed: $!";
if (1) {
# When the pid namespace is also unshared, then processes expect a
# master pid to always be alive within the namespace. To achieve
# this, we fork() here instead of exec() to always have one dummy
# process running as pid 1 inside the namespace. This is also what
# the unshare tool does when used with the --fork option.
#
# Otherwise, without a pid 1, new processes cannot be forked
# anymore after pid 1 finished.
my $cpid = fork() // error "fork() failed: $!";
if ($cpid != 0) {
# The parent process will stay alive as pid 1 in this
# namespace until the child finishes executing. This is
# important because pid 1 must never die or otherwise nothing
# new can be forked.
$cpid == waitpid $cpid, 0 or error "waitpid() failed: $!";
exit ($? >> 8);
}
}
&{$cmd}();
exit 0;
}
# parent
return $gcpid;
}
sub havemknod($) {
my $root = shift;
my $havemknod = 0;
if (-e "$root/test-dev-null") {
error "/test-dev-null already exists";
}
TEST: {
# we fork so that we can read STDERR
my $pid = open my $fh, '-|' // error "failed to fork(): $!";
if ($pid == 0) {
open(STDERR, '>&', STDOUT);
# we use mknod(1) instead of the system call because creating the
# right dev_t argument requires makedev(3)
exec 'mknod', "$root/test-dev-null", 'c', '1', '3';
}
chomp (my $content = do { local $/; <$fh> });
close $fh;
{
last TEST unless $? == 0 and $content eq '';
last TEST unless -c "$root/test-dev-null";
last TEST unless open my $fh, '>', "$root/test-dev-null";
last TEST unless print $fh 'test';
}
$havemknod = 1;
}
if (-e "$root/test-dev-null") {
unlink "$root/test-dev-null" or error "cannot unlink /test-dev-null: $!";
}
return $havemknod;
}
sub print_progress {
if ($verbosity_level != 1) {
return;
}
my $perc = shift;
if (!-t STDERR) {
return;
}
if ($perc eq "done") {
# \e[2K clears everything on the current line (i.e. the progress bar)
print STDERR "\e[2Kdone\n";
return;
}
if ($perc >= 100) {
$perc = 100;
}
my $width = 50;
my $num_x = int($perc*$width/100);
my $bar = '=' x $num_x;
if ($num_x != $width) {
$bar .= '>';
$bar .= ' ' x ($width - $num_x - 1);
}
printf STDERR "%6.2f [%s]\r", $perc, $bar;
}
sub run_progress {
my ($get_exec, $line_handler, $line_has_error, $chdir) = @_;
pipe my $rfh, my $wfh;
my $got_signal = 0;
my $ignore = sub {
info "run_progress() received signal $_[0]: waiting for child...";
};
# delay signals so that we can fork and change behaviour of the signal
# handler in parent and child without getting interrupted
my $sigset = POSIX::SigSet->new(SIGINT, SIGHUP, SIGPIPE, SIGTERM);
POSIX::sigprocmask(SIG_BLOCK, $sigset) or error "Can't block signals: $!";
my $pid1 = open(my $pipe, '-|') // error "failed to fork(): $!";
if ($pid1 == 0) {
# child: default signal handlers
$SIG{'INT'} = 'DEFAULT';
$SIG{'HUP'} = 'DEFAULT';
$SIG{'PIPE'} = 'DEFAULT';
$SIG{'TERM'} = 'DEFAULT';
# unblock all delayed signals (and possibly handle them)
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or error "Can't unblock signals: $!";
close $rfh;
# Unset the close-on-exec flag, so that the file descriptor does not
# get closed when we exec
my $flags = fcntl( $wfh, F_GETFD, 0 ) or error "fcntl F_GETFD: $!";
fcntl($wfh, F_SETFD, $flags & ~FD_CLOEXEC ) or error "fcntl F_SETFD: $!";
my $fd = fileno $wfh;
# redirect stderr to stdout so that we can capture it
open(STDERR, '>&', STDOUT);
my @execargs = $get_exec->($fd);
# before apt 1.5, "apt-get update" attempted to chdir() into the
# working directory. This will fail if the current working directory
# is not accessible by the user (for example in unshare mode). See
# Debian bug #860738
if (defined $chdir) {
chdir $chdir or error "failed chdir() to $chdir: $!";
}
exec { $execargs[0] } @execargs or error 'cannot exec() ' . (join ' ', @execargs);
}
close $wfh;
# spawn two processes:
# parent will parse stdout to look for errors
# child will parse $rfh for the progress meter
my $pid2 = fork() // error "failed to fork(): $!";
if ($pid2 == 0) {
# child: default signal handlers
$SIG{'INT'} = 'IGNORE';
$SIG{'HUP'} = 'IGNORE';
$SIG{'PIPE'} = 'IGNORE';
$SIG{'TERM'} = 'IGNORE';
# unblock all delayed signals (and possibly handle them)
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or error "Can't unblock signals: $!";
print_progress 0.0;
while (my $line = <$rfh>) {
my $output = $line_handler->($line);
next unless $output;
print_progress $output;
}
print_progress "done";
exit 0;
}
# parent: ignore signals
# by using "local", the original is automatically restored once the
# function returns
local $SIG{'INT'} = $ignore;
local $SIG{'HUP'} = $ignore;
local $SIG{'PIPE'} = $ignore;
local $SIG{'TERM'} = $ignore;
# unblock all delayed signals (and possibly handle them)
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or error "Can't unblock signals: $!";
my $output = '';
my $has_error = 0;
while (my $line = <$pipe>) {
$has_error = $line_has_error->($line);
if ($verbosity_level >= 2) {
print STDERR $line;
} else {
# forward captured apt output
$output .= $line;
}
}
close($pipe);
my $fail = 0;
if ($? != 0 or $has_error) {
$fail = 1;
}
waitpid $pid2, 0;
$? == 0 or error "progress parsing failed";
if ($got_signal) {
error "run_progress() received signal: $got_signal";
}
# only print failure after progress output finished or otherwise it
# might interfere with the remaining output
if ($fail) {
if ($verbosity_level >= 1) {
print STDERR $output;
}
error ((join ' ', $get_exec->('<$fd>')) . ' failed');
}
}
sub run_dpkg_progress {
my $options = shift;
my @debs = @{$options->{PKGS} // []};
my $get_exec = sub { return @{$options->{ARGV}}, "--status-fd=$_[0]", @debs; };
my $line_has_error = sub { return 0; };
my $num = 0;
# each package has one install and one configure step, thus the total
# number is twice the number of packages
my $total = (scalar @debs) * 2;
my $line_handler = sub {
if ($_[0] =~ /^processing: (install|configure): /) {
$num += 1;
}
return $num/$total*100;
};
run_progress $get_exec, $line_handler, $line_has_error;
}
sub run_apt_progress {
my $options = shift;
my @debs = @{$options->{PKGS} // []};
my $get_exec = sub {
return (
@{$options->{ARGV}},
"-oAPT::Status-Fd=$_[0]",
# prevent apt from messing up the terminal and allow dpkg to
# receive SIGINT and quit immediately without waiting for
# maintainer script to finish
'-oDpkg::Use-Pty=false',
@debs
)};
my $line_has_error = sub { return 0; };
if ($options->{FIND_APT_WARNINGS}) {
$line_has_error = sub {
# apt-get doesn't report a non-zero exit if the update failed.
# Thus, we have to parse its output. See #778357, #776152, #696335
# and #745735
if ($_[0] =~ /^(W: |Err:)/) {
return 1;
}
return 0;
};
}
my $line_handler = sub {
if ($_[0] =~ /(pmstatus|dlstatus):[^:]+:(\d+\.\d+):.*/) {
return $2;
}
};
run_progress $get_exec, $line_handler, $line_has_error, $options->{CHDIR};
}
sub run_chroot(&$) {
my $cmd = shift;
my $options = shift;
my @cleanup_tasks = ();
my $cleanup = sub {
my $signal = $_[0];
while (my $task = pop @cleanup_tasks) {
$task->();
}
if ($signal) {
warning "pid $PID cought signal: $signal";
exit 1;
}
};
local $SIG{INT} = $cleanup;
local $SIG{HUP} = $cleanup;
local $SIG{PIPE} = $cleanup;
local $SIG{TERM} = $cleanup;
eval {
if (any { $_ eq $options->{mode} } ('root', 'unshare')) {
# if more than essential should be installed, make the system look
# more like a real one by creating or bind-mounting the device nodes
foreach my $file (@devfiles) {
my ($fname, $mode, $type, $linkname, $devmajor, $devminor) = @{$file};
next if $fname eq './dev/';
if ($type == 0) { # normal file
error "type 0 not implemented";
} elsif ($type == 1) { # hardlink
error "type 1 not implemented";
} elsif ($type == 2) { # symlink
if (!$options->{havemknod}) {
if ($options->{mode} eq 'fakechroot' and $linkname =~ /^\/proc/) {
# there is no /proc in fakechroot mode
next;
}
if (any { $_ eq $options->{mode} } ('root', 'unshare')) {
push @cleanup_tasks, sub {
unlink "$options->{root}/$fname" or warn "cannot unlink $fname: $!";
}
}
symlink $linkname, "$options->{root}/$fname" or error "cannot create symlink $fname";
}
} elsif ($type == 3 or $type == 4) { # character/block special
if (!$options->{havemknod}) {
open my $fh, '>', "$options->{root}/$fname" or error "cannot open $options->{root}/$fname: $!";
close $fh;
if ($options->{mode} eq 'unshare') {
push @cleanup_tasks, sub {
0 == system('umount', '--no-mtab', "$options->{root}/$fname") or warn "umount $fname failed: $?";
unlink "$options->{root}/$fname" or warn "cannot unlink $fname: $!";
};
} elsif ($options->{mode} eq 'root') {
push @cleanup_tasks, sub {
0 == system('umount', "$options->{root}/$fname") or warn "umount failed: $?";
unlink "$options->{root}/$fname" or warn "cannot unlink $fname: $!";
};
} else {
error "unknown mode: $options->{mode}";
}
0 == system('mount', '-o', 'bind', "/$fname", "$options->{root}/$fname") or error "mount $fname failed: $?";
}
} elsif ($type == 5) { # directory
if (!$options->{havemknod}) {
if (any { $_ eq $options->{mode} } ('root', 'unshare')) {
push @cleanup_tasks, sub {
rmdir "$options->{root}/$fname" or warn "cannot rmdir $fname: $!";
}
}
make_path "$options->{root}/$fname" or error "cannot make_path $fname";
chmod $mode, "$options->{root}/$fname" or error "cannot chmod $fname: $!";
}
if ($options->{mode} eq 'unshare') {
push @cleanup_tasks, sub {
0 == system('umount', '--no-mtab', "$options->{root}/$fname") or warn "umount $fname failed: $?";
};
} elsif ($options->{mode} eq 'root') {
push @cleanup_tasks, sub {
0 == system('umount', "$options->{root}/$fname") or warn "umount $fname failed: $?";
};
} else {
error "unknown mode: $options->{mode}";
}
0 == system('mount', '-o', 'bind', "/$fname", "$options->{root}/$fname") or error "mount $fname failed: $?";
} else {
error "unsupported type: $type";
}
}
} elsif (any { $_ eq $options->{mode} } ('proot', 'fakechroot', 'chrootless')) {
# we cannot mount in fakechroot and proot mode
# in proot mode we have /dev bind-mounted already through --bind=/dev
} else {
error "unknown mode: $options->{mode}";
}
# We can only mount /proc and /sys after extracting the essential
# set because if we mount it before, then base-files will not be able
# to extract those
if ($options->{mode} eq 'root') {
push @cleanup_tasks, sub {
0 == system('umount', "$options->{root}/sys") or warn "umount /sys failed: $?";
};
0 == system('mount', '-t', 'sysfs', '-o', 'nosuid,nodev,noexec', 'sys', "$options->{root}/sys") or error "mount /sys failed: $?";
} elsif ($options->{mode} eq 'unshare') {
# naturally we have to clean up after ourselves in sudo mode where we
# do a real mount. But we also need to unmount in unshare mode because
# otherwise, even with the --one-file-system tar option, the
# permissions of the mount source will be stored and not the mount
# target (the directory)
push @cleanup_tasks, sub {
# since we cannot write to /etc/mtab we need --no-mtab
# unmounting /sys only seems to be successful with --lazy
0 == system('umount', '--no-mtab', '--lazy', "$options->{root}/sys") or warn "umount /sys failed: $?";
};
# without the network namespace unshared, we cannot mount a new
# sysfs. Since we need network, we just bind-mount.
#
# we have to rbind because just using bind results in "wrong fs
# type, bad option, bad superblock" error
0 == system('mount', '-o', 'rbind', '/sys', "$options->{root}/sys") or error "mount /sys failed: $?";
} elsif (any { $_ eq $options->{mode} } ('proot', 'fakechroot', 'chrootless')) {
# we cannot mount in fakechroot and proot mode
# in proot mode we have /proc bind-mounted already through --bind=/proc
} else {
error "unknown mode: $options->{mode}";
}
if ($options->{mode} eq 'root') {
push @cleanup_tasks, sub {
0 == system('umount', "$options->{root}/proc") or error "umount /proc failed: $?";
};
0 == system('mount', '-t', 'proc', 'proc', "$options->{root}/proc") or error "mount /proc failed: $?";
} elsif ($options->{mode} eq 'unshare') {
# naturally we have to clean up after ourselves in sudo mode where we
# do a real mount. But we also need to unmount in unshare mode because
# otherwise, even with the --one-file-system tar option, the
# permissions of the mount source will be stored and not the mount
# target (the directory)
push @cleanup_tasks, sub {
# since we cannot write to /etc/mtab we need --no-mtab
0 == system('umount', '--no-mtab', "$options->{root}/proc") or error "umount /proc failed: $?";
};
0 == system('mount', '-t', 'proc', 'proc', "$options->{root}/proc") or error "mount /proc failed: $?";
} elsif (any { $_ eq $options->{mode} } ('proot', 'fakechroot', 'chrootless')) {
# we cannot mount in fakechroot and proot mode
# in proot mode we have /sys bind-mounted already through --bind=/sys
} else {
error "unknown mode: $options->{mode}";
}
# prevent daemons from starting
# the directory might not exist in custom variant, for example
if (-d "$options->{root}/usr/sbin/") {
open my $fh, '>', "$options->{root}/usr/sbin/policy-rc.d" or error "cannot open policy-rc.d: $!";
print $fh "#!/bin/sh\n";
print $fh "exit 101\n";
close $fh;
chmod 0755, "$options->{root}/usr/sbin/policy-rc.d" or error "cannot chmod policy-rc.d: $!";
}
# the file might not exist if it was removed in a hook
if (-e "$options->{root}/sbin/start-stop-daemon") {
if (-e "$options->{root}/sbin/start-stop-daemon.REAL") {
error "$options->{root}/sbin/start-stop-daemon.REAL already exists";
}
move("$options->{root}/sbin/start-stop-daemon", "$options->{root}/sbin/start-stop-daemon.REAL") or error "cannot move start-stop-daemon: $!";
open my $fh, '>', "$options->{root}/sbin/start-stop-daemon" or error "cannot open start-stop-daemon: $!";
print $fh "#!/bin/sh\n";
print $fh "echo \"Warning: Fake start-stop-daemon called, doing nothing\">&2\n";
close $fh;
chmod 0755, "$options->{root}/sbin/start-stop-daemon" or error "cannot chmod start-stop-daemon: $!";
}
&{$cmd}();
# cleanup
if (-e "$options->{root}/sbin/start-stop-daemon.REAL") {
move("$options->{root}/sbin/start-stop-daemon.REAL", "$options->{root}/sbin/start-stop-daemon") or error "cannot move start-stop-daemon: $!";
}
if (-e "$options->{root}/usr/sbin/policy-rc.d") {
unlink "$options->{root}/usr/sbin/policy-rc.d" or error "cannot unlink policy-rc.d: $!";
}
};
my $error = $@;
# we use the cleanup function to do the unmounting
$cleanup->(0);
if ($error) {
error "run_chroot failed: $error";
}
}
sub run_hooks($$) {
my $name = shift;
my $options = shift;
if (scalar @{$options->{"${name}_hook"}} == 0) {
return;
}
my $runner = sub {
foreach my $script (@{$options->{"${name}_hook"}}) {
if ( -x $script || $script !~ m/[^\w@\%+=:,.\/-]/a) {
info "running --$name-hook directly: $script $options->{root}";
# execute it directly if it's an executable file
# or if it there are no shell metacharacters
# (the /a regex modifier makes \w match only ASCII)
0 == system($script, $options->{root}) or error "command failed: $script";
} else {
info "running --$name-hook in shell: sh -c '$script' exec $options->{root}";
# otherwise, wrap everything in sh -c
0 == system('sh', '-c', $script, 'exec', $options->{root}) or error "command failed: $script";
}
}
};
if ($name eq 'setup') {
# execute directly without mounting anything (the mount points do not
# exist yet)
&{$runner}();
} else {
run_chroot \&$runner, $options;
}
}
sub setup {
my $options = shift;
foreach my $key (sort keys %{$options}) {
my $value = $options->{$key};
if (!defined $value) {
next;
}
if (ref $value eq '') {
debug "$key: $options->{$key}";
} elsif (ref $value eq 'ARRAY') {
debug "$key: [" . (join ', ', @{$value}) . "]";
} else {
error "unknown type for key $key: " . (ref $value);
}
}
my ($conf, $tmpfile) = tempfile(UNLINK => 1) or error "cannot open apt.conf: $!";
print $conf "Apt::Architecture \"$options->{nativearch}\";\n";
# the host system might have configured additional architectures
# force only the native architecture
if (scalar @{$options->{foreignarchs}} > 0) {
print $conf "Apt::Architectures { \"$options->{nativearch}\"; ";
foreach my $arch (@{$options->{foreignarchs}}) {
print $conf "\"$arch\"; ";
}
print $conf "};\n";
} else {
print $conf "Apt::Architectures \"$options->{nativearch}\";\n";
}
print $conf "Dir \"$options->{root}\";\n";
# not needed anymore for apt 1.3 and newer
print $conf "Dir::State::Status \"$options->{root}/var/lib/dpkg/status\";\n";
# for authentication, use the keyrings from the host
print $conf "Dir::Etc::Trusted \"/etc/apt/trusted.gpg\";\n";
print $conf "Dir::Etc::TrustedParts \"/etc/apt/trusted.gpg.d\";\n";
if ($options->{variant} ne 'apt') {
# apt considers itself essential. Thus, when generating an EDSP
# document for an external solver, it will add the Essential:yes field
# to the apt package stanza. This is unnecessary for any other variant
# than 'apt' because in all other variants we compile the set of
# packages we consider essential ourselves and for the 'essential'
# variant it would even be wrong to add apt. This workaround is only
# needed when apt is used with an external solver but doesn't hurt
# otherwise and we don't have a good way to figure out whether apt is
# using an external solver or not short of parsing the --aptopt
# options.
print $conf "pkgCacheGen::ForceEssential \",\";\n";
}
close $conf;
{
my @directories = ('/etc/apt/apt.conf.d', '/etc/apt/sources.list.d',
'/etc/apt/preferences.d', '/var/cache/apt',
'/var/lib/apt/lists/partial', '/var/lib/dpkg',
'/etc/dpkg/dpkg.cfg.d/');
# if dpkg and apt operate from the outside we need some more
# directories because dpkg and apt might not even be installed inside
# the chroot
if ($options->{mode} eq 'chrootless') {
push @directories, ('/var/log/apt', '/var/lib/dpkg/triggers',
'/var/lib/dpkg/info', '/var/lib/dpkg/alternatives',
'/var/lib/dpkg/updates');
}
foreach my $dir (@directories) {
make_path("$options->{root}/$dir") or error "failed to create $dir: $!";
}
}
# We put certain configuration items in their own configuration file
# because they have to be valid for apt invocation from outside as well as
# from inside the chroot.
# The config filename is chosen such that any settings in it will be
# overridden by what the user specified with --aptopt.
{
open my $fh, '>', "$options->{root}/etc/apt/apt.conf.d/00mmdebstrap" or error "cannot open /etc/apt/apt.conf.d/00mmdebstrap: $!";
print $fh "Apt::Install-Recommends false;\n";
print $fh "Acquire::Languages \"none\";\n";
close $fh;
}
{
open my $fh, '>', "$options->{root}/var/lib/dpkg/status" or error "failed to open(): $!";
close $fh;
}
# /var/lib/dpkg/available is required to exist or otherwise package
# removals will fail
{
open my $fh, '>', "$options->{root}/var/lib/dpkg/available" or error "failed to open(): $!";
close $fh;
}
# /var/lib/dpkg/cmethopt is used by dselect
# see #930788
{
open my $fh, '>', "$options->{root}/var/lib/dpkg/cmethopt" or error "failed to open(): $!";
print $fh "apt apt\n";
close $fh;
}
# we create /var/lib/dpkg/arch inside the chroot either if there is more
# than the native architecture in the chroot or if chrootless mode is
# used to create a chroot of a different architecture than the native
# architecture outside the chroot.
chomp (my $hostarch = `dpkg --print-architecture`);
if (scalar @{$options->{foreignarchs}} > 0 or (
$options->{mode} eq 'chrootless' and $hostarch ne $options->{nativearch})) {
open my $fh, '>', "$options->{root}/var/lib/dpkg/arch" or error "cannot open /var/lib/dpkg/arch: $!";
print $fh "$options->{nativearch}\n";
foreach my $arch (@{$options->{foreignarchs}}) {
print $fh "$arch\n";
}
close $fh;
}
if (scalar @{$options->{aptopts}} > 0) {
open my $fh, '>', "$options->{root}/etc/apt/apt.conf.d/99mmdebstrap" or error "cannot open /etc/apt/apt.conf.d/99mmdebstrap: $!";
foreach my $opt (@{$options->{aptopts}}) {
if (-r $opt) {
# flush handle because copy() uses syswrite() which bypasses
# buffered IO
$fh->flush();
copy $opt, $fh or error "cannot copy $opt: $!";
} else {
print $fh $opt;
if ($opt !~ /;$/) {
print $fh ';';
}
if ($opt !~ /\n$/) {
print $fh "\n";
}
}
}
close $fh;
}
if (scalar @{$options->{dpkgopts}} > 0) {
# FIXME: in chrootless mode, dpkg will only read the configuration
# from the host
open my $fh, '>', "$options->{root}/etc/dpkg/dpkg.cfg.d/99mmdebstrap" or error "cannot open /etc/dpkg/dpkg.cfg.d/99mmdebstrap: $!";
foreach my $opt (@{$options->{dpkgopts}}) {
if (-r $opt) {
# flush handle because copy() uses syswrite() which bypasses
# buffered IO
$fh->flush();
copy $opt, $fh or error "cannot copy $opt: $!";
} else {
print $fh $opt;
if ($opt !~ /\n$/) {
print $fh "\n";
}
}
}
close $fh;
}
## setup merged usr
#my @amd64_dirs = ('lib32', 'lib64', 'libx32'); # only amd64 for now
#foreach my $dir ("bin", "sbin", "lib", @amd64_dirs) {
# symlink "usr/$dir", "$options->{root}/$dir" or die "cannot create symlink: $!";
# make_path("$options->{root}/usr/$dir") or die "cannot create /usr/$dir: $!";
#}
{
open my $fh, '>', "$options->{root}/etc/fstab" or error "cannot open fstab: $!";
print $fh "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n";
close $fh;
chmod 0644, "$options->{root}/etc/fstab" or error "cannot chmod fstab: $!";
}
# write /etc/apt/sources.list
{
open my $fh, '>', "$options->{root}/etc/apt/sources.list" or error "cannot open /etc/apt/sources.list: $!";
print $fh $options->{sourceslist};
close $fh;
}
# allow network access from within
if (-e "/etc/resolv.conf") {
copy("/etc/resolv.conf", "$options->{root}/etc/resolv.conf") or error "cannot copy /etc/resolv.conf: $!";
} else {
warning("Host system does not have a /etc/resolv.conf to copy into the rootfs.")
}
if (-e "/etc/hostname") {
copy("/etc/hostname", "$options->{root}/etc/hostname") or error "cannot copy /etc/hostname: $!";
} else {
warning("Host system does not have a /etc/hostname to copy into the rootfs.")
}
if ($options->{havemknod}) {
foreach my $file (@devfiles) {
my ($fname, $mode, $type, $linkname, $devmajor, $devminor) = @{$file};
if ($type == 0) { # normal file
error "type 0 not implemented";
} elsif ($type == 1) { # hardlink
error "type 1 not implemented";
} elsif ($type == 2) { # symlink
if ($options->{mode} eq 'fakechroot' and $linkname =~ /^\/proc/) {
# there is no /proc in fakechroot mode
next;
}
symlink $linkname, "$options->{root}/$fname" or error "cannot create symlink $fname";
next; # chmod cannot work on symlinks
} elsif ($type == 3) { # character special
0 == system('mknod', "$options->{root}/$fname", 'c', $devmajor, $devminor) or error "mknod failed: $?";
} elsif ($type == 4) { # block special
0 == system('mknod', "$options->{root}/$fname", 'b', $devmajor, $devminor) or error "mknod failed: $?";
} elsif ($type == 5) { # directory
make_path "$options->{root}/$fname", { error => \my $err };
if (@$err) {
error "cannot create $fname";
}
} else {
error "unsupported type: $type";
}
chmod $mode, "$options->{root}/$fname" or error "cannot chmod $fname: $!";
}
}
# we tell apt about the configuration via a config file passed via the
# APT_CONFIG environment variable instead of using the --option command
# line arguments because configuration settings like Dir::Etc have already
# been evaluated at the time that apt takes its command line arguments
# into account.
$ENV{"APT_CONFIG"} = "$tmpfile";
# when apt-get update is run by the root user, then apt will attempt to
# drop privileges to the _apt user. This will fail if the _apt user does
# not have permissions to read the root directory. In that case, we have
# to disable apt sandboxing.
if ($options->{mode} eq 'root') {
my $partial = '/var/lib/apt/lists/partial';
if (system('/usr/lib/apt/apt-helper', 'drop-privs', '--', 'test', '-r', "$options->{root}$partial") != 0) {
warning "Download is performed unsandboxed as root as file $options->{root}$partial couldn't be accessed by user _apt";
open my $fh, '>>', $tmpfile or error "cannot open $tmpfile for appending: $!";
print $fh "APT::Sandbox::User \"root\";\n";
close $fh;
}
}
# setting PATH for chroot, ldconfig, start-stop-daemon...
if (defined $ENV{PATH} && $ENV{PATH} ne "") {
$ENV{PATH} = "$ENV{PATH}:/usr/sbin:/usr/bin:/sbin:/bin";
} else {
$ENV{PATH} = "/usr/sbin:/usr/bin:/sbin:/bin";
}
# run setup hooks
run_hooks('setup', $options);
info "running apt-get update...";
run_apt_progress({ ARGV => ['apt-get', 'update'],
CHDIR => $options->{root},
FIND_APT_WARNINGS => 1 });
# check if anything was downloaded at all
{
open my $fh, '-|', 'apt-get', 'indextargets' // error "failed to fork(): $!";
chomp (my $indextargets = do { local $/; <$fh> });
close $fh;
if ($indextargets eq '') {
info "content of /etc/apt/sources.list:";
if ($verbosity_level >= 1) {
copy("$options->{root}/etc/apt/sources.list", *STDERR);
}
error "apt-get update didn't download anything";
}
}
my @pkgs_to_install;
for my $incl (@{$options->{include}}) {
for my $pkg (split /[,\s]+/, $incl) {
# strip leading and trailing whitespace
$pkg =~ s/^\s+|\s+$//g;
# skip if the remainder is an empty string
if ($pkg eq '') {
next;
}
# do not append component if it's already in the list
if (any {$_ eq $pkg} @pkgs_to_install) {
next;
}
push @pkgs_to_install, $pkg;
}
}
if ($options->{variant} eq 'buildd') {
push @pkgs_to_install, 'build-essential';
}
# To figure out the right package set for the apt variant we can use:
# $ apt-get dist-upgrade -o dir::state::status=/dev/null
# This is because that variants only contain essential packages and
# apt and libapt treats apt as essential. If we want to install less
# (essential variant) then we have to compute the package set ourselves.
# Same if we want to install priority based variants.
if (any { $_ eq $options->{variant} } ('extract', 'custom')) {
info "downloading packages with apt...";
run_apt_progress({
ARGV => ['apt-get', '--yes',
'-oApt::Get::Download-Only=true',
'install'],
PKGS => [@pkgs_to_install],
});
} elsif ($options->{variant} eq 'apt') {
# if we just want to install Essential:yes packages, apt and their
# dependencies then we can make use of libapt treating apt as
# implicitly essential. An upgrade with the (currently) empty status
# file will trigger an installation of the essential packages plus apt.
#
# 2018-09-02, #debian-dpkg on OFTC, times in UTC+2
# 23:39 < josch> I'll just put it in my script and if it starts
# breaking some time I just say it's apt's fault. :P
# 23:42 < DonKult> that is how it usually works, so yes, do that :P (<-
# and please add that line next to it so you can
# remind me in 5+ years that I said that after I wrote
# in the bugreport: "Are you crazy?!? Nobody in his
# right mind would even suggest depending on it!")
info "downloading packages with apt...";
run_apt_progress({
ARGV => ['apt-get', '--yes',
'-oApt::Get::Download-Only=true',
'dist-upgrade'],
});
} elsif (any { $_ eq $options->{variant} } ('essential', 'standard', 'important', 'required', 'buildd', 'minbase')) {
my %ess_pkgs;
open(my $pipe_apt, '-|', 'apt-get', 'indextargets', '--format', '$(FILENAME)', 'Created-By: Packages') or error "cannot start apt-get indextargets: $!";
while (my $fname = <$pipe_apt>) {
chomp $fname;
open (my $pipe_cat, '-|', '/usr/lib/apt/apt-helper', 'cat-file', $fname) or error "cannot start apt-helper cat-file: $!";
my $pkgname;
my $ess = '';
my $prio = 'optional';
my $arch = '';
while (my $line = <$pipe_cat>) {
chomp $line;
# Dpkg::Index takes 10 seconds to parse a typical Packages
# file. Thus we instead use a simple parser that just retrieve
# the information we need.
if ($line ne "") {
if ($line =~ /^Package: (.*)/) {
$pkgname = $1;
} elsif ($line =~ /^Essential: yes$/) {
$ess = 'yes'
} elsif ($line =~ /^Priority: (.*)/) {
$prio = $1;
} elsif ($line =~ /^Architecture: (.*)/) {
$arch = $1;
}
next;
}
# we are only interested of packages of native architecture or
# Architecture:all
if ($arch eq $options->{nativearch} or $arch eq 'all') {
# the line is empty, thus a package stanza just finished
# processing and we can handle it now
if ($ess eq 'yes') {
$ess_pkgs{$pkgname} = ();
} elsif ($options->{variant} eq 'essential') {
# for this variant we are only interested in the
# essential packages
} elsif (any { $_ eq $options->{variant} } ('standard', 'important', 'required', 'buildd', 'minbase')) {
if ($prio eq 'optional' or $prio eq 'extra') {
# always ignore packages of priority optional and extra
} elsif ($prio eq 'standard') {
if (none { $_ eq $options->{variant} } ('important', 'required', 'buildd', 'minbase')) {
push @pkgs_to_install, $pkgname;
}
} elsif ($prio eq 'important') {
if (none { $_ eq $options->{variant} } ('required', 'buildd', 'minbase')) {
push @pkgs_to_install, $pkgname;
}
} elsif ($prio eq 'required') {
# required packages are part of all sets except
# essential and apt
push @pkgs_to_install, $pkgname;
} else {
error "unknown priority: $prio";
}
} else {
error "unknown variant: $options->{variant}";
}
}
# reset values
undef $pkgname;
$ess = '';
$prio = 'optional';
$arch = '';
}
close $pipe_cat;
$? == 0 or error "apt-helper cat-file failed: $?";
}
close $pipe_apt;
$? == 0 or error "apt-get indextargets failed: $?";
debug "Identified the following Essential:yes packages:";
foreach my $pkg (sort keys %ess_pkgs) {
debug " $pkg";
}
info "downloading packages with apt...";
run_apt_progress({
ARGV => ['apt-get', '--yes',
'-oApt::Get::Download-Only=true',
'install'],
PKGS => [keys %ess_pkgs],
});
} else {
error "unknown variant: $options->{variant}";
}
# extract the downloaded packages
my @essential_pkgs;
{
my $apt_archives = "/var/cache/apt/archives/";
opendir my $dh, "$options->{root}/$apt_archives" or error "cannot read $apt_archives";
while (my $deb = readdir $dh) {
if ($deb !~ /\.deb$/) {
next;
}
$deb = "$apt_archives/$deb";
if (!-f "$options->{root}/$deb") {
next;
}
push @essential_pkgs, $deb;
}
close $dh;
}
if (scalar @essential_pkgs == 0) {
# check if a file:// URI was used
open(my $pipe_apt, '-|', 'apt-get', 'indextargets', '--format', '$(URI)', 'Created-By: Packages') or error "cannot start apt-get indextargets: $!";
while (my $uri = <$pipe_apt>) {
if ($uri =~ /^file:\/\//) {
error "nothing got downloaded -- use copy:// instead of file://";
}
}
error "nothing got downloaded";
}
# We have to extract the packages from @essential_pkgs either if we run in
# chrootless mode and extract variant or in any other mode.
# In other words, the only scenario in which the @essential_pkgs are not
# extracted are in chrootless mode in any other than the extract variant.
if ($options->{mode} eq 'chrootless' and $options->{variant} ne 'extract') {
# nothing to do
} else {
info "extracting archives...";
print_progress 0.0;
my $counter = 0;
my $total = scalar @essential_pkgs;
foreach my $deb (@essential_pkgs) {
$counter += 1;
# not using dpkg-deb --extract as that would replace the
# merged-usr symlinks with plain directories
pipe my $rfh, my $wfh;
my $pid1 = fork() // error "fork() failed: $!";
if ($pid1 == 0) {
open(STDOUT, '>&', $wfh);
debug("running dpkg-deb --fsys-tarfile $options->{root}/$deb");
exec 'dpkg-deb', '--fsys-tarfile', "$options->{root}/$deb";
}
my $pid2 = fork() // error "fork() failed: $!";
if ($pid2 == 0) {
open(STDIN, '<&', $rfh);
debug("running tar -C $options->{root} --keep-directory-symlink --extract --file -");
exec 'tar', '-C', $options->{root}, '--keep-directory-symlink', '--extract', '--file', '-';
}
waitpid($pid1, 0);
$? == 0 or error "dpkg-deb --fsys-tarfile failed: $?";
waitpid($pid2, 0);
$? == 0 or error "tar --extract failed: $?";
print_progress ($counter/$total*100);
}
print_progress "done";
}
if ($options->{mode} eq 'chrootless') {
info "installing packages...";
# FIXME: the dpkg config from the host is parsed before the command
# line arguments are parsed and might break this mode
# Example: if the host has --path-exclude set, then this will also
# affect the chroot.
my @chrootless_opts = (
'-oDPkg::Options::=--force-not-root',
'-oDPkg::Options::=--force-script-chrootless',
'-oDPkg::Options::=--root=' . $options->{root},
'-oDPkg::Options::=--log=' . "$options->{root}/var/log/dpkg.log");
if (defined $options->{qemu}) {
# The binfmt support on the outside is used, so qemu needs to know
# where it has to look for shared libraries
if (defined $ENV{QEMU_LD_PREFIX}
&& $ENV{QEMU_LD_PREFIX} ne "") {
$ENV{QEMU_LD_PREFIX} = "$ENV{QEMU_LD_PREFIX}:$options->{root}";
} else {
$ENV{QEMU_LD_PREFIX} = $options->{root};
}
}
if ($options->{variant} eq 'extract') {
# nothing to do
} else {
run_apt_progress({
ARGV => ['apt-get', '--yes',
@chrootless_opts,
'install'],
PKGS => [map { "$options->{root}/$_" } @essential_pkgs],
});
}
if (any { $_ eq $options->{variant} } ('extract', 'custom')) {
# nothing to do
} elsif (any { $_ eq $options->{variant} } ('essential', 'apt', 'standard', 'important', 'required', 'buildd', 'minbase')) {
# run essential hooks
run_hooks('essential', $options);
if (scalar @pkgs_to_install > 0) {
run_apt_progress({
ARGV => ['apt-get', '--yes',
@chrootless_opts,
'install'],
PKGS => [@pkgs_to_install],
});
}
} else {
error "unknown variant: $options->{variant}";
}
} elsif (any { $_ eq $options->{mode} } ('root', 'unshare', 'fakechroot', 'proot')) {
if (any { $_ eq $options->{variant} } ('extract')) {
# nothing to do
} elsif (any { $_ eq $options->{variant} } ('custom', 'essential', 'apt', 'standard', 'important', 'required', 'buildd', 'minbase')) {
if ($options->{mode} eq 'fakechroot') {
# this borrows from and extends
# /etc/fakechroot/debootstrap.env and /etc/fakechroot/chroot.env
{
my @fakechrootsubst = ();
foreach my $dir ('/usr/sbin', '/usr/bin', '/sbin', '/bin') {
push @fakechrootsubst, "$dir/chroot=/usr/sbin/chroot.fakechroot";
push @fakechrootsubst, "$dir/mkfifo=/bin/true";
push @fakechrootsubst, "$dir/ldconfig=/bin/true";
push @fakechrootsubst, "$dir/ldd=/usr/bin/ldd.fakechroot";
push @fakechrootsubst, "$dir/ischroot=/bin/true";
}
if (defined $ENV{FAKECHROOT_CMD_SUBST}
&& $ENV{FAKECHROOT_CMD_SUBST} ne "") {
push @fakechrootsubst, split /:/, $ENV{FAKECHROOT_CMD_SUBST};
}
$ENV{FAKECHROOT_CMD_SUBST} = join ':', @fakechrootsubst;
}
if (defined $ENV{FAKECHROOT_EXCLUDE_PATH}
&& $ENV{FAKECHROOT_EXCLUDE_PATH} ne "") {
$ENV{FAKECHROOT_EXCLUDE_PATH} = "$ENV{FAKECHROOT_EXCLUDE_PATH}:/dev:/proc:/sys";
} else {
$ENV{FAKECHROOT_EXCLUDE_PATH} = '/dev:/proc:/sys';
}
# workaround for long unix socket path if FAKECHROOT_BASE
# exceeds the limit of 108 bytes
$ENV{FAKECHROOT_AF_UNIX_PATH} = "/tmp";
{
my @ldsoconf = ('/etc/ld.so.conf');
opendir(my $dh, '/etc/ld.so.conf.d') or error "Can't opendir(/etc/ld.so.conf.d): $!";
while (my $entry = readdir $dh) {
# skip the "." and ".." entries
next if $entry eq ".";
next if $entry eq "..";
next if $entry !~ /\.conf$/;
push @ldsoconf, "/etc/ld.so.conf.d/$entry";
}
closedir($dh);
my @ldlibpath = ();
if (defined $ENV{LD_LIBRARY_PATH}
&& $ENV{LD_LIBRARY_PATH} ne "") {
push @ldlibpath, (split /:/, $ENV{LD_LIBRARY_PATH});
}
# FIXME: workaround allowing installation of systemd should
# live in fakechroot, see #917920
push @ldlibpath, "/lib/systemd";
foreach my $fname (@ldsoconf) {
open my $fh, "<", $fname or error "cannot open $fname for reading: $!";
while (my $line = <$fh>) {
next if $line !~ /^\//;
push @ldlibpath, $line;
}
close $fh;
}
$ENV{LD_LIBRARY_PATH} = join ':', @ldlibpath;
}
}
# make sure that APT_CONFIG is not set when executing anything inside the
# chroot
my @chrootcmd = ();
if ($options->{mode} eq 'proot') {
push @chrootcmd, (
'proot',
'--root-id',
'--bind=/dev',
'--bind=/proc',
'--bind=/sys',
"--rootfs=$options->{root}",
'--cwd=/');
} elsif (any { $_ eq $options->{mode} } ('root', 'unshare', 'fakechroot')) {
push @chrootcmd, ('/usr/sbin/chroot', $options->{root});
} else {
error "unknown mode: $options->{mode}";
}
# copy qemu-user-static binary into chroot or setup proot with --qemu
if (defined $options->{qemu}) {
if ($options->{mode} eq 'proot') {
push @chrootcmd, "--qemu=qemu-$options->{qemu}";
} elsif ($options->{mode} eq 'fakechroot') {
# The binfmt support on the outside is used, so qemu needs to know
# where it has to look for shared libraries
if (defined $ENV{QEMU_LD_PREFIX}
&& $ENV{QEMU_LD_PREFIX} ne "") {
$ENV{QEMU_LD_PREFIX} = "$ENV{QEMU_LD_PREFIX}:$options->{root}";
} else {
$ENV{QEMU_LD_PREFIX} = $options->{root};
}
# Make sure that the fakeroot and fakechroot shared libraries
# exist for the right architecture
open my $fh, '-|', 'dpkg-architecture', '-a', $options->{nativearch}, '-qDEB_HOST_MULTIARCH' // error "failed to fork(): $!";
chomp (my $deb_host_multiarch = do { local $/; <$fh> });
close $fh;
if ($? != 0 or !$deb_host_multiarch) {
error "dpkg-architecture failed: $?";
}
my $fakechrootdir = "/usr/lib/$deb_host_multiarch/fakechroot";
if (!-e "$fakechrootdir/libfakechroot.so") {
error "$fakechrootdir/libfakechroot.so doesn't exist. Install libfakechroot:$options->{nativearch} outside the chroot";
}
my $fakerootdir = "/usr/lib/$deb_host_multiarch/libfakeroot";
if (!-e "$fakerootdir/libfakeroot-sysv.so") {
error "$fakerootdir/libfakeroot-sysv.so doesn't exist. Install libfakeroot:$options->{nativearch} outside the chroot";
}
# fakechroot only fills LD_LIBRARY_PATH with the directories of
# the host's architecture. We append the directories of the chroot
# architecture.
$ENV{LD_LIBRARY_PATH} .= ":$fakechrootdir:$fakerootdir";
} elsif (any { $_ eq $options->{mode} } ('root', 'unshare')) {
# other modes require a static qemu-user binary
my $qemubin = "/usr/bin/qemu-$options->{qemu}-static";
if (!-e $qemubin) {
error "cannot find $qemubin";
}
copy $qemubin, "$options->{root}/$qemubin" or error "cannot copy $qemubin: $!";
# File::Copy does not retain permissions but on some
# platforms (like Travis CI) the binfmt interpreter must
# have the executable bit set or otherwise execve will
# fail with EACCES
chmod 0755, "$options->{root}/$qemubin" or error "cannot chmod $qemubin: $!";
} else {
error "unknown mode: $options->{mode}";
}
}
# some versions of coreutils use the renameat2 system call in mv.
# This breaks certain versions of fakechroot and proot. Here we do
# a sanity check and warn the user in case things might break.
if (any { $_ eq $options->{mode} } ('fakechroot', 'proot') and -e "$options->{root}/bin/mv") {
mkdir "$options->{root}/000-move-me" or error "cannot create directory: $!";
my $ret = system @chrootcmd, '/bin/mv', '/000-move-me', '/001-delete-me';
if ($ret != 0) {
if ($options->{mode} eq 'proot') {
info "the /bin/mv binary inside the chroot doesn't work under proot";
info "this is likely due to missing support for renameat2 in proot";
info "see https://github.com/proot-me/PRoot/issues/147";
} else {
info "the /bin/mv binary inside the chroot doesn't work under fakechroot";
info "with certain versions of coreutils and glibc, this is due to missing support for renameat2 in fakechroot";
info "see https://github.com/dex4er/fakechroot/issues/60";
}
info "expect package post installation scripts not to work";
rmdir "$options->{root}/000-move-me" or error "cannot rmdir: $!";
} else {
rmdir "$options->{root}/001-delete-me" or error "cannot rmdir: $!";
}
}
# install the extracted packages properly
# we need --force-depends because dpkg does not take Pre-Depends into
# account and thus doesn't install them in the right order
# And the --predep-package option is broken: #539133
info "installing packages...";
run_dpkg_progress({
ARGV => [@chrootcmd, 'env', '--unset=TMPDIR',
'dpkg', '--install', '--force-depends'],
PKGS => \@essential_pkgs,
});
# if the path-excluded option was added to the dpkg config, reinstall all
# packages
if (-e "$options->{root}/etc/dpkg/dpkg.cfg.d/99mmdebstrap") {
open(my $fh, '<', "$options->{root}/etc/dpkg/dpkg.cfg.d/99mmdebstrap") or error "cannot open /etc/dpkg/dpkg.cfg.d/99mmdebstrap: $!";
my $num_matches = grep /^path-exclude=/, <$fh>;
close $fh;
if ($num_matches > 0) {
# without --skip-same-version, dpkg will install the given
# packages even though they are already installed
info "re-installing packages because of path-exclude...";
run_dpkg_progress({
ARGV => [@chrootcmd, 'env', '--unset=TMPDIR',
'dpkg', '--install', '--force-depends'],
PKGS => \@essential_pkgs,
});
}
}
foreach my $deb (@essential_pkgs) {
unlink "$options->{root}/$deb" or error "cannot unlink $deb: $!";
}
# run essential hooks
if ($options->{variant} ne 'custom') {
run_hooks('essential', $options);
}
if ($options->{variant} ne 'custom' and scalar @pkgs_to_install > 0) {
# some packages have to be installed from the outside before anything
# can be installed from the inside.
#
# we do not need to install any *-archive-keyring packages inside the
# chroot prior to installing the packages, because the keyring is only
# used when doing "apt-get update" and that was already done at the
# beginning using key material from the outside. Since the apt cache
# is already filled and we are not calling "apt-get update" again, the
# keyring can be installed later during installation. But: if it's not
# installed during installation, then we might end up with a fully
# installed system without keyrings that are valid for its
# sources.list.
my @pkgs_to_install_from_outside;
# install apt if necessary
if ($options->{variant} ne 'apt') {
push @pkgs_to_install_from_outside, 'apt';
}
# since apt will be run inside the chroot, make sure that
# apt-transport-https and ca-certificates gets installed first if any
# mirror is a https URI
open(my $pipe_apt, '-|', 'apt-get', 'indextargets', '--format', '$(URI)', 'Created-By: Packages') or error "cannot start apt-get indextargets: $!";
while (my $uri = <$pipe_apt>) {
if ($uri =~ /^https:\/\//) {
# FIXME: support for https is part of apt >= 1.5
push @pkgs_to_install_from_outside, 'apt-transport-https';
push @pkgs_to_install_from_outside, 'ca-certificates';
last;
} elsif ($uri =~ /^tor(\+[a-z]+)*:\/\//) {
# tor URIs can be tor+http://, tor+https:// or even
# tor+mirror+file://
push @pkgs_to_install_from_outside, 'apt-transport-tor';
last;
}
}
close $pipe_apt;
$? == 0 or error "apt-get indextargets failed";
if (scalar @pkgs_to_install_from_outside > 0) {
info 'downloading ' . (join ', ', @pkgs_to_install_from_outside) . "...";
run_apt_progress({
ARGV => ['apt-get', '--yes',
'-oApt::Get::Download-Only=true',
'install'],
PKGS => [@pkgs_to_install_from_outside],
});
my @debs_to_install;
my $apt_archives = "/var/cache/apt/archives/";
opendir my $dh, "$options->{root}/$apt_archives" or error "cannot read $apt_archives";
while (my $deb = readdir $dh) {
if ($deb !~ /\.deb$/) {
next;
}
$deb = "$apt_archives/$deb";
if (!-f "$options->{root}/$deb") {
next;
}
push @debs_to_install, $deb;
}
close $dh;
if (scalar @debs_to_install == 0) {
warning "nothing got downloaded -- maybe the packages were already installed?";
} else {
# we need --force-depends because dpkg does not take Pre-Depends
# into account and thus doesn't install them in the right order
info 'installing ' . (join ', ', @pkgs_to_install_from_outside) . "...";
run_dpkg_progress({
ARGV => [@chrootcmd, 'env', '--unset=TMPDIR',
'dpkg', '--install', '--force-depends'],
PKGS => \@debs_to_install,
});
foreach my $deb (@debs_to_install) {
unlink "$options->{root}/$deb" or error "cannot unlink $deb: $!";
}
}
}
run_chroot {
info "installing remaining packages inside the chroot...";
run_apt_progress({
ARGV => [@chrootcmd, 'env',
'--unset=APT_CONFIG',
'--unset=TMPDIR',
'apt-get', '--yes', 'install'],
PKGS => [@pkgs_to_install],
});
} $options;
}
} else {
error "unknown variant: $options->{variant}";
}
} else {
error "unknown mode: $options->{mode}";
}
run_hooks('customize', $options);
# clean up temporary configuration file
unlink "$options->{root}/etc/apt/apt.conf.d/00mmdebstrap" or error "failed to unlink /etc/apt/apt.conf.d/00mmdebstrap: $!";
info "cleaning package lists and apt cache...";
run_apt_progress({
ARGV => ['apt-get', '--option', 'Dir::Etc::SourceList=/dev/null', 'update'],
CHDIR => $options->{root},
});
run_apt_progress({ ARGV => ['apt-get', 'clean'], CHDIR => $options->{root} });
# apt since 1.6 creates the auxfiles directory. If apt inside the chroot
# is older than that, then it will not know how to clean it.
if (-e "$options->{root}/var/lib/apt/lists/auxfiles") {
rmdir "$options->{root}/var/lib/apt/lists/auxfiles" or die "cannot rmdir /var/lib/apt/lists/auxfiles: $!";
}
if (defined $options->{qemu} and any { $_ eq $options->{mode} } ('root', 'unshare')) {
unlink "$options->{root}/usr/bin/qemu-$options->{qemu}-static" or error "cannot unlink /usr/bin/qemu-$options->{qemu}-static: $!";
}
# clean up certain files to make output reproducible
unlink "$options->{root}/var/log/dpkg.log";
unlink "$options->{root}/var/log/apt/history.log";
unlink "$options->{root}/var/log/apt/term.log";
unlink "$options->{root}/var/log/alternatives.log";
unlink "$options->{root}/var/cache/ldconfig/aux-cache";
}
sub main() {
umask 022;
my $mtime = time;
if (exists $ENV{SOURCE_DATE_EPOCH}) {
$mtime = $ENV{SOURCE_DATE_EPOCH}+0;
}
$ENV{DEBIAN_FRONTEND} = 'noninteractive';
$ENV{DEBCONF_NONINTERACTIVE_SEEN} = 'true';
$ENV{LC_ALL} = 'C.UTF-8';
$ENV{LANGUAGE} = 'C.UTF-8';
$ENV{LANG} = 'C.UTF-8';
# copy ARGV because getopt modifies it
my @ARGVORIG = @ARGV;
chomp (my $hostarch = `dpkg --print-architecture`);
my $options = {
components => ["main"],
variant => "important",
include => [],
architectures => [$hostarch],
mode => 'auto',
dpkgopts => [],
aptopts => [],
noop => [],
setup_hook => [],
essential_hook => [],
customize_hook => [],
};
my $logfile = undef;
Getopt::Long::Configure ('default', 'bundling', 'auto_abbrev', 'ignore_case_always');
GetOptions(
'h|help' => sub { pod2usage(-exitval => 0, -verbose => 2) },
'version' => sub { print STDOUT "mmdebstrap $VERSION\n"; exit 0; },
'components=s@' => \$options->{components},
'variant=s' => \$options->{variant},
'include=s@' => \$options->{include},
'architectures=s@' => \$options->{architectures},
'mode=s' => \$options->{mode},
'dpkgopt=s@' => \$options->{dpkgopts},
'aptopt=s@' => \$options->{aptopts},
'keyring=s' => sub {
my ($opt_name, $opt_value) = @_;
if ($opt_value =~ /"/) {
error "apt cannot handle paths with double quotes";
}
if (! -e $opt_value) {
error "keyring \"$opt_value\" does not exist";
}
if (-d $opt_value) {
push @{$options->{aptopts}}, "Dir::Etc::TrustedParts \"$opt_value\"";
} else {
push @{$options->{aptopts}}, "Dir::Etc::Trusted \"$opt_value\"";
}
},
's|silent' => sub { $verbosity_level = 0; },
'q|quiet' => sub { $verbosity_level = 0; },
'v|verbose' => sub { $verbosity_level = 2; },
'd|debug' => sub { $verbosity_level = 3; },
'logfile=s' => \$logfile,
# no-op options so that mmdebstrap can be used with
# sbuild-createchroot --debootstrap=mmdebstrap
'resolve-deps' => sub { push @{$options->{noop}}, 'resolve-deps'; },
'merged-usr' => sub { push @{$options->{noop}}, 'merged-usr'; },
'no-merged-usr' => sub { push @{$options->{noop}}, 'no-merged-usr'; },
'force-check-gpg' => sub { push @{$options->{noop}}, 'force-check-gpg'; },
# hook options are hidden until I'm happy with them
'setup-hook=s@' => \$options->{setup_hook},
'essential-hook=s@' => \$options->{essential_hook},
'customize-hook=s@' => \$options->{customize_hook},
) or pod2usage(-exitval => 2, -verbose => 1);
if (defined($logfile)) {
open(STDERR, '>', $logfile) or error "cannot open $logfile: $!";
}
foreach my $arg (@{$options->{noop}}) {
info "The option --$arg is a no-op. It only exists for compatibility with some debootstrap wrappers.";
}
my @valid_variants = ('extract', 'custom', 'essential', 'apt', 'required',
'minbase', 'buildd', 'important', 'debootstrap', '-', 'standard');
if (none { $_ eq $options->{variant}} @valid_variants) {
error "invalid variant. Choose from " . (join ', ', @valid_variants);
}
# debootstrap and - are an alias for important
if (any { $_ eq $options->{variant} } ('-', 'debootstrap')) {
$options->{variant} = 'important';
}
if ($options->{variant} eq 'essential' and scalar @{$options->{include}} > 0) {
warning "cannot install extra packages with variant essential because apt is missing";
}
# fakeroot is an alias for fakechroot
if ($options->{mode} eq 'fakeroot') {
$options->{mode} = 'fakechroot';
}
# sudo is an alias for root
if ($options->{mode} eq 'sudo') {
$options->{mode} = 'root';
}
my @valid_modes = ('auto', 'root', 'unshare', 'fakechroot', 'proot',
'chrootless');
if (none { $_ eq $options->{mode} } @valid_modes) {
error "invalid mode. Choose from " . (join ', ', @valid_modes);
}
my $check_fakechroot_running = sub {
# test if we are inside fakechroot already
# We fork a child process because setting FAKECHROOT_DETECT seems to
# be an irreversible operation for fakechroot.
my $pid = open my $rfh, '-|' // error "failed to fork(): $!";
if ($pid == 0) {
# with the FAKECHROOT_DETECT environment variable set, any program
# execution will be replaced with the output "fakeroot [version]"
$ENV{FAKECHROOT_DETECT} = 0;
exec 'echo', 'If fakechroot is running, this will not be printed';
}
my $content = do { local $/; <$rfh> };
waitpid $pid, 0;
my $result = 0;
if ($? == 0 and $content =~ /^fakechroot \d\.\d+$/) {
$result = 1;
}
return $result;
};
# figure out the mode to use or test whether the chosen mode is legal
if ($options->{mode} eq 'auto') {
if (&{$check_fakechroot_running}()) {
# if mmdebstrap is executed inside fakechroot, then we assume the
# user expects fakechroot mode
$options->{mode} = 'fakechroot';
} elsif ($EFFECTIVE_USER_ID == 0) {
# if mmdebstrap is executed as root, we assume the user wants root
# mode
$options->{mode} = 'root';
} elsif (test_unshare(0)) {
# otherwise, unshare mode is our best option if test_unshare()
# succeeds
$options->{mode} = 'unshare';
} elsif (system('fakechroot --version>/dev/null') == 0) {
# the next fallback is fakechroot
# exec ourselves again but within fakechroot
exec 'fakechroot', 'fakeroot', $PROGRAM_NAME, @ARGVORIG;
} elsif (system('proot --version>/dev/null') == 0) {
# and lastly, proot
$options->{mode} = 'proot';
} else {
error "unable to pick chroot mode automatically";
}
info "automatically chosen mode: $options->{mode}";
} elsif ($options->{mode} eq 'root') {
if ($EFFECTIVE_USER_ID != 0) {
error "need to be root";
}
} elsif ($options->{mode} eq 'proot') {
if (system('proot --version>/dev/null') != 0) {
error "need working proot binary";
}
} elsif ($options->{mode} eq 'fakechroot') {
if (&{$check_fakechroot_running}()) {
# fakechroot is already running
} elsif (system('fakechroot --version>/dev/null') != 0) {
error "need working fakechroot binary";
} else {
# exec ourselves again but within fakechroot
exec 'fakechroot', 'fakeroot', $PROGRAM_NAME, @ARGVORIG;
}
} elsif ($options->{mode} eq 'unshare') {
if (!test_unshare(1)) {
my $procfile = '/proc/sys/kernel/unprivileged_userns_clone';
open(my $fh, '<', $procfile) or error "failed to open $procfile: $!";
chomp(my $content = do { local $/; <$fh> });
close($fh);
if ($content ne "1") {
info "/proc/sys/kernel/unprivileged_userns_clone is set to $content";
info "try running: sudo sysctl -w kernel.unprivileged_userns_clone=1";
info "or permanently enable unprivileged usernamespaces by putting the setting into /etc/sysctl.d/";
info "see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=898446";
}
exit 1;
}
} elsif ($options->{mode} eq 'chrootless') {
# nothing to do
} else {
error "unknown mode: $options->{mode}";
}
my @architectures = ();
foreach my $archs (@{$options->{architectures}}) {
foreach my $arch (split /[,\s]+/, $archs) {
# strip leading and trailing whitespace
$arch =~ s/^\s+|\s+$//g;
# skip if the remainder is an empty string
if ($arch eq '') {
next;
}
# do not append component if it's already in the list
if (any {$_ eq $arch} @architectures) {
next;
}
push @architectures, $arch;
}
}
$options->{nativearch} = $hostarch;
$options->{foreignarchs} = [];
if (scalar @architectures == 0) {
warning "empty architecture list: falling back to native architecture $hostarch";
} elsif (scalar @architectures == 1) {
$options->{nativearch} = $architectures[0];
} else {
$options->{nativearch} = $architectures[0];
push @{$options->{foreignarchs}}, @architectures[1..$#architectures];
}
debug "Native architecture (outside): $hostarch";
debug "Native architecture (inside): $options->{nativearch}";
debug ("Foreign architectures (inside): " . (join ', ', @{$options->{foreignarchs}}));
{
# FIXME: autogenerate this list
my $deb2qemu = {
alpha => 'alpha',
amd64 => 'x86_64',
arm => 'arm',
arm64 => 'aarch64',
armel => 'arm',
armhf => 'arm',
hppa => 'hppa',
i386 => 'i386',
m68k => 'm68k',
mips => 'mips',
mips64 => 'mips64',
mips64el => 'mips64el',
mipsel => 'mipsel',
powerpc => 'ppc',
ppc64 => 'ppc64',
ppc64el => 'ppc64le',
riscv64 => 'riscv64',
s390x => 's390x',
sh4 => 'sh4',
sparc => 'sparc',
sparc64 => 'sparc64',
};
if ($hostarch ne $options->{nativearch}) {
my $withemu = 0;
my $noemu = 0;
{
my $pid = open my $fh, '-|' // error "failed to fork(): $!";
if ($pid == 0) {
{
no warnings; # don't print a warning if the following fails
exec 'arch-test', $options->{nativearch};
}
# if exec didn't work (for example because the arch-test program is
# missing) prepare for the worst and assume that the architecture
# cannot be executed
print "$options->{nativearch}: not supported on this machine/kernel\n";
exit 1;
}
chomp (my $content = do { local $/; <$fh> });
close $fh;
if ($? == 0 and $content eq "$options->{nativearch}: ok") {
$withemu = 1;
}
}
{
my $pid = open my $fh, '-|' // error "failed to fork(): $!";
if ($pid == 0) {
{
no warnings; # don't print a warning if the following fails
exec 'arch-test', '-n', $options->{nativearch};
}
# if exec didn't work (for example because the arch-test program is
# missing) prepare for the worst and assume that the architecture
# cannot be executed
print "$options->{nativearch}: not supported on this machine/kernel\n";
exit 1;
}
chomp (my $content = do { local $/; <$fh> });
close $fh;
if ($? == 0 and $content eq "$options->{nativearch}: ok") {
$noemu = 1;
}
}
# four different outcomes, depending on whether arch-test
# succeeded with or without emulation
#
# withemu | noemu |
# --------+-------+-----------------
# 0 | 0 | test why emu doesn't work and quit
# 0 | 1 | should never happen
# 1 | 0 | use qemu emulation
# 1 | 1 | don't use qemu emulation
if ($withemu == 0 and $noemu == 0) {
{
open my $fh, '<', '/proc/filesystems' or error "failed to open /proc/filesystems: $!";
unless (grep /^nodev\tbinfmt_misc$/, (<$fh>)) {
warning "binfmt_misc not found in /proc/filesystems -- is the module loaded?";
}
close $fh;
}
{
open my $fh, '<', '/proc/mounts' or error "failed to open /proc/mounts: $!";
unless (grep /^binfmt_misc \/proc\/sys\/fs\/binfmt_misc binfmt_misc/, (<$fh>)) {
warning "binfmt_misc not found in /proc/mounts -- not mounted?";
}
close $fh;
}
{
if (!exists $deb2qemu->{$options->{nativearch}}) {
warning "no mapping from $options->{nativearch} to qemu-user binary";
} else {
my $binfmt_identifier = 'qemu-' . $deb2qemu->{$options->{nativearch}};
open my $fh, '-|', '/usr/sbin/update-binfmts', '--display', $binfmt_identifier // error "failed to fork(): $!";
chomp (my $binfmts = do { local $/; <$fh> });
close $fh;
if ($binfmts eq '') {
warning "$binfmt_identifier is not a supported binfmt name";
}
}
}
error "$options->{nativearch} can neither be executed natively nor via qemu user emulation with binfmt_misc";
} elsif ($withemu == 0 and $noemu == 1) {
error "arch-test succeeded without emu but not with emu";
} elsif ($withemu == 1 and $noemu == 0) {
info "$options->{nativearch} cannot be executed, falling back to qemu-user";
if (!exists $deb2qemu->{$options->{nativearch}}) {
error "no mapping from $options->{nativearch} to qemu-user binary";
}
$options->{qemu} = $deb2qemu->{$options->{nativearch}};
} elsif ($withemu == 1 and $noemu == 1) {
info "$options->{nativearch} is different from $hostarch but can be executed natively";
} else {
error "logic error";
}
} else {
info "chroot architecture $options->{nativearch} is equal to the host's architecture";
}
}
{
my $suite;
if (scalar @ARGV > 0) {
$suite = shift @ARGV;
if (scalar @ARGV > 0) {
$options->{target} = shift @ARGV;
} else {
$options->{target} = '-';
}
} else {
info "No SUITE specified, expecting sources.list on standard input";
$options->{target} = '-';
}
my $sourceslist = '';
if (! defined $suite) {
# If no suite was specified, then the whole sources.list has to
# come from standard input
info "Reading sources.list from standard input...";
$sourceslist = do { local $/; <STDIN> };
} else {
my @components = ();
foreach my $comp (@{$options->{components}}) {
my @comps = split /[,\s]+/, $comp;
foreach my $c (@comps) {
# strip leading and trailing whitespace
$c =~ s/^\s+|\s+$//g;
# skip if the remainder is an empty string
if ($c eq "") {
next;
}
# do not append component if it's already in the list
if (any {$_ eq $c} @components) {
next;
}
push @components, $c;
}
}
my $compstr = join " ", @components;
if (scalar @ARGV > 0) {
for my $arg (@ARGV) {
if ($arg eq '-') {
info "Reading sources.list from standard input...";
$sourceslist .= do { local $/; <STDIN> };
} elsif ($arg =~ /^deb(-src)? /) {
$sourceslist .= "$arg\n";
} elsif ($arg =~ /:\/\//) {
$sourceslist .= "deb $arg $suite $compstr\n";
} elsif (-f $arg) {
open my $fh, '<', $arg or error "cannot open $arg: $!";
while (my $line = <$fh>) {
$sourceslist .= $line;
}
close $fh;
} else {
error "invalid mirror: $arg";
}
}
} else {
my @debstable = ('stable', 'oldstable', 'stretch', 'buster');
my @ubuntustable = ('trusty', 'xenial', 'zesty', 'artful', 'bionic', 'cosmic');
my @tanglustable = ('aequorea', 'bartholomea', 'chromodoris', 'dasyatis');
my @kali = ('kali-dev', 'kali-rolling', 'kali-bleeding-edge');
my $mirror = 'http://deb.debian.org/debian';
my $secmirror = 'http://security.debian.org/debian-security';
if (any {$_ eq $suite} @ubuntustable) {
if (any {$_ eq $options->{nativearch}} ('amd64', 'i386')) {
$mirror = 'http://archive.ubuntu.com/ubuntu';
$secmirror = 'http://security.ubuntu.com/ubuntu';
} else {
$mirror = 'http://ports.ubuntu.com/ubuntu-ports';
$secmirror = 'http://ports.ubuntu.com/ubuntu-ports';
}
} elsif (any {$_ eq $suite} @tanglustable) {
$mirror = 'http://archive.tanglu.org/tanglu'
} elsif (any {$_ eq $suite} @kali) {
$mirror = 'https://http.kali.org/kali'
}
$sourceslist .= "deb $mirror $suite $compstr\n";
if (any {$_ eq $suite} @ubuntustable) {
$sourceslist .= "deb $mirror $suite-updates $compstr\n";
$sourceslist .= "deb $secmirror $suite-security $compstr\n";
} elsif (any {$_ eq $suite} @tanglustable) {
$sourceslist .= "deb $secmirror $suite-updates $compstr\n";
} elsif (any {$_ eq $suite} @debstable) {
$sourceslist .= "deb $mirror $suite-updates $compstr\n";
if (any {$_ eq $suite} ('stable', 'oldstable', 'stretch', 'buster')) {
$sourceslist .= "deb $secmirror $suite/updates $compstr\n";
} else {
# starting from bullseye use
# https://lists.debian.org/87r26wqr2a.fsf@43-1.org
$sourceslist .= "deb $secmirror $suite-security $compstr\n";
}
}
}
}
if ($sourceslist eq '') {
error "empty apt sources.list";
}
$options->{sourceslist} = $sourceslist;
}
if ($options->{target} ne '-') {
my $abs_path = abs_path($options->{target});
if (!defined $abs_path) {
error "unable to get absolute path of target directory $options->{target}";
}
$options->{target} = $abs_path;
}
if ($options->{target} eq '/') {
error "refusing to use the filesystem root as output directory";
}
my $tar_compressor = get_tar_compressor($options->{target});
# figure out whether a tarball has to be created in the end
$options->{maketar} = 0;
if (defined $tar_compressor or $options->{target} =~ /\.tar$/ or $options->{target} eq '-') {
$options->{maketar} = 1;
if (any { $_ eq $options->{variant} } ('extract', 'custom') and $options->{mode} eq 'fakechroot') {
info "creating a tarball in fakechroot mode might fail in extract and custom variants because there might be no tar inside the chroot";
}
# try to fail early if target tarball cannot be opened for writing
if ($options->{target} ne '-') {
open my $fh, '>', $options->{target} or error "cannot open $options->{target} for writing: $!";
close $fh;
}
# check if the compressor is installed
if (defined $tar_compressor) {
my $pid = fork();
if ($pid == 0) {
open(STDOUT, '>', '/dev/null') or error "cannot open /dev/null for writing: $!";
open(STDIN, '<', '/dev/null') or error "cannot open /dev/null for reading: $!";
exec $tar_compressor or error "cannot exec $tar_compressor: $!";
}
waitpid $pid, 0;
if ($? != 0) {
error "failed to start $tar_compressor";
}
}
}
if ($options->{maketar}) {
# since the output is a tarball, we create the rootfs in a temporary
# directory
$options->{root} = tempdir(
'mmdebstrap.XXXXXXXXXX',
DIR => File::Spec->tmpdir
);
info "using $options->{root} as tempdir";
# in unshare and root mode, other users than the current user need to
# access the rootfs, most prominently, the _apt user. Thus, make the
# temporary directory world readable.
if (any { $_ eq $options->{mode} } ('unshare', 'root')) {
chmod 0755, $options->{root} or error "cannot chmod root: $!";
}
} else {
# user does not seem to have specified a tarball as output, thus work
# directly in the supplied directory
$options->{root} = $options->{target};
if (-e $options->{root}) {
if (!-d $options->{root}) {
error "$options->{root} exists and is not a directory";
}
# check if the directory is empty or contains nothing more than an
# empty lost+found directory. The latter exists on freshly created
# ext3 and ext4 partitions.
# rationale for requiring an empty directory: https://bugs.debian.org/833525
opendir(my $dh, $options->{root}) or error "Can't opendir($options->{root}): $!";
while (my $entry = readdir $dh) {
# skip the "." and ".." entries
next if $entry eq ".";
next if $entry eq "..";
# if the entry is a directory named "lost+found" then skip it
# if it's empty
if ($entry eq "lost+found" and -d "$options->{root}/$entry") {
opendir(my $dh2, "$options->{root}/$entry");
# Attempt reading the directory thrice. If the third time
# succeeds, then it has more entries than just "." and ".."
# and must thus not be empty.
readdir $dh2;
readdir $dh2;
# rationale for requiring an empty directory:
# https://bugs.debian.org/833525
if (readdir $dh2) {
error "$options->{root} contains a non-empty lost+found directory";
}
closedir($dh2);
} else {
error "$options->{root} is not empty";
}
}
closedir($dh);
} else {
make_path($options->{root}) or error "cannot create root: $!";
}
}
# check for double quotes because apt doesn't allow to escape them and
# thus paths with double quotes are invalid in the apt config
if ($options->{root} =~ /"/) {
error "apt cannot handle paths with double quotes";
}
my @idmap;
# for unshare mode the rootfs directory has to have appropriate
# permissions
if ($options->{mode} eq 'unshare') {
@idmap = read_subuid_subgid;
# sanity check
if (scalar(@idmap) != 2 || $idmap[0][0] ne 'u' || $idmap[1][0] ne 'g') {
error "invalid idmap";
}
my $outer_gid = $REAL_GROUP_ID+0;
my $pid = get_unshare_cmd { chown 1, 1, $options->{root} }
[
['u', '0', $REAL_USER_ID, '1'],
['g', '0', $outer_gid, '1'],
['u', '1', $idmap[0][2], '1'],
['g', '1', $idmap[1][2], '1']];
waitpid $pid, 0;
$? == 0 or error "chown failed";
}
# figure out whether we have mknod
$options->{havemknod} = 0;
if ($options->{mode} eq 'unshare') {
my $pid = get_unshare_cmd {
$options->{havemknod} = havemknod($options->{root});
} \@idmap;
waitpid $pid, 0;
$? == 0 or error "havemknod failed";
} elsif (any { $_ eq $options->{mode} } ('root', 'fakechroot', 'proot', 'chrootless')) {
$options->{havemknod} = havemknod($options->{root});
} else {
error "unknown mode: $options->{mode}";
}
my $devtar = '';
# We always craft the /dev entries ourselves if a tarball is to be created
if ($options->{maketar}) {
foreach my $file (@devfiles) {
my ($fname, $mode, $type, $linkname, $devmajor, $devminor) = @{$file};
my $entry = pack('a100 a8 a8 a8 a12 a12 A8 a1 a100 a8 a32 a32 a8 a8 a155 x12',
$fname,
sprintf('%07o', $mode),
sprintf('%07o', 0), # uid
sprintf('%07o', 0), # gid
sprintf('%011o', 0), # size
sprintf('%011o', $mtime),
'', # checksum
$type,
$linkname,
"ustar ",
'', # username
'', # groupname
defined($devmajor) ? sprintf('%07o', $devmajor) : '',
defined($devminor) ? sprintf('%07o', $devminor) : '',
'', # prefix
);
# compute and insert checksum
substr($entry,148,7) = sprintf("%06o\0", unpack("%16C*",$entry));
$devtar .= $entry;
}
}
my $exitstatus = 0;
my @taropts = ('--sort=name', "--mtime=\@$mtime", '--clamp-mtime', '--numeric-owner', '--one-file-system', '-c', '--exclude=./dev');
# disable signals so that we can fork and change behaviour of the signal
# handler in the parent and child without getting interrupted
my $sigset = POSIX::SigSet->new(SIGINT, SIGHUP, SIGPIPE, SIGTERM);
POSIX::sigprocmask(SIG_BLOCK, $sigset) or error "Can't block signals: $!";
my $pid;
pipe my $rfh, my $wfh;
if ($options->{mode} eq 'unshare') {
$pid = get_unshare_cmd {
# child
$SIG{'INT'} = 'DEFAULT';
$SIG{'HUP'} = 'DEFAULT';
$SIG{'PIPE'} = 'DEFAULT';
$SIG{'TERM'} = 'DEFAULT';
# unblock all delayed signals (and possibly handle them)
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or error "Can't unblock signals: $!";
close $rfh;
open(STDOUT, '>&', STDERR);
setup($options);
if ($options->{maketar}) {
info "creating tarball...";
# redirect tar output to the writing end of the pipe so that the
# parent process can capture the output
open(STDOUT, '>&', $wfh);
# Add ./dev as the first entries of the tar file.
# We cannot add them after calling tar, because there is no way to
# prevent tar from writing NULL entries at the end.
print $devtar;
# pack everything except ./dev
0 == system('tar', @taropts, '-C', $options->{root}, '.') or error "tar failed: $?";
info "done";
}
exit 0;
} \@idmap;
} elsif (any { $_ eq $options->{mode} } ('root', 'fakechroot', 'proot', 'chrootless')) {
$pid = fork() // error "fork() failed: $!";
if ($pid == 0) {
$SIG{'INT'} = 'DEFAULT';
$SIG{'HUP'} = 'DEFAULT';
$SIG{'PIPE'} = 'DEFAULT';
$SIG{'TERM'} = 'DEFAULT';
# unblock all delayed signals (and possibly handle them)
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or error "Can't unblock signals: $!";
close $rfh;
open(STDOUT, '>&', STDERR);
setup($options);
if ($options->{maketar}) {
info "creating tarball...";
# redirect tar output to the writing end of the pipe so that the
# parent process can capture the output
open(STDOUT, '>&', $wfh);
# Add ./dev as the first entries of the tar file.
# We cannot add them after calling tar, because there is no way to
# prevent tar from writing NULL entries at the end.
print $devtar;
if ($options->{mode} eq 'fakechroot') {
# Fakechroot requires tar to run inside the chroot or
# otherwise absolute symlinks will include the path to the
# root directory
0 == system('/usr/sbin/chroot', $options->{root}, 'tar', @taropts, '-C', '/', '.') or error "tar failed: $?";
} elsif ($options->{mode} eq 'proot') {
# proot requires tar to run inside proot or otherwise
# permissions will be completely off
my @qemuopt = ();
if (defined $options->{qemu}) {
push @qemuopt, "--qemu=qemu-$options->{qemu}";
push @taropts, "--exclude=./host-rootfs"
}
0 == system('proot', '--root-id', "--rootfs=$options->{root}", '--cwd=/', @qemuopt, 'tar', @taropts, '-C', '/', '.') or error "tar failed: $?";
} elsif (any { $_ eq $options->{mode} } ('root', 'chrootless')) {
# If the chroot directory is not owned by the root user,
# then we assume that no measure was taken to fake root
# permissions. Since the final tarball should contain
# entries with root ownership, we instruct tar to do so.
my @owneropts = ();
if ((stat $options->{root})[4] != 0) {
push @owneropts, '--owner=0', '--group=0', '--numeric-owner';
}
0 == system('tar', @taropts, @owneropts, '-C', $options->{root}, '.') or error "tar failed: $?";
} else {
error "unknown mode: $options->{mode}";
}
info "done";
}
exit 0;
}
} else {
error "unknown mode: $options->{mode}";
}
# parent
my $got_signal = 0;
my $waiting_for = "setup";
my $ignore = sub {
$got_signal = shift;
info "main() received signal $got_signal: waiting for $waiting_for...";
};
$SIG{'INT'} = $ignore;
$SIG{'HUP'} = $ignore;
$SIG{'PIPE'} = $ignore;
$SIG{'TERM'} = $ignore;
# unblock all delayed signals (and possibly handle them)
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or error "Can't unblock signals: $!";
close $wfh;
if ($options->{maketar}) {
# we use eval() so that error() doesn't take this process down and
# thus leaves the setup() process without a parent
eval {
if ($options->{target} eq '-') {
if (!copy($rfh, *STDOUT)) {
error "cannot copy to standard output: $!";
}
} else {
if (defined $tar_compressor) {
POSIX::sigprocmask(SIG_BLOCK, $sigset) or error "Can't block signals: $!";
my $cpid = fork();
if ($cpid == 0) {
# child: default signal handlers
$SIG{'INT'} = 'DEFAULT';
$SIG{'HUP'} = 'DEFAULT';
$SIG{'PIPE'} = 'DEFAULT';
$SIG{'TERM'} = 'DEFAULT';
# unblock all delayed signals (and possibly handle them)
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or error "Can't unblock signals: $!";
open(STDOUT, '>', $options->{target}) or error "cannot open $options->{target} for writing: $!";
open(STDIN, '<&', $rfh) or error "cannot open file handle for reading: $!";
exec $tar_compressor or error "cannot exec $tar_compressor: $!";
}
POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or error "Can't unblock signals: $!";
waitpid $cpid, 0;
if ($? != 0) {
error "failed to start $tar_compressor";
}
} else {
if(!copy($rfh, $options->{target})) {
error "cannot copy to $options->{target}: $!";
}
}
}
};
if ($@) {
# we cannot die here because that would leave the other thread
# running without a parent
warning "run_chroot failed: $@";
$exitstatus = 1;
}
}
close($rfh);
waitpid $pid, 0;
if ($? != 0) {
$exitstatus = 1;
}
# change signal handler message
$waiting_for = "cleanup";
if ($options->{maketar} and -e $options->{root}) {
info "removing tempdir $options->{root}...";
if ($options->{mode} eq 'unshare') {
# We don't have permissions to remove the directory outside
# the unshared namespace, so we remove it here.
# Since this is still inside the unshared namespace, there is
# no risk of removing anything important.
$pid = get_unshare_cmd {
# File::Path will produce the error "cannot stat initial
# working directory" if the working directory cannot be
# accessed by the unprivileged unshared user. Thus, we first
# navigate to the parent of the root directory.
chdir "$options->{root}/.." or error "unable to chdir() to parent directory of $options->{root}: $!";
remove_tree($options->{root}, {error => \my $err});
if (@$err) {
for my $diag (@$err) {
my ($file, $message) = %$diag;
if ($file eq '') {
warning "general error: $message";
}
else {
warning "problem unlinking $file: $message";
}
}
}
} \@idmap;
waitpid $pid, 0;
$? == 0 or error "remove_tree failed";
} elsif (any { $_ eq $options->{mode} } ('root', 'fakechroot', 'proot', 'chrootless')) {
# without unshare, we use the system's rm to recursively remove the
# temporary directory just to make sure that we do not accidentally
# remove more than we should by using --one-file-system.
#
# --interactive=never is needed when in proot mode, the
# write-protected file /apt/apt.conf.d/01autoremove-kernels is to
# be removed.
0 == system('rm', '--interactive=never', '--recursive', '--preserve-root', '--one-file-system', $options->{root}) or error "rm failed: $!";
} else {
error "unknown mode: $options->{mode}";
}
}