mmdebstrap/mmdebstrap

#!/usr/bin/perl
#
# Copyright: 2018 Johannes Schauer <josch@mister-muffin.de>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.

use strict;
use warnings;

use English;
use Getopt::Long;
use Pod::Usage;
use File::Copy;
use File::Path qw(make_path remove_tree);
use File::Temp qw(tempfile tempdir);
use Cwd qw(abs_path);
require "syscall.ph";
use Fcntl qw(S_IFCHR S_IFBLK FD_CLOEXEC F_GETFD F_SETFD);
use List::Util qw(any none);
use POSIX qw(SIGINT SIGHUP SIGPIPE SIGTERM SIG_BLOCK SIG_UNBLOCK);

# 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 ],
);

# 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_compress_options($) {
    my $filename = shift;
    if ($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 ('--use-compress-program', 'lz4');
    } elsif ($filename =~ /\.(xz|txz)$/) {
	return ('--xz');
    }
    return ();
}

sub test_unshare($) {
    my $verbose = shift;
    if ($EFFECTIVE_USER_ID == 0) {
	if ($verbose) {
	    print STDERR "E: cannot use unshare mode when executing as root\n";
	}
	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() // die "fork() failed: $!";
    if ($pid == 0) {
	my $ret = syscall &SYS_unshare, $unshare_flags;
	if ($ret == 0) {
	    exit 0;
	} else {
	    if ($verbose) {
		print STDERR "E: unshare syscall failed: $!\n";
	    }
	    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 ($verbose) {
	    if (($? >> 8) == 127) {
		print STDERR "E: cannot find newuidmap\n";
	    } else {
		print STDERR "E: newuidmap returned unknown exit status\n";
	    }
	}
	return 0;
    }
    system "newgidmap 2>/dev/null";
    if (($? >> 8) != 1) {
	if ($verbose) {
	    if (($? >> 8) == 127) {
		print STDERR "E: cannot find newgidmap\n";
	    } else {
		print STDERR "E: newgidmap returned unknown exit status\n";
	    }
	}
	return 0;
    }
    return 1;
}

sub read_subuid_subgid() {
    my $username = getpwuid $<;
    my ($subid, $num_subid, $fh, $n);
    my @result = ();

    if (! -e "/etc/subuid") {
	printf STDERR "/etc/subuid doesn't exist\n";
	return;
    }
    if (! -r "/etc/subuid") {
	printf STDERR "/etc/subuid is not readable\n";
	return;
    }

    open $fh, "<", "/etc/subuid" or die "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) {
	printf STDERR "/etc/subuid does not contain an entry for $username\n";
	return;
    }
    if (scalar(@result) > 1) {
	printf STDERR "/etc/subuid contains multiple entries for $username\n";
	return;
    }

    open $fh, "<", "/etc/subgid" or die "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) {
	printf STDERR "/etc/subgid does not contain an entry for $username\n";
	return;
    }
    if (scalar(@result) > 2) {
	printf STDERR "/etc/subgid contains multiple entries for $username\n";
	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() // die "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() // die "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 die "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") {
		    die "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 die "newuidmap $ppid $uidmapcmd failed: $!";
	    }
	    if ($gidmapcmd ne "") {
		0 == system "newgidmap $ppid $gidmapcmd" or die "newgidmap $ppid $gidmapcmd failed: $!";
	    }
	    exit 0;
	}

	# parent

	# After fork()-ing, the parent immediately calls unshare...
	0 == syscall &SYS_unshare, $unshare_flags or die "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 die "waitpid() failed: $!";
	my $exit = $? >> 8;
	if ($exit != 0) {
	    die "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 die "setgid failed: $!";
	0 == syscall &SYS_setuid, 0 or die "setuid failed: $!";
	0 == syscall &SYS_setgroups, 0, 0 or die "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() // die "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 die "waitpid() failed: $!";
		exit ($? >> 8);
	    }
	}

	&{$cmd}();

	exit 0;
    }

    # parent
    return $gcpid;
}

sub havemknod($) {
    my $root = shift;
    my $havemknod = 0;
    if (-e "$root/test-dev-null") {
	die "/test-dev-null already exists";
    }
    TEST: {
	# we fork so that we can read STDERR
	my $pid = open my $fh, '-|' // die "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 die "cannot unlink /test-dev-null";
    }
    return $havemknod;
}

sub print_progress {
    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, $verbose) = @_;
    pipe my $rfh, my $wfh;
    my $got_signal = 0;
    my $ignore = sub {
	print STDERR "I: run_progress() received signal $_[0]: waiting for child...\n";
    };

    # 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 die "Can't block signals: $!\n";

    my $pid1 = open(my $pipe, '-|') // die "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 die "Can't unblock signals: $!\n";

	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 die "fcntl F_GETFD: $!";
	fcntl($wfh, F_SETFD, $flags & ~FD_CLOEXEC ) or die "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);
	exec { $execargs[0] } @execargs;
	die '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() // die "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 die "Can't unblock signals: $!\n";

	print_progress 0.0 if not $verbose;
	while (my $line = <$rfh>) {
	    next if $verbose;
	    my $output = $line_handler->($line);
	    next unless $output;
	    print_progress $output;
	}
	print_progress "done" if not $verbose;

	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 die "Can't unblock signals: $!\n";

    my $output = '';
    my $has_error = 0;
    while (my $line = <$pipe>) {
	$has_error = $line_has_error->($line);
	if ($verbose) {
	    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 die "progress parsing failed";

    if ($got_signal) {
	die "run_progress() received signal: $got_signal";
    }

    # only print failure after progress output finished or otherwise it
    # might interfere with the remaining output
    if ($fail) {
	print STDERR $output;
	die ((join ' ', $get_exec->('<$fd>')) . ' failed');
    }
}

sub run_dpkg_progress {
    my $options = shift;
    my @debs = @{$options->{PKGS} // []};
    my $verbose = $options->{VERBOSE} // 0;
    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, $verbose;
}

sub run_apt_progress {
    my $options = shift;
    my @debs = @{$options->{PKGS} // []};
    my $verbose = $options->{VERBOSE} // 0;
    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 {
	# 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, $verbose;
}

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) {
	    print STDERR "W: pid $PID cought signal: $signal\n";
	    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
		    die "type 0 not implemented";
		} elsif ($type == 1) { # hardlink
		    die "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 die "cannot create symlink $fname";
		    }
		} elsif ($type == 3 or $type == 4) { # character/block special
		    if (!$options->{havemknod}) {
			open my $fh, '>', "$options->{root}/$fname" or die "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 {
			    die "unknown mode: $options->{mode}";
			}
			0 == system('mount', '-o', 'bind', "/$fname", "$options->{root}/$fname") or die "mount $fname failed: $?";
		    }
		} elsif ($type == 5) { # directory
		    if (!$options->{havemknod}) {
			if (any { $_ eq $options->{mode} } ('root', 'unshare')) {
			    push @cleanup_tasks, sub {
				rmdir "$options->{root}/$fname" or warn "cannot rmdir $fname: $!";
			    }
			}
			make_path "$options->{root}/$fname" or die "cannot make_path $fname";
			chmod $mode, "$options->{root}/$fname" or die "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 {
			die "unknown mode: $options->{mode}";
		    }
		    0 == system('mount', '-o', 'bind', "/$fname", "$options->{root}/$fname") or die "mount $fname failed: $?";
		} else {
		    die "unsupported type: $type";
		}
	    }
	} elsif (any { $_ eq $options->{mode} } ('proot', 'fakechroot')) {
	    # we cannot mount in fakechroot and proot mode
	    # in proot mode we have /dev bind-mounted already through --bind=/dev
	} else {
	    die "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 die "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 die "mount /sys failed: $?";
	} elsif (any { $_ eq $options->{mode} } ('proot', 'fakechroot')) {
	    # we cannot mount in fakechroot and proot mode
	    # in proot mode we have /proc bind-mounted already through --bind=/proc
	} else {
	    die "unknown mode: $options->{mode}";
	}
	if ($options->{mode} eq 'root') {
	    push @cleanup_tasks, sub {
		0 == system('umount', "$options->{root}/proc") or die "umount /proc failed: $?";
	    };
	    0 == system('mount', '-t', 'proc', 'proc', "$options->{root}/proc") or die "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 die "umount /proc failed: $?";
	    };
	    0 == system('mount', '-t', 'proc', 'proc', "$options->{root}/proc") or die "mount /proc failed: $?";
	} elsif (any { $_ eq $options->{mode} } ('proot', 'fakechroot')) {
	    # we cannot mount in fakechroot and proot mode
	    # in proot mode we have /sys bind-mounted already through --bind=/sys
	} else {
	    die "unknown mode: $options->{mode}";
	}

	# prevent daemons from starting
	{
	    open my $fh, '>', "$options->{root}/usr/sbin/policy-rc.d" or die "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 die "cannot chmod policy-rc.d: $!";
	}

	{
	    move("$options->{root}/sbin/start-stop-daemon", "$options->{root}/sbin/start-stop-daemon.REAL") or die "cannot move start-stop-daemon";
	    open my $fh, '>', "$options->{root}/sbin/start-stop-daemon" or die "cannot open policy-rc.d: $!";
	    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 die "cannot chmod start-stop-daemon: $!";
	}

	&{$cmd}();

	# cleanup
	move("$options->{root}/sbin/start-stop-daemon.REAL", "$options->{root}/sbin/start-stop-daemon") or die "cannot move start-stop-daemon";
	unlink "$options->{root}/usr/sbin/policy-rc.d" or die "cannot unlink policy-rc.d";

    };

    my $error = $@;

    # we use the cleanup function to do the unmounting
    $cleanup->(0);

    if ($error) {
	die "run_chroot failed: $error";
    }
}

