coverage.sh: test with perlcritic
This commit is contained in:
parent
4ba82a41cf
commit
f867384c20
2 changed files with 252 additions and 191 deletions
|
@ -12,6 +12,13 @@ if [ "$ret" -ne 0 ]; then
|
|||
fi
|
||||
rm mmdebstrap.tdy
|
||||
|
||||
if [ $(wc -L < mmdebstrap) -gt 79 ]; then
|
||||
echo "exceeded maximum line length of 79 characters" >&2
|
||||
exit 1
|
||||
fi
|
||||
|
||||
perlcritic --severity 4 --verbose 8 mmdebstrap
|
||||
|
||||
mirrordir="./shared/cache/debian"
|
||||
|
||||
if [ ! -e "$mirrordir" ]; then
|
||||
|
|
436
mmdebstrap
436
mmdebstrap
|
@ -33,7 +33,7 @@ use File::Path qw(make_path remove_tree);
|
|||
use File::Temp qw(tempfile tempdir);
|
||||
use File::Basename;
|
||||
use Cwd qw(abs_path);
|
||||
require "syscall.ph";
|
||||
require "syscall.ph"; ## no critic (Modules::RequireBarewordIncludes)
|
||||
use Fcntl qw(S_IFCHR S_IFBLK FD_CLOEXEC F_GETFD F_SETFD);
|
||||
use List::Util qw(any none);
|
||||
use POSIX qw(SIGINT SIGHUP SIGPIPE SIGTERM SIG_BLOCK SIG_UNBLOCK);
|
||||
|
@ -41,15 +41,21 @@ use Carp;
|
|||
use Term::ANSIColor;
|
||||
use Socket;
|
||||
|
||||
## no critic (InputOutput::RequireBriefOpen)
|
||||
|
||||
# from sched.h
|
||||
use constant {
|
||||
CLONE_NEWNS => 0x20000,
|
||||
CLONE_NEWUTS => 0x4000000,
|
||||
CLONE_NEWIPC => 0x8000000,
|
||||
CLONE_NEWUSER => 0x10000000,
|
||||
CLONE_NEWPID => 0x20000000,
|
||||
CLONE_NEWNET => 0x40000000,
|
||||
};
|
||||
# use typeglob constants because "use constant" has several drawback as
|
||||
# explained in the documentation for the Readonly CPAN module
|
||||
*CLONE_NEWNS = \0x20000;
|
||||
*CLONE_NEWUTS = \0x4000000;
|
||||
*CLONE_NEWIPC = \0x8000000;
|
||||
*CLONE_NEWUSER = \0x10000000;
|
||||
*CLONE_NEWPID = \0x20000000;
|
||||
*CLONE_NEWNET = \0x40000000;
|
||||
our (
|
||||
$CLONE_NEWNS, $CLONE_NEWUTS, $CLONE_NEWIPC,
|
||||
$CLONE_NEWUSER, $CLONE_NEWPID, $CLONE_NEWNET
|
||||
);
|
||||
|
||||
# type codes:
|
||||
# 0 -> normal file
|
||||
|
@ -60,21 +66,21 @@ use constant {
|
|||
# 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],
|
||||
["./dev/", oct(755), 5, '', undef, undef],
|
||||
["./dev/console", oct(666), 3, '', 5, 1],
|
||||
["./dev/fd", oct(777), 2, '/proc/self/fd', undef, undef],
|
||||
["./dev/full", oct(666), 3, '', 1, 7],
|
||||
["./dev/null", oct(666), 3, '', 1, 3],
|
||||
["./dev/ptmx", oct(666), 3, '', 5, 2],
|
||||
["./dev/pts/", oct(755), 5, '', undef, undef],
|
||||
["./dev/random", oct(666), 3, '', 1, 8],
|
||||
["./dev/shm/", oct(755), 5, '', undef, undef],
|
||||
["./dev/stderr", oct(777), 2, '/proc/self/fd/2', undef, undef],
|
||||
["./dev/stdin", oct(777), 2, '/proc/self/fd/0', undef, undef],
|
||||
["./dev/stdout", oct(777), 2, '/proc/self/fd/1', undef, undef],
|
||||
["./dev/tty", oct(666), 3, '', 5, 0],
|
||||
["./dev/urandom", oct(666), 3, '', 1, 9],
|
||||
["./dev/zero", oct(666), 3, '', 1, 5],
|
||||
);
|
||||
|
||||
# verbosity levels:
|
||||
|
@ -84,7 +90,7 @@ my @devfiles = (
|
|||
# 3 -> debug output
|
||||
my $verbosity_level = 1;
|
||||
|
||||
my $is_covering = !!(eval 'Devel::Cover::get_coverage()');
|
||||
my $is_covering = !!(eval { Devel::Cover::get_coverage() });
|
||||
|
||||
sub debug {
|
||||
if ($verbosity_level < 3) {
|
||||
|
@ -93,10 +99,11 @@ sub debug {
|
|||
my $msg = shift;
|
||||
my ($package, $filename, $line) = caller;
|
||||
$msg = "D: $PID $line $msg";
|
||||
if (-t STDERR) {
|
||||
if (-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest)
|
||||
$msg = colored($msg, 'clear');
|
||||
}
|
||||
print STDERR "$msg\n";
|
||||
return;
|
||||
}
|
||||
|
||||
sub info {
|
||||
|
@ -109,10 +116,11 @@ sub info {
|
|||
$msg = "$PID $line $msg";
|
||||
}
|
||||
$msg = "I: $msg";
|
||||
if (-t STDERR) {
|
||||
if (-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest)
|
||||
$msg = colored($msg, 'green');
|
||||
}
|
||||
print STDERR "$msg\n";
|
||||
return;
|
||||
}
|
||||
|
||||
sub warning {
|
||||
|
@ -121,10 +129,11 @@ sub warning {
|
|||
}
|
||||
my $msg = shift;
|
||||
$msg = "W: $msg";
|
||||
if (-t STDERR) {
|
||||
if (-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest)
|
||||
$msg = colored($msg, 'bold yellow');
|
||||
}
|
||||
print STDERR "$msg\n";
|
||||
return;
|
||||
}
|
||||
|
||||
sub error {
|
||||
|
@ -136,11 +145,11 @@ sub error {
|
|||
# are stripping here
|
||||
chomp(my $msg = shift);
|
||||
$msg = "E: $msg";
|
||||
if (-t STDERR) {
|
||||
if (-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest)
|
||||
$msg = colored($msg, 'bold red');
|
||||
}
|
||||
if ($verbosity_level == 3) {
|
||||
croak $msg; # produces a backtrace
|
||||
croak $msg; # produces a backtrace
|
||||
} else {
|
||||
die "$msg\n";
|
||||
}
|
||||
|
@ -148,7 +157,7 @@ sub error {
|
|||
|
||||
# check whether a directory is mounted by comparing the device number of the
|
||||
# directory itself with its parent
|
||||
sub is_mountpoint($) {
|
||||
sub is_mountpoint {
|
||||
my $dir = shift;
|
||||
if (!-e $dir) {
|
||||
return 0;
|
||||
|
@ -169,12 +178,12 @@ sub is_mountpoint($) {
|
|||
# tar cannot figure out the decompression program when receiving data on
|
||||
# standard input, thus we do it ourselves. This is copied from tar's
|
||||
# src/suffix.c
|
||||
sub get_tar_compressor($) {
|
||||
sub get_tar_compressor {
|
||||
my $filename = shift;
|
||||
if ($filename eq '-') {
|
||||
return undef;
|
||||
return;
|
||||
} elsif ($filename =~ /\.tar$/) {
|
||||
return undef;
|
||||
return;
|
||||
} elsif ($filename =~ /\.(gz|tgz|taz)$/) {
|
||||
return ['gzip'];
|
||||
} elsif ($filename =~ /\.(Z|taZ)$/) {
|
||||
|
@ -194,10 +203,10 @@ sub get_tar_compressor($) {
|
|||
} elsif ($filename =~ /\.zst$/) {
|
||||
return ['zstd'];
|
||||
}
|
||||
return undef;
|
||||
return;
|
||||
}
|
||||
|
||||
sub test_unshare($) {
|
||||
sub test_unshare {
|
||||
my $verbose = shift;
|
||||
if ($EFFECTIVE_USER_ID == 0) {
|
||||
my $msg = "cannot use unshare mode when executing as root";
|
||||
|
@ -210,12 +219,12 @@ 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;
|
||||
my $unshare_flags = $CLONE_NEWUSER;
|
||||
# we spawn a new per process because if unshare succeeds, we would
|
||||
# otherwise have unshared the mmdebstrap process itself which we don't want
|
||||
my $pid = fork() // error "fork() failed: $!";
|
||||
if ($pid == 0) {
|
||||
my $ret = syscall &SYS_unshare, $unshare_flags;
|
||||
my $ret = syscall(&SYS_unshare, $unshare_flags);
|
||||
if ($ret == 0) {
|
||||
exit 0;
|
||||
} else {
|
||||
|
@ -371,16 +380,16 @@ sub read_subuid_subgid() {
|
|||
# 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(&$) {
|
||||
sub get_unshare_cmd {
|
||||
my $cmd = shift;
|
||||
my $idmap = shift;
|
||||
|
||||
my $unshare_flags
|
||||
= CLONE_NEWUSER | CLONE_NEWNS | CLONE_NEWPID | CLONE_NEWUTS
|
||||
| CLONE_NEWIPC;
|
||||
= $CLONE_NEWUSER | $CLONE_NEWNS | $CLONE_NEWPID | $CLONE_NEWUTS
|
||||
| $CLONE_NEWIPC;
|
||||
|
||||
if (0) {
|
||||
$unshare_flags |= CLONE_NEWNET;
|
||||
$unshare_flags |= $CLONE_NEWNET;
|
||||
}
|
||||
|
||||
# fork a new process and let the child get unshare()ed
|
||||
|
@ -522,7 +531,7 @@ sub get_unshare_cmd(&$) {
|
|||
return $gcpid;
|
||||
}
|
||||
|
||||
sub havemknod($) {
|
||||
sub havemknod {
|
||||
my $root = shift;
|
||||
my $havemknod = 0;
|
||||
if (-e "$root/test-dev-null") {
|
||||
|
@ -561,7 +570,7 @@ sub print_progress {
|
|||
return;
|
||||
}
|
||||
my $perc = shift;
|
||||
if (!-t STDERR) {
|
||||
if (!-t STDERR) { ## no critic (InputOutput::ProhibitInteractiveTest)
|
||||
return;
|
||||
}
|
||||
if ($perc eq "done") {
|
||||
|
@ -580,6 +589,7 @@ sub print_progress {
|
|||
$bar .= ' ' x ($width - $num_x - 1);
|
||||
}
|
||||
printf STDERR "%6.2f [%s]\r", $perc, $bar;
|
||||
return;
|
||||
}
|
||||
|
||||
sub run_progress {
|
||||
|
@ -599,10 +609,10 @@ sub run_progress {
|
|||
|
||||
if ($pid1 == 0) {
|
||||
# child: default signal handlers
|
||||
$SIG{'INT'} = 'DEFAULT';
|
||||
$SIG{'HUP'} = 'DEFAULT';
|
||||
$SIG{'PIPE'} = 'DEFAULT';
|
||||
$SIG{'TERM'} = 'DEFAULT';
|
||||
local $SIG{'INT'} = 'DEFAULT';
|
||||
local $SIG{'HUP'} = 'DEFAULT';
|
||||
local $SIG{'PIPE'} = 'DEFAULT';
|
||||
local $SIG{'TERM'} = 'DEFAULT';
|
||||
|
||||
# unblock all delayed signals (and possibly handle them)
|
||||
POSIX::sigprocmask(SIG_UNBLOCK, $sigset)
|
||||
|
@ -625,7 +635,7 @@ sub run_progress {
|
|||
if (defined $chdir) {
|
||||
chdir $chdir or error "failed chdir() to $chdir: $!";
|
||||
}
|
||||
eval 'Devel::Cover::set_coverage("none")' if $is_covering;
|
||||
eval { Devel::Cover::set_coverage("none") } if $is_covering;
|
||||
exec { $execargs[0] } @execargs
|
||||
or error 'cannot exec() ' . (join ' ', @execargs);
|
||||
}
|
||||
|
@ -637,22 +647,22 @@ sub run_progress {
|
|||
my $pid2 = fork() // error "failed to fork(): $!";
|
||||
if ($pid2 == 0) {
|
||||
# child: default signal handlers
|
||||
$SIG{'INT'} = 'IGNORE';
|
||||
$SIG{'HUP'} = 'IGNORE';
|
||||
$SIG{'PIPE'} = 'IGNORE';
|
||||
$SIG{'TERM'} = 'IGNORE';
|
||||
local $SIG{'INT'} = 'IGNORE';
|
||||
local $SIG{'HUP'} = 'IGNORE';
|
||||
local $SIG{'PIPE'} = 'IGNORE';
|
||||
local $SIG{'TERM'} = 'IGNORE';
|
||||
|
||||
# unblock all delayed signals (and possibly handle them)
|
||||
POSIX::sigprocmask(SIG_UNBLOCK, $sigset)
|
||||
or error "Can't unblock signals: $!";
|
||||
|
||||
print_progress 0.0;
|
||||
print_progress(0.0);
|
||||
while (my $line = <$rfh>) {
|
||||
my $output = $line_handler->($line);
|
||||
next unless $output;
|
||||
print_progress $output;
|
||||
print_progress($output);
|
||||
}
|
||||
print_progress "done";
|
||||
print_progress("done");
|
||||
|
||||
exit 0;
|
||||
}
|
||||
|
@ -702,6 +712,7 @@ sub run_progress {
|
|||
}
|
||||
error((join ' ', $get_exec->('<$fd>')) . ' failed');
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub run_dpkg_progress {
|
||||
|
@ -721,6 +732,7 @@ sub run_dpkg_progress {
|
|||
return $num / $total * 100;
|
||||
};
|
||||
run_progress $get_exec, $line_handler, $line_has_error;
|
||||
return;
|
||||
}
|
||||
|
||||
sub run_apt_progress {
|
||||
|
@ -755,9 +767,10 @@ sub run_apt_progress {
|
|||
}
|
||||
};
|
||||
run_progress $get_exec, $line_handler, $line_has_error, $options->{CHDIR};
|
||||
return;
|
||||
}
|
||||
|
||||
sub run_chroot(&$) {
|
||||
sub run_chroot {
|
||||
my $cmd = shift;
|
||||
my $options = shift;
|
||||
|
||||
|
@ -1044,9 +1057,10 @@ sub run_chroot(&$) {
|
|||
if ($error) {
|
||||
error "run_chroot failed: $error";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub run_hooks($$) {
|
||||
sub run_hooks {
|
||||
my $name = shift;
|
||||
my $options = shift;
|
||||
|
||||
|
@ -1123,9 +1137,9 @@ sub run_hooks($$) {
|
|||
# exist yet)
|
||||
&{$runner}();
|
||||
} else {
|
||||
run_chroot \&$runner, $options;
|
||||
run_chroot(\&$runner, $options);
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub setup {
|
||||
|
@ -1417,7 +1431,10 @@ sub setup {
|
|||
# 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";
|
||||
{
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{"APT_CONFIG"} = "$tmpfile";
|
||||
}
|
||||
|
||||
# when apt-get update is run by the root user, then apt will attempt to
|
||||
# drop privileges to the _apt user. This will fail if the _apt user does
|
||||
|
@ -1440,8 +1457,10 @@ sub setup {
|
|||
|
||||
# setting PATH for chroot, ldconfig, start-stop-daemon...
|
||||
if (defined $ENV{PATH} && $ENV{PATH} ne "") {
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{PATH} = "$ENV{PATH}:/usr/sbin:/usr/bin:/sbin:/bin";
|
||||
} else {
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{PATH} = "/usr/sbin:/usr/bin:/sbin:/bin";
|
||||
}
|
||||
|
||||
|
@ -1692,7 +1711,7 @@ sub setup {
|
|||
if ($pid1 == 0) {
|
||||
open(STDOUT, '>&', $wfh) or error "cannot open STDOUT: $!";
|
||||
debug("running dpkg-deb --fsys-tarfile $options->{root}/$deb");
|
||||
eval 'Devel::Cover::set_coverage("none")' if $is_covering;
|
||||
eval { Devel::Cover::set_coverage("none") } if $is_covering;
|
||||
exec 'dpkg-deb', '--fsys-tarfile', "$options->{root}/$deb";
|
||||
}
|
||||
my $pid2 = fork() // error "fork() failed: $!";
|
||||
|
@ -1700,7 +1719,7 @@ sub setup {
|
|||
open(STDIN, '<&', $rfh) or error "cannot open STDIN: $!";
|
||||
debug( "running tar -C $options->{root}"
|
||||
. " --keep-directory-symlink --extract --file -");
|
||||
eval 'Devel::Cover::set_coverage("none")' if $is_covering;
|
||||
eval { Devel::Cover::set_coverage("none") } if $is_covering;
|
||||
exec 'tar', '-C', $options->{root},
|
||||
'--keep-directory-symlink', '--extract', '--file', '-';
|
||||
}
|
||||
|
@ -1730,8 +1749,10 @@ sub setup {
|
|||
# where it has to look for shared libraries
|
||||
if (defined $ENV{QEMU_LD_PREFIX}
|
||||
&& $ENV{QEMU_LD_PREFIX} ne "") {
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{QEMU_LD_PREFIX} = "$ENV{QEMU_LD_PREFIX}:$options->{root}";
|
||||
} else {
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{QEMU_LD_PREFIX} = $options->{root};
|
||||
}
|
||||
}
|
||||
|
@ -1798,18 +1819,24 @@ sub setup {
|
|||
push @fakechrootsubst, split /:/,
|
||||
$ENV{FAKECHROOT_CMD_SUBST};
|
||||
}
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{FAKECHROOT_CMD_SUBST} = join ':', @fakechrootsubst;
|
||||
}
|
||||
if (defined $ENV{FAKECHROOT_EXCLUDE_PATH}
|
||||
&& $ENV{FAKECHROOT_EXCLUDE_PATH} ne "") {
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{FAKECHROOT_EXCLUDE_PATH}
|
||||
= "$ENV{FAKECHROOT_EXCLUDE_PATH}:/dev:/proc:/sys";
|
||||
} else {
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{FAKECHROOT_EXCLUDE_PATH} = '/dev:/proc:/sys';
|
||||
}
|
||||
# workaround for long unix socket path if FAKECHROOT_BASE
|
||||
# exceeds the limit of 108 bytes
|
||||
$ENV{FAKECHROOT_AF_UNIX_PATH} = "/tmp";
|
||||
{
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{FAKECHROOT_AF_UNIX_PATH} = "/tmp";
|
||||
}
|
||||
{
|
||||
my @ldsoconf = ('/etc/ld.so.conf');
|
||||
opendir(my $dh, '/etc/ld.so.conf.d')
|
||||
|
@ -1839,6 +1866,7 @@ sub setup {
|
|||
}
|
||||
close $fh;
|
||||
}
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$ENV{LD_LIBRARY_PATH} = join ':', @ldlibpath;
|
||||
}
|
||||
}
|
||||
|
@ -1869,15 +1897,6 @@ sub setup {
|
|||
if ($options->{mode} eq 'proot') {
|
||||
push @chrootcmd, "--qemu=qemu-$options->{qemu}";
|
||||
} elsif ($options->{mode} eq 'fakechroot') {
|
||||
# The binfmt support on the outside is used, so qemu needs
|
||||
# to know where it has to look for shared libraries
|
||||
if (defined $ENV{QEMU_LD_PREFIX}
|
||||
&& $ENV{QEMU_LD_PREFIX} ne "") {
|
||||
$ENV{QEMU_LD_PREFIX}
|
||||
= "$ENV{QEMU_LD_PREFIX}:$options->{root}";
|
||||
} else {
|
||||
$ENV{QEMU_LD_PREFIX} = $options->{root};
|
||||
}
|
||||
# Make sure that the fakeroot and fakechroot shared
|
||||
# libraries exist for the right architecture
|
||||
open my $fh, '-|', 'dpkg-architecture', '-a',
|
||||
|
@ -1887,7 +1906,7 @@ sub setup {
|
|||
my $deb_host_multiarch = do { local $/; <$fh> }
|
||||
);
|
||||
close $fh;
|
||||
if ($? != 0 or !$deb_host_multiarch) {
|
||||
if (($? != 0) or (!$deb_host_multiarch)) {
|
||||
error "dpkg-architecture failed: $?";
|
||||
}
|
||||
my $fakechrootdir
|
||||
|
@ -1904,10 +1923,24 @@ sub setup {
|
|||
. " Install libfakeroot:$options->{nativearch}"
|
||||
. " outside the chroot";
|
||||
}
|
||||
# The rest of this block sets environment variables, so we
|
||||
# have to add the "no critic" statement to stop perlcritic
|
||||
# from complaining about setting global variables
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
# fakechroot only fills LD_LIBRARY_PATH with the
|
||||
# directories of the host's architecture. We append the
|
||||
# directories of the chroot architecture.
|
||||
$ENV{LD_LIBRARY_PATH} .= ":$fakechrootdir:$fakerootdir";
|
||||
$ENV{LD_LIBRARY_PATH}
|
||||
= "$ENV{LD_LIBRARY_PATH}:$fakechrootdir:$fakerootdir";
|
||||
# The binfmt support on the outside is used, so qemu needs
|
||||
# to know where it has to look for shared libraries
|
||||
if (defined $ENV{QEMU_LD_PREFIX}
|
||||
&& $ENV{QEMU_LD_PREFIX} ne "") {
|
||||
$ENV{QEMU_LD_PREFIX}
|
||||
= "$ENV{QEMU_LD_PREFIX}:$options->{root}";
|
||||
} else {
|
||||
$ENV{QEMU_LD_PREFIX} = $options->{root};
|
||||
}
|
||||
} elsif (any { $_ eq $options->{mode} } ('root', 'unshare')) {
|
||||
# other modes require a static qemu-user binary
|
||||
my $qemubin = "/usr/bin/qemu-$options->{qemu}-static";
|
||||
|
@ -1968,17 +2001,19 @@ sub setup {
|
|||
# into account and thus doesn't install them in the right order
|
||||
# And the --predep-package option is broken: #539133
|
||||
info "installing packages...";
|
||||
run_chroot {
|
||||
run_dpkg_progress({
|
||||
ARGV => [
|
||||
@chrootcmd, 'env',
|
||||
'--unset=TMPDIR', 'dpkg',
|
||||
'--install', '--force-depends'
|
||||
],
|
||||
PKGS => \@essential_pkgs,
|
||||
});
|
||||
}
|
||||
$options;
|
||||
run_chroot(
|
||||
sub {
|
||||
run_dpkg_progress({
|
||||
ARGV => [
|
||||
@chrootcmd, 'env',
|
||||
'--unset=TMPDIR', 'dpkg',
|
||||
'--install', '--force-depends'
|
||||
],
|
||||
PKGS => \@essential_pkgs,
|
||||
});
|
||||
},
|
||||
$options
|
||||
);
|
||||
|
||||
# if the path-excluded option was added to the dpkg config,
|
||||
# reinstall all packages
|
||||
|
@ -1986,7 +2021,7 @@ sub setup {
|
|||
open(my $fh, '<',
|
||||
"$options->{root}/etc/dpkg/dpkg.cfg.d/99mmdebstrap")
|
||||
or error "cannot open /etc/dpkg/dpkg.cfg.d/99mmdebstrap: $!";
|
||||
my $num_matches = grep /^path-exclude=/, <$fh>;
|
||||
my $num_matches = grep { /^path-exclude=/ } <$fh>;
|
||||
close $fh;
|
||||
if ($num_matches > 0) {
|
||||
# without --skip-same-version, dpkg will install the given
|
||||
|
@ -2107,19 +2142,22 @@ sub setup {
|
|||
}
|
||||
}
|
||||
|
||||
run_chroot {
|
||||
info "installing remaining packages inside the chroot...";
|
||||
run_apt_progress({
|
||||
ARGV => [
|
||||
@chrootcmd, 'env',
|
||||
'--unset=APT_CONFIG', '--unset=TMPDIR',
|
||||
'apt-get', '--yes',
|
||||
'install'
|
||||
],
|
||||
PKGS => [@pkgs_to_install],
|
||||
});
|
||||
}
|
||||
$options;
|
||||
run_chroot(
|
||||
sub {
|
||||
info
|
||||
"installing remaining packages inside the chroot...";
|
||||
run_apt_progress({
|
||||
ARGV => [
|
||||
@chrootcmd, 'env',
|
||||
'--unset=APT_CONFIG', '--unset=TMPDIR',
|
||||
'apt-get', '--yes',
|
||||
'install'
|
||||
],
|
||||
PKGS => [@pkgs_to_install],
|
||||
});
|
||||
},
|
||||
$options
|
||||
);
|
||||
|
||||
}
|
||||
} else {
|
||||
|
@ -2192,6 +2230,7 @@ sub setup {
|
|||
}
|
||||
closedir($dh);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# messages from process inside unshared namespace to the outside
|
||||
|
@ -2209,6 +2248,7 @@ sub checkokthx {
|
|||
my ($len, $msg) = unpack("nA5", $buf);
|
||||
if ($msg ne "okthx") { error "expected okthx but got: $msg"; }
|
||||
if ($len != 0) { error "expected no payload but got $len bytes"; }
|
||||
return;
|
||||
}
|
||||
|
||||
sub main() {
|
||||
|
@ -2467,11 +2507,14 @@ sub main() {
|
|||
$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';
|
||||
{
|
||||
## no critic (Variables::RequireLocalizedPunctuationVars)
|
||||
$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;
|
||||
|
@ -2596,7 +2639,7 @@ sub main() {
|
|||
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;
|
||||
local $ENV{FAKECHROOT_DETECT} = 0;
|
||||
exec 'echo', 'If fakechroot is running, this will not be printed';
|
||||
}
|
||||
my $content = do { local $/; <$rfh> };
|
||||
|
@ -2752,8 +2795,9 @@ sub main() {
|
|||
my $pid = open my $fh, '-|' // error "failed to fork(): $!";
|
||||
if ($pid == 0) {
|
||||
{
|
||||
no warnings
|
||||
; # don't print a warning if the following fails
|
||||
## no critic (TestingAndDebugging::ProhibitNoWarnings)
|
||||
# don't print a warning if the following fails
|
||||
no warnings;
|
||||
exec 'arch-test', $options->{nativearch};
|
||||
}
|
||||
# if exec didn't work (for example because the arch-test
|
||||
|
@ -2775,8 +2819,9 @@ sub main() {
|
|||
my $pid = open my $fh, '-|' // error "failed to fork(): $!";
|
||||
if ($pid == 0) {
|
||||
{
|
||||
no warnings
|
||||
; # don't print a warning if the following fails
|
||||
## no critic (TestingAndDebugging::ProhibitNoWarnings)
|
||||
# don't print a warning if the following fails
|
||||
no warnings;
|
||||
exec 'arch-test', '-n', $options->{nativearch};
|
||||
}
|
||||
# if exec didn't work (for example because the arch-test
|
||||
|
@ -2807,7 +2852,7 @@ sub main() {
|
|||
{
|
||||
open my $fh, '<', '/proc/filesystems'
|
||||
or error "failed to open /proc/filesystems: $!";
|
||||
unless (grep /^nodev\tbinfmt_misc$/, (<$fh>)) {
|
||||
unless (grep { /^nodev\tbinfmt_misc$/ } (<$fh>)) {
|
||||
warning "binfmt_misc not found in /proc/filesystems --"
|
||||
. " is the module loaded?";
|
||||
}
|
||||
|
@ -2817,9 +2862,11 @@ sub main() {
|
|||
open my $fh, '<', '/proc/mounts'
|
||||
or error "failed to open /proc/mounts: $!";
|
||||
unless (
|
||||
grep
|
||||
/^binfmt_misc \/proc\/sys\/fs\/binfmt_misc binfmt_misc/,
|
||||
(<$fh>)
|
||||
grep {
|
||||
/^binfmt_misc
|
||||
\/proc\/sys\/fs\/binfmt_misc
|
||||
binfmt_misc/x
|
||||
} (<$fh>)
|
||||
) {
|
||||
warning "binfmt_misc not found in /proc/mounts -- not"
|
||||
. " mounted?";
|
||||
|
@ -2890,7 +2937,7 @@ sub main() {
|
|||
# If no suite was specified, then the whole sources.list has to
|
||||
# come from standard input
|
||||
info "Reading sources.list from standard input...";
|
||||
$sourceslist = do { local $/; <STDIN> };
|
||||
$sourceslist = do { local $/; <> };
|
||||
} else {
|
||||
my @components = ();
|
||||
foreach my $comp (@{ $options->{components} }) {
|
||||
|
@ -3050,7 +3097,7 @@ sub main() {
|
|||
for my $arg (@ARGV) {
|
||||
if ($arg eq '-') {
|
||||
info "Reading sources.list from standard input...";
|
||||
$sourceslist .= do { local $/; <STDIN> };
|
||||
$sourceslist .= do { local $/; <> };
|
||||
} elsif ($arg =~ /^deb(-src)? /) {
|
||||
$sourceslist .= "$arg\n";
|
||||
} elsif ($arg =~ /:\/\//) {
|
||||
|
@ -3284,12 +3331,13 @@ sub main() {
|
|||
|
||||
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']];
|
||||
my $pid = get_unshare_cmd(
|
||||
sub { chown 1, 1, $options->{root} },
|
||||
[
|
||||
['u', '0', $REAL_USER_ID, '1'],
|
||||
['g', '0', $outer_gid, '1'],
|
||||
['u', '1', $idmap[0][2], '1'],
|
||||
['g', '1', $idmap[1][2], '1']]);
|
||||
waitpid $pid, 0;
|
||||
$? == 0 or error "chown failed";
|
||||
}
|
||||
|
@ -3297,10 +3345,12 @@ sub main() {
|
|||
# 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;
|
||||
my $pid = get_unshare_cmd(
|
||||
sub {
|
||||
$options->{havemknod} = havemknod($options->{root});
|
||||
},
|
||||
\@idmap
|
||||
);
|
||||
waitpid $pid, 0;
|
||||
$? == 0 or error "havemknod failed";
|
||||
} elsif (
|
||||
|
@ -3366,60 +3416,62 @@ sub main() {
|
|||
or error "socketpair failed: $!";
|
||||
$options->{hooksock} = $childsock;
|
||||
if ($options->{mode} eq 'unshare') {
|
||||
$pid = get_unshare_cmd {
|
||||
# child
|
||||
$SIG{'INT'} = 'DEFAULT';
|
||||
$SIG{'HUP'} = 'DEFAULT';
|
||||
$SIG{'PIPE'} = 'DEFAULT';
|
||||
$SIG{'TERM'} = 'DEFAULT';
|
||||
$pid = get_unshare_cmd(
|
||||
sub {
|
||||
# child
|
||||
local $SIG{'INT'} = 'DEFAULT';
|
||||
local $SIG{'HUP'} = 'DEFAULT';
|
||||
local $SIG{'PIPE'} = 'DEFAULT';
|
||||
local $SIG{'TERM'} = 'DEFAULT';
|
||||
|
||||
# unblock all delayed signals (and possibly handle them)
|
||||
POSIX::sigprocmask(SIG_UNBLOCK, $sigset)
|
||||
or error "Can't unblock signals: $!";
|
||||
# unblock all delayed signals (and possibly handle them)
|
||||
POSIX::sigprocmask(SIG_UNBLOCK, $sigset)
|
||||
or error "Can't unblock signals: $!";
|
||||
|
||||
close $rfh;
|
||||
close $parentsock;
|
||||
open(STDOUT, '>&', STDERR) or error "cannot open STDOUT: $!";
|
||||
close $rfh;
|
||||
close $parentsock;
|
||||
open(STDOUT, '>&', STDERR) or error "cannot open STDOUT: $!";
|
||||
|
||||
setup($options);
|
||||
setup($options);
|
||||
|
||||
print $childsock (pack('n', 0) . 'adios');
|
||||
$childsock->flush();
|
||||
print $childsock (pack('n', 0) . 'adios');
|
||||
$childsock->flush();
|
||||
|
||||
close $childsock;
|
||||
close $childsock;
|
||||
|
||||
if ($options->{maketar} or $options->{makesqfs}) {
|
||||
info "creating tarball...";
|
||||
if ($options->{maketar} or $options->{makesqfs}) {
|
||||
info "creating tarball...";
|
||||
|
||||
# redirect tar output to the writing end of the pipe so that
|
||||
# the parent process can capture the output
|
||||
open(STDOUT, '>&', $wfh) or error "cannot open STDOUT: $!";
|
||||
# redirect tar output to the writing end of the pipe so
|
||||
# that the parent process can capture the output
|
||||
open(STDOUT, '>&', $wfh) or error "cannot open STDOUT: $!";
|
||||
|
||||
# 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;
|
||||
# Add ./dev as the first entries of the tar file.
|
||||
# We cannot add them after calling tar, because there is no
|
||||
# way to prevent tar from writing NULL entries at the end.
|
||||
print $devtar;
|
||||
|
||||
# pack everything except ./dev
|
||||
0 == system('tar', @taropts, '-C', $options->{root}, '.')
|
||||
or error "tar failed: $?";
|
||||
# pack everything except ./dev
|
||||
0 == system('tar', @taropts, '-C', $options->{root}, '.')
|
||||
or error "tar failed: $?";
|
||||
|
||||
info "done";
|
||||
}
|
||||
info "done";
|
||||
}
|
||||
|
||||
exit 0;
|
||||
}
|
||||
\@idmap;
|
||||
exit 0;
|
||||
},
|
||||
\@idmap
|
||||
);
|
||||
} elsif (
|
||||
any { $_ eq $options->{mode} }
|
||||
('root', 'fakechroot', 'proot', 'chrootless')
|
||||
) {
|
||||
$pid = fork() // error "fork() failed: $!";
|
||||
if ($pid == 0) {
|
||||
$SIG{'INT'} = 'DEFAULT';
|
||||
$SIG{'HUP'} = 'DEFAULT';
|
||||
$SIG{'PIPE'} = 'DEFAULT';
|
||||
$SIG{'TERM'} = 'DEFAULT';
|
||||
local $SIG{'INT'} = 'DEFAULT';
|
||||
local $SIG{'HUP'} = 'DEFAULT';
|
||||
local $SIG{'PIPE'} = 'DEFAULT';
|
||||
local $SIG{'TERM'} = 'DEFAULT';
|
||||
|
||||
# unblock all delayed signals (and possibly handle them)
|
||||
POSIX::sigprocmask(SIG_UNBLOCK, $sigset)
|
||||
|
@ -3503,10 +3555,10 @@ sub main() {
|
|||
info "main() received signal $got_signal: waiting for $waiting_for...";
|
||||
};
|
||||
|
||||
$SIG{'INT'} = $ignore;
|
||||
$SIG{'HUP'} = $ignore;
|
||||
$SIG{'PIPE'} = $ignore;
|
||||
$SIG{'TERM'} = $ignore;
|
||||
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)
|
||||
|
@ -3880,10 +3932,10 @@ sub main() {
|
|||
my $cpid = fork() // error "fork() failed: $!";
|
||||
if ($cpid == 0) {
|
||||
# child: default signal handlers
|
||||
$SIG{'INT'} = 'DEFAULT';
|
||||
$SIG{'HUP'} = 'DEFAULT';
|
||||
$SIG{'PIPE'} = 'DEFAULT';
|
||||
$SIG{'TERM'} = 'DEFAULT';
|
||||
local $SIG{'INT'} = 'DEFAULT';
|
||||
local $SIG{'HUP'} = 'DEFAULT';
|
||||
local $SIG{'PIPE'} = 'DEFAULT';
|
||||
local $SIG{'TERM'} = 'DEFAULT';
|
||||
|
||||
# unblock all delayed signals (and possibly handle
|
||||
# them)
|
||||
|
@ -3900,7 +3952,7 @@ sub main() {
|
|||
}
|
||||
open(STDIN, '<&', $rfh)
|
||||
or error "cannot open file handle for reading: $!";
|
||||
eval 'Devel::Cover::set_coverage("none")'
|
||||
eval { Devel::Cover::set_coverage("none") }
|
||||
if $is_covering;
|
||||
exec { $argv[0] } @argv
|
||||
or
|
||||
|
@ -3943,27 +3995,29 @@ sub main() {
|
|||
# the unshared namespace, so we remove it here.
|
||||
# Since this is still inside the unshared namespace, there is
|
||||
# no risk of removing anything important.
|
||||
$pid = get_unshare_cmd {
|
||||
# File::Path will produce the error "cannot stat initial
|
||||
# working directory" if the working directory cannot be
|
||||
# accessed by the unprivileged unshared user. Thus, we first
|
||||
# navigate to the parent of the root directory.
|
||||
chdir "$options->{root}/.."
|
||||
or error "unable to chdir() to parent directory of"
|
||||
. " $options->{root}: $!";
|
||||
remove_tree($options->{root}, { error => \my $err });
|
||||
if (@$err) {
|
||||
for my $diag (@$err) {
|
||||
my ($file, $message) = %$diag;
|
||||
if ($file eq '') {
|
||||
warning "general error: $message";
|
||||
} else {
|
||||
warning "problem unlinking $file: $message";
|
||||
$pid = get_unshare_cmd(
|
||||
sub {
|
||||
# File::Path will produce the error "cannot stat initial
|
||||
# working directory" if the working directory cannot be
|
||||
# accessed by the unprivileged unshared user. Thus, we
|
||||
# first navigate to the parent of the root directory.
|
||||
chdir "$options->{root}/.."
|
||||
or error "unable to chdir() to parent directory of"
|
||||
. " $options->{root}: $!";
|
||||
remove_tree($options->{root}, { error => \my $err });
|
||||
if (@$err) {
|
||||
for my $diag (@$err) {
|
||||
my ($file, $message) = %$diag;
|
||||
if ($file eq '') {
|
||||
warning "general error: $message";
|
||||
} else {
|
||||
warning "problem unlinking $file: $message";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
\@idmap;
|
||||
},
|
||||
\@idmap
|
||||
);
|
||||
waitpid $pid, 0;
|
||||
$? == 0 or error "remove_tree failed";
|
||||
} elsif (
|
||||
|
|
Loading…
Reference in a new issue