mmdebstrap/mmdebstrap
Benjamin Drung 1dbb576c99
Preserve extended attributes in tarball
When specifying a tarball as output format, the extended attributes are
lost. This leads to programs like ping fail to run as normal user.

Therefore preserve the extended attributes when generating the tarball.

Signed-off-by: Benjamin Drung <benjamin.drung@cloud.ionos.com>
2019-12-10 17:38:36 +01:00

4081 lines
144 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.
#
# 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.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 File::Basename;
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;
use Socket;
# 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";
}
}
# 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 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', '--threads=0'];
} 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: $!";
}
}
if (-e "$options->{root}/$fname") {
if (! -d "$options->{root}/$fname") {
error "$fname already exists but is not a directory";
}
} else {
my $num_created = make_path "$options->{root}/$fname", {error => \my $err};
if ($err && @$err) {
error (join "; ", (map {"cannot create " . (join ": ", %{$_})} @$err));
} elsif ($num_created == 0) {
error "cannot create $options->{root}/$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 {
# 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', '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 ($script =~ /^(copy-in|copy-out|tar-in|tar-out|upload|download) /) {
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
exec 'sh', '-c', "$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($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}) . "]";
} elsif (ref $value eq 'GLOB') {
debug "$key: GLOB";
} 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 \"$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;
{
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) {
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";
}
}
}
}
# 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
if (-e "$options->{root}/$fname") {
if (! -d "$options->{root}/$fname") {
error "$fname already exists but is not a directory";
}
} else {
my $num_created = make_path "$options->{root}/$fname", {error => \my $err};
if ($err && @$err) {
error (join "; ", (map {"cannot create " . (join ": ", %{$_})} @$err));
} elsif ($num_created == 0) {
error "cannot create $options->{root}/$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_chroot {
run_dpkg_progress({
ARGV => [@chrootcmd, 'env', '--unset=TMPDIR',
'dpkg', '--install', '--force-depends'],
PKGS => \@essential_pkgs,
});
} $options;
# 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
foreach my $fname ('/var/log/dpkg.log', '/var/log/apt/history.log', '/var/log/apt/term.log', '/var/log/alternatives.log', '/var/cache/ldconfig/aux-cache', '/var/log/apt/eipp.log.xz') {
my $path = "$options->{root}$fname";
if (! -e $path) {
next;
}
unlink $path or error "cannot unlink $path: $!";
}
}
# messages from process inside unshared namespace to the outside
# openw -- open file for writing
# untar -- extract tar into directory
# write -- write data to last opened file or tar process
# close -- finish file writing or tar extraction
# adios -- last message and tear-down
# messages from process outside unshared namespace to the inside
# okthx -- success
sub checkokthx {
my $fh = shift;
my $ret = read ($fh, my $buf, 2+5) // error "cannot read from socket: $!";
if ($ret == 0) { error "received eof on socket"; }
my ($len, $msg) = unpack("nA5", $buf);
if ($msg ne "okthx") { error "expected okthx but got: $msg"; }
if ($len != 0) { error "expected no payload but got $len bytes"; }
}
sub main() {
umask 022;
if (scalar @ARGV >= 7 && $ARGV[0] eq "--hook-helper") {
my $root = $ARGV[1];
my $mode = $ARGV[2];
my $hook = $ARGV[3];
my $qemu = $ARGV[4];
$verbosity_level = $ARGV[5];
my $command = $ARGV[6];
# unless we are in the setup hook (where there is no tar inside the
# chroot) we need to run tar on the inside because otherwise, possible
# absolute symlinks in the path given via --directory are not
# correctly resolved
#
# FIXME: the issue above can be fixed by a function that is able to
# resolve absolute symlinks even inside the chroot directory to a full
# path that is valid on the outside -- fakechroot and proot have their
# own reasons, see below
my @cmdprefix = ();
my @tarcmd = ('tar');
if ($hook eq 'setup') {
if ($mode eq 'proot') {
# since we cannot run tar inside the chroot under proot during
# the setup hook because the chroot is empty, we have to run
# tar from the outside, which leads to all files being owned
# by the user running mmdebstrap. To let the ownership
# information not be completely off, we force all files be
# owned by the root user.
push @tarcmd, '--owner=root', '--group=root';
}
} elsif (any { $_ eq $hook} ('essential', 'customize')) {
if ($mode eq 'fakechroot') {
# Fakechroot requires tar to run inside the chroot or
# otherwise absolute symlinks will include the path to the
# root directory
push @cmdprefix, '/usr/sbin/chroot', $root;
} elsif ($mode eq 'proot') {
# proot requires tar to run inside proot or otherwise
# permissions will be completely off
push @cmdprefix, 'proot', '--root-id', "--rootfs=$root", '--cwd=/', "--qemu=$qemu";
} elsif (any { $_ eq $mode } ('root', 'chrootless', 'unshare')) {
push @cmdprefix, '/usr/sbin/chroot', $root;
} else {
error "unknown mode: $mode";
}
} else {
error "unknown hook: $hook";
}
if (any { $_ eq $command} ('copy-in', 'tar-in', 'upload')) {
if (scalar @ARGV < 9) {
error "copy-in and tar-in need at least one path on the outside and the output path inside the chroot"
}
my $outpath = $ARGV[-1];
for (my $i = 7; $i < $#ARGV; $i++) {
# the right argument for tar's --directory argument depends on
# whether tar is called from inside the chroot or from the
# outside
my $directory;
if ($hook eq 'setup') {
$directory = "$root/$outpath";
} elsif (any { $_ eq $hook} ('essential', 'customize')) {
$directory = $outpath;
} else {
error "unknown hook: $hook";
}
# FIXME: here we would like to check if the path inside the
# chroot given by $directory actually exists but we cannot
# because we are missing a function that can resolve even
# paths including absolute symlinks to paths that are valid
# outside the chroot
my $fh;
if ($command eq 'upload') {
# open the requested file for writing
open $fh, '|-', @cmdprefix, 'sh', '-c', 'cat > "$1"', 'exec', $directory // error "failed to fork(): $!";
} else {
# open a tar process that extracts the tarfile that we supply
# it with on stdin to the output directory inside the chroot
open $fh, '|-', @cmdprefix, @tarcmd, '--directory', $directory, '--extract', '--file', '-' // error "failed to fork(): $!";
}
if ($command eq 'copy-in') {
# instruct the parent process to create a tarball of the
# requested path outside the chroot
debug "sending mktar";
print STDOUT (pack("n", length $ARGV[$i]) . "mktar" . $ARGV[$i]);
} else {
# instruct parent process to open a tarball of the
# requested path outside the chroot for reading
debug "sending openr";
print STDOUT (pack("n", length $ARGV[$i]) . "openr" . $ARGV[$i]);
}
STDOUT->flush();
debug "waiting for okthx";
checkokthx \*STDIN;
# handle "write" messages from the parent process and feed
# their payload into the tar process until a "close" message
# is encountered
while(1) {
# receive the next message
my $ret = read (STDIN, my $buf, 2+5) // error "cannot read from socket: $!";
if ($ret == 0) {
error "received eof on socket";
}
my ($len, $msg) = unpack("nA5", $buf);
debug "received message: $msg";
if ($msg eq "close") {
# finish the loop
if ($len != 0) {
error "expected no payload but got $len bytes";
}
debug "sending okthx";
print STDOUT (pack("n", 0) . "okthx") or error "cannot write to socket: $!";
STDOUT->flush();
last;
} elsif ($msg ne "write") {
# we should not receive this message at this point
print STDOUT (pack("n", 0) . "error") or error "cannot write to socket: $!";
STDOUT->flush();
error "expected write but got: $msg";
}
# read the payload
my $content;
{
my $ret = read (STDIN, $content, $len) // error "error cannot read from socket: $!";
if ($ret == 0) {
error "received eof on socket";
}
}
# write the payload to the tar process
print $fh $content or error "cannot write to tar process: $!";
debug "sending okthx";
print STDOUT (pack("n", 0) . "okthx") or error "cannot write to socket: $!";
STDOUT->flush();
}
close $fh;
if ($command ne 'upload' and $? != 0) {
error "tar failed";
}
}
} elsif (any { $_ eq $command} ('copy-out', 'tar-out', 'download')) {
if (scalar @ARGV < 9) {
error "copy-out needs at least one path inside the chroot and the output path on the outside"
}
my $outpath = $ARGV[-1];
for (my $i = 7; $i < $#ARGV; $i++) {
# the right argument for tar's --directory argument depends on
# whether tar is called from inside the chroot or from the
# outside
my $directory;
if ($hook eq 'setup') {
$directory = "$root/$ARGV[$i]";
} elsif (any { $_ eq $hook} ('essential', 'customize')) {
$directory = $ARGV[$i];
} else {
error "unknown hook: $hook";
}
# FIXME: here we would like to check if the path inside the
# chroot given by $directory actually exists but we cannot
# because we are missing a function that can resolve even
# paths including absolute symlinks to paths that are valid
# outside the chroot
my $fh;
if ($command eq 'download') {
# open the requested file for reading
open $fh, '-|', @cmdprefix, 'sh', '-c', 'cat "$1"', 'exec', $directory // error "failed to fork(): $!";
} else {
# Open a tar process that creates a tarfile of everything in
# the requested directory inside the chroot and writes it to
# stdout. To emulate the behaviour of cp, change to the
# dirname of the requested path first.
open $fh, '-|', @cmdprefix, @tarcmd, '--directory', dirname($directory), '--create', '--file', '-', basename($directory) // error "failed to fork(): $!";
}
if ($command eq 'copy-out') {
# instruct the parent process to extract a tarball to a
# certain path outside the chroot
debug "sending untar";
print STDOUT (pack("n", length $outpath) . "untar" . $outpath);
} else {
# instruct parent process to open a tarball of the
# requested path outside the chroot for writing
debug "sending openw";
print STDOUT (pack("n", length $outpath) . "openw" . $outpath);
}
STDOUT->flush();
debug "waiting for okthx";
checkokthx \*STDIN;
# read from the tar process and send as payload to the parent
# process
while (1) {
# read from tar
my $ret = read ($fh, my $cont, 4096) // error "cannot read from pipe: $!";
if ($ret == 0) { last; }
debug "sending write";
# send to parent
print STDOUT pack("n", $ret) . "write" . $cont;
STDOUT->flush();
debug "waiting for okthx";
checkokthx \*STDIN;
if ($ret < 4096) { last; }
}
# signal to the parent process that we are done
debug "sending close";
print STDOUT pack("n", 0) . "close";
STDOUT->flush();
debug "waiting for okthx";
checkokthx \*STDIN;
close $fh;
if ($command ne 'download' and $? != 0) {
error "tar failed";
}
}
} else {
error "unknown command: $command";
}
exit 0;
}
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 => [],
apttrusted => "/etc/apt/trusted.gpg",
apttrustedparts => "/etc/apt/trusted.gpg.d",
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 => 1) },
'man' => 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 "--keyring: apt cannot handle paths with double quotes: $opt_value";
}
if (! -e $opt_value) {
error "keyring \"$opt_value\" does not exist";
}
my $abs_path = abs_path($opt_value);
if (!defined $abs_path) {
error "unable to get absolute path of --keyring: $opt_value";
}
# since abs_path resolved all symlinks for us, we can now test
# what the actual target actually is
if (-d $opt_value) {
$options->{apttrustedparts} = $opt_value;
} else {
$options->{apttrusted} = $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 the currently selected apt keyrings do not contain the
# necessary key material for the chosen suite, then attempt adding
# a signed-by option
my $signedby = '';
{
# try to guess the right keyring path for the given suite
my $keyring;
if (any {$_ eq $suite} ('potato', 'woody', 'sarge', 'etch', 'lenny', 'squeeze', 'wheezy')) {
$keyring = '/usr/share/keyrings/debian-archive-removed-keys.gpg';
} elsif (any {$_ eq $suite} ('aequorea', 'bartholomea', 'chromodoris', 'dasyatis')) {
$keyring = '/usr/share/keyrings/tanglu-archive-keyring.gpg';
} elsif (any {$_ eq $suite} ('kali-dev', 'kali-rolling', 'kali-bleeding-edge')) {
$keyring = '/usr/share/keyrings/kali-archive-keyring.gpg';
} elsif (any {$_ eq $suite} ('trusty', 'xenial', 'zesty', 'artful', 'bionic', 'cosmic')) {
$keyring = '/usr/share/keyrings/ubuntu-archive-keyring.gpg';
} elsif (any {$_ eq $suite} ('unstable', 'stable', 'oldstable', 'jessie', 'stretch', 'buster', 'bullseye', 'bookworm')) {
$keyring = '/usr/share/keyrings/debian-archive-keyring.gpg';
}
# we can only check if we need the signed-by entry if we u
# automatically chosen keyring exists
if (defined $keyring && -e $keyring) {
# we can only check key material if gpg is installed
my $gpghome = tempdir("mmdebstrap.gpghome.XXXXXXXXXXXX", TMPDIR => 1, CLEANUP => 1);
my @gpgcmd = ('gpg', '--quiet', '--ignore-time-conflict', '--no-options', '--no-default-keyring', '--homedir', $gpghome, '--no-auto-check-trustdb', '--trust-model', 'always');
my ($ret, $fh, $message);
{
# change warning handler to prevent message
# Can't exec "gpg": No such file or directory
local $SIG{__WARN__} = sub { $message = shift; };
$ret = open $fh, '-|', @gpgcmd, '--version';
}
close $fh; # we only want to check if the gpg command exists
if ($? == 0 && defined $ret && !defined $message) {
# find all the fingerprints of the keys apt currently
# knows about
my @aptfingerprints = ();
my $collect_fingerprints = sub {
my $filename = shift;
open my $fh, '-|', @gpgcmd, '--keyring', $filename, '--with-colons', '--list-keys' // error "failed to fork(): $!";
while (my $line = <$fh>) {
if ($line !~ /^fpr:::::::::([^:]+):/) {
next;
}
push @aptfingerprints, $1;
}
close $fh;
};
opendir my $dh, "$options->{apttrustedparts}" or error "cannot read $options->{apttrustedparts}";
while (my $filename = readdir $dh) {
if ($filename !~ /\.(asc|gpg)$/) {
next;
}
$collect_fingerprints->("$options->{apttrustedparts}/$filename");
}
if (-e $options->{apttrusted}) {
$collect_fingerprints->($options->{apttrusted});
}
# check if all fingerprints from the keyring that we
# guessed are known by apt and only add signed-by
# option if that's not the case
my @suitefingerprints = ();
open my $suitefh, '-|', @gpgcmd, '--keyring', $keyring, '--with-colons', '--list-keys' // error "failed to fork(): $!";
while (my $line = <$suitefh>) {
if ($line !~ /^fpr:::::::::([^:]+):/) {
next;
}
# if this fingerprint is not known by apt, then we
# need to add the signed-by option
if (none { $_ eq $1 } @aptfingerprints) {
$signedby = " [signed-by=\"$keyring\"]";
last;
}
}
close $suitefh;
if ($? != 0) {
error "gpg failed";
}
} else {
info "gpg --version failed: cannot determine the right signed-by value"
}
remove_tree($gpghome, {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"; }
}
}
}
}
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$signedby $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 {