Control: tags -1 patch
gregor herrmann writes ("Re: Bug#1143215: sysread calls should check for
EINTR"):
> Thanks for you bug report, which I've forwarded to
> https://rt.cpan.org/Ticket/Display.html?id=180563
Thanks. Unfortunately, that seems to have been "deleted" without
explanation.
Anyway, here is the fix. There's one commit to fix the error handling
from sysread and two commits to add a test case.
Regards,
Ian.
>From f2ce8e498052351fd150b88ac69d53f6caab993c Mon Sep 17 00:00:00 2001
From: Ian Jackson <[email protected]>
Date: Mon, 21 Sep 2026 20:18:29 +0100
Subject: [PATCH 1/3] Handle EINTR and read errors correctly
_sysread_1 now enapsulates the two call sites of sysread.
Functional changes here:
* If we get a *read error* rather than EOF in parse_request or
parse_headers, those functions return undef. That is correct,
because otherwise we might process a partial request.
* But if the error is EINTR, we ignore it and keep reading.
Fixes https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1143215
---
lib/HTTP/Server/Simple.pm | 18 ++++++++++++++++--
1 file changed, 16 insertions(+), 2 deletions(-)
diff --git a/lib/HTTP/Server/Simple.pm b/lib/HTTP/Server/Simple.pm
index 70fc38d..0f66c08 100644
--- a/lib/HTTP/Server/Simple.pm
+++ b/lib/HTTP/Server/Simple.pm
@@ -6,6 +6,7 @@ use FileHandle;
use Socket;
use Carp;
use IO::Select;
+use POSIX;
use vars qw($VERSION $bad_request_doc);
$VERSION = '0.52';
@@ -399,6 +400,19 @@ sub restart {
exec {$0}( ( ( -x $0 ) ? () : ($^X) ), $0, @ARGV );
}
+# Read 1 character from STDIN with sysread. Returns '' on EOF, or undef on
error.
+sub _sysread_1 {
+ my $buff;
+ for (;;) {
+ my $r = sysread( STDIN, $buff, 1 );
+ return $buff // '' if defined $r;
+ # Normal perlio (read/print) handles EINTR for us. But we have to use
sysread,
+ # which doesen't. We can get EINTR if we're in the middle of reading
here, and
+ # handle a signal. As a library, we don't get to tell the application
programmer
+ # they ought not to have any signal handlers. So we must retry on
EINTR.
+ return undef if $! != EINTR;
+ }
+}
sub _process_request {
my $self = shift;
@@ -679,7 +693,7 @@ method, request URI and the protocol.
sub parse_request {
my $self = shift;
my $chunk;
- while ( sysread( STDIN, my $buff, 1 ) ) {
+ while ( length(my $buff = _sysread_1() // return undef) ) {
last if $buff eq "\n";
$chunk .= $buff;
}
@@ -711,7 +725,7 @@ sub parse_headers {
my @headers;
my $chunk = '';
- while ( sysread( STDIN, my $buff, 1 ) ) {
+ while ( length(my $buff = _sysread_1() // return undef) ) {
if ( $buff eq "\n" ) {
$chunk =~ s/[\r\l\n\s]+$//;
if ( $chunk =~ /^([^()<>\@,;:\\"\/\[\]?={} \t]+):\s*(.*)/i ) {
--
2.47.3
>From 0897889a377d7a7d16e41c6cb4bc4719db8de02c Mon Sep 17 00:00:00 2001
From: Ian Jackson <[email protected]>
Date: Mon, 21 Sep 2026 19:51:55 +0100
Subject: [PATCH 2/3] tests: Provide fetch_interactive, and normal fetch
wrapper
We'll need fetch_interactive for the EINTR test case.
---
t/01live.t | 14 +++++++++++---
1 file changed, 11 insertions(+), 3 deletions(-)
diff --git a/t/01live.t b/t/01live.t
index 2a66129..272a42e 100644
--- a/t/01live.t
+++ b/t/01live.t
@@ -87,13 +87,21 @@ for my $fam ( AF_INET, AF_INET6 ) {
is( kill( 9, $_ ), 1, "Killed PID: $_" ) for @pids;
-# this function may look excessive, but hopefully will be very useful
+# these functions may look excessive, but hopefully will be very useful
# in identifying common problems
sub fetch {
my $family = shift;
+ my $message = join "", map { "$_\015\012" } @_;
+ fetch_interactive($family, sub {
+ (send SOCK, $message, 0) || die "send: $!";
+ });
+}
+
+# more subtle version of fetch, that calls $send_callback after connect SOCK
succeeds
+sub fetch_interactive ($$) {
+ my ($family, $send_callback) = @_;
my $hostname = get_localhost($family);
my $port = $PORT;
- my $message = join "", map { "$_\015\012" } @_;
my $timeout = 5;
my $response;
my $proto = getprotobyname('tcp') || die "getprotobyname: $!";
@@ -119,7 +127,7 @@ sub fetch {
}
socket(SOCK, $family, $socktype, $proto) || die "socket: $!";
connect(SOCK, $paddr) || die "connect: $!";
- (send SOCK, $message, 0) || die "send: $!";
+ $send_callback->();
my $rvec = '';
vec($rvec, fileno(SOCK), 1) = 1;
--
2.47.3
>From dc9dfd51551c0b6d6864cc4ddf0352a24af762b2 Mon Sep 17 00:00:00 2001
From: Ian Jackson <[email protected]>
Date: Mon, 21 Sep 2026 19:55:57 +0100
Subject: [PATCH 3/3] tests: Test EINTR
I have tested this test, by experimentally reverting
Handle EINTR and read errors correctly
> 1..36
> ok 1 - constructor set family properly
> ok 2 - Constructor set port correctly
> HTTP::Server::Simple::CGI: You can connect to your server at
> http://localhost:49019/
> ok 3 - pid is numeric
> ok 4 - Returns a page
> ok 5 - constructor set family properly
> ok 6 - Constructor set port correctly
> HTTP::Server::Simple::CGI: You can connect to your server at
> http://localhost:49020/
> ok 7 - pid is numeric
> ok 8 - Returns a page
> ok 9 - constructor set family properly
> ok 10 - Constructor set port correctly
> SlowServer: You can connect to your server at http://localhost:49021/
> ok 11 - pid is numeric
> ok 12 - Returns a page
> ok 13 - constructor set family properly
> ok 14 - Constructor set port correctly
> SlowServer: You can connect to your server at http://localhost:49022/
> ok 15 - pid is numeric
> ok 16 - Returns a page
> ok 17 - family OK
> HTTP::Server::Simple::CGI: You can connect to your server at
> http://localhost:49023/
> ok 18 - pid is numeric
> ok 19 - Returns a page
> ok 20 - knows what a request isn't
> ok 21 - HTTP/1.1 request
> ok 22 - HTTP/0.9 request
> # SIGWINCH received
> not ok 23 - HTTP/1.1 request with EINTR
> # Failed test 'HTTP/1.1 request with EINTR'
> # at t/01live.t line 95.
> # 'HTTP/1.0 400 Bad request
> # Content-Type: text/html
> # Content-Length: 193
> #
> # <html>
> # <head>
> # <title>Bad Request</title>
> # </head>
> # <body>
> # <h1>Bad Request</h1>
> #
> # <p>Your browser sent a request which this web server could not
> # grok.</p>
> # </body>
> # </html>
> # '
> # doesn't match '/Congratulations/'
> ok 24 - Signaled 1 process successfully
> ok 25 - family OK
> HTTP::Server::Simple::CGI: You can connect to your server at
> http://localhost:49023/
> ok 26 - pid is numeric
> ok 27 - Returns a page
> ok 28 - knows what a request isn't
> ok 29 - HTTP/1.1 request
> ok 30 - HTTP/0.9 request
> # SIGWINCH received
> not ok 31 - HTTP/1.1 request with EINTR
> # Failed test 'HTTP/1.1 request with EINTR'
> # at t/01live.t line 95.
> # 'HTTP/1.0 400 Bad request
> # Content-Type: text/html
> # Content-Length: 193
> #
> # <html>
> # <head>
> # <title>Bad Request</title>
> # </head>
> # <body>
> # <h1>Bad Request</h1>
> #
> # <p>Your browser sent a request which this web server could not
> # grok.</p>
> # </body>
> # </html>
> # '
> # doesn't match '/Congratulations/'
> ok 32 - Signaled 1 process successfully
> ok 33 - Killed PID: 30838
> ok 34 - Killed PID: 30839
> ok 35 - Killed PID: 30840
> ok 36 - Killed PID: 30846
> # Looks like you failed 2 tests of 36.
---
t/01live.t | 17 +++++++++++++++--
1 file changed, 15 insertions(+), 2 deletions(-)
diff --git a/t/01live.t b/t/01live.t
index 272a42e..f7af49a 100644
--- a/t/01live.t
+++ b/t/01live.t
@@ -21,10 +21,10 @@ my $RUN_IPV6 = eval {
return 1;
};
if ( $RUN_IPV6) {
- plan tests => 34;
+ plan tests => 36;
} else {
diag("Skipping IPv6");
- plan tests => 17;
+ plan tests => 18;
}
use HTTP::Server::Simple;
@@ -53,6 +53,7 @@ for my $class (@classes) {
$PORT++; # don't reuse the port incase your bogus os doesn't release in
time
}
+$SIG{WINCH} = sub { note "SIGWINCH received"; }; # See EINTR test, below
for my $fam ( AF_INET, AF_INET6 ) {
next if ($fam == AF_INET6 && not $RUN_IPV6);
@@ -80,6 +81,18 @@ for my $fam ( AF_INET, AF_INET6 ) {
like(fetch($fam, "GET /"), '/Congratulations/',
"HTTP/0.9 request");
+
+ like(fetch_interactive($fam, sub {
+ # Arrange for the server to get EINTR, by sending part of the
request,
+ # and then a SIGWINCH. (We choose SIGWINCH because it's a
harmless signal
+ # that is normally ignored, but which an application might want to
handle.)
+ # Tests for regression of
https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1143215
+ (send SOCK, "GET", 0) or die "send G: $!";
+ sleep 1;
+ kill(28,$pid) or die "send SIGWINCH: $!";
+ sleep 1;
+ (send SOCK, " / HTTP/1.1\015\012\015\012", 0) or die "send ET etc.:
$!";
+ }), '/Congratulations/', "HTTP/1.1 request with EINTR");
}
is(kill(9,$pid),1,'Signaled 1 process successfully');
--
2.47.3
--
Ian Jackson <[email protected]> These opinions are my own.
Pronouns: they/he. If I emailed you from @fyvzl.net or @evade.org.uk,
that is a private address which bypasses my fierce spamfilter.