sub setup {
    my $options = shift;

    if (0) {
	foreach my $key (sort keys %{$options}) {
	    my $value = $options->{$key};
	    if (!defined $value) {
		next;
	    }
	    if (ref $value eq '') {
		print STDERR "I: $key: $options->{$key}\n";
	    } elsif (ref $value eq 'ARRAY') {
		print STDERR "I: $key: [" . (join ', ', @{$value}) . "]\n";
	    } else {
		die "unknown type";
	    }
	}
    }

    my ($conf, $tmpfile) = tempfile(UNLINK => 1) or die "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::Etc \"$options->{root}/etc/apt\";\n";
    print $conf "Dir::State \"$options->{root}/var/lib/apt\";\n";
    print $conf "Dir::Cache \"$options->{root}/var/cache/apt\";\n";
    print $conf "Dir::Log \"$options->{root}/var/log/apt\";\n";
    # for authentication, use the keyrings from the host
    print $conf "Dir::Etc::Trusted \"/etc/apt/trusted.gpg\";\n";
    print $conf "Dir::Etc::TrustedParts \"/etc/apt/trusted.gpg.d\";\n";
    close $conf;

    {
	my @directories = ('/etc/apt/apt.conf.d', '/etc/apt/sources.list.d',
	    '/etc/apt/preferences.d', '/var/cache/apt',
	    '/var/lib/apt/lists/partial', '/var/lib/dpkg',
	    '/etc/dpkg/dpkg.cfg.d/');
	# if dpkg and apt operate from the outside we need some more
	# directories because dpkg and apt might not even be installed inside
	# the chroot
	if ($options->{mode} eq 'chrootless') {
	    push @directories, ('/var/log/apt', '/var/lib/dpkg/triggers',
		'/var/lib/dpkg/info', '/var/lib/dpkg/alternatives',
		'/var/lib/dpkg/updates');
	}
	foreach my $dir (@directories) {
	    make_path("$options->{root}/$dir") or die "failed to create $dir: $!";
	}
    }

    # We put certain configuration items in their own configuration file
    # because they have to be valid for apt invocation from outside as well as
    # from inside the chroot.
    # The config filename is chosen such that any settings in it will be
    # overridden by what the user specified with --aptopt.
    {
	open my $fh, '>', "$options->{root}/etc/apt/apt.conf.d/00mmdebstrap" or die "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 die "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 die "failed to open(): $!";
	close $fh;
    }

    if (scalar @{$options->{foreignarchs}} > 0) {
	open my $fh, '>', "$options->{root}/var/lib/dpkg/arch" or die "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 die "cannot open /etc/apt/apt.conf.d/99mmdebstrap: $!";
	foreach my $opt (@{$options->{aptopts}}) {
	    if (-r $opt) {
		copy $opt, $fh or die "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 die "cannot open /etc/dpkg/dpkg.cfg.d/99mmdebstrap: $!";
	foreach my $opt (@{$options->{dpkgopts}}) {
	    if (-r $opt) {
		copy $opt, $fh or die "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 die "cannot open fstab: $!";
	print $fh "# UNCONFIGURED FSTAB FOR BASE SYSTEM\n";
	close $fh;
	chmod 0644, "$options->{root}/etc/fstab" or die "cannot chmod fstab: $!";
    }

    # write /etc/apt/sources.list
    {
	open my $fh, '>', "$options->{root}/etc/apt/sources.list" or die "cannot open /etc/apt/sources.list: $!";
	print $fh $options->{sourceslist};
	close $fh;
    }

    # allow network access from within
    copy("/etc/resolv.conf", "$options->{root}/etc/resolv.conf") or die "cannot copy /etc/resolv.conf: $!";
    copy("/etc/hostname", "$options->{root}/etc/hostname") or die "cannot copy /etc/hostname: $!";

    if ($options->{havemknod}) {
	foreach my $file (@devfiles) {
	    my ($fname, $mode, $type, $linkname, $devmajor, $devminor) = @{$file};
	    if ($type == 0) { # normal file
		die "type 0 not implemented";
	    } elsif ($type == 1) { # hardlink
		die "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 die "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 die "mknod failed: $?";
	    } elsif ($type == 4) { # block special
		0 == system('mknod', "$options->{root}/$fname", 'b', $devmajor, $devminor) or die "mknod failed: $?";
	    } elsif ($type == 5) { # directory
		make_path "$options->{root}/$fname", { error => \my $err };
		if (@$err) {
		    die "cannot create $fname";
		}
	    } else {
		die "unsupported type: $type";
	    }
	    chmod $mode, "$options->{root}/$fname" or die "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";

    print STDERR "I: running apt-get update...\n";
    run_apt_progress({
	    ARGV => ['apt-get', 'update'],
	    VERBOSE => $options->{verbose}
	});

    # check if anything was downloaded at all
    {
	open my $fh, '-|', 'apt-get', 'indextargets' // die "failed to fork(): $!";
	chomp (my $indextargets = do { local $/; <$fh> });
	close $fh;
	if ($indextargets eq '') {
	    print STDERR "content of /etc/apt/sources.list:\n";
	    copy("$options->{root}/etc/apt/sources.list", *STDERR);
	    die "apt-get update didn't download anything";
	}
    }

    # 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";
    }

    my %pkgs_to_install;
    if (defined $options->{include}) {
	for my $pkg (split /,/, $options->{include}) {
	    $pkgs_to_install{$pkg} = ();
	}
    }
    if ($options->{variant} eq 'buildd') {
	$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')) {
	print STDERR "I: downloading packages with apt...\n";
	run_apt_progress({
		ARGV => ['apt-get', '--yes',
		    '-oApt::Get::Download-Only=true',
		    'install'],
		PKGS => [keys %pkgs_to_install],
		VERBOSE => $options->{verbose}
	    });
    } 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!")
	print STDERR "I: downloading packages with apt...\n";
	run_apt_progress({
		ARGV => ['apt-get', '--yes',
		    '-oApt::Get::Download-Only=true',
		    'dist-upgrade'],
		VERBOSE => $options->{verbose}
	    });
    } 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 die "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 die "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')) {
				$pkgs_to_install{$pkgname} = ();
			    }
			} elsif ($prio eq 'important') {
			    if (none { $_ eq $options->{variant} } ('required', 'buildd', 'minbase')) {
				$pkgs_to_install{$pkgname} = ();
			    }
			} elsif ($prio eq 'required') {
			    # required packages are part of all sets except
			    # essential and apt
			    $pkgs_to_install{$pkgname} = ();
			} else {
			    die "unknown priority: $prio";
			}
		    } else {
			die "unknown variant: $options->{variant}";
		    }
		}
		# reset values
		undef $pkgname;
		$ess = '';
		$prio = 'optional';
		$arch = '';
	    }

	    close $pipe_cat;
	    $? == 0 or die "apt-helper cat-file failed: $?";
	}
	close $pipe_apt;
	$? == 0 or die "apt-get indextargets failed: $?";

	print STDERR "I: downloading packages with apt...\n";
	run_apt_progress({
		ARGV => ['apt-get', '--yes',
		    '-oApt::Get::Download-Only=true',
		    'install'],
		PKGS => [keys %ess_pkgs],
		VERBOSE => $options->{verbose}
	    });
    } else {
	die "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 die "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 die "cannot start apt-get indextargets: $!";
	while (my $uri = <$pipe_apt>) {
	    if ($uri =~ /^file:\/\//) {
		die "nothing got downloaded -- use copy:// instead of file://";
	    }
	}
	die "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 {
	print STDERR "I: extracting archives...\n";
	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() // die "fork() failed: $!";
	    if ($pid1 == 0) {
		open(STDOUT, '>&', $wfh);
		exec 'dpkg-deb', '--fsys-tarfile', "$options->{root}/$deb";
	    }
	    my $pid2 = fork() // die "fork() failed: $!";
	    if ($pid2 == 0) {
		open(STDIN, '<&', $rfh);
		exec 'tar', '-C', $options->{root}, '--keep-directory-symlink', '--extract', '--file', '-';
	    }
	    waitpid($pid1, 0);
	    $? == 0 or die "dpkg-deb --fsys-tarfile failed: $?";
	    waitpid($pid2, 0);
	    $? == 0 or die "tar --extract failed: $?";
	    print_progress ($counter/$total*100);
	}
	print_progress "done";
    }

    if ($options->{mode} eq 'chrootless') {
	print STDERR "I: installing packages...\n";
	# 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 ($options->{variant} eq 'extract') {
	    # nothing to do
	} else {
	    run_apt_progress({
		    ARGV => ['apt-get', '--yes',
			@chrootless_opts,
			'install'],
		    PKGS => [map { "$options->{root}/$_" } @essential_pkgs],
		    VERBOSE => $options->{verbose}
		});
	}
	if (any { $_ eq $options->{variant} } ('extract', 'custom')) {
	    # nothing to do
	} elsif (any { $_ eq $options->{variant} } ('essential', 'apt', 'standard', 'important', 'required', 'buildd', 'minbase')) {
	    if (%pkgs_to_install) {
		run_apt_progress({
			ARGV => ['apt-get', '--yes',
			    @chrootless_opts,
			    'install'],
			PKGS => [keys %pkgs_to_install],
			VERBOSE => $options->{verbose}
		    });
	    }
	} else {
	    die "unknown variant: $options->{variant}";
	}
    } elsif (any { $_ eq $options->{mode} } ('root', 'unshare', 'fakechroot', 'proot')) {

	if ($options->{variant} eq '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 die "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 die "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 = ('env', '--unset=APT_CONFIG');
	    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 {
		die "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
		    $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' // die "failed to fork(): $!";
		    chomp (my $deb_host_multiarch = do { local $/; <$fh> });
		    close $fh;
		    if ($? != 0 or !$deb_host_multiarch) {
			die "dpkg-architecture failed: $?";
		    }
		    my $fakechrootdir = "/usr/lib/$deb_host_multiarch/fakechroot";
		    if (!-e "$fakechrootdir/libfakechroot.so") {
			die "$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") {
			die "$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) {
			die "cannot find $qemubin";
		    }
		    copy $qemubin, "$options->{root}/$qemubin" or die "cannot copy $qemubin: $!";
		} else {
		    die "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 die "cannot create directory: $!";
		my $ret = system @chrootcmd, '/bin/mv', '/000-move-me', '/001-delete-me';
		if ($ret != 0) {
		    print STDERR "I: the /bin/mv binary inside the chroot doesn't work under ";
		    if ($options->{mode} eq 'proot') {
			print STDERR "proot\n";
			print STDERR "I: this is likely due to missing support for renameat2 in proot\n";
			print STDERR "I: see https://github.com/proot-me/PRoot/issues/147\n";
		    } else {
			print STDERR "fakechroot\n";
			print STDERR "I: with certain versions of coreutils and glibc, this is due to missing support for renameat2 in fakechroot\n";
			print STDERR "I: see https://github.com/dex4er/fakechroot/issues/60\n";
		    }
		    print STDERR "I: expect package post installation scripts not to work\n";
		    rmdir "$options->{root}/000-move-me" or die "cannot rmdir: $!";
		} else {
		    rmdir "$options->{root}/001-delete-me" or die "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
	    print STDERR "I: installing packages...\n";
	    run_dpkg_progress({
		    ARGV => [@chrootcmd, 'dpkg', '--install', '--force-depends'],
		    PKGS => \@essential_pkgs,
		    VERBOSE => $options->{verbose}
		});

	    # 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 die "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
		    print STDERR "I: re-installing packages because of path-exclude...\n";
		    run_dpkg_progress({
			    ARGV => [@chrootcmd, 'dpkg', '--install', '--force-depends'],
			    PKGS => \@essential_pkgs,
			    VERBOSE => $options->{verbose}
			});
		}
	    }

	    foreach my $deb (@essential_pkgs) {
		unlink "$options->{root}/$deb" or die "cannot unlink $deb";
	    }

	    if (%pkgs_to_install) {
		# 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') {
		    $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 die "cannot start apt-get indextargets: $!";
		while (my $uri = <$pipe_apt>) {
		    if ($uri =~ /^https:\/\//) {
			# FIXME: support for https is part of apt >= 1.5
			$pkgs_to_install_from_outside{'apt-transport-https'} = ();
			$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://
			$pkgs_to_install_from_outside{'apt-transport-tor'} = ();
			last;
		    }
		}
		close $pipe_apt;
		$? == 0 or die "apt-get indextargets failed";

		if (%pkgs_to_install_from_outside) {
		    print STDERR 'I: downloading ' . (join ', ', keys %pkgs_to_install_from_outside) . "...\n";
		    run_apt_progress({
			    ARGV => ['apt-get', '--yes',
				'-oApt::Get::Download-Only=true',
				'install'],
			    PKGS => [keys %pkgs_to_install_from_outside],
			    VERBOSE => $options->{verbose}
			});
		    my @debs_to_install;
		    my $apt_archives = "/var/cache/apt/archives/";
		    opendir my $dh, "$options->{root}/$apt_archives" or die "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) {
			die "nothing got downloaded";
		    }
		    # we need --force-depends because dpkg does not take Pre-Depends
		    # into account and thus doesn't install them in the right order
		    print STDERR 'I: installing ' . (join ', ', keys %pkgs_to_install_from_outside) . "...\n";
		    run_dpkg_progress({
			    ARGV => [@chrootcmd, 'dpkg',  '--install', '--force-depends'],
			    PKGS => \@debs_to_install,
			    VERBOSE => $options->{verbose}
			});
		    foreach my $deb (@debs_to_install) {
			unlink "$options->{root}/$deb" or die "cannot unlink $deb";
		    }
		}

		run_chroot {
		    print STDERR "I: installing remaining packages inside the chroot...\n";
		    run_apt_progress({
			    ARGV => [@chrootcmd, 'apt-get', '--yes', 'install'],
			    PKGS => [keys %pkgs_to_install],
			    VERBOSE => $options->{verbose}
			});
		} $options;

	    }
	} else {
	    die "unknown variant: $options->{variant}";
	}
    } else {
	die "unknown mode: $options->{mode}";
    }

    if (scalar @{$options->{customize}} > 0) {
	run_chroot {
	    foreach my $script (@{$options->{customize}}) {
		if ( -x $script || $script !~ m/[^\w@\%+=:,.\/-]/a) {
		    print STDERR "I: running customize script directly: $script $options->{root}\n";
		    # 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 die "customization script failed: $script";
		} else {
		    print STDERR "I: running customize script in shell: sh -c '$script' exec $options->{root}\n";
		    # otherwise, wrap everything in sh -c
		    0 == system('sh', '-c', $script, 'exec', $options->{root}) or die "customization script failed: $script";
		}
	    }
	} $options;
    }

    # clean up temporary configuration file
    unlink "$options->{root}/etc/apt/apt.conf.d/00mmdebstrap" or die "failed to unlink /etc/apt/apt.conf.d/00mmdebstrap: $!";

    print STDERR "I: cleaning package lists and apt cache...\n";
    run_apt_progress({
	    ARGV => ['apt-get', '--option', 'Dir::Etc::SourceList=/dev/null', 'update'],
	    VERBOSE => $options->{verbose}
	});
    run_apt_progress({
	    ARGV => ['apt-get', 'clean'],
	    VERBOSE => $options->{verbose}
	});

    if (defined $options->{qemu} and $options->{mode} ne 'proot' and $options->{mode} ne 'fakechroot') {
	unlink "$options->{root}/usr/bin/qemu-$options->{qemu}-static" or die "cannot unlink /usr/bin/qemu-$options->{qemu}-static";
    }

    # clean up certain files to make output reproducible
    unlink "$options->{root}/var/log/dpkg.log";
    unlink "$options->{root}/var/log/apt/history.log";
    unlink "$options->{root}/var/log/apt/term.log";
    unlink "$options->{root}/var/log/alternatives.log";
    unlink "$options->{root}/var/cache/ldconfig/aux-cache";

    # clean up leftover lock files
    unlink "$options->{root}/var/cache/apt/archives/lock";
    unlink "$options->{root}/var/lib/apt/extended_states";
    unlink "$options->{root}/var/lib/apt/lists/lock";
    unlink "$options->{root}/var/lib/dpkg/lock-frontend";
    unlink "$options->{root}/var/lib/dpkg/lock";
}

