From 46372a3b084f4d58c1b4de180d54ad89f261546a Mon Sep 17 00:00:00 2001 From: Olaf Alders Date: Thu, 14 May 2026 00:09:58 +0000 Subject: [PATCH 1/2] Fix CVE-2026-8450: send_file() honoured 2-arg open() shell-magic HTTP::Daemon::ClientConn::send_file() used the 2-arg form open(FILE, $file), which interprets shell-magic prefixes in the path argument: '| cmd' (write pipe -- RCE), 'cmd |' (read pipe -- RCE plus response-body exfiltration via the sysread / print loop below), '> path' (write-truncate -- arbitrary file write), and '>> path', '+< path', '<&fd', and leading-whitespace variants of the above. Any HTTP::Daemon-based application that passed attacker-influenced bytes to send_file($string) -- for example, a download endpoint that derived the filename from a query parameter -- granted command execution and/or arbitrary file write at the daemon's UID. Switch to 3-arg open(my $fh, '<', $file): the explicit '<' mode makes the path argument a literal filename, so every magic shape above is opened (and fails, returning undef) as an ordinary file by that exact name. The localized typeglob is no longer needed and is replaced with a lexical filehandle. Two collateral hardening changes ride along: - binmode() failure now closes the handle and returns undef, rather than streaming the file with a wrong PerlIO layer. - send_file() returns '0E0' (true zero) on a successful zero-byte transfer so callers using "send_file or die" can distinguish open failure (undef) from an empty-but-successful copy. The POD now documents the new return-value contract and spells out that the fix only neutralises 2-arg open() shell-magic; callers remain responsible for validating attacker-influenced paths against symlinks, character/block devices (e.g. /dev/zero), named pipes, and document-root escapes. Reported and patched by Stig Palmquist (stigtsp). Co-Authored-By: Claude Opus 4.7 --- lib/HTTP/Daemon.pm | 35 ++++++++++++++++++++++++++++++----- 1 file changed, 30 insertions(+), 5 deletions(-) diff --git a/lib/HTTP/Daemon.pm b/lib/HTTP/Daemon.pm index 1a83136..2fd5c96 100644 --- a/lib/HTTP/Daemon.pm +++ b/lib/HTTP/Daemon.pm @@ -564,11 +564,10 @@ sub send_dir { sub send_file { my ($self, $file) = @_; my $opened = 0; - local (*FILE); if (!ref($file)) { - open(FILE, $file) || return undef; - binmode(FILE); - $file = \*FILE; + open(my $fh, '<', $file) || return undef; + binmode($fh) || do { close($fh); return undef }; + $file = $fh; $opened++; } my $cnt = 0; @@ -580,7 +579,11 @@ sub send_file { print $self $buf; } close($file) if $opened; - $cnt; + + # Return a "true zero" for empty-but-successful copies so callers + # using `send_file or die` can distinguish open failure (undef) + # from a successful zero-byte transfer. + $cnt || '0E0'; } sub daemon { @@ -874,6 +877,28 @@ Copy the file to the client. The file can be a string (which will be interpreted as a filename) or a reference to an C or glob. +Returns the number of bytes copied on success, or C if the +filename form failed to open. An empty file returns the string +C<'0E0'> (zero numerically, true in boolean context) so that callers +using C<< send_file or die >> can distinguish open failure from a +successful zero-byte transfer. + +The filename form uses Perl's 3-argument C with an explicit C<< +< >> mode, so the path is no longer interpreted as a 2-argument +C shell-magic shape such as C<< | cmd >>, C<< cmd | >>, or +C<< > path >>. See +L for +the prior 2-argument C behaviour this replaces. + +Note that this fix only neutralises 2-argument C shell-magic. +Callers remain responsible for validating attacker-influenced paths: +C will still happily open symlinks, character/block devices +(e.g. C, C), named pipes (which may block the +worker), and files outside an intended document root. If C<$filename> +can be derived from request input, validate it (canonicalise, reject +C<..> segments, require C<-f _> and a vetted prefix) before passing it +in. + =item $c->daemon Return a reference to the corresponding C object. -- 2.52.0 From 792869cf497b87b179a576e33b6798cdc69ada9d Mon Sep 17 00:00:00 2001 From: Olaf Alders Date: Thu, 14 May 2026 00:10:14 +0000 Subject: [PATCH 2/2] Add regression test for send_file() shell-magic refusal t/send-file-magic-open.t exercises four 2-arg open() shell-magic shapes that map to the CVE-2026-8450 harm table: - '| cmd' (write-pipe) -- RCE - 'cmd |' (read-pipe) -- RCE + response-body exfiltration - ' | cmd' (leading-ws-pipe) -- whitespace-stripping bypass - '> path' (write-redirect) -- arbitrary file write plus a bare ' --- t/send-file-magic-open.t | 133 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 133 insertions(+) create mode 100644 t/send-file-magic-open.t diff --git a/t/send-file-magic-open.t b/t/send-file-magic-open.t new file mode 100644 index 0000000..d13ee4c --- /dev/null +++ b/t/send-file-magic-open.t @@ -0,0 +1,133 @@ +use strict; +use warnings; + +use Test::More; + +BEGIN { + if ($^O eq 'MSWin32') { + plan skip_all => + 'POSIX shell is required to exercise 2-arg open() shell-magic shapes'; + } +} + +use File::Spec (); +use File::Temp qw(tempfile tempdir); +use Socket qw(AF_UNIX SOCK_STREAM PF_UNSPEC); +use HTTP::Daemon (); # also defines HTTP::Daemon::ClientConn, which + # is where send_file() actually lives + +# Regression test for CVE-2026-8450. send_file() used to call open() in +# the 2-arg form, which interpreted shell-magic prefixes in the path. +# The 3-arg form with an explicit '<' mode treats the path as a literal +# filename. The load-bearing oracle for each shape is a marker file: +# an unpatched build runs a child that creates the marker, the patched +# build never does. For the pipe shapes the marker path is passed to +# the child via an env var (not shell-interpolated) so the test is +# robust to spaces/quotes in $TMPDIR. For the redirect shape the path +# goes straight to Perl's open() with no shell, so a literal path is +# fine there too. + +# Stand up a real HTTP::Daemon::ClientConn so $self in send_file is +# a blessed socket. Any future method dispatch on $self surfaces here +# instead of silently no-oping against an unblessed scalar filehandle. +sub make_clientconn { + socketpair(my $server, my $client, AF_UNIX, SOCK_STREAM, PF_UNSPEC) + or die "socketpair: $!"; + bless $server, 'HTTP::Daemon::ClientConn'; + return ($server, $client); +} + +my $tmpdir = tempdir(CLEANUP => 1); + +# A perl one-liner that touches $ENV{HTTPD_MAGIC_MARKER}. Single-quoted +# for the shell so $f / $ENV are seen by perl, not by the shell. +my $writer + = qq{$^X -e 'open my \$f, q{>}, \$ENV{HTTPD_MAGIC_MARKER} or die; close \$f'}; + +my @magic_shapes = ( + {name => 'write-pipe', shape => sub {"| $writer"}}, + {name => 'read-pipe', shape => sub {"$writer |"}}, + + # 2-arg open() strips leading whitespace before checking for magic + # prefixes, so " | cmd" (note the leading space) is also a pipe. + {name => 'leading-ws-pipe', shape => sub {" | $writer"}}, + {name => 'write-redirect', shape => sub { my ($m) = @_; "> $m" }}, +); + +for my $case (@magic_shapes) { + my $name = $case->{name}; + my $marker = File::Spec->catfile($tmpdir, "marker-$name"); + unlink $marker; + my $shape = $case->{shape}->($marker); + + local $ENV{HTTPD_MAGIC_MARKER} = $marker; + + my ($server, $client) = make_clientconn(); + + my $rv = $server->send_file($shape); + + is($rv, undef, "[$name] send_file refuses magic shape '$shape'"); + ok(!-e $marker, "[$name] no on-disk side effect for '$shape'"); + + close $server; + my $captured = do { local $/; <$client> }; + $captured = q{} unless defined $captured; + is($captured, q{}, "[$name] no bytes streamed for '$shape'"); +} + +# Bare "catfile($tmpdir, 'secret-do-not-leak'); + open my $f, '>', $secret or die "open $secret: $!"; + print $f "do-not-leak-this-string\n"; + close $f; + + my $shape = "<$secret"; + my ($server, $client) = make_clientconn(); + my $rv = $server->send_file($shape); + + is($rv, undef, "[bare-lt] send_file refuses magic shape '$shape'"); + close $server; + my $captured = do { local $/; <$client> }; + $captured = q{} unless defined $captured; + unlike($captured, qr/do-not-leak/, + '[bare-lt] secret contents did not stream to the client'); +} + +# Positive control: an ordinary file still streams through the real +# blessed ClientConn. +my ($src_fh, $src) = tempfile(UNLINK => 1); +binmode $src_fh; +print $src_fh "hello world\n"; +close $src_fh; + +my ($server, $client) = make_clientconn(); +my $rv = $server->send_file($src); +close $server; +my $captured = do { local $/; <$client> }; +$captured = q{} unless defined $captured; + +ok(defined $rv, 'send_file still works on an ordinary filename'); +cmp_ok($rv, '>', 0, 'non-zero byte count returned'); +like($captured, qr/hello world/, 'file contents reach the client end'); + +# Return-value contract: an empty-but-successful copy must be +# distinguishable from open failure. send_file() returns '0E0' (zero +# numerically, true in boolean context) on success-with-no-bytes so +# that `send_file or die` only trips on undef. +{ + my (undef, $empty) = tempfile(UNLINK => 1); + my ($server) = make_clientconn(); + my $rv = $server->send_file($empty); + ok(defined $rv, 'empty file: rv is defined'); + ok($rv, 'empty file: rv is true (so `or die` does not fire)'); + cmp_ok($rv, '==', 0, 'empty file: rv compares numerically equal to 0'); +} + +done_testing(); -- 2.52.0