293 lines
11 KiB
Diff
293 lines
11 KiB
Diff
From 46372a3b084f4d58c1b4de180d54ad89f261546a Mon Sep 17 00:00:00 2001
|
|
From: Olaf Alders <olaf@wundersolutions.com>
|
|
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 <noreply@anthropic.com>
|
|
---
|
|
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<IO::Handle>
|
|
or glob.
|
|
|
|
+Returns the number of bytes copied on success, or C<undef> 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<open> with an explicit C<<
|
|
+< >> mode, so the path is no longer interpreted as a 2-argument
|
|
+C<open> shell-magic shape such as C<< | cmd >>, C<< cmd | >>, or
|
|
+C<< > path >>. See
|
|
+L<CVE-2026-8450|https://www.cve.org/CVERecord?id=CVE-2026-8450> for
|
|
+the prior 2-argument C<open> behaviour this replaces.
|
|
+
|
|
+Note that this fix only neutralises 2-argument C<open> shell-magic.
|
|
+Callers remain responsible for validating attacker-influenced paths:
|
|
+C<send_file> will still happily open symlinks, character/block devices
|
|
+(e.g. C</dev/zero>, C</dev/stdin>), 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<HTTP::Daemon> object.
|
|
--
|
|
2.52.0
|
|
|
|
|
|
From 792869cf497b87b179a576e33b6798cdc69ada9d Mon Sep 17 00:00:00 2001
|
|
From: Olaf Alders <olaf@wundersolutions.com>
|
|
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 '<file' shape that under 2-arg open silently strips the
|
|
'<' and opens an existing file the caller never named, leaking its
|
|
contents to the response body.
|
|
|
|
For each case, send_file() is invoked on a real
|
|
HTTP::Daemon::ClientConn (built via socketpair() and bless) so any
|
|
future method dispatch on $self surfaces in the test rather than
|
|
silently no-oping against an unblessed scalar filehandle. The pipe
|
|
shapes use a marker file as the load-bearing oracle (the marker is
|
|
created by the would-be subprocess; absence proves the subprocess
|
|
never ran). The marker path is passed to the child via
|
|
$ENV{HTTPD_MAGIC_MARKER}, not shell-interpolated, so the test is
|
|
robust to spaces or quotes in $TMPDIR. The file is skipped on
|
|
Windows where cmd.exe does not honour POSIX single quoting.
|
|
|
|
A positive control confirms an ordinary file still streams through.
|
|
A return-value-contract section confirms send_file() returns '0E0'
|
|
(defined, true, numerically zero) for a successful zero-byte copy.
|
|
|
|
Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
|
|
---
|
|
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 "<file" prefix: under 2-arg open() this opens "file" for read,
|
|
+# bypassing any path validation a caller may have done on the
|
|
+# attacker-supplied string. Under 3-arg open with mode '<' the leading
|
|
+# '<' is part of the literal filename, so the open fails and no bytes
|
|
+# leak. Place a real file at the would-be target so an unpatched build
|
|
+# would actually stream its contents (and the assertion would catch it),
|
|
+# rather than failing for the boring reason that the file doesn't exist.
|
|
+{
|
|
+ my $secret = File::Spec->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
|
|
|