sub main() {
    umask 022;

    my $mtime = time;
    if (exists $ENV{SOURCE_DATE_EPOCH}) {
	$mtime = $ENV{SOURCE_DATE_EPOCH}+0;
    }

    $ENV{DEBIAN_FRONTEND} = 'noninteractive';
    $ENV{DEBCONF_NONINTERACTIVE_SEEN} = 'true';
    $ENV{LC_ALL} = 'C.UTF-8';
    $ENV{LANGUAGE} = 'C.UTF-8';
    $ENV{LANG} = 'C.UTF-8';

    # copy ARGV because getopt modifies it
    my @ARGVORIG = @ARGV;

    my $options = {
	components => "main",
	variant => "important",
	include => undef,
	mode => 'auto',
	dpkgopts => [],
	aptopts => [],
	verbose => 0,
	customize => [],
    };
    chomp ($options->{architectures} = `dpkg --print-architecture`);
    Getopt::Long::Configure ("bundling");
    GetOptions(
	'h|help'   => sub { pod2usage(-exitval => 0, -verbose => 2) },
	'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},
	'verbose' => \$options->{verbose},
	# no-op options so that mmdebstrap can be used with
	# sbuild-createchroot --debootstrap=mmdebstrap
	'resolve-deps' => sub {},
	'merged-usr' => sub {},
	'no-merged-usr' => sub {},
	# option is hidden until I'm happy with it
	'customize=s@' => \$options->{customize},
    ) or pod2usage(-exitval => 2, -verbose => 1);

    my @valid_variants = ('extract', 'custom', 'essential', 'apt', 'required',
	'minbase', 'buildd', 'important', 'debootstrap', '-', 'standard');
    if (none { $_ eq $options->{variant}} @valid_variants) {
	die "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 defined $options->{include}) {
	die "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) {
	die "invalid mode. Choose from " . (join ', ', @valid_modes);
    }

    # figure out the mode to use or test whether the chosen mode is legal
    if ($options->{mode} eq 'auto') {
	if ($EFFECTIVE_USER_ID == 0) {
	    $options->{mode} = 'root';
	} elsif (test_unshare(0)) {
	    $options->{mode} = 'unshare';
	} elsif (system('proot --version>/dev/null') == 0) {
	    $options->{mode} = 'proot';
	} elsif (system('fakechroot --version>/dev/null') == 0) {
	    $options->{mode} = 'fakechroot';
	} else {
	    die "unable to pick chroot mode automatically";
	}
	print STDERR "I: automatically chosen mode: $options->{mode}\n";
    } elsif ($options->{mode} eq 'root') {
	if ($EFFECTIVE_USER_ID != 0) {
	    die "need to be root";
	}
    } elsif ($options->{mode} eq 'proot') {
	if (system('proot --version>/dev/null') != 0) {
	    die "need working proot binary";
	}
    } elsif ($options->{mode} eq 'fakechroot') {
	# 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, '-|' // die "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;
	if ($? == 0 and $content =~ /^fakechroot \d\.\d+$/) {
	    # fakechroot is already running
	} elsif (system('fakechroot --version>/dev/null') != 0) {
	    die "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 die "failed to open $procfile: $!";
	    chomp(my $content = do { local $/; <$fh> });
	    close($fh);
	    if ($content ne "1") {
		print STDERR "I: /proc/sys/kernel/unprivileged_userns_clone is set to $content\n";
		print STDERR "I: try running: sudo sysctl -w kernel.unprivileged_userns_clone=1\n";
		print STDERR "I: or permanently enable unprivileged usernamespaces by putting the setting into /etc/sysctl.d/\n";
		print STDERR "I: see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=898446\n";
	    }
	    exit 1;
	}
    } elsif ($options->{mode} eq 'chrootless') {
	# nothing to do
    } else {
	die "unknown mode: $options->{mode}";
    }

    my ($nativearch, @foreignarchs) = split /,/, $options->{architectures};
    $options->{nativearch} = $nativearch;
    $options->{foreignarchs} = \@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',
	};
	chomp (my $hostarch = `dpkg --print-architecture`);
	if ($hostarch ne $nativearch) {
	    my $pid = open my $fh, '-|' // die "failed to fork(): $!";
	    if ($pid == 0) {
		{
		    no warnings; # don't print a warning if the following fails
		    exec 'arch-test', '-n', $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 "$nativearch: not supported on this machine/kernel\n";
		exit 1;
	    }
	    chomp (my $content = do { local $/; <$fh> });
	    close $fh;
	    if ($? != 0 or $content ne "$nativearch: ok") {
		print STDERR "I: $nativearch cannot be executed, falling back to qemu-user\n";
		if (!exists $deb2qemu->{$nativearch}) {
		    die "no mapping from $nativearch to qemu-user binary";
		}
		$options->{qemu} = $deb2qemu->{$nativearch};
		{
		    open my $fh, '<', '/proc/filesystems' or die "failed to open /proc/filesystems: $!";
		    unless (grep /^nodev\tbinfmt_misc$/, (<$fh>)) {
			die "binfmt_misc not found in /proc/filesystems -- is the module loaded?";
		    }
		    close $fh;
		}
		{
		    open my $fh, '<', '/proc/mounts' or die "failed to open /proc/mounts: $!";
		    unless (grep /^binfmt_misc \/proc\/sys\/fs\/binfmt_misc binfmt_misc/, (<$fh>)) {
			die "binfmt_misc not found in /proc/mounts -- not mounted?";
		    }
		    close $fh;
		}
		{
		    open my $fh, '-|', '/usr/sbin/update-binfmts', '--display', "qemu-$options->{qemu}" // die "failed to fork(): $!";
		    chomp (my $binfmts = do { local $/; <$fh> });
		    close $fh;
		    if ($binfmts eq '') {
			die "qemu-$options->{qemu} is not a supported binfmt name";
		    }
		}
	    } else {
		print STDERR "I: $nativearch can be executed on this $hostarch machine\n";
	    }
	} else {
	    print STDERR "I: chroot architecture $nativearch is equal to the host's architecture\n";
	}
    }

    {
	my $suite;
	if (scalar @ARGV > 0) {
	    $suite = shift @ARGV;
	    if (scalar @ARGV > 0) {
		$options->{target} = shift @ARGV;
	    } else {
		$options->{target} = '-';
	    }
	} else {
	    print STDERR "I: No SUITE specified, expecting sources.list on standard input\n";
	    $options->{target} = '-';
	}

	my $sourceslist = '';
	my $stdindata = '';
	# make sure that we only attempt to read from STDIN if it's *not*
	# connected to the terminal (because we don't expect the user to type
	# the sources.list file
	if (! -t STDIN) {
	    print STDERR "I: Reading sources.list from standard input...\n";
	    $stdindata = do { local $/; <STDIN> };
	}
	if (! defined $suite) {
	    # If no suite was specified, then the whole sources.list has to
	    # come from standard input
	    $sourceslist .= $stdindata;
	} else {
	    if (scalar @ARGV > 0) {
		for my $arg (@ARGV) {
		    if ($arg eq '-') {
			$sourceslist .= $stdindata;
		    } elsif ($arg =~ /^deb(-src)? /) {
			$sourceslist .= "$arg\n";
		    } elsif ($arg =~ /:\/\//) {
			$sourceslist .= "deb $arg $suite $options->{components}\n";
		    } elsif (-f $arg) {
			open my $fh, '<', $arg or die "cannot open $arg: $!";
			while (my $line = <$fh>) {
			    $sourceslist .= $line;
			}
			close $fh;
		    } else {
			die "invalid mirror: $arg";
		    }
		}
		# if there was no explicit '-' mirror listed and something was
		# read on standard input, then just append it to the end
		if (none { $_ eq '-' } @ARGV) {
		    # if nothing was read on standard input then nothing will
		    # be appended
		    $sourceslist .= $stdindata;
		}
	    } elsif ($stdindata ne '') {
		$sourceslist .= $stdindata;
	    } else {
		# FIXME: change default mirror depending on $suite
		#        (for derivatives)
		$sourceslist .= "deb http://deb.debian.org/debian $suite $options->{components}\n";
		if (any { $_ eq $suite } ('stable', 'oldstable', 'stretch') ) {
		    $sourceslist .= "deb http://deb.debian.org/debian $suite-updates $options->{components}\n";
		    $sourceslist .= "deb http://security.debian.org/debian-security $suite/updates $options->{components}\n";
		}
	    }
	}
	if ($sourceslist eq '') {
	    die "empty apt sources.list";
	}
	$options->{sourceslist} = $sourceslist;
    }

    if ($options->{target} ne '-') {
	my $abs_path = abs_path($options->{target});
	if (!defined $abs_path) {
	    die "unable to get absolute path of target directory $options->{target}";
	}
	$options->{target} = $abs_path;
    }

    if ($options->{target} eq '/') {
	die "refusing to use the filesystem root as output directory";
    }

    my @tar_compress_opts = get_tar_compress_options($options->{target});

    # figure out whether a tarball has to be created in the end
    $options->{maketar} = 0;
    if (scalar @tar_compress_opts > 0 or $options->{target} =~ /\.tar$/ or $options->{target} eq '-') {
	$options->{maketar} = 1;
	if (any { $_ eq $options->{variant} } ('extract', 'custom') and $options->{mode} eq 'fakechroot') {
	    print STDERR "I: creating a tarball in fakechroot mode might fail in extract and custom variants because there might be no tar inside the chroot\n";
	}
	# try to fail early if target tarball cannot be opened for writing
	if ($options->{target} ne '-') {
	    open my $fh, '>', $options->{target} or die "cannot open $options->{target} for writing: $!";
	    close $fh;
	}
    }

    if ($options->{maketar}) {
	# since the output is a tarball, we create the rootfs in a temporary
	# directory
	$options->{root} = tempdir();
	# in unshare and root mode, other users than the current user need to
	# access the rootfs, most prominently, the _apt user. Thus, make the
	# temporary directory world readable.
	if (any { $_ eq $options->{mode} } ('unshare', 'root')) {
	    chmod 0755, $options->{root} or die "cannot chmod root: $!";
	}
    } else {
	# user does not seem to have specified a tarball as output, thus work
	# directly in the supplied directory
	$options->{root} = $options->{target};
	if (-e $options->{root}) {
	    if (!-d $options->{root}) {
		die "$options->{root} exists and is not a directory";
	    }
	    # check if the directory is empty or contains nothing more than an
	    # empty lost+found directory. The latter exists on freshly created
	    # ext3 and ext4 partitions.
	    # rationale for requiring an empty directory: https://bugs.debian.org/833525
	    opendir(my $dh, $options->{root}) or die "Can't opendir($options->{root}): $!";
	    while (my $entry = readdir $dh) {
		# skip the "." and ".." entries
		next if $entry eq ".";
		next if $entry eq "..";
		# if the entry is a directory named "lost+found" then skip it
		# if it's empty
		if ($entry eq "lost+found" and -d "$options->{root}/$entry") {
		    opendir(my $dh2, "$options->{root}/$entry");
		    # Attempt reading the directory thrice. If the third time
		    # succeeds, then it has more entries than just "." and ".."
		    # and must thus not be empty.
		    readdir $dh2;
		    readdir $dh2;
		    # rationale for requiring an empty directory:
		    # https://bugs.debian.org/833525
		    if (readdir $dh2) {
			die "$options->{root} contains a non-empty lost+found directory";
		    }
		    closedir($dh2);
		} else {
		    die "$options->{root} is not empty";
		}
	    }
	    closedir($dh);
	} else {
	    make_path($options->{root}) or die "cannot create root: $!";
	}
    }

    # check for double quotes because apt doesn't allow to escape them and
    # thus paths with double quotes are invalid in the apt config
    if ($options->{root} =~ /"/) {
	die "apt cannot handle paths with double quotes";
    }

    my @idmap;
    # for unshare mode the rootfs directory has to have appropriate
    # permissions
    if ($options->{mode} eq 'unshare') {
	@idmap = read_subuid_subgid;
	# sanity check
	if (scalar(@idmap) != 2 || $idmap[0][0] ne 'u' || $idmap[1][0] ne 'g') {
	    printf STDERR "invalid idmap\n";
	    return 0;
	}

	my $outer_gid = $REAL_GROUP_ID+0;

	my $pid = get_unshare_cmd { chown 1, 1, $options->{root} }
	[
	    ['u', '0', $REAL_USER_ID, '1'],
	    ['g', '0', $outer_gid, '1'],
	    ['u', '1', $idmap[0][2], '1'],
	    ['g', '1', $idmap[1][2], '1']];
	waitpid $pid, 0;
	$? == 0 or die "chown failed";
    }

    # figure out whether we have mknod
    $options->{havemknod} = 0;
    if ($options->{mode} eq 'unshare') {
	my $pid = get_unshare_cmd {
	    $options->{havemknod} = havemknod($options->{root});
	} \@idmap;
	waitpid $pid, 0;
	$? == 0 or die "havemknod failed";
    } elsif (any { $_ eq $options->{mode} } ('root', 'fakechroot', 'proot', 'chrootless')) {
	$options->{havemknod} = havemknod($options->{root});
    } else {
	die "unknown mode: $options->{mode}";
    }

    my $devtar = '';
    # We always craft the /dev entries ourselves if a tarball is to be created
    if ($options->{maketar}) {
	foreach my $file (@devfiles) {
	    my ($fname, $mode, $type, $linkname, $devmajor, $devminor) = @{$file};
	    my $entry = pack('a100 a8 a8 a8 a12 a12 A8 a1 a100 a8 a32 a32 a8 a8 a155 x12',
		$fname,
		sprintf('%07o', $mode),
		sprintf('%07o', 0), # uid
		sprintf('%07o', 0), # gid
		sprintf('%011o', 0), # size
		sprintf('%011o', $mtime),
		'', # checksum
		$type,
		$linkname,
		"ustar  ",
		'', # username
		'', # groupname
		defined($devmajor) ? sprintf('%07o', $devmajor) : '',
		defined($devminor) ? sprintf('%07o', $devminor) : '',
		'', # prefix
	    );
	    # compute and insert checksum
	    substr($entry,148,7) = sprintf("%06o\0", unpack("%16C*",$entry));
	    $devtar .= $entry;
	}
    }

    my $exitstatus = 0;
    my @taropts = ('--sort=name', "--mtime=\@$mtime", '--clamp-mtime', '--numeric-owner', '--one-file-system', '-c', '--exclude=./dev');
    push @taropts, @tar_compress_opts;

    # disable signals so that we can fork and change behaviour of the signal
    # handler in the parent and child without getting interrupted
    my $sigset = POSIX::SigSet->new(SIGINT, SIGHUP, SIGPIPE, SIGTERM);
    POSIX::sigprocmask(SIG_BLOCK, $sigset) or die "Can't block signals: $!\n";

    my $pid;
    pipe my $rfh, my $wfh;
    if ($options->{mode} eq 'unshare') {
	$pid = get_unshare_cmd {
	    # child
	    $SIG{'INT'} = 'DEFAULT';
	    $SIG{'HUP'} = 'DEFAULT';
	    $SIG{'PIPE'} = 'DEFAULT';
	    $SIG{'TERM'} = 'DEFAULT';

	    # unblock all delayed signals (and possibly handle them)
	    POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock signals: $!\n";

	    close $rfh;
	    open(STDOUT, '>&', STDERR);

	    setup($options);

	    if ($options->{maketar}) {
		print STDERR "I: creating tarball...\n";

		# redirect tar output to the writing end of the pipe so that the
		# parent process can capture the output
		open(STDOUT, '>&', $wfh);

		# Add ./dev as the first entries of the tar file.
		# We cannot add them after calling tar, because there is no way to
		# prevent tar from writing NULL entries at the end.
		print $devtar;

		# pack everything except ./dev
		0 == system('tar', @taropts, '-C', $options->{root}, '.') or die "tar failed: $?";

		print STDERR "done\n";
	    }

	    exit 0;
	} \@idmap;
    } elsif (any { $_ eq $options->{mode} } ('root', 'fakechroot', 'proot', 'chrootless')) {
	$pid = fork() // die "fork() failed: $!";
	if ($pid == 0) {
	    $SIG{'INT'} = 'DEFAULT';
	    $SIG{'HUP'} = 'DEFAULT';
	    $SIG{'PIPE'} = 'DEFAULT';
	    $SIG{'TERM'} = 'DEFAULT';

	    # unblock all delayed signals (and possibly handle them)
	    POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock signals: $!\n";

	    close $rfh;
	    open(STDOUT, '>&', STDERR);

	    setup($options);

	    if ($options->{maketar}) {
		print STDERR "I: creating tarball...\n";

		# redirect tar output to the writing end of the pipe so that the
		# parent process can capture the output
		open(STDOUT, '>&', $wfh);

		# Add ./dev as the first entries of the tar file.
		# We cannot add them after calling tar, because there is no way to
		# prevent tar from writing NULL entries at the end.
		print $devtar;

		if ($options->{mode} eq 'fakechroot') {
		    # Fakechroot requires tar to run inside the chroot or
		    # otherwise absolute symlinks will include the path to the
		    # root directory
		    0 == system('/usr/sbin/chroot', $options->{root}, 'tar', @taropts, '-C', '/', '.') or die "tar failed: $?";
		} elsif ($options->{mode} eq 'proot') {
		    # proot requires tar to run inside proot or otherwise
		    # permissions will be completely off
		    my @qemuopt = ();
		    if (defined $options->{qemu}) {
			push @qemuopt, "--qemu=qemu-$options->{qemu}";
			push @taropts, "--exclude=./host-rootfs"
		    }
		    0 == system('proot', '--root-id', "--rootfs=$options->{root}", '--cwd=/', @qemuopt, 'tar', @taropts, '-C', '/', '.') or die "tar failed: $?";
		} elsif (any { $_ eq $options->{mode} } ('root', 'chrootless')) {
		    0 == system('tar', @taropts, '-C', $options->{root}, '.') or die "tar failed: $?";
		} else {
		    die "unknown mode: $options->{mode}";
		}

		print STDERR "done\n";
	    }

	    exit 0;
	}
    } else {
	die "unknown mode: $options->{mode}";
    }

    # parent

    my $got_signal = 0;
    my $waiting_for = "setup";
    my $ignore = sub {
	$got_signal = shift;
	print STDERR "I: main() received signal $got_signal: waiting for $waiting_for...\n";
    };

    $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 die "Can't unblock signals: $!\n";

    close $wfh;

    if ($options->{maketar}) {
	# we cannot die here because that would leave the other thread running
	# without a parent
	if ($options->{target} ne '-') {
	    if(!copy($rfh, $options->{target})) {
		print STDERR "E: cannot copy to $options->{target}: $!\n";
		$exitstatus = 1;
	    }
	} else {
	    if (!copy($rfh, *STDOUT)) {
		print STDERR "E: cannot copy to standard output: $!\n";
		$exitstatus = 1;
	    }
	}
    }
    close($rfh);
    waitpid $pid, 0;
    if ($? != 0) {
	$exitstatus = 1;
    }

    # change signal handler message
    $waiting_for = "cleanup";

    if ($options->{maketar} and -e $options->{root}) {
	if ($options->{mode} eq 'unshare') {
	    # We don't have permissions to remove the directory outside
	    # the unshared namespace, so we remove it here.
	    # Since this is still inside the unshared namespace, there is
	    # no risk of removing anything important.
	    $pid = get_unshare_cmd {
		remove_tree($options->{root}, {error => \my $err});
		if (@$err) {
		    for my $diag (@$err) {
			my ($file, $message) = %$diag;
			if ($file eq '') {
			    print "general error: $message\n";
			}
			else {
			    print "problem unlinking $file: $message\n";
			}
		    }
		}
	    } \@idmap;
	    waitpid $pid, 0;
	    $? == 0 or die "remove_tree failed";
	} elsif (any { $_ eq $options->{mode} } ('root', 'fakechroot', 'proot', 'chrootless')) {
	    # without unshare, we use the system's rm to recursively remove the
	    # temporary directory just to make sure that we do not accidentally
	    # remove more than we should by using --one-file-system.
	    #
	    # --interactive=never is needed when in proot mode, the
	    # write-protected file /apt/apt.conf.d/01autoremove-kernels is to
	    # be removed.
	    0 == system('rm', '--interactive=never', '--recursive', '--preserve-root', '--one-file-system', $options->{root}) or die "rm failed: $!";
	} else {
	    die "unknown mode: $options->{mode}";
	}
    }

    if ($got_signal) {
	$exitstatus = 1;
    }

    exit $exitstatus;
}

