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);
use Dpkg::Index;
require "syscall.ph";
use Fcntl qw(S_IFCHR S_IFBLK);

# 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() {
    # 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 sbuild 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 >> 8) == 0) {
	    exit 0;
	} else {
	    exit 1;
	}
    }
    waitpid($pid, 0);
    if (($? >> 8) != 0) {
	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 failed: $!";
	    }
	    if ($gidmapcmd ne "") {
		0 == system "newgidmap $ppid $gidmapcmd" or die "newgidmap 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";
    }
    while ($havemknod == 0) {
	# 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 unless $? == 0 and $content eq '';
	    last unless -c "$root/test-dev-null";
	    last unless open my $fh, '>', "$root/test-dev-null";
	    last 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 setup {
    my $options = shift;

    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} @{$options->{foreignarchs}}\";\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 "Apt::Install-Recommends false;\n";
    # for retrieving the essential packages set, only download
    print $conf "Apt::Get::Download-Only true;\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";
    print $conf "Acquire::Languages \"none\";\n";
    close $conf;

    foreach my $dir ('/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/') {
	make_path("$options->{root}/$dir") or die "failed to create $dir: $!";
    }

    {
	open my $fh, '>', "$options->{root}/var/lib/dpkg/status" 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/00mmdebstrap" or die "cannot open /etc/apt/apt.conf.d/00mmdebstrap: $!";
	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) {
	open my $fh, '>', "$options->{root}/etc/dpkg/dpkg.cfg.d/00mmdebstrap" or die "cannot open /etc/dpkg/dpkg.cfg.d/00mmdebstrap: $!";
	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: $!";
    }

    {
	my $archopt = '';
	if (scalar @{$options->{foreignarchs}} > 0) {
	    $archopt = " [arch=$options->{nativearch}]";
	}
	open my $fh, '>', "$options->{root}/etc/apt/sources.list" or die "cannot open /etc/apt/sources.list: $!";
	if (scalar(@{$options->{mirrors}}) > 0) {
	    if((grep /^-$/, @{$options->{mirrors}}) > 1 ) {
		die "can only read from stdin once";
	    }
	    for my $arg (@{$options->{mirrors}}) {
		if ($arg eq '-') {
		    # read from stdin
		    print STDERR "I: Reading sources.list from standard input...\n";
		    copy *STDIN, $fh or die "cannot copy stdin: $!";
		} elsif ($arg =~ /:\/\//) {
		    print $fh "deb$archopt $arg $options->{suite} $options->{components}\n";
		} elsif ($arg =~ /^deb(-src)? /) {
		    print $fh "$arg\n";
		} elsif (-f $arg) {
		    copy($arg, $fh) or die "cannot copy $arg: $!";
		} else {
		    die "invalid mirror: $arg";
		}
	    }
	} else {
	    print $fh "deb$archopt http://deb.debian.org/debian $options->{suite} $options->{components}\n";
	    if (grep { $_ eq $options->{suite} } ('stable', 'oldstable', 'stretch') ) {
		print $fh "deb$archopt http://deb.debian.org/debian $options->{suite}-updates $options->{components}\n";
		print $fh "deb$archopt http://security.debian.org/debian-security $options->{suite}/updates $options->{components}\n";
	    }
	}
	close $fh;
    }

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

    # 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
    {
	my $pid = open(my $pipe_apt, '-|') // die "failed to fork(): $!";
	if ($pid == 0) {
	    # redirect apt's stderr to stdout so that we can capture it
	    open(STDERR, '>&', STDOUT);
	    exec('apt-get', 'update');
	    die "cannot exec apt-get update: $!";
	}
	my $has_error = 0;
	while (my $line = <$pipe_apt>) {
	    if ($line =~ '^W: ') {
		$has_error = 1;
	    } elsif ($line =~ '^Err:') {
		$has_error = 1;
	    }
	    # forward captured apt output
	    print STDERR $line;
	}
	close($pipe_apt);
	if ($? != 0 or $has_error) {
	    die "apt-get update failed to download some indexes";
	}
    }

    # 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 '') {
	    die "apt-get update didn't download anything";
	}
    }

    # setting PATH for chroot, ldconfig, start-stop-daemon...
    $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 ($options->{variant} ne 'apt') {
	my %ess_pkgs;
	open(my $pipe_apt, '-|', 'apt-get', 'indextargets', '--format', '$(FILENAME)', 'Created-By: Packages', "Architecture: $options->{nativearch}") 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 $key_func = sub {
		return $_[0]->{Package} . ' ' . $_[0]->{Version} . ' ' . $_[0]->{Architecture};
	    };

	    my $index = Dpkg::Index->new(get_key_func=>$key_func);

	    $index->parse($pipe_cat, 'apt-helper cat-file') or die "failed to parse";

	    foreach my $key ($index->get_keys()) {
		my $cdata = $index->get_by_key($key);
		my $pkgname = $cdata->{Package};
		my $arch = $cdata->{Architecture} // '';
		my $ess = $cdata->{Essential} // '';
		if ($ess eq 'yes') {
		    $ess_pkgs{$pkgname} = ();
		}
		my $prio = $cdata->{Priority} // 'optional';
		if ($options->{variant} eq 'essential') {
		    # for this variant we are only interested in the
		    # essential packages
		    next;
		} elsif ($options->{variant} eq 'standard' or $options->{variant} eq 'important' or $options->{variant} eq 'required' or $options->{variant} eq 'buildd' or $options->{variant} eq 'minbase') {
		    if ($prio eq 'optional' or $prio eq 'extra') {
			next;
		    } elsif ($prio eq 'standard') {
			if ($options->{variant} eq 'important' or $options->{variant} eq 'required' or $options->{variant} eq 'buildd' or $options->{variant} eq 'minbase') {
			    next;
			}
		    } elsif ($prio eq 'important') {
			if ($options->{variant} eq 'required' or $options->{variant} eq 'buildd' or $options->{variant} eq 'minbase') {
			    next;
			}
		    } elsif ($prio eq 'required' or $options->{variant} eq 'buildd' or $options->{variant} eq 'minbase') {
			# required packages are part of all sets
		    } else {
			die "unknown priority: $prio";
		    }
		} else {
		    die "unknown variant: $options->{variant}";
		}
		$pkgs_to_install{$pkgname} = ();
	    }

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

	0 == system('apt-get', '--yes', 'install', keys %ess_pkgs) or die "apt-get install failed: $?";
    } else {
	# 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!")
	0 == system('apt-get', '--yes', 'dist-upgrade') or die "apt-get dist-upgrade failed: $?";
    }

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

    foreach my $deb (@essential_pkgs) {
	# 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: $?";
    }

    if ($options->{mode} eq 'fakechroot') {
	$ENV{FAKECHROOT_CMD_SUBST} = join ':', (
	    '/bin/mount=/bin/true',
	    '/usr/bin/env=/usr/bin/env.fakechroot',
	    '/usr/bin/ldd=/usr/bin/ldd.fakechroot',
	    '/usr/bin/mkfifo=/bin/true',
	    '/usr/sbin/ldconfig=/bin/true',
	);
    }

    my @chrootcmd = ('/usr/sbin/chroot', $options->{root});
    if ($options->{mode} eq 'proot') {
	# FIXME: proot currently cannot install apt because of https://github.com/proot-me/PRoot/issues/147
	@chrootcmd = ('proot', '--root-id', '--bind=/dev', "--rootfs=$options->{root}", '--cwd=/');
    }

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

    if ($options->{havemknod}) {
	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
		# nothing to do
	    } 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";
	}
    }

    # install the extracted packages properly
    0 == system(@chrootcmd, 'dpkg', '--install', '--force-depends', @essential_pkgs) or die "dpkg --install failed: $?";

    # if the path-excluded option was added to the dpkg config, reinstall all
    # packages
    if (-e "$options->{root}/etc/dpkg/dpkg.cfg.d/00mmdebstrap") {
	open(my $fh, '<', "$options->{root}/etc/dpkg/dpkg.cfg.d/00mmdebstrap") or die "cannot open /etc/dpkg/dpkg.cfg.d/00mmdebstrap: $!";
	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
	    0 == system(@chrootcmd, 'dpkg', '--install', @essential_pkgs) or die "dpkg --install failed: $?";
	}
    }

    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.
	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) {
	    0 == system('apt-get', '--yes', 'install', (keys %pkgs_to_install_from_outside)) or die "apt-get install failed: $?";
	    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
	    0 == system(@chrootcmd, 'dpkg',  '--install', '--force-depends', @debs_to_install) or die "dpkg --install failed: $?";
	    foreach my $deb (@debs_to_install) {
		unlink "$options->{root}/$deb" or die "cannot unlink $deb";
	    }
	}

	# from now on, apt will be executed inside the chroot
	undef $ENV{"APT_CONFIG"};

	# 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
		symlink $linkname, "$options->{root}/$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;
		    0 == system('mount', '-o', 'bind', "/$fname", "$options->{root}/$fname") or die "mount failed: $?";
		}
	    } elsif ($type == 5) { # directory
		if (!$options->{havemknod}) {
		    make_path "$options->{root}/$fname";
		}
		0 == system('mount', '-o', 'bind', "/$fname", "$options->{root}/$fname") or die "mount failed: $?";
	    } else {
		die "unsupported type: $type";
	    }
	    chmod $mode, "$options->{root}/$fname";
	}
	# We can only mount /proc and /sys after extracting the essential
	# set because if we mount it before, then base-files not be able
	# to extract those
	0 == system('mount', '-o', 'rbind', '/sys', "$options->{root}/sys") or die "mount failed: $?";
	0 == system('mount', '-t', 'proc', 'proc', "$options->{root}/proc") or die "mount failed: $?";

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

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

	0 == system(@chrootcmd, 'apt-get',  '--yes', 'install',
	    '--no-install-recommends',
	    keys %pkgs_to_install) or die "apt-get install failed: $?";

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

	foreach my $file (@devfiles) {
	    my ($fname, undef, $type, $linkname, undef, undef) = @{$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
		unlink "$options->{root}/$fname" or die "cannot unlink $fname: $!";
	    } elsif ($type == 3 or $type == 4) { # character/block special
		if (!$options->{havemknod}) {
		    0 == system('umount', '--no-mtab', "$options->{root}/$fname") or die "umount failed: $?";
		    unlink "$options->{root}/$fname";
		}
	    } elsif ($type == 5) { # directory
		0 == system('umount', '--no-mtab', "$options->{root}/$fname") or die "umount failed: $?";
		if (!$options->{havemknod}) {
		    rmdir "$options->{root}/$fname" or die "cannot rmdir $fname: $!";
		}
	    } else {
		die "unsupported type: $type";
	    }
	}
	# no need to umount if the mount namespace was unshared
	if ($options->{mode} ne 'unshare') {
	    0 == system('umount', '--no-mtab', '--recursive', '--lazy', "$options->{root}/sys") or die "umount failed: $?";
	    0 == system('umount', '--no-mtab', "$options->{root}/proc") or die "umount failed: $?";
	}
    }

    # if there is no apt inside the chroot, clean it from the outside
    if ($options->{variant} eq 'essential') {
	$ENV{"APT_CONFIG"} = "$tmpfile";
	0 == system('apt-get', '--option', 'Dir::Etc::SourceList=/dev/null', 'update') or die "apt-get update failed: $?";
	0 == system('apt-get', 'clean') or die "apt-get clean failed: $?";
	undef $ENV{"APT_CONFIG"};
    } else {
	0 == system(@chrootcmd, 'apt-get', '--option', 'Dir::Etc::SourceList=/dev/null', 'update') or die "apt-get update failed: $?";
	0 == system(@chrootcmd, 'apt-get', 'clean') or die "apt-get clean failed: $?";
    }

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

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 => [],
    };
    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},
    ) or pod2usage(-exitval => 2, -verbose => 1);

    my @valid_variants = ('essential', 'apt', 'required', 'minbase', 'buildd',
	'important', 'debootstrap', '-', 'standard');
    if (!grep { $_ eq $options->{variant}} @valid_variants) {
	die "invalid variant. Choose from " . (join ', ', @valid_variants);
    }
    # debootstrap and - are an alias for important
    if (grep { $_ eq $options->{variant} } ('-', 'debootstrap')) {
	$options->{variant} = 'important';
    }

    # 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');
    if (!grep { $_ eq $options->{mode} } @valid_modes) {
	die "invalid mode. Choose from " . (join ', ', @valid_modes);
    }

    if ($options->{variant} eq 'essential' and defined $options->{include}) {
	die "cannot install extra packages in essential and required variants because apt is missing";
    }

    my ($nativearch, @foreignarchs) = split /,/, $options->{architectures};
    $options->{nativearch} = $nativearch;
    $options->{foreignarchs} = \@foreignarchs;

    {
	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) {
		{ 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};
	    } 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";
	}
    }

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

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

    # 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()) {
	    $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()) {
	    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";
	    }
	    exit 1;
	}
    } else {
	die "unknown mode: $options->{mode}";
    }

    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 ($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 (grep { $_ eq $options->{mode} } ('unshare', 'root')) {
	    chmod 0755, $options->{root} or die "cannot chmod root: $!";
	}