mmdebstrap/mmdebstrap
Johannes Schauer Marin Rodrigues 489e51a2eb
Run File::Find::find with no_chdir=>1
Without no_chdir=>1 the unshared child process in unshare mode needs
read permissions for the directory from which mmdebstrap is executed.
With this change, the current working directory does not need to be
world-readable anymore.

Closes: #1005857
Reported-by: Trent W. Buck <trentbuck@gmail.com>
2022-02-16 10:53:05 +01:00

7050 lines
279 KiB
Perl
Executable file

#!/usr/bin/perl
#
# © 2018 - 2021 Johannes Schauer Marin Rodrigues <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.
#
# The software is provided "as is", without warranty of any kind, express or
# implied, including but not limited to the warranties of merchantability,
# fitness for a particular purpose and noninfringement. In no event shall the
# authors or copyright holders be liable for any claim, damages or other
# liability, whether in an action of contract, tort or otherwise, arising
# from, out of or in connection with the software or the use or other dealings
# in the software.
use strict;
use warnings;
our $VERSION = '0.8.4';
use English;
use Getopt::Long;
use Pod::Usage;
use File::Copy;
use File::Path qw(make_path);
use File::Temp qw(tempfile tempdir);
use File::Basename;
use File::Find;
use Cwd qw(abs_path getcwd);
require "syscall.ph"; ## no critic (Modules::RequireBarewordIncludes)
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 strftime);
use Carp;
use Term::ANSIColor;
use Socket;
use Time::HiRes;
use Math::BigInt;
use version;
## no critic (InputOutput::RequireBriefOpen)
# from sched.h
# use typeglob constants because "use constant" has several drawback as
# explained in the documentation for the Readonly CPAN module
*CLONE_NEWNS = \0x20000; # mount namespace
*CLONE_NEWUTS = \0x4000000; # utsname
*CLONE_NEWIPC = \0x8000000; # ipc
*CLONE_NEWUSER = \0x10000000; # user
*CLONE_NEWPID = \0x20000000; # pid
*CLONE_NEWNET = \0x40000000; # net
*_LINUX_CAPABILITY_VERSION_3 = \0x20080522;
*CAP_SYS_ADMIN = \21;
*PR_CAPBSET_READ = \23;
our (
$CLONE_NEWNS, $CLONE_NEWUTS,
$CLONE_NEWIPC, $CLONE_NEWUSER,
$CLONE_NEWPID, $CLONE_NEWNET,
$_LINUX_CAPABILITY_VERSION_3, $CAP_SYS_ADMIN,
$PR_CAPBSET_READ
);
#<<<
# 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
["", oct(755), 5, '', undef, undef],
["console", oct(666), 3, '', 5, 1],
["fd", oct(777), 2, '/proc/self/fd', undef, undef],
["full", oct(666), 3, '', 1, 7],
["null", oct(666), 3, '', 1, 3],
["ptmx", oct(666), 3, '', 5, 2],
["pts/", oct(755), 5, '', undef, undef],
["random", oct(666), 3, '', 1, 8],
["shm/", oct(755), 5, '', undef, undef],
["stderr", oct(777), 2, '/proc/self/fd/2', undef, undef],
["stdin", oct(777), 2, '/proc/self/fd/0', undef, undef],
["stdout", oct(777), 2, '/proc/self/fd/1', undef, undef],
["tty", oct(666), 3, '', 5, 0],
["urandom", oct(666), 3, '', 1, 9],
["zero", oct(666), 3, '', 1, 5],
);
#>>>
# verbosity levels:
# 0 -> print nothing
# 1 -> normal output and progress bars
# 2 -> verbose output
# 3 -> debug output
my $verbosity_level = 1;
my $is_covering = 0;
{
# make $@ local, so we don't print "Undefined subroutine called"
# in other parts where we evaluate $@
local $@ = '';
$is_covering = !!(eval { Devel::Cover::get_coverage() });
}
# the reason why Perl::Critic warns about this is, that it suspects that the
# programmer wants to implement a test whether the terminal is interactive or
# not, in which case, complex interactions with the magic *ARGV indeed make it
# advisable to use IO::Interactive. In our case, we do not want to create an
# interactivity check but just want to check whether STDERR is opened to a tty,
# so our use of -t is fine and not "fragile and complicated" as is written in
# the description of InputOutput::ProhibitInteractiveTest. Also see
# https://github.com/Perl-Critic/Perl-Critic/issues/918
sub stderr_is_tty() {
## no critic (InputOutput::ProhibitInteractiveTest)
if (-t STDERR) {
return 1;
} else {
return 0;
}
}
sub debug {
if ($verbosity_level < 3) {
return;
}
my $msg = shift;
my ($package, $filename, $line) = caller;
$msg = "D: $PID $line $msg";
if (stderr_is_tty()) {
$msg = colored($msg, 'clear');
}
print STDERR "$msg\n";
return;
}
sub info {
if ($verbosity_level == 0) {
return;
}
my $msg = shift;
if ($verbosity_level >= 3) {
my ($package, $filename, $line) = caller;
$msg = "$PID $line $msg";
}
$msg = "I: $msg";
if (stderr_is_tty()) {
$msg = colored($msg, 'green');
}
print STDERR "$msg\n";
return;
}
sub warning {
if ($verbosity_level == 0) {
return;
}
my $msg = shift;
$msg = "W: $msg";
if (stderr_is_tty()) {
$msg = colored($msg, 'bold yellow');
}
print STDERR "$msg\n";
return;
}
sub error {
# 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 (stderr_is_tty()) {
$msg = colored($msg, 'bold red');
}
if ($verbosity_level == 3) {
croak $msg; # produces a backtrace
} else {
die "$msg\n";
}
}
# The encoding of dev_t is MMMM Mmmm mmmM MMmm, where M is a hex digit of
# the major number and m is a hex digit of the minor number.
sub major {
my $rdev = shift;
my $right
= Math::BigInt->from_hex("0x00000000000fff00")->band($rdev)->brsft(8);
my $left
= Math::BigInt->from_hex("0xfffff00000000000")->band($rdev)->brsft(32);
return $right->bior($left);
}
sub minor {
my $rdev = shift;
my $right = Math::BigInt->from_hex("0x00000000000000ff")->band($rdev);
my $left
= Math::BigInt->from_hex("0x00000ffffff00000")->band($rdev)->brsft(12);
return $right->bior($left);
}
# check whether a directory is mounted by comparing the device number of the
# directory itself with its parent
sub is_mountpoint {
my $dir = shift;
if (!-e $dir) {
return 0;
}
my @a = stat "$dir/.";
my @b = stat "$dir/..";
# if the device number is different, then the directory must be mounted
if ($a[0] != $b[0]) {
return 1;
}
# if the inode number is the same, then the directory must be mounted
if ($a[1] == $b[1]) {
return 1;
}
return 0;
}
# 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;
} elsif ($filename =~ /\.tar$/) {
return;
} 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;
}
# 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 test_unshare_userns {
my $verbose = shift;
if ($EFFECTIVE_USER_ID == 0) {
my $msg = "cannot unshare user namespace 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 $REAL_USER_ID;
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;
if (!length $subid) {
warning "/etc/subuid is empty";
return;
}
if ($n ne $username) {
warning "no entry in /etc/subuid for $username";
return;
}
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;
}
my $groupname = getgrgid $REAL_GROUP_ID;
if (!-e "/etc/subgid") {
warning "/etc/subgid doesn't exist";
return;
}
if (!-r "/etc/subgid") {
warning "/etc/subgid is not readable";
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 $groupname);
}
close $fh;
if (!length $subid) {
warning "/etc/subgid is empty";
return;
}
if ($n ne $groupname) {
warning "no entry in /etc/subgid for $groupname";
return;
}
push @result, ["g", 0, $subid, $num_subid];
if (scalar(@result) < 2) {
warning "/etc/subgid does not contain an entry for $groupname";
return;
}
if (scalar(@result) > 2) {
warning "/etc/subgid contains multiple entries for $groupname";
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;
# unsharing the mount namespace (NEWNS) requires CAP_SYS_ADMIN
my $unshare_flags
= $CLONE_NEWNS | $CLONE_NEWPID | $CLONE_NEWUTS | $CLONE_NEWIPC;
# we only need to add CLONE_NEWUSER if we are not yet root
if ($EFFECTIVE_USER_ID != 0) {
$unshare_flags |= $CLONE_NEWUSER;
}
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 process is already root, so no need for newuidmap/newgidmap
if ($EFFECTIVE_USER_ID == 0) {
exit 0;
}
# 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.
if ($EFFECTIVE_USER_ID != 0) {
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) or error "cannot open STDERR: $!";
# 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 (!stderr_is_tty()) {
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;
return;
}
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...";
};
debug("run_progress: exec " . (join ' ', ($get_exec->('${FD}'))));
# 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
local $SIG{'INT'} = 'DEFAULT';
local $SIG{'HUP'} = 'DEFAULT';
local $SIG{'PIPE'} = 'DEFAULT';
local $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) or error "cannot open 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: $!";
}
eval { Devel::Cover::set_coverage("none") } if $is_covering;
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
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 $progress = 0.0;
my $status = undef;
print_progress($progress);
while (my $line = <$rfh>) {
my ($newprogress, $newstatus) = $line_handler->($line);
next unless $newprogress;
# start a new line if the new progress value is less than the
# previous one
if ($newprogress < $progress) {
print_progress("done");
}
if (defined $newstatus) {
$status = $newstatus;
}
if ( defined $status
and $verbosity_level == 1
and stderr_is_tty()) {
# \e[2K clears everything on the current line (i.e. the
# progress bar)
print STDERR "\e[2K$status: ";
}
print_progress($newprogress);
$progress = $newprogress;
}
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');
}
return;
}
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 {
my $status = undef;
if ($_[0] =~ /^processing: (install|configure): /) {
if ($1 eq 'install') {
$status = 'installing';
} elsif ($1 eq 'configure') {
$status = 'configuring';
} else {
error "unknown status: $1";
}
$num += 1;
}
return $num / $total * 100, $status;
};
run_progress $get_exec, $line_handler, $line_has_error;
return;
}
sub run_apt_progress {
my $options = shift;
my @debs = @{ $options->{PKGS} // [] };
my $tmpedsp;
if (exists $options->{EDSP_RES}) {
(undef, $tmpedsp) = tempfile(
"mmdebstrap.edsp.XXXXXXXXXXXX",
OPEN => 0,
TMPDIR => 1
);
}
my $get_exec = sub {
my @prefix = ();
my @opts = ();
if (exists $options->{EDSP_RES}) {
push @prefix, 'env', "APT_EDSP_DUMP_FILENAME=$tmpedsp";
if (-e "./proxysolver") {
# for development purposes, use the current directory if it
# contains a file called proxysolver
push @opts, ("-oDir::Bin::solvers=" . getcwd()),
'--solver=proxysolver';
} else {
push @opts, '--solver=mmdebstrap-dump-solution';
}
}
return (
@prefix,
@{ $options->{ARGV} },
@opts,
"-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 for the parsing bugs as well as #594813, #696335,
# #776152, #778357 and #953726 for non-zero exit on transient
# network errors.
#
# For example, we want to fail with the following warning:
# W: Some index files failed to download. They have been ignored,
# or old ones used instead.
# But since this message is meant for human consumption it is not
# guaranteed to be stable across different apt versions and may
# change arbitrarily in the future. Thus, we error out on any W:
# lines as well. The downside is, that apt also unconditionally
# and by design prints a warning for unsigned repositories, even
# if they were allowed with Acquire::AllowInsecureRepositories "1"
# or with trusted=yes.
#
# A workaround was introduced by apt 2.1.16 with the --error-on=any
# option to apt-get update.
if ($_[0] =~ /^(W: |Err:)/) {
return 1;
}
return 0;
};
}
my $line_handler = sub {
if ($_[0] =~ /(pmstatus|dlstatus):[^:]+:(\d+\.\d+):.*/) {
my $status = undef;
if ($1 eq 'pmstatus') {
$status = "installing";
} elsif ($1 eq 'dlstatus') {
$status = "downloading";
} else {
error "unknown status: $1";
}
return $2, $status;
}
};
run_progress $get_exec, $line_handler, $line_has_error, $options->{CHDIR};
if (exists $options->{EDSP_RES}) {
info "parsing EDSP results...";
open my $fh, '<', $tmpedsp
or error "failed to open $tmpedsp for reading: $!";
my $inst = 0;
my $pkg;
my $ver;
while (my $line = <$fh>) {
chomp $line;
if ($line ne "") {
if ($line =~ /^Install: \d+/) {
$inst = 1;
} elsif ($line =~ /^Package: (.*)/) {
$pkg = $1;
} elsif ($line =~ /^Version: (.*)/) {
$ver = $1;
}
next;
}
if ($inst == 1 && defined $pkg && defined $ver) {
push @{ $options->{EDSP_RES} }, [$pkg, $ver];
}
$inst = 0;
undef $pkg;
undef $ver;
}
close $fh;
unlink $tmpedsp;
}
return;
}
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 '';
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 we had mknod, then the symlink was already created
# in the run_setup function.
if (!-d "$options->{root}/dev") {
warning(
"skipping creation of ./dev/$fname because the"
. " /dev directory is missing in the target"
);
next;
}
push @cleanup_tasks, sub {
unlink "$options->{root}/dev/$fname"
or warn "cannot unlink ./dev/$fname: $!";
};
symlink $linkname, "$options->{root}/dev/$fname"
or error
"cannot create symlink ./dev/$fname -> $linkname";
}
} elsif ($type == 3 or $type == 4) {
# character/block special
if ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !$options->{canmount}) {
warning "skipping bind-mounting ./dev/$fname";
} elsif (!$options->{havemknod}) {
if (!-d "$options->{root}/dev") {
warning(
"skipping creation of ./dev/$fname because the"
. " /dev directory is missing in the target"
);
next;
}
if (!-e "/dev/$fname") {
warning("skipping creation of ./dev/$fname because"
. " /dev/$fname does not exist"
. " on the outside");
next;
}
if (!-c "/dev/$fname") {
warning("skipping creation of ./dev/$fname because"
. " /dev/$fname on the outside is not a"
. " character special file");
next;
}
open my $fh, '>', "$options->{root}/dev/$fname"
or error
"cannot open $options->{root}/dev/$fname: $!";
close $fh;
my @umountopts = ();
if ($options->{mode} eq 'unshare') {
push @umountopts, '--no-mtab';
}
push @cleanup_tasks, sub {
0 == system('umount', @umountopts,
"$options->{root}/dev/$fname")
or warn "umount ./dev/$fname failed: $?";
unlink "$options->{root}/dev/$fname"
or warn "cannot unlink ./dev/$fname: $!";
};
0 == system('mount', '-o', 'bind', "/dev/$fname",
"$options->{root}/dev/$fname")
or error "mount ./dev/$fname failed: $?";
}
} elsif ($type == 5
&& (any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !$options->{canmount}) {
warning "skipping bind-mounting ./dev/$fname";
} elsif ($type == 5) { # directory
if (!-d "$options->{root}/dev") {
warning(
"skipping creation of ./dev/$fname because the"
. " /dev directory is missing in the target");
next;
}
if (!-e "/dev/$fname") {
warning("skipping creation of ./dev/$fname because"
. " /dev/$fname does not exist"
. " on the outside");
next;
}
if (!-d "/dev/$fname") {
warning("skipping creation of ./dev/$fname because"
. " /dev/$fname on the outside is not a"
. " directory");
next;
}
if (!$options->{havemknod}) {
# If had mknod, then the directory to bind-mount into
# was already created in the run_setup function.
push @cleanup_tasks, sub {
rmdir "$options->{root}/dev/$fname"
or warn "cannot rmdir ./dev/$fname: $!";
};
if (-e "$options->{root}/dev/$fname") {
if (!-d "$options->{root}/dev/$fname") {
error "./dev/$fname already exists but is not"
. " a directory";
}
} else {
my $num_created
= make_path "$options->{root}/dev/$fname",
{ error => \my $err };
if ($err && @$err) {
error(
join "; ",
(
map {
"cannot create "
. (join ": ", %{$_})
} @$err
));
} elsif ($num_created == 0) {
error
"cannot create $options->{root}/dev/$fname";
}
}
chmod $mode, "$options->{root}/dev/$fname"
or error "cannot chmod ./dev/$fname: $!";
}
my @umountopts = ();
if ($options->{mode} eq 'unshare') {
push @umountopts, '--no-mtab';
}
push @cleanup_tasks, sub {
0 == system('umount', @umountopts,
"$options->{root}/dev/$fname")
or warn "umount ./dev/$fname failed: $?";
};
0 == system('mount', '-o', 'bind', "/dev/$fname",
"$options->{root}/dev/$fname")
or error "mount ./dev/$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 ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !$options->{canmount}) {
warning "skipping mount sysfs";
} elsif ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !-d "$options->{root}/sys") {
warning("skipping mounting of sysfs because the"
. " /sys directory is missing in the target");
} elsif ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !-e "/sys") {
warning("skipping bind-mounting /sys because"
. " /sys does not exist on the outside");
} elsif ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !-d "/sys") {
warning("skipping bind-mounting /sys because"
. " /sys on the outside is not a directory");
} elsif ($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', 'ro,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 ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !$options->{canmount}) {
warning "skipping mount proc";
} elsif ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !-d "$options->{root}/proc") {
warning("skipping mounting of proc because the"
. " /proc directory is missing in the target");
} elsif ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !-e "/proc") {
warning("skipping bind-mounting /proc because"
. " /proc does not exist on the outside");
} elsif ((any { $_ eq $options->{mode} } ('root', 'unshare'))
&& !-d "/proc") {
warning("skipping bind-mounting /proc because"
. " /proc on the outside is not a directory");
} elsif ($options->{mode} eq 'root') {
push @cleanup_tasks, sub {
# some maintainer scripts mount additional stuff into /proc
# which we need to unmount beforehand
if (
is_mountpoint(
$options->{root} . "/proc/sys/fs/binfmt_misc"
)
) {
0 == system('umount',
"$options->{root}/proc/sys/fs/binfmt_misc")
or error "umount /proc/sys/fs/binfmt_misc failed: $?";
}
0 == system('umount', "$options->{root}/proc")
or error "umount /proc failed: $?";
};
0 == system('mount', '-t', 'proc', '-o', 'ro', '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
#
# ideally, we should use update-alternatives but we cannot rely on it
# existing inside the chroot
#
# See #911290 for more problems of this interface
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 (-f "$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 (-f "$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";
}
return;
}
sub run_hooks {
my $name = shift;
my $options = shift;
if (scalar @{ $options->{"${name}_hook"} } == 0) {
return;
}
if ($options->{dryrun}) {
info "not running ${name}-hooks because of --dry-run";
return;
}
my @env_opts = ();
# At this point TMPDIR is set to "$options->{root}/tmp". This is to have a
# writable TMPDIR even in unshare mode. But if TMPDIR is still set when
# running hooks, then every hook script calling chroot, will have to wrap
# that into an "env --unset=TMPDIR". To avoid this, we unset TMPDIR here.
# If the hook script needs a writable TMPDIR, then it can always use /tmp
# inside the chroot. This is also why we do not set a new MMDEBSTRAP_TMPDIR
# environment variable.
if (length $ENV{TMPDIR}) {
push @env_opts, '--unset=TMPDIR';
}
# The APT_CONFIG variable, if set, will confuse any manual calls to
# apt-get. If you want to use the same config used by mmdebstrap, the
# original value is stored in MMDEBSTRAP_APT_CONFIG.
if (length $ENV{APT_CONFIG}) {
push @env_opts, '--unset=APT_CONFIG';
}
if (length $ENV{APT_CONFIG}) {
push @env_opts, "MMDEBSTRAP_APT_CONFIG=$ENV{APT_CONFIG}";
}
# Storing the mode is important for hook scripts to potentially change
# their behavior depending on the mode. It's also important for when the
# hook wants to use the mmdebstrap --hook-helper.
push @env_opts, "MMDEBSTRAP_MODE=$options->{mode}";
# Storing the hook name is important for hook scripts to potentially change
# their behavior depending on the hook. It's also important for when the
# hook wants to use the mmdebstrap --hook-helper.
push @env_opts, "MMDEBSTRAP_HOOK=$name";
# This is the file descriptor of the socket that the mmdebstrap
# --hook-helper can write to and read from to communicate with the outside.
push @env_opts, ("MMDEBSTRAP_HOOKSOCK=" . fileno($options->{hooksock}));
my $runner = sub {
foreach my $script (@{ $options->{"${name}_hook"} }) {
if (
$script =~ /^(
copy-in|copy-out
|tar-in|tar-out
|upload|download
|sync-in|sync-out
)\ /x
) {
info "running special hook: $script";
if (
any { $_ eq $options->{variant} } ('extract', 'custom')
and any { $_ eq $options->{mode} }
('fakechroot', 'proot') and $name ne 'setup'
) {
info "the copy-in, copy-out, tar-in and tar-out commands"
. " in fakechroot mode or proot mode might fail in"
. " extract and custom variants because there might be"
. " no tar inside the chroot";
}
my $pid = fork() // error "fork() failed: $!";
if ($pid == 0) {
# whatever the script writes on stdout is sent to the
# socket
# whatever is written to the socket, send to stdin
open(STDOUT, '>&', $options->{hooksock})
or error "cannot open STDOUT: $!";
open(STDIN, '<&', $options->{hooksock})
or error "cannot open STDIN: $!";
# we execute ourselves under sh to avoid having to
# implement a clever parser of the quoting used in $script
# for the filenames
my $prefix = "";
if ($is_covering) {
$prefix
= "$EXECUTABLE_NAME -MDevel::Cover=-silent,-nogcov ";
}
exec 'sh', '-c',
"$prefix$PROGRAM_NAME --hook-helper"
. " \"\$1\" \"\$2\" \"\$3\" \"\$4\" \"\$5\" $script",
'exec', $options->{root}, $options->{mode}, $name,
(
defined $options->{qemu}
? "qemu-$options->{qemu}"
: 'env',
$verbosity_level
);
}
waitpid($pid, 0);
$? == 0 or error "special hook failed with exit code $?";
} elsif (-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('env', @env_opts, $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('env', @env_opts,
'sh', '-c', $script, 'exec', $options->{root})
or error "command failed: $script";
}
}
};
# Unset the close-on-exec flag, so that the file descriptor does not
# get closed when we exec
my $flags = fcntl($options->{hooksock}, F_GETFD, 0)
or error "fcntl F_GETFD: $!";
fcntl($options->{hooksock}, F_SETFD, $flags & ~FD_CLOEXEC)
or error "fcntl F_SETFD: $!";
if ($name eq 'setup') {
# execute directly without mounting anything (the mount points do not
# exist yet)
&{$runner}();
} else {
run_chroot(\&$runner, $options);
}
# Restore flags
fcntl($options->{hooksock}, F_SETFD, $flags) or error "fcntl F_SETFD: $!";
return;
}
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}) . "]";
} elsif (ref $value eq 'GLOB') {
debug "$key: GLOB";
} else {
error "unknown type for key $key: " . (ref $value);
}
}
if (-e $options->{apttrusted} && !-r $options->{apttrusted}) {
warning "cannot read $options->{apttrusted}";
}
if (-e $options->{apttrustedparts} && !-r $options->{apttrustedparts}) {
warning "cannot read $options->{apttrustedparts}";
}
if (any { $_ eq 'setup' } @{ $options->{skip} }) {
info "skipping setup as requested";
} else {
run_setup($options);
}
run_hooks('setup', $options);
if (any { $_ eq 'update' } @{ $options->{skip} }) {
info "skipping update as requested";
} else {
run_update($options);
}
(my $essential_pkgs, my $cached_debs) = run_download($options);
# in theory, we don't have to extract the packages in chrootless mode
# but we do it anyways because otherwise directory creation timestamps
# will differ compared to non-chrootless and we want to create bit-by-bit
# identical tar output
#
# FIXME: dpkg could be changed to produce the same results
run_extract($options, $essential_pkgs);
run_hooks('extract', $options);
if ($options->{variant} ne 'extract') {
my $chrootcmd = [];
if ($options->{mode} ne 'chrootless') {
$chrootcmd = run_prepare($options);
}
run_essential($options, $essential_pkgs, $chrootcmd, $cached_debs);
run_hooks('essential', $options);
run_install($options, $chrootcmd);
run_hooks('customize', $options);
}
if (any { $_ eq 'cleanup' } @{ $options->{skip} }) {
info "skipping cleanup as requested";
} else {
run_cleanup($options);
}
return;
}
sub run_setup() {
my $options = shift;
{
my @directories = (
'/etc/apt/apt.conf.d', '/etc/apt/sources.list.d',
'/etc/apt/preferences.d', '/var/cache/apt',
'/var/lib/apt/lists/partial', '/tmp'
);
# we need /var/lib/dpkg in case we need to write to /var/lib/dpkg/arch
push @directories, '/var/lib/dpkg';
# since we do not know the dpkg version inside the chroot at this
# point, we can only omit it in chrootless mode
if ($options->{mode} ne 'chrootless'
or scalar @{ $options->{dpkgopts} } > 0) {
push @directories, '/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. Thus, the following block is not strictly necessary in
# chrootless mode. We unconditionally add it anyways, so that the
# output with and without chrootless mode is equal.
{
push @directories, '/var/log/apt';
# since we do not know the dpkg version inside the chroot at this
# point, we can only omit it in chrootless mode
if ($options->{mode} ne 'chrootless') {
push @directories, '/var/lib/dpkg/triggers',
'/var/lib/dpkg/info', '/var/lib/dpkg/alternatives',
'/var/lib/dpkg/updates';
}
}
foreach my $dir (@directories) {
if (-e "$options->{root}/$dir") {
if (!-d "$options->{root}/$dir") {
error "$dir already exists but is not a directory";
}
} else {
my $num_created = make_path "$options->{root}/$dir",
{ error => \my $err };
if ($err && @$err) {
error(
join "; ",
(map { "cannot create " . (join ": ", %{$_}) } @$err));
} elsif ($num_created == 0) {
error "cannot create $options->{root}/$dir";
}
}
}
# make sure /tmp is not 0755 like the rest
chmod 01777, "$options->{root}/tmp" or error "cannot chmod /tmp: $!";
}
# The TMPDIR set by the user or even /tmp might be inaccessible by the
# unshared user. Thus, we place all temporary files in /tmp inside the new
# rootfs.
#
# This will affect calls to tempfile() as well as runs of "apt-get update"
# which will create temporary clearsigned.message.XXXXXX files to verify
# signatures.
#
# Setting TMPDIR to inside the chroot is also necessary for when packages
# are installed with apt from outside the chroot with
# DPkg::Chroot-Directory
{
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{"TMPDIR"} = "$options->{root}/tmp";
}
my ($conf, $tmpfile)
= tempfile("mmdebstrap.apt.conf.XXXXXXXXXXXX", TMPDIR => 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 \"$options->{apttrusted}\";\n";
print $conf "Dir::Etc::TrustedParts \"$options->{apttrustedparts}\";\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;
# 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.
if (!-e "$options->{root}/etc/apt/apt.conf.d/00mmdebstrap") {
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;
}
# apt-get update requires this
if (!-e "$options->{root}/var/lib/dpkg/status") {
open my $fh, '>', "$options->{root}/var/lib/dpkg/status"
or error "failed to open(): $!";
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 (
(!-e "$options->{root}/var/lib/dpkg/arch")
and (
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
and (!-e "$options->{root}/etc/apt/apt.conf.d/99mmdebstrap")) {
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 ($verbosity_level >= 3) {
debug "content of /etc/apt/apt.conf.d/99mmdebstrap:";
copy("$options->{root}/etc/apt/apt.conf.d/99mmdebstrap", \*STDERR);
}
}
if (scalar @{ $options->{dpkgopts} } > 0
and (!-e "$options->{root}/etc/dpkg/dpkg.cfg.d/99mmdebstrap")) {
# FIXME: in chrootless mode, dpkg will only read the configuration
# from the host -- see #808203
if ($options->{mode} eq 'chrootless') {
warning('dpkg is unable to read an alternative configuration in'
. 'chrootless mode -- see Debian bug #808203');
}
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;
if ($verbosity_level >= 3) {
debug "content of /etc/dpkg/dpkg.cfg.d/99mmdebstrap:";
copy("$options->{root}/etc/dpkg/dpkg.cfg.d/99mmdebstrap",
\*STDERR);
}
}
if (!-e "$options->{root}/etc/fstab") {
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 and files in /etc/apt/sources.list.d/
{
my $firstentry = $options->{sourceslists}->[0];
# if the first sources.list entry is of one-line type and without
# explicit filename, then write out an actual /etc/apt/sources.list
# otherwise everything goes into /etc/apt/sources.list.d
my $fname;
if ($firstentry->{type} eq 'one-line'
&& !defined $firstentry->{fname}) {
$fname = "$options->{root}/etc/apt/sources.list";
} else {
$fname = "$options->{root}/etc/apt/sources.list.d/0000";
if (defined $firstentry->{fname}) {
$fname .= $firstentry->{fname};
if ( $firstentry->{fname} !~ /\.list/
&& $firstentry->{fname} !~ /\.sources/) {
if ($firstentry->{type} eq 'one-line') {
$fname .= '.list';
} elsif ($firstentry->{type} eq 'deb822') {
$fname .= '.sources';
} else {
error "invalid type: $firstentry->{type}";
}
}
} else {
# if no filename is given, then this must be a deb822 file
# because if it was a one-line type file, then it would've been
# written to /etc/apt/sources.list
$fname .= 'main.sources';
}
}
if (!-e $fname) {
open my $fh, '>', "$fname" or error "cannot open $fname: $!";
print $fh $firstentry->{content};
close $fh;
}
# everything else goes into /etc/apt/sources.list.d/
for (my $i = 1 ; $i < scalar @{ $options->{sourceslists} } ; $i++) {
my $entry = $options->{sourceslists}->[$i];
my $fname = "$options->{root}/etc/apt/sources.list.d/"
. sprintf("%04d", $i);
if (defined $entry->{fname}) {
$fname .= $entry->{fname};
if ( $entry->{fname} !~ /\.list/
&& $entry->{fname} !~ /\.sources/) {
if ($entry->{type} eq 'one-line') {
$fname .= '.list';
} elsif ($entry->{type} eq 'deb822') {
$fname .= '.sources';
} else {
error "invalid type: $entry->{type}";
}
}
} else {
if ($entry->{type} eq 'one-line') {
$fname .= 'main.list';
} elsif ($entry->{type} eq 'deb822') {
$fname .= 'main.sources';
} else {
error "invalid type: $entry->{type}";
}
}
if (!-e $fname) {
open my $fh, '>', "$fname" or error "cannot open $fname: $!";
print $fh $entry->{content};
close $fh;
}
}
}
# allow network access from within
foreach my $file ("/etc/resolv.conf", "/etc/hostname") {
if (-e $file && !-e "$options->{root}/$file") {
# this will create a new file with 644 permissions and copy
# contents only even if $file was a symlink
copy($file, "$options->{root}/$file")
or error "cannot copy $file: $!";
# if the source was a regular file, preserve the permissions
if (-f $file) {
my $mode = (stat($file))[2];
$mode &= oct(7777); # mask off bits that aren't the mode
chmod $mode, "$options->{root}/$file"
or error "cannot chmod $file: $!";
}
} else {
warning("Host system does not have a $file 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}/dev/$fname"
or error "cannot create symlink ./dev/$fname";
next; # chmod cannot work on symlinks
} elsif ($type == 3) { # character special
0 == system('mknod', "$options->{root}/dev/$fname", 'c',
$devmajor, $devminor)
or error "mknod failed: $?";
} elsif ($type == 4) { # block special
0 == system('mknod', "$options->{root}/dev/$fname", 'b',
$devmajor, $devminor)
or error "mknod failed: $?";
} elsif ($type == 5) { # directory
if (-e "$options->{root}/dev/$fname") {
if (!-d "$options->{root}/dev/$fname") {
error
"./dev/$fname already exists but is not a directory";
}
} else {
my $num_created = make_path "$options->{root}/dev/$fname",
{ error => \my $err };
if ($err && @$err) {
error(
join "; ",
(
map { "cannot create " . (join ": ", %{$_}) }
@$err
));
} elsif ($num_created == 0) {
error "cannot create $options->{root}/dev/$fname";
}
}
} else {
error "unsupported type: $type";
}
chmod $mode, "$options->{root}/dev/$fname"
or error "cannot chmod ./dev/$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.
{
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{"APT_CONFIG"} = "$tmpfile";
}
# we have to make the config file world readable so that a possible
# /usr/lib/apt/solvers/apt process which is run by the _apt user is also
# able to read it
chmod 0666, "$tmpfile" or error "cannot chmod $tmpfile: $!";
if ($verbosity_level >= 3) {
0 == system('apt-get', '--version')
or error "apt-get --version failed: $?";
0 == system('apt-config', 'dump') or error "apt-config failed: $?";
debug "content of $tmpfile:";
copy($tmpfile, \*STDERR);
}
if (none { $_ eq $options->{mode} } ('fakechroot', 'proot')) {
# Apt dropping privileges to another user than root is not useful in
# fakechroot and proot mode because all users are faked and thus there
# is no real privilege difference anyways. We could set
# APT::Sandbox::User "root" in fakechroot and proot mode but we don't
# because if we would, then /var/cache/apt/archives/partial/ and
# /var/lib/apt/lists/partial/ would not be owned by the _apt user
# if mmdebstrap was run in fakechroot or proot mode.
#
# 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. This can for example happen in
# root mode when the path of the chroot is not in a world-readable
# location.
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;
}
}
return;
}
sub run_update() {
my $options = shift;
my $aptopts = {
ARGV => ['apt-get', 'update', '--error-on=any'],
CHDIR => $options->{root},
};
info "running apt-get update...";
run_apt_progress($aptopts);
# 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 '') {
if ($verbosity_level >= 1) {
0 == system('apt-cache', 'policy')
or error "apt-cache failed: $?";
}
error "apt-get update didn't download anything";
}
}
return;
}
sub run_download() {
my $options = shift;
# We use /var/cache/apt/archives/ to figure out which packages apt chooses
# to install. That's why the directory must be empty if:
# - /var/cache/apt/archives exists, and
# - no simulation run is done, and
# - the variant is not extract or custom or the number to be
# installed packages not zero
#
# We could also unconditionally use the proxysolver and then "apt-get
# download" any missing packages but using the proxysolver requires
# /usr/lib/apt/solvers/apt from the apt-utils package and we want to avoid
# that dependency.
#
# In the future we want to replace downloading packages with "apt-get
# install --download-only" and installing them with dpkg by just installing
# the essential packages with apt from the outside with
# DPkg::Chroot-Directory. We are not doing that because then the preinst
# script of base-passwd will not be called early enough and packages will
# fail to install because they are missing /etc/passwd.
my @cached_debs = ();
my @dl_debs = ();
if (
!$options->{dryrun}
&& ((none { $_ eq $options->{variant} } ('extract', 'custom'))
|| scalar @{ $options->{include} } != 0)
&& -d "$options->{root}/var/cache/apt/archives/"
) {
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;
}
if (!-f "$options->{root}/$apt_archives/$deb") {
next;
}
push @cached_debs, $deb;
}
closedir $dh;
if (scalar @cached_debs > 0) {
if (any { $_ eq 'download/empty' } @{ $options->{skip} }) {
info "skipping download/empty as requested";
} else {
error("/var/cache/apt/archives/ inside the chroot contains: "
. (join ', ', (sort @cached_debs)));
}
}
}
# 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')) {
if (scalar @{ $options->{include} } == 0) {
info "nothing to download -- skipping...";
return ([], []);
}
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;
}
$pkgs_to_install{$pkg} = ();
}
}
my %result = ();
if ($options->{dryrun}) {
info "simulate downloading packages with apt...";
} else {
# if there are already packages in /var/cache/apt/archives/, we
# need to use our proxysolver to obtain the solution chosen by apt
if (scalar @cached_debs > 0) {
$result{EDSP_RES} = \@dl_debs;
}
info "downloading packages with apt...";
}
run_apt_progress({
ARGV => [
'apt-get',
'--yes',
'-oApt::Get::Download-Only=true',
$options->{dryrun} ? '-oAPT::Get::Simulate=true' : (),
'install'
],
PKGS => [keys %pkgs_to_install],
%result
});
} 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!")
my %result = ();
if ($options->{dryrun}) {
info "simulate downloading packages with apt...";
} else {
# if there are already packages in /var/cache/apt/archives/, we
# need to use our proxysolver to obtain the solution chosen by apt
if (scalar @cached_debs > 0) {
$result{EDSP_RES} = \@dl_debs;
}
info "downloading packages with apt...";
}
run_apt_progress({
ARGV => [
'apt-get',
'--yes',
'-oApt::Get::Download-Only=true',
$options->{dryrun} ? '-oAPT::Get::Simulate=true' : (),
'dist-upgrade'
],
%result
});
} elsif (
any { $_ eq $options->{variant} }
('essential', 'standard', 'important', 'required', 'buildd')
) {
# 2021-06-07, #debian-apt on OFTC, times in UTC+2
# 17:27 < DonKult> (?essential includes 'apt' through)
# 17:30 < josch> DonKult: no, because pkgCacheGen::ForceEssential ",";
# 17:32 < DonKult> touché
my %result = ();
if ($options->{dryrun}) {
info "simulate downloading packages with apt...";
} else {
# if there are already packages in /var/cache/apt/archives/, we
# need to use our proxysolver to obtain the solution chosen by apt
if (scalar @cached_debs > 0) {
$result{EDSP_RES} = \@dl_debs;
}
info "downloading packages with apt...";
}
run_apt_progress({
ARGV => [
'apt-get',
'--yes',
'-oApt::Get::Download-Only=true',
$options->{dryrun} ? '-oAPT::Get::Simulate=true' : (),
'install',
'?narrow('
. (
length($options->{suite})
? '?or(?archive(^'
. $options->{suite}
. '$),?codename(^'
. $options->{suite} . '$)),'
: ''
)
. '?architecture('
. $options->{nativearch}
. '),?essential)'
],
%result
});
} else {
error "unknown variant: $options->{variant}";
}
my @essential_pkgs;
if (scalar @cached_debs > 0 && scalar @dl_debs > 0) {
my $archives = "/var/cache/apt/archives/";
# for each package in @dl_debs, check if it's in
# /var/cache/apt/archives/ and add it to @essential_pkgs
foreach my $p (@dl_debs) {
my ($pkg, $ver_epoch) = @{$p};
# apt appends the architecture at the end of the package name
($pkg, my $arch) = split ':', $pkg, 2;
# apt replaces the colon by its percent encoding %3a
my $ver = $ver_epoch;
$ver =~ s/:/%3a/;
# the architecture returned by apt is the native architecture.
# Since we don't know whether the package is architecture
# independent or not, we first try with the native arch and then
# with "all" and only error out if neither exists.
if (-e "$options->{root}/$archives/${pkg}_${ver}_$arch.deb") {
push @essential_pkgs, "$archives/${pkg}_${ver}_$arch.deb";
} elsif (-e "$options->{root}/$archives/${pkg}_${ver}_all.deb") {
push @essential_pkgs, "$archives/${pkg}_${ver}_all.deb";
} else {
error( "cannot find package for $pkg:$arch (= $ver_epoch) "
. "in /var/cache/apt/archives/");
}
}
} else {
# collect the .deb files that were downloaded by apt from the content
# of /var/cache/apt/archives/
if (!$options->{dryrun}) {
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;
}
closedir $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";
}
}
}
# Unpack order matters. Since we create this list using two different
# methods but we want both methods to have the same result, we sort the
# list before returning it.
@essential_pkgs = sort @essential_pkgs;
return (\@essential_pkgs, \@cached_debs);
}
sub run_extract() {
my $options = shift;
my $essential_pkgs = shift;
if ($options->{dryrun}) {
info "skip extracting packages because of --dry-run";
return;
}
if (scalar @{$essential_pkgs} == 0) {
info "nothing to extract -- skipping...";
return;
}
info "extracting archives...";
print_progress 0.0;
my $counter = 0;
my $total = scalar @{$essential_pkgs};
foreach my $deb (@{$essential_pkgs}) {
$counter += 1;
my $tarfilter;
my @tarfilterargs;
# if the path-excluded option was added to the dpkg config,
# insert the tarfilter between dpkg-deb and tar
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 @matches = grep { /^path-(?:exclude|include)=/ } <$fh>;
close $fh;
chop @matches; # remove trailing newline
@tarfilterargs = map { "--" . $_ } @matches;
}
if (scalar @tarfilterargs > 0) {
if (-x "./tarfilter") {
$tarfilter = "./tarfilter";
} else {
$tarfilter = "mmtarfilter";
}
}
my $dpkg_writer;
my $tar_reader;
my $filter_reader;
my $filter_writer;
if (scalar @tarfilterargs > 0) {
pipe $filter_reader, $dpkg_writer or error "pipe failed: $!";
pipe $tar_reader, $filter_writer or error "pipe failed: $!";
} else {
pipe $tar_reader, $dpkg_writer or error "pipe failed: $!";
}
# not using dpkg-deb --extract as that would replace the
# merged-usr symlinks with plain directories
# https://bugs.debian.org/989602
# not using dpkg --unpack because that would try running preinst
# maintainer scripts
my $pid1 = fork() // error "fork() failed: $!";
if ($pid1 == 0) {
open(STDOUT, '>&', $dpkg_writer) or error "cannot open STDOUT: $!";
close($tar_reader) or error "cannot close tar_reader: $!";
if (scalar @tarfilterargs > 0) {
close($filter_reader)
or error "cannot close filter_reader: $!";
close($filter_writer)
or error "cannot close filter_writer: $!";
}
debug("running dpkg-deb --fsys-tarfile $options->{root}/$deb");
eval { Devel::Cover::set_coverage("none") } if $is_covering;
exec 'dpkg-deb', '--fsys-tarfile', "$options->{root}/$deb";
}
my $pid2;
if (scalar @tarfilterargs > 0) {
$pid2 = fork() // error "fork() failed: $!";
if ($pid2 == 0) {
open(STDIN, '<&', $filter_reader)
or error "cannot open STDIN: $!";
open(STDOUT, '>&', $filter_writer)
or error "cannot open STDOUT: $!";
close($dpkg_writer) or error "cannot close dpkg_writer: $!";
close($tar_reader) or error "cannot close tar_reader: $!";
debug("running $tarfilter " . (join " ", @tarfilterargs));
eval { Devel::Cover::set_coverage("none") } if $is_covering;
exec $tarfilter, @tarfilterargs;
}
}
my $pid3 = fork() // error "fork() failed: $!";
if ($pid3 == 0) {
open(STDIN, '<&', $tar_reader) or error "cannot open STDIN: $!";
close($dpkg_writer) or error "cannot close dpkg_writer: $!";
if (scalar @tarfilterargs > 0) {
close($filter_reader)
or error "cannot close filter_reader: $!";
close($filter_writer)
or error "cannot close filter_writer: $!";
}
debug( "running tar -C $options->{root}"
. " --keep-directory-symlink --extract --file -");
eval { Devel::Cover::set_coverage("none") } if $is_covering;
exec 'tar', '-C', $options->{root},
'--keep-directory-symlink', '--extract', '--file', '-';
}
close($dpkg_writer) or error "cannot close dpkg_writer: $!";
close($tar_reader) or error "cannot close tar_reader: $!";
if (scalar @tarfilterargs > 0) {
close($filter_reader) or error "cannot close filter_reader: $!";
close($filter_writer) or error "cannot close filter_writer: $!";
}
waitpid($pid1, 0);
$? == 0 or error "dpkg-deb --fsys-tarfile failed: $?";
if (scalar @tarfilterargs > 0) {
waitpid($pid2, 0);
$? == 0 or error "tarfilter failed: $?";
}
waitpid($pid3, 0);
$? == 0 or error "tar --extract failed: $?";
print_progress($counter / $total * 100);
}
print_progress "done";
return;
}
sub run_prepare {
my $options = shift;
if ($options->{mode} eq 'fakechroot') {
# this borrows from and extends
# /etc/fakechroot/debootstrap.env and
# /etc/fakechroot/chroot.env
{
my $ldconfig = getcwd() . '/ldconfig.fakechroot';
if (!-x $ldconfig) {
$ldconfig = '/usr/libexec/mmdebstrap/ldconfig.fakechroot';
}
my @fakechrootsubst = ();
foreach my $d ('/usr/sbin', '/usr/bin', '/sbin', '/bin') {
push @fakechrootsubst, "$d/chroot=/usr/sbin/chroot.fakechroot";
push @fakechrootsubst, "$d/mkfifo=/bin/true";
push @fakechrootsubst, "$d/ldconfig=$ldconfig";
push @fakechrootsubst, "$d/ldd=/usr/bin/ldd.fakechroot";
push @fakechrootsubst, "$d/ischroot=/bin/true";
}
if (defined $ENV{FAKECHROOT_CMD_SUBST}
&& $ENV{FAKECHROOT_CMD_SUBST} ne "") {
push @fakechrootsubst, split /:/, $ENV{FAKECHROOT_CMD_SUBST};
}
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{FAKECHROOT_CMD_SUBST} = join ':', @fakechrootsubst;
}
if (defined $ENV{FAKECHROOT_EXCLUDE_PATH}
&& $ENV{FAKECHROOT_EXCLUDE_PATH} ne "") {
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{FAKECHROOT_EXCLUDE_PATH}
= "$ENV{FAKECHROOT_EXCLUDE_PATH}:/dev:/proc:/sys";
} else {
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{FAKECHROOT_EXCLUDE_PATH} = '/dev:/proc:/sys';
}
# workaround for long unix socket path if FAKECHROOT_BASE
# exceeds the limit of 108 bytes
{
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{FAKECHROOT_AF_UNIX_PATH} = "/tmp";
}
{
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, "$options->{root}/lib/systemd";
my $parse_ld_so_conf;
$parse_ld_so_conf = sub {
foreach my $conf (@_) {
next if !-r $conf;
open my $fh, '<', "$conf" or error "can't read $conf: $!";
while (my $line = <$fh>) {
chomp $line;
if ($line eq "") {
next;
}
if ($line =~ /^#/) {
next;
}
if ($line =~ /include (.*)/) {
$parse_ld_so_conf->(glob("$options->{root}/$1"));
next;
}
if (!-d "$options->{root}/$line") {
next;
}
push @ldlibpath, "$options->{root}/$line";
}
close $fh;
}
};
if (-e "$options->{root}/etc/ld.so.conf") {
$parse_ld_so_conf->("$options->{root}/etc/ld.so.conf");
}
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{LD_LIBRARY_PATH} = join ':', @ldlibpath;
}
}
# make sure that APT_CONFIG and TMPDIR are not set when executing
# anything inside the chroot
my @chrootcmd = ('env', '--unset=APT_CONFIG', '--unset=TMPDIR');
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') {
# 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";
}
# The rest of this block sets environment variables, so we
# have to add the "no critic" statement to stop perlcritic
# from complaining about setting global variables
## no critic (Variables::RequireLocalizedPunctuationVars)
# 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}
= "$ENV{LD_LIBRARY_PATH}:$fakechrootdir:$fakerootdir";
# 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};
}
} elsif (any { $_ eq $options->{mode} } ('root', 'unshare')) {
my $require_qemu_static = 1;
# make $@ local, so we don't print an eventual error
# in other parts where we evaluate $@
local $@ = '';
eval {
# Check for the F flag which makes the kernel open the binfmt
# binary at configuration time instead of lazily at startup
# time. If the flag is set, then the qemu-static binary is not
# required inside the chroot.
open my $fh, '<',
"/proc/sys/fs/binfmt_misc/qemu-$options->{qemu}";
while (my $line = <$fh>) {
chomp($line);
if ($line =~ /^flags: [A-Z]*F[A-Z]*$/) {
$require_qemu_static = 0;
last;
}
}
close $fh;
};
if ($require_qemu_static) {
# 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: $!";
}
}
return \@chrootcmd;
}
sub run_essential() {
my $options = shift;
my $essential_pkgs = shift;
my $chrootcmd = shift;
my $cached_debs = shift;
if (scalar @{$essential_pkgs} == 0) {
info "no essential packages -- skipping...";
return;
}
if ($options->{mode} eq 'chrootless') {
if ($options->{dryrun}) {
info "simulate installing essential packages...";
} else {
info "installing essential 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. See #808203
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",
$options->{dryrun} ? '-oAPT::Get::Simulate=true' : (),
);
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 "") {
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{QEMU_LD_PREFIX} = "$ENV{QEMU_LD_PREFIX}:$options->{root}";
} else {
## no critic (Variables::RequireLocalizedPunctuationVars)
$ENV{QEMU_LD_PREFIX} = $options->{root};
}
}
# we don't use apt because that will not run the base-passwd preinst
# early enough
#run_apt_progress({
# ARGV => ['apt-get', '--yes', @chrootless_opts, 'install'],
# PKGS => [map { "$options->{root}/$_" } @{$essential_pkgs}],
#});
run_dpkg_progress({
ARGV => [
'dpkg',
'--force-not-root',
'--force-script-chrootless',
"--root=$options->{root}",
"--log=$options->{root}/var/log/dpkg.log",
'--install',
'--force-depends'
],
PKGS => [map { "$options->{root}/$_" } @{$essential_pkgs}] });
} elsif (
any { $_ eq $options->{mode} }
('root', 'unshare', 'fakechroot', 'proot')
) {
# 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
#
# We could use apt from outside the chroot using DPkg::Chroot-Directory
# but then the preinst script of base-passwd will not be called early
# enough and packages will fail to install because they are missing
# /etc/passwd. Also, with plain dpkg the essential variant can finish
# within 9 seconds. If we use apt instead, it becomes 12 seconds. We
# prefer speed here.
if ($options->{dryrun}) {
info "simulate installing essential packages...";
} else {
info "installing essential packages...";
run_chroot(
sub {
run_dpkg_progress({
ARGV => [
@{$chrootcmd}, 'dpkg',
'--install', '--force-depends'
],
PKGS => $essential_pkgs,
});
},
$options
);
}
} else {
error "unknown mode: $options->{mode}";
}
if (any { $_ eq 'essential/unlink' } @{ $options->{skip} }) {
info "skipping essential/unlink as requested";
} else {
foreach my $deb (@{$essential_pkgs}) {
# do not unlink those packages that were in /var/cache/apt/archive
# before the download phase
next
if any { "/var/cache/apt/archives/$_" eq $deb } @{$cached_debs};
unlink "$options->{root}/$deb"
or error "cannot unlink $deb: $!";
}
}
return;
}
sub run_install() {
my $options = shift;
my $chrootcmd = shift;
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;
}
$pkgs_to_install{$pkg} = ();
}
}
if ($options->{variant} eq 'buildd') {
$pkgs_to_install{'build-essential'} = ();
}
if (
any { $_ eq $options->{variant} }