main();

__END__

=head1 NAME

mmdebstrap - multi-mirror Debian chroot creation

=head1 SYNOPSIS

B<mmdebstrap> [B<OPTION...>] [I<SUITE> [I<TARGET> [I<MIRROR>...]]]

=head1 DESCRIPTION

B<mmdebstrap> creates a Debian chroot of I<SUITE> into I<TARGET> from one or
more I<MIRROR>s. It is meant as an alternative to the debootstrap tool (see
section B<DEBOOTSTRAP>). In contrast to debootstrap it uses apt to resolve
dependencies and is thus able to use more than one mirror and resolve more
complex dependencies.

If no I<MIRROR> option is provided, L<http://deb.debian.org/debian> is used,
except if data was given on standard input in which case the lines read from
there are used as the content of the chroot's sources.list file. If
I<SUITE> is a stable release name, then mirrors for updates and security are
automatically added. If a I<MIRROR> option starts with "deb " or "deb-src "
then it is used as a one-line-style format entry for apt's sources.list inside
the chroot.  If a I<MIRROR> option contains a "://" then it is interpreted as
a mirror URI and the apt line inside the chroot is assembled as "deb [arch=A]
B C D" where A is the host's native architecture, B is the I<MIRROR>, C is the
given I<SUITE> and D is the components given via B<--components> (defaults to
"main"). If a I<MIRROR> option happens to be an existing file, then its
contents are pasted into the chroot's sources.list.  This can be used to
supply a deb822 style sources.list. If I<MIRROR> is C<-> then standard input
is pasted into the chroot's sources.list. If there was data on standard input
but no C<-> mirror was listed, the lines read from standard input will be
appended to the end of the chroot's sources.list. More than one mirror can be
specified and are appended to the chroot's sources.list in the given order. If
any mirror contains a https URI, then the packages apt-transport-https and
ca-certificates will be installed inside the chroot.

