forked from josch/mmdebstrap
put hook listener into its own function and expose it to the CLI via --hook-listener
This commit is contained in:
parent
c2c270390b
commit
e2a759967f
2 changed files with 400 additions and 326 deletions
38
coverage.sh
38
coverage.sh
|
@ -1936,6 +1936,44 @@ else
|
||||||
runtests=$((runtests+1))
|
runtests=$((runtests+1))
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
print_header "mode=root,variant=apt: test special hooks using helpers"
|
||||||
|
cat << END > shared/test.sh
|
||||||
|
#!/bin/sh
|
||||||
|
set -eu
|
||||||
|
export LC_ALL=C.UTF-8
|
||||||
|
mkfifo /tmp/myfifo
|
||||||
|
mkdir /tmp/root
|
||||||
|
ln -s /real /tmp/root/link
|
||||||
|
mkdir /tmp/root/real
|
||||||
|
run_testA() {
|
||||||
|
echo content > /tmp/foo
|
||||||
|
{ { { $CMD --hook-helper /tmp/root root setup env 1 upload /tmp/foo \$1 < /tmp/myfifo 3>&-; echo \$? >&3;
|
||||||
|
} | $CMD --hook-listener 3>&- >/tmp/myfifo; echo \$?; } 3>&1;
|
||||||
|
} | { read xs1; [ "\$xs1" -eq 0 ]; read xs2; [ "\$xs2" -eq 0 ]; }
|
||||||
|
echo content | diff -u - /tmp/root/real/foo
|
||||||
|
rm /tmp/foo
|
||||||
|
rm /tmp/root/real/foo
|
||||||
|
}
|
||||||
|
run_testA link/foo
|
||||||
|
run_testA /link/foo
|
||||||
|
run_testA ///link///foo///
|
||||||
|
run_testA /././link/././foo/././
|
||||||
|
run_testA /link/../link/foo
|
||||||
|
run_testA /link/../../link/foo
|
||||||
|
run_testA /../../link/foo
|
||||||
|
rmdir /tmp/root/real
|
||||||
|
rm /tmp/root/link
|
||||||
|
rmdir /tmp/root
|
||||||
|
rm /tmp/myfifo
|
||||||
|
END
|
||||||
|
if [ "$HAVE_QEMU" = "yes" ]; then
|
||||||
|
./run_qemu.sh
|
||||||
|
runtests=$((runtests+1))
|
||||||
|
else
|
||||||
|
./run_null.sh SUDO
|
||||||
|
runtests=$((runtests+1))
|
||||||
|
fi
|
||||||
|
|
||||||
# test special hooks
|
# test special hooks
|
||||||
for mode in root unshare fakechroot proot; do
|
for mode in root unshare fakechroot proot; do
|
||||||
print_header "mode=$mode,variant=apt: test special hooks with $mode mode"
|
print_header "mode=$mode,variant=apt: test special hooks with $mode mode"
|
||||||
|
|
688
mmdebstrap
688
mmdebstrap
|
@ -2954,6 +2954,341 @@ sub hookhelper {
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub hooklistener {
|
||||||
|
# we put everything in an eval block because that way we can easily handle
|
||||||
|
# errors without goto labels or much code duplication: the error handler
|
||||||
|
# has to send an "error" message to the other side
|
||||||
|
eval {
|
||||||
|
while (1) {
|
||||||
|
# get the next message
|
||||||
|
my $msg = "error";
|
||||||
|
my $len = -1;
|
||||||
|
{
|
||||||
|
debug "reading next command";
|
||||||
|
my $ret = read(STDIN, my $buf, 2 + 5)
|
||||||
|
// error "cannot read from socket: $!";
|
||||||
|
debug "finished reading command";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
($len, $msg) = unpack("nA5", $buf);
|
||||||
|
}
|
||||||
|
if ($msg eq "adios") {
|
||||||
|
# setup finished, so we break out of the loop
|
||||||
|
if ($len != 0) {
|
||||||
|
error "expected no payload but got $len bytes";
|
||||||
|
}
|
||||||
|
last;
|
||||||
|
} elsif ($msg eq "openr") {
|
||||||
|
# handle the openr message
|
||||||
|
debug "received message: openr";
|
||||||
|
my $infile;
|
||||||
|
{
|
||||||
|
my $ret = read(STDIN, $infile, $len)
|
||||||
|
// error "cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# make sure that the requested path exists outside the chroot
|
||||||
|
if (!-e $infile) {
|
||||||
|
error "$infile does not exist";
|
||||||
|
}
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
|
||||||
|
open my $fh, '<', $infile
|
||||||
|
or error "failed to open $infile for reading: $!";
|
||||||
|
|
||||||
|
# read from the file and send as payload to the child process
|
||||||
|
while (1) {
|
||||||
|
# read from file
|
||||||
|
my $ret = read($fh, my $cont, 4096)
|
||||||
|
// error "cannot read from pipe: $!";
|
||||||
|
if ($ret == 0) { last; }
|
||||||
|
debug "sending write";
|
||||||
|
# send to child
|
||||||
|
print STDOUT pack("n", $ret) . "write" . $cont;
|
||||||
|
STDOUT->flush();
|
||||||
|
debug "waiting for okthx";
|
||||||
|
checkokthx \*STDIN;
|
||||||
|
if ($ret < 4096) { last; }
|
||||||
|
}
|
||||||
|
|
||||||
|
# signal to the child process that we are done
|
||||||
|
debug "sending close";
|
||||||
|
print STDOUT pack("n", 0) . "close";
|
||||||
|
STDOUT->flush();
|
||||||
|
debug "waiting for okthx";
|
||||||
|
checkokthx \*STDIN;
|
||||||
|
|
||||||
|
close $fh;
|
||||||
|
} elsif ($msg eq "openw") {
|
||||||
|
debug "received message: openw";
|
||||||
|
# payload is the output directory
|
||||||
|
my $outfile;
|
||||||
|
{
|
||||||
|
my $ret = read(STDIN, $outfile, $len)
|
||||||
|
// error "cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# make sure that the directory exists
|
||||||
|
my $outdir = dirname($outfile);
|
||||||
|
if (-e $outdir) {
|
||||||
|
if (!-d $outdir) {
|
||||||
|
error "$outdir already exists but is not a directory";
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
my $num_created = make_path $outdir, { error => \my $err };
|
||||||
|
if ($err && @$err) {
|
||||||
|
error(
|
||||||
|
join "; ",
|
||||||
|
(
|
||||||
|
map { "cannot create " . (join ": ", %{$_}) }
|
||||||
|
@$err
|
||||||
|
));
|
||||||
|
} elsif ($num_created == 0) {
|
||||||
|
error "cannot create $outdir";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
|
||||||
|
# now we expect one or more "write" messages containing the
|
||||||
|
# tarball to write
|
||||||
|
open my $fh, '>', $outfile
|
||||||
|
or error "failed to open $outfile for writing: $!";
|
||||||
|
|
||||||
|
# handle "write" messages from the child process and feed
|
||||||
|
# their payload into the file handle until a "close" message
|
||||||
|
# is encountered
|
||||||
|
while (1) {
|
||||||
|
# receive the next message
|
||||||
|
my $ret = read(STDIN, my $buf, 2 + 5)
|
||||||
|
// error "cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
my ($len, $msg) = unpack("nA5", $buf);
|
||||||
|
debug "received message: $msg";
|
||||||
|
if ($msg eq "close") {
|
||||||
|
# finish the loop
|
||||||
|
if ($len != 0) {
|
||||||
|
error "expected no payload but got $len bytes";
|
||||||
|
}
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
last;
|
||||||
|
} elsif ($msg ne "write") {
|
||||||
|
# we should not receive this message at this point
|
||||||
|
error "expected write but got: $msg";
|
||||||
|
}
|
||||||
|
# read the payload
|
||||||
|
my $content;
|
||||||
|
{
|
||||||
|
my $ret = read(STDIN, $content, $len)
|
||||||
|
// error "error cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# write the payload to the file handle
|
||||||
|
print $fh $content
|
||||||
|
or error "cannot write to file handle: $!";
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
}
|
||||||
|
close $fh;
|
||||||
|
} elsif (any { $_ eq $msg } ('mktar', 'mktac')) {
|
||||||
|
# handle the mktar message
|
||||||
|
debug "received message: $msg";
|
||||||
|
my $indir;
|
||||||
|
{
|
||||||
|
my $ret = read(STDIN, $indir, $len)
|
||||||
|
// error "cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# make sure that the requested path exists outside the chroot
|
||||||
|
if (!-e $indir) {
|
||||||
|
error "$indir does not exist";
|
||||||
|
}
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
|
||||||
|
# Open a tar process creating a tarfile of the instructed
|
||||||
|
# path. To emulate the behaviour of cp, change to the
|
||||||
|
# dirname of the requested path first.
|
||||||
|
open my $fh, '-|', 'tar', '--numeric-owner', '--xattrs',
|
||||||
|
'--format=pax',
|
||||||
|
'--pax-option=exthdr.name=%d/PaxHeaders/%f,'
|
||||||
|
. 'delete=atime,delete=ctime',
|
||||||
|
'--directory',
|
||||||
|
$msg eq 'mktar' ? dirname($indir) : $indir,
|
||||||
|
'--create', '--file', '-',
|
||||||
|
$msg eq 'mktar' ? basename($indir) : '.'
|
||||||
|
// error "failed to fork(): $!";
|
||||||
|
|
||||||
|
# read from the tar process and send as payload to the child
|
||||||
|
# process
|
||||||
|
while (1) {
|
||||||
|
# read from tar
|
||||||
|
my $ret = read($fh, my $cont, 4096)
|
||||||
|
// error "cannot read from pipe: $!";
|
||||||
|
if ($ret == 0) { last; }
|
||||||
|
debug "sending write";
|
||||||
|
# send to child
|
||||||
|
print STDOUT pack("n", $ret) . "write" . $cont;
|
||||||
|
STDOUT->flush();
|
||||||
|
debug "waiting for okthx";
|
||||||
|
checkokthx \*STDIN;
|
||||||
|
if ($ret < 4096) { last; }
|
||||||
|
}
|
||||||
|
|
||||||
|
# signal to the child process that we are done
|
||||||
|
debug "sending close";
|
||||||
|
print STDOUT pack("n", 0) . "close";
|
||||||
|
STDOUT->flush();
|
||||||
|
debug "waiting for okthx";
|
||||||
|
checkokthx \*STDIN;
|
||||||
|
|
||||||
|
close $fh;
|
||||||
|
if ($? != 0) {
|
||||||
|
error "tar failed";
|
||||||
|
}
|
||||||
|
} elsif ($msg eq "untar") {
|
||||||
|
debug "received message: untar";
|
||||||
|
# payload is the output directory
|
||||||
|
my $outdir;
|
||||||
|
{
|
||||||
|
my $ret = read(STDIN, $outdir, $len)
|
||||||
|
// error "cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# make sure that the directory exists
|
||||||
|
if (-e $outdir) {
|
||||||
|
if (!-d $outdir) {
|
||||||
|
error "$outdir already exists but is not a directory";
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
my $num_created = make_path $outdir, { error => \my $err };
|
||||||
|
if ($err && @$err) {
|
||||||
|
error(
|
||||||
|
join "; ",
|
||||||
|
(
|
||||||
|
map { "cannot create " . (join ": ", %{$_}) }
|
||||||
|
@$err
|
||||||
|
));
|
||||||
|
} elsif ($num_created == 0) {
|
||||||
|
error "cannot create $outdir";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
|
||||||
|
# now we expect one or more "write" messages containing the
|
||||||
|
# tarball to unpack
|
||||||
|
open my $fh, '|-', 'tar', '--numeric-owner', '--xattrs',
|
||||||
|
'--xattrs-include=*', '--directory', $outdir,
|
||||||
|
'--extract', '--file',
|
||||||
|
'-' // error "failed to fork(): $!";
|
||||||
|
|
||||||
|
# handle "write" messages from the child process and feed
|
||||||
|
# their payload into the tar process until a "close" message
|
||||||
|
# is encountered
|
||||||
|
while (1) {
|
||||||
|
# receive the next message
|
||||||
|
my $ret = read(STDIN, my $buf, 2 + 5)
|
||||||
|
// error "cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
my ($len, $msg) = unpack("nA5", $buf);
|
||||||
|
debug "received message: $msg";
|
||||||
|
if ($msg eq "close") {
|
||||||
|
# finish the loop
|
||||||
|
if ($len != 0) {
|
||||||
|
error "expected no payload but got $len bytes";
|
||||||
|
}
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
last;
|
||||||
|
} elsif ($msg ne "write") {
|
||||||
|
# we should not receive this message at this point
|
||||||
|
error "expected write but got: $msg";
|
||||||
|
}
|
||||||
|
# read the payload
|
||||||
|
my $content;
|
||||||
|
{
|
||||||
|
my $ret = read(STDIN, $content, $len)
|
||||||
|
// error "error cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
# write the payload to the tar process
|
||||||
|
print $fh $content
|
||||||
|
or error "cannot write to tar process: $!";
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
}
|
||||||
|
close $fh;
|
||||||
|
if ($? != 0) {
|
||||||
|
error "tar failed";
|
||||||
|
}
|
||||||
|
} elsif ($msg eq "nblks") {
|
||||||
|
# handle the nblks message
|
||||||
|
my $numblocks;
|
||||||
|
debug "received message: nblks";
|
||||||
|
{
|
||||||
|
my $ret = read(STDIN, $numblocks, $len)
|
||||||
|
// error "cannot read from socket: $!";
|
||||||
|
if ($ret == 0) {
|
||||||
|
error "received eof on socket";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if ($numblocks !~ /^\d+$/) {
|
||||||
|
error "invalid number of blocks: $numblocks";
|
||||||
|
}
|
||||||
|
debug "sending okthx";
|
||||||
|
print STDOUT (pack("n", 0) . "okthx")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
} else {
|
||||||
|
error "unknown message: $msg";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
};
|
||||||
|
if ($@) {
|
||||||
|
# inform the other side that something went wrong
|
||||||
|
print STDOUT (pack("n", 0) . "error")
|
||||||
|
or error "cannot write to socket: $!";
|
||||||
|
STDOUT->flush();
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
sub guess_sources_format {
|
sub guess_sources_format {
|
||||||
my $content = shift;
|
my $content = shift;
|
||||||
my $is_deb822 = 0;
|
my $is_deb822 = 0;
|
||||||
|
@ -3019,6 +3354,14 @@ sub main() {
|
||||||
hookhelper();
|
hookhelper();
|
||||||
exit 0;
|
exit 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# this is the counterpart to --hook-helper and will receive and carry
|
||||||
|
# out its instructions
|
||||||
|
if (scalar @ARGV == 1 && $ARGV[0] eq "--hook-listener") {
|
||||||
|
hooklistener();
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
# this is like:
|
# this is like:
|
||||||
# lxc-usernsexec -- lxc-unshare -s 'MOUNT|PID|UTSNAME|IPC' ...
|
# lxc-usernsexec -- lxc-unshare -s 'MOUNT|PID|UTSNAME|IPC' ...
|
||||||
# but without needing lxc
|
# but without needing lxc
|
||||||
|
@ -4418,334 +4761,27 @@ sub main() {
|
||||||
|
|
||||||
debug "starting to listen for hooks";
|
debug "starting to listen for hooks";
|
||||||
# handle special hook commands via parentsock
|
# handle special hook commands via parentsock
|
||||||
# we use eval() so that error() doesn't take this process down and
|
my $lpid = fork() // error "fork() failed: $!";
|
||||||
# thus leaves the setup() process without a parent
|
if ($lpid == 0) {
|
||||||
eval {
|
# whatever the script writes on stdout is sent to the
|
||||||
while (1) {
|
# socket
|
||||||
# get the next message
|
# whatever is written to the socket, send to stdin
|
||||||
my $msg = "error";
|
open(STDOUT, '>&', $parentsock)
|
||||||
my $len = -1;
|
or error "cannot open STDOUT: $!";
|
||||||
{
|
open(STDIN, '<&', $parentsock)
|
||||||
debug "reading from parentsock";
|
or error "cannot open STDIN: $!";
|
||||||
my $ret = read($parentsock, my $buf, 2 + 5)
|
|
||||||
// error "cannot read from socket: $!";
|
|
||||||
debug "finished reading from parentsock";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
($len, $msg) = unpack("nA5", $buf);
|
|
||||||
}
|
|
||||||
if ($msg eq "adios") {
|
|
||||||
# setup finished, so we break out of the loop
|
|
||||||
if ($len != 0) {
|
|
||||||
error "expected no payload but got $len bytes";
|
|
||||||
}
|
|
||||||
last;
|
|
||||||
} elsif ($msg eq "openr") {
|
|
||||||
# handle the openr message
|
|
||||||
debug "received message: openr";
|
|
||||||
my $infile;
|
|
||||||
{
|
|
||||||
my $ret = read($parentsock, $infile, $len)
|
|
||||||
// error "cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
# make sure that the requested path exists outside the chroot
|
|
||||||
if (!-e $infile) {
|
|
||||||
error "$infile does not exist";
|
|
||||||
}
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
|
|
||||||
open my $fh, '<', $infile
|
# we execute ourselves under sh to avoid having to
|
||||||
or error "failed to open $infile for reading: $!";
|
# implement a clever parser of the quoting used in $script
|
||||||
|
# for the filenames
|
||||||
# read from the file and send as payload to the child process
|
my @prefix = ();
|
||||||
while (1) {
|
if ($is_covering) {
|
||||||
# read from file
|
@prefix = ($EXECUTABLE_NAME, "-MDevel::Cover=-silent,-nogcov");
|
||||||
my $ret = read($fh, my $cont, 4096)
|
|
||||||
// error "cannot read from pipe: $!";
|
|
||||||
if ($ret == 0) { last; }
|
|
||||||
debug "sending write";
|
|
||||||
# send to child
|
|
||||||
print $parentsock pack("n", $ret) . "write" . $cont;
|
|
||||||
$parentsock->flush();
|
|
||||||
debug "waiting for okthx";
|
|
||||||
checkokthx $parentsock;
|
|
||||||
if ($ret < 4096) { last; }
|
|
||||||
}
|
|
||||||
|
|
||||||
# signal to the child process that we are done
|
|
||||||
debug "sending close";
|
|
||||||
print $parentsock pack("n", 0) . "close";
|
|
||||||
$parentsock->flush();
|
|
||||||
debug "waiting for okthx";
|
|
||||||
checkokthx $parentsock;
|
|
||||||
|
|
||||||
close $fh;
|
|
||||||
} elsif ($msg eq "openw") {
|
|
||||||
debug "received message: openw";
|
|
||||||
# payload is the output directory
|
|
||||||
my $outfile;
|
|
||||||
{
|
|
||||||
my $ret = read($parentsock, $outfile, $len)
|
|
||||||
// error "cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
# make sure that the directory exists
|
|
||||||
my $outdir = dirname($outfile);
|
|
||||||
if (-e $outdir) {
|
|
||||||
if (!-d $outdir) {
|
|
||||||
error "$outdir already exists but is not a directory";
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
my $num_created = make_path $outdir, { error => \my $err };
|
|
||||||
if ($err && @$err) {
|
|
||||||
error(
|
|
||||||
join "; ",
|
|
||||||
(
|
|
||||||
map { "cannot create " . (join ": ", %{$_}) }
|
|
||||||
@$err
|
|
||||||
));
|
|
||||||
} elsif ($num_created == 0) {
|
|
||||||
error "cannot create $outdir";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
|
|
||||||
# now we expect one or more "write" messages containing the
|
|
||||||
# tarball to write
|
|
||||||
open my $fh, '>', $outfile
|
|
||||||
or error "failed to open $outfile for writing: $!";
|
|
||||||
|
|
||||||
# handle "write" messages from the child process and feed
|
|
||||||
# their payload into the file handle until a "close" message
|
|
||||||
# is encountered
|
|
||||||
while (1) {
|
|
||||||
# receive the next message
|
|
||||||
my $ret = read($parentsock, my $buf, 2 + 5)
|
|
||||||
// error "cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
my ($len, $msg) = unpack("nA5", $buf);
|
|
||||||
debug "received message: $msg";
|
|
||||||
if ($msg eq "close") {
|
|
||||||
# finish the loop
|
|
||||||
if ($len != 0) {
|
|
||||||
error "expected no payload but got $len bytes";
|
|
||||||
}
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
last;
|
|
||||||
} elsif ($msg ne "write") {
|
|
||||||
# we should not receive this message at this point
|
|
||||||
error "expected write but got: $msg";
|
|
||||||
}
|
|
||||||
# read the payload
|
|
||||||
my $content;
|
|
||||||
{
|
|
||||||
my $ret = read($parentsock, $content, $len)
|
|
||||||
// error "error cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
# write the payload to the file handle
|
|
||||||
print $fh $content
|
|
||||||
or error "cannot write to file handle: $!";
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
}
|
|
||||||
close $fh;
|
|
||||||
} elsif (any { $_ eq $msg } ('mktar', 'mktac')) {
|
|
||||||
# handle the mktar message
|
|
||||||
debug "received message: $msg";
|
|
||||||
my $indir;
|
|
||||||
{
|
|
||||||
my $ret = read($parentsock, $indir, $len)
|
|
||||||
// error "cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
# make sure that the requested path exists outside the chroot
|
|
||||||
if (!-e $indir) {
|
|
||||||
error "$indir does not exist";
|
|
||||||
}
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
|
|
||||||
# Open a tar process creating a tarfile of the instructed
|
|
||||||
# path. To emulate the behaviour of cp, change to the
|
|
||||||
# dirname of the requested path first.
|
|
||||||
open my $fh, '-|', 'tar', '--numeric-owner', '--xattrs',
|
|
||||||
'--format=pax',
|
|
||||||
'--pax-option=exthdr.name=%d/PaxHeaders/%f,'
|
|
||||||
. 'delete=atime,delete=ctime',
|
|
||||||
'--directory',
|
|
||||||
$msg eq 'mktar' ? dirname($indir) : $indir,
|
|
||||||
'--create', '--file', '-',
|
|
||||||
$msg eq 'mktar' ? basename($indir) : '.'
|
|
||||||
// error "failed to fork(): $!";
|
|
||||||
|
|
||||||
# read from the tar process and send as payload to the child
|
|
||||||
# process
|
|
||||||
while (1) {
|
|
||||||
# read from tar
|
|
||||||
my $ret = read($fh, my $cont, 4096)
|
|
||||||
// error "cannot read from pipe: $!";
|
|
||||||
if ($ret == 0) { last; }
|
|
||||||
debug "sending write";
|
|
||||||
# send to child
|
|
||||||
print $parentsock pack("n", $ret) . "write" . $cont;
|
|
||||||
$parentsock->flush();
|
|
||||||
debug "waiting for okthx";
|
|
||||||
checkokthx $parentsock;
|
|
||||||
if ($ret < 4096) { last; }
|
|
||||||
}
|
|
||||||
|
|
||||||
# signal to the child process that we are done
|
|
||||||
debug "sending close";
|
|
||||||
print $parentsock pack("n", 0) . "close";
|
|
||||||
$parentsock->flush();
|
|
||||||
debug "waiting for okthx";
|
|
||||||
checkokthx $parentsock;
|
|
||||||
|
|
||||||
close $fh;
|
|
||||||
if ($? != 0) {
|
|
||||||
error "tar failed";
|
|
||||||
}
|
|
||||||
} elsif ($msg eq "untar") {
|
|
||||||
debug "received message: untar";
|
|
||||||
# payload is the output directory
|
|
||||||
my $outdir;
|
|
||||||
{
|
|
||||||
my $ret = read($parentsock, $outdir, $len)
|
|
||||||
// error "cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
# make sure that the directory exists
|
|
||||||
if (-e $outdir) {
|
|
||||||
if (!-d $outdir) {
|
|
||||||
error "$outdir already exists but is not a directory";
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
my $num_created = make_path $outdir, { error => \my $err };
|
|
||||||
if ($err && @$err) {
|
|
||||||
error(
|
|
||||||
join "; ",
|
|
||||||
(
|
|
||||||
map { "cannot create " . (join ": ", %{$_}) }
|
|
||||||
@$err
|
|
||||||
));
|
|
||||||
} elsif ($num_created == 0) {
|
|
||||||
error "cannot create $outdir";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
|
|
||||||
# now we expect one or more "write" messages containing the
|
|
||||||
# tarball to unpack
|
|
||||||
open my $fh, '|-', 'tar', '--numeric-owner', '--xattrs',
|
|
||||||
'--xattrs-include=*', '--directory', $outdir,
|
|
||||||
'--extract', '--file',
|
|
||||||
'-' // error "failed to fork(): $!";
|
|
||||||
|
|
||||||
# handle "write" messages from the child process and feed
|
|
||||||
# their payload into the tar process until a "close" message
|
|
||||||
# is encountered
|
|
||||||
while (1) {
|
|
||||||
# receive the next message
|
|
||||||
my $ret = read($parentsock, my $buf, 2 + 5)
|
|
||||||
// error "cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
my ($len, $msg) = unpack("nA5", $buf);
|
|
||||||
debug "received message: $msg";
|
|
||||||
if ($msg eq "close") {
|
|
||||||
# finish the loop
|
|
||||||
if ($len != 0) {
|
|
||||||
error "expected no payload but got $len bytes";
|
|
||||||
}
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
last;
|
|
||||||
} elsif ($msg ne "write") {
|
|
||||||
# we should not receive this message at this point
|
|
||||||
error "expected write but got: $msg";
|
|
||||||
}
|
|
||||||
# read the payload
|
|
||||||
my $content;
|
|
||||||
{
|
|
||||||
my $ret = read($parentsock, $content, $len)
|
|
||||||
// error "error cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
# write the payload to the tar process
|
|
||||||
print $fh $content
|
|
||||||
or error "cannot write to tar process: $!";
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
}
|
|
||||||
close $fh;
|
|
||||||
if ($? != 0) {
|
|
||||||
error "tar failed";
|
|
||||||
}
|
|
||||||
} elsif ($msg eq "nblks") {
|
|
||||||
# handle the nblks message
|
|
||||||
debug "received message: nblks";
|
|
||||||
{
|
|
||||||
my $ret = read($parentsock, $numblocks, $len)
|
|
||||||
// error "cannot read from socket: $!";
|
|
||||||
if ($ret == 0) {
|
|
||||||
error "received eof on socket";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if ($numblocks !~ /^\d+$/) {
|
|
||||||
error "invalid number of blocks: $numblocks";
|
|
||||||
}
|
|
||||||
debug "sending okthx";
|
|
||||||
print $parentsock (pack("n", 0) . "okthx")
|
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
} else {
|
|
||||||
error "unknown message: $msg";
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
};
|
exec @prefix, $PROGRAM_NAME, "--hook-listener";
|
||||||
if ($@) {
|
}
|
||||||
# inform the other side that something went wrong
|
waitpid($lpid, 0);
|
||||||
print $parentsock (pack("n", 0) . "error")
|
if ($? != 0) {
|
||||||
or error "cannot write to socket: $!";
|
|
||||||
$parentsock->flush();
|
|
||||||
# we cannot die here because that would leave the other thread
|
# we cannot die here because that would leave the other thread
|
||||||
# running without a parent
|
# running without a parent
|
||||||
warning "listening on child socket failed: $@";
|
warning "listening on child socket failed: $@";
|
||||||
|
|
Loading…
Reference in a new issue