The I<TARGET> argument can either be a directory or a tarball filename. If
I<TARGET> is a directory, then it must not exist beforehand. A tarball
filename is detected by the filename extension of I<TARGET>. Choosing a
directory only makes sense with the B<sudo> mode because otherwise the
contents of the chroot will not be owned by the superuser. If no I<TARGET> was
specified or if I<TARGET> is C<->, then a tarball of the chroot is written to
standard output.

The I<SUITE> may be a valid release code name (eg, sid, stretch, jessie) or a
symbolic name (eg, unstable, testing, stable, oldstable). Any suite name that
works with apt on the given mirror will work. If no I<SUITE> was specified,
then a single I<MIRROR> C<-> is added and thus the information of the desired
suite has to come from standard input as part of a valid apt sources.list
file.

=head1 OPTIONS

=over 8

=item B<-h,--help>

Print this help text and exit.

=item B<--variant>=I<name>

Choose which package set to install. Valid variant I<name>s are B<extract>,
B<custom>, B<essential>, B<apt>, B<required>, B<minbase>, B<buildd>,
B<important>, B<debootstrap>, B<->, and B<standard>. The default variant is
B<required>. See the section B<VARIANTS> for more information.

=item B<--mode>=I<name>

Choose how to perform the chroot operation and create a filesystem with
ownership information different from the current user. Valid mode I<name>s are B<auto>,
B<sudo>, B<root>, B<unshare>, B<fakeroot>, B<fakechroot> and B<proot>. The
default mode is B<auto>. See the section B<MODES> for more information.

=item B<--aptopt>=I<option>|I<file>

Pass arbitrary I<option>s to apt. Will be added to
F</etc/apt/apt.conf.d/99mmdebstrap> inside the chroot.  Can be specified
multiple times. Each I<option> will be appended to 99mmdebstrap. A semicolon will
be added at the end of the option if necessary. If the command line argument
is an existing I<file>, the content of the file will be appended to 99mmdebstrap
verbatim.

Examples:

    --aptopt='Acquire::Check-Valid-Until "false"'
    --aptopt='Acquire::Languages { "environment"; "en"; }'
    --aptopt='Acquire::Languages "none"'
    --aptopt='Apt::Install-Recommends "true"'
    --aptopt='Acquire::http { Proxy "http://127.0.0.1:3142"; }'

=item B<--dpkgopt>=I<option>|I<file>

Pass arbitrary I<option>s to dpkg. Will be added to
F</etc/dpkg/dpkg.cfg.d/99mmdebstrap> inside the chroot. Can be specified
multiple times. Each I<option> will be appended to 99mmdebstrap. If the command
line argument is an existing I<file>, the content of the file will be appended to
99mmdebstrap verbatim.

Example: --dpkgopt="path-exclude=/usr/share/man/*"

=item B<--include>=I<pkg1>[,I<pkg2>,...]

Comma separated list of packages which will be installed in addition to the
packages installed by the specified variant. The direct and indirect hard
dependencies will also be installed. The behaviour of this option depends on
the selected variant. The B<extract> and B<custom> variants install no packages
by default, so for these variants, the packages specified by this option will
be the only ones that get either extracted or installed by dpkg, respectively.
For all other variants, apt is used to install the additional packages. The
B<essential> variant does not include apt and thus, the include option will
only work when the B<chrootless> mode is selected and thus apt from the outside
can be used.

=item B<--components>=I<comp1>[,I<comp2>,...]

Comma separated list of components like main, contrib and non-free which will
be used for all URI-only I<MIRROR> arguments.

=item B<--architectures>=I<native>[,I<foreign1>,...]

Comma separated list of architectures. The first architecture is the I<native>
architecture inside the chroot. The remaining architectures will be added to
the foreign dpkg architectures. Without this option, the I<native>
architecture of the chroot defaults to the native architecture of the system
running mmdebstrap.

=begin comment

=item B<--customize>=I<command>

Execute arbitrary I<command>s after the chroot is set up and before it is
cleaned up. Can be specified multiple times. The commands are executed in the
order in which they are given on the command line. If I<command> is an
existing executable file or if I<command> does not contain any shell
metacharacters, then I<command> is directly exec-ed with the path to the
chroot directory passed as the first argument. Otherwise, I<command> is
executed under I<sh> and the chroot directory can be accessed via I<$1>.

Examples:

    --customize='chroot "$1" passwd --delete root'
    --customize='chroot "$1" useradd --home-dir /home/user --create-home user'
    --customize='chroot "$1" passwd --delete user'
    --customize='echo host > "$1/etc/hostname"'
    --customize=/usr/share/autopkgtest/setup-commands/setup-testbed

=end comment

=back

=head1 MODES

Creating a Debian chroot requires not only permissions for running chroot but
also the ability to create files owned by the superuser. The selected mode
decides which way this is achieved.

=over 8

=item B<auto>

This mode automatically selects a fitting mode. If the effective user id is the
one of the superuser, then the B<sudo> mode is chosen. Otherwise, the
B<unshare> mode is picked if the system has the sysctl
C<kernel.unprivileged_userns_clone> set to C<1>. Should that not be the case
and if the proot binary exists, the B<proot> mode is chosen. Lastly, the
B<fakechroot> is used if the fakechroot binary exists.

=item B<sudo>, B<root>

This mode directly executes chroot and is the same mode of operation as is used
by debootstrap. It is the only mode that can directly create a directory chroot
with the right permissions.

=item B<unshare>

This mode uses Linux user namespaces to allow unpriviliged use of chroot and
creation of files that appear to be owned by the superuser inside the unshared
namespace. A directory chroot created with this mode will end up with wrong
permissions. Choose to create a tarball instead.

=item B<fakeroot>, B<fakechroot>

This mode will exec mmdebstrap again under C<fakechroot fakeroot>. A
directory chroot created with this mode will end up with wrong permissions.
Choose to create a tarball instead.

=item B<proot>

This mode will carry out all calls to chroot with proot instead. Since
permissions are only retained while proot is still running, this will lead to
wrong permissions in the final directory and tarball. This mode is useful if
you plan to use the chroot with proot.

=item B<chrootless>

Uses the dpkg option C<--force-script-chrootless> to install packages into
B<TARGET> without dpkg and apt inside B<target> but using apt and dpkg from
the machine running mmdebstrap. Maintainer scripts are run without chrooting
into B<TARGET> and rely on their dependencies being installed on the machine
running mmdebstrap.

=for TODO
=item B<qemu>

=back

=head1 VARIANTS

All package sets also include the direct and indirect hard dependencies (but
not recommends) of the selected package sets. The variants B<minbase>,
B<buildd> and B<->, resemble the package sets that debootstrap would install
with the same I<--variant> argument.

=over 8

=item B<extract>

Installs nothing by default (not even C<Essential:yes> packages). Packages
given by the C<--include> option are extracted but will not be installed.

=item B<custom>

Installs nothing by default (not even C<Essential:yes> packages). Packages
given by the C<--include> option will be installed.  If another mode than
B<chrootless> was selected and dpkg was not part of the included package set,
then this variant will fail because it cannot configure the packages.

=item B<essential>

C<Essential:yes> packages.

=item B<apt>

The B<essential> set plus apt.

=item B<required>, B<minbase>

The B<essential> set plus all packages with Priority:required and apt.

=item B<buildd>

The B<minbase> set plus build-essential.

=item B<important>, B<debootstrap>, B<->

The B<required> set plus all packages with Priority:important. This is the default of debootstrap.

=item B<standard>

The B<important> set plus all packages with Priority:standard.

=back

=head1 EXAMPLES

Use like debootstrap:

    $ sudo mmdebstrap unstable ./unstable-chroot

Without superuser privileges:

    $ mmdebstrap unstable unstable-chroot.tar

With complex apt options:

    $ mmdebstrap < /etc/apt/sources.list > unstable-chroot.tar

Drop locales (but not the symlink to the locale name alias database),
translated manual packages (but not the untranslated ones), and documentation
(but not copyright and Debian changelog).

    $ mmdebstrap --variant=essential \
        --dpkgopt='path-exclude=/usr/share/man/*' \
        --dpkgopt='path-include=/usr/share/man/man[1-9]/*' \
        --dpkgopt='path-exclude=/usr/share/locale/*' \
        --dpkgopt='path-include=/usr/share/locale/locale.alias' \
        --dpkgopt='path-exclude=/usr/share/doc/*' \
        --dpkgopt='path-include=/usr/share/doc/*/copyright' \
        --dpkgopt='path-include=/usr/share/doc/*/changelog.Debian.*' \
        unstable debian-unstable.tar

Use as debootstrap replacement in sbuild-createchroot:

    $ sbuild-createchroot --debootstrap=mmdebstrap \
        --make-sbuild-tarball ~/.cache/sbuild/unstable-amd64.tar.gz \
        unstable $(mktemp -d)

=begin comment

Use as replacement for autopkgtest-build-qemu and vmdb2:

    $ mmdebstrap --variant=important --include=linux-image-amd64 \
        --customize='chroot "$1" passwd --delete root' \
        --customize='chroot "$1" useradd --home-dir /home/user --create-home user' \
        --customize='chroot "$1" passwd --delete user' \
        --customize='echo host > "$1/etc/hostname"' \
        --customize=/usr/share/autopkgtest/setup-commands/setup-testbed \
        unstable debian-unstable.tar
    $ cat << END > extlinux.conf
    > default linux
    > timeout 0
    >
    > label linux
    > kernel /vmlinuz
    > append initrd=/initrd.img root=/dev/vda1 rw console=ttyS0
    END
    $ echo "127.0.0.1 localhost" > hosts
    $ guestfish -N debian-unstable.img=disk:2G -- \
        part-disk /dev/sda mbr : \
        part-set-bootable /dev/sda 1 true : \
        mkfs ext2 /dev/sda1 : mount /dev/sda1 / : \
        tar-in debian-unstable.tar / : \
        extlinux / : \
        copy-in extlinux.conf / :
        copy-in hosts /etc/
    $ qemu-img convert -O qcow2 debian-unstable.img debian-unstable.qcow2

=end comment

=head1 ENVIRONMENT VARIABLES

By setting C<SOURCE_DATE_EPOCH> the result will be reproducible over multiple
runs with the same options and mirror content.

=head1 DEBOOTSTRAP

This section lists some differences to debootstrap.

=over 8

=item * More than one mirror possible

=item * Default mirrors for stable releases include updates and security mirror

=item * Multiple ways to operate as non-root: fakechroot, proot, unshare

=item * 3-6 times faster

=item * Can create a chroot with only C<Essential:yes> packages and their dependencies

=item * Reproducible output by default if $SOURCE_DATE_EPOCH is set

=item * Can create output on filesystems with nodev set

=item * apt cache and lists are cleaned at the end

=item * foreign architecture chroots using qemu-user

=back

Limitations in comparison to debootstrap:

=over 8

=item * Only runs on systems with apt installed

=item * No I<SCRIPT> argument

=item * No I<--second-stage> option.

=back

=head1 SEE ALSO

    debootstrap(8)

=cut