Bug#1016391: bullseye-pu: libhttp-daemon-perl/6.12-1+deb11u1
Package: release.debian.org
Severity: normal
Tags: bulleye
User: release.debian.org@packages.debian.org
Usertags: pu
The attached debdiff for libhttp-daemon-perl fixes CVE-2022-31081 in
Bullseye. This CVE has been marked as no-dsa by the security team.
The patch is accompanied by a new test and should not create any issue.
It had been used to fix unstable and will be used for Buster, <Stretch and
Jessie as well.
Thorsten
diff -Nru libhttp-daemon-perl-6.12/debian/changelog libhttp-daemon-perl-6.12/debian/changelog
--- libhttp-daemon-perl-6.12/debian/changelog 2020-06-06 03:12:55.000000000 +0200
+++ libhttp-daemon-perl-6.12/debian/changelog 2022-07-26 20:08:59.000000000 +0200
@@ -1,3 +1,11 @@
+libhttp-daemon-perl (6.12-1+deb11u1) bullseye; urgency=high
+
+ * Non-maintainer upload by the ELTS Team.
+ * CVE-2022-31081 (Closes: #1014808)
+ improved Content-Length: handling in HTTP-header
+
+ -- Thorsten Alteholz <debian@alteholz.de> Tue, 26 Jul 2022 20:08:59 +0200
+
libhttp-daemon-perl (6.12-1) unstable; urgency=medium
* Import upstream version 6.12.
diff -Nru libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-1.patch libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-1.patch
--- libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-1.patch 1970-01-01 01:00:00.000000000 +0100
+++ libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-1.patch 2022-07-26 20:08:59.000000000 +0200
@@ -0,0 +1,48 @@
+commit e84475de51d6fd7b29354a997413472a99db70b2
+Author: Theo van Hoesel <tvanhoesel@perceptyx.com>
+Date: Thu Jun 16 08:28:30 2022 +0000
+
+ Fix Content-Length ', '-separated string issues
+
+ After a security issue, we ensure we comply to
+ RFC-7230 -- HTTP/1.1 Message Syntax and Routing
+ - section 3.3.2 -- Content-Length
+ - section 3.3.3 -- Message Body Length
+
+diff --git a/lib/HTTP/Daemon.pm b/lib/HTTP/Daemon.pm
+index c0cdf76..a5112b3 100644
+--- a/lib/HTTP/Daemon.pm
++++ b/lib/HTTP/Daemon.pm
+@@ -288,6 +288,32 @@ READ_HEADER:
+ }
+ elsif ($ct_len) {
+
++ # After a security issue, we ensure we comply to
++ # RFC-7230 -- HTTP/1.1 Message Syntax and Routing
++ # section 3.3.2 -- Content-Length
++ # section 3.3.3 -- Message Body Length
++
++ # split and clean up Content-Length ', ' separated string
++ my @vals = map {my $str = $_; $str =~ s/^\s+//; $str =~ s/\s+$//; $str }
++ split ',', $ct_len;
++ # check that they are all numbers (RFC: Content-Length = 1*DIGIT)
++ my @nums = grep { /^[0-9]+$/} @vals;
++ unless (@vals == @nums) {
++ $self->send_error(400);
++ $self->reason("Content-Length value must be a unsigned integer");
++ return;
++ }
++ # check they are all the same
++ my $ct_len = shift @nums;
++ foreach (@nums) {
++ next if $_ == $ct_len;
++ $self->send_error(400);
++ $self->reason("Content-Length values are not the same");
++ return;
++ }
++ # ensure we have now a fixed header, with only 1 value
++ $r->header('Content-Length' => $ct_len);
++
+ # Plain body specified by "Content-Length"
+ my $missing = $ct_len - length($buf);
+ while ($missing > 0) {
diff -Nru libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-2.patch libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-2.patch
--- libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-2.patch 1970-01-01 01:00:00.000000000 +0100
+++ libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-2.patch 2022-07-26 20:08:59.000000000 +0200
@@ -0,0 +1,33 @@
+commit 8dc5269d59e2d5d9eb1647d82c449ccd880f7fd0
+Author: Theo van Hoesel <tvanhoesel@perceptyx.com>
+Date: Tue Jun 21 20:00:47 2022 +0000
+
+ Include reason in response body content
+
+diff --git a/lib/HTTP/Daemon.pm b/lib/HTTP/Daemon.pm
+index a5112b3..2d022ae 100644
+--- a/lib/HTTP/Daemon.pm
++++ b/lib/HTTP/Daemon.pm
+@@ -299,16 +299,18 @@ READ_HEADER:
+ # check that they are all numbers (RFC: Content-Length = 1*DIGIT)
+ my @nums = grep { /^[0-9]+$/} @vals;
+ unless (@vals == @nums) {
+- $self->send_error(400);
+- $self->reason("Content-Length value must be a unsigned integer");
++ my $reason = "Content-Length value must be an unsigned integer";
++ $self->send_error(400, $reason);
++ $self->reason($reason);
+ return;
+ }
+ # check they are all the same
+ my $ct_len = shift @nums;
+ foreach (@nums) {
+ next if $_ == $ct_len;
+- $self->send_error(400);
+- $self->reason("Content-Length values are not the same");
++ my $reason = "Content-Length values are not the same";
++ $self->send_error(400, $reason);
++ $self->reason($reason);
+ return;
+ }
+ # ensure we have now a fixed header, with only 1 value
diff -Nru libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-rename.patch libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-rename.patch
--- libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-rename.patch 1970-01-01 01:00:00.000000000 +0100
+++ libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-rename.patch 2022-07-26 20:08:59.000000000 +0200
@@ -0,0 +1,102 @@
+commit 331d5c1d1f0e48e6b57ef738c2a8509b1eb53376
+Author: Theo van Hoesel <tvanhoesel@perceptyx.com>
+Date: Thu Jun 16 08:17:39 2022 +0000
+
+ Rename variables
+
+ can not remember 2-letter abreviation more than 100 lines below
+
+diff --git a/lib/HTTP/Daemon.pm b/lib/HTTP/Daemon.pm
+index a02486c..c0cdf76 100644
+--- a/lib/HTTP/Daemon.pm
++++ b/lib/HTTP/Daemon.pm
+@@ -192,9 +192,9 @@ READ_HEADER:
+ }
+
+ # Find out how much content to read
+- my $te = $r->header('Transfer-Encoding');
+- my $ct = $r->header('Content-Type');
+- my $len = $r->header('Content-Length');
++ my $tr_enc = $r->header('Transfer-Encoding');
++ my $ct_type = $r->header('Content-Type');
++ my $ct_len = $r->header('Content-Length');
+
+ # Act on the Expect header, if it's there
+ for my $e ($r->header('Expect')) {
+@@ -209,7 +209,7 @@ READ_HEADER:
+ }
+ }
+
+- if ($te && lc($te) eq 'chunked') {
++ if ($tr_enc && lc($tr_enc) eq 'chunked') {
+
+ # Handle chunked transfer encoding
+ my $body = "";
+@@ -280,32 +280,32 @@ READ_HEADER:
+ $r->push_header($key, $val) if $key;
+
+ }
+- elsif ($te) {
++ elsif ($tr_enc) {
+ $self->send_error(501); # Unknown transfer encoding
+- $self->reason("Unknown transfer encoding '$te'");
++ $self->reason("Unknown transfer encoding '$tr_enc'");
+ return;
+
+ }
+- elsif ($len) {
++ elsif ($ct_len) {
+
+ # Plain body specified by "Content-Length"
+- my $missing = $len - length($buf);
++ my $missing = $ct_len - length($buf);
+ while ($missing > 0) {
+ print "Need $missing more bytes of content\n" if $DEBUG;
+ my $n = $self->_need_more($buf, $timeout, $fdset);
+ return unless $n;
+ $missing -= $n;
+ }
+- if (length($buf) > $len) {
+- $r->content(substr($buf, 0, $len));
+- substr($buf, 0, $len) = '';
++ if (length($buf) > $ct_len) {
++ $r->content(substr($buf, 0, $ct_len));
++ substr($buf, 0, $ct_len) = '';
+ }
+ else {
+ $r->content($buf);
+ $buf = '';
+ }
+ }
+- elsif ($ct && $ct =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*("?)(\w+)\1/i) {
++ elsif ($ct_type && $ct_type =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*("?)(\w+)\1/i) {
+
+ # Handle multipart content type
+ my $boundary = "$CRLF--$2--";
+@@ -497,8 +497,8 @@ sub send_redirect {
+ print $self "Location: $loc$CRLF";
+
+ if ($content) {
+- my $ct = $content =~ /^\s*</ ? "text/html" : "text/plain";
+- print $self "Content-Type: $ct$CRLF";
++ my $ct_type = $content =~ /^\s*</ ? "text/html" : "text/plain";
++ print $self "Content-Type: $ct_type$CRLF";
+ }
+ print $self $CRLF;
+ print $self $content if $content && !$self->head_request;
+@@ -537,12 +537,12 @@ sub send_file_response {
+ local (*F);
+ sysopen(F, $file, 0) or return $self->send_error(RC_FORBIDDEN);
+ binmode(F);
+- my ($ct, $ce) = guess_media_type($file);
++ my ($mime_type, $file_enc) = guess_media_type($file);
+ my ($size, $mtime) = (stat _)[7, 9];
+ unless ($self->antique_client) {
+ $self->send_basic_header;
+- print $self "Content-Type: $ct$CRLF";
+- print $self "Content-Encoding: $ce$CRLF" if $ce;
++ print $self "Content-Type: $mime_type$CRLF";
++ print $self "Content-Encoding: $file_enc$CRLF" if $file_enc;
+ print $self "Content-Length: $size$CRLF" if $size;
+ print $self "Last-Modified: ", time2str($mtime), "$CRLF" if $mtime;
+ print $self $CRLF;
diff -Nru libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-testcase.patch libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-testcase.patch
--- libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-testcase.patch 1970-01-01 01:00:00.000000000 +0100
+++ libhttp-daemon-perl-6.12/debian/patches/CVE-2022-31081-testcase.patch 2022-07-26 20:08:59.000000000 +0200
@@ -0,0 +1,292 @@
+commit faebad54455c2c2919e234202362570925fb99d1
+Author: Theo van Hoesel <tvanhoesel@perceptyx.com>
+Date: Tue Jun 21 20:30:36 2022 +0000
+
+ Add new test for Content-Length issues
+
+ prove we fixed CVE-2022-31081
+
+diff --git a/t/content_length.t b/t/content_length.t
+new file mode 100644
+index 0000000..1751845
+--- /dev/null
++++ b/t/content_length.t
+@@ -0,0 +1,278 @@
++use strict;
++use warnings;
++
++use Test::More 0.98;
++
++use Config;
++
++use HTTP::Daemon;
++use HTTP::Response;
++use HTTP::Status;
++use HTTP::Tiny 0.042;
++
++patch_http_tiny(); # do not fix Content-Length, we want to forge something bad
++
++plan skip_all => "This system cannot fork" unless can_fork();
++
++my $BASE_URL;
++my @TESTS = get_tests();
++
++for my $test (@TESTS) {
++
++ my $http_daemon = HTTP::Daemon->new() or die "HTTP::Daemon->new: $!";
++ $BASE_URL = $http_daemon->url;
++
++ my $pid = fork;
++ die "fork: $!" if !defined $pid;
++ if ($pid == 0) {
++ accept_requests($http_daemon);
++ }
++
++ my $resp = http_test_request($test);
++
++ ok $resp, $test->{title};
++
++ is $resp->{status}, $test->{status},
++ "... and has expected status";
++
++ like $resp->{content}, $test->{like},
++ "... and body does match"
++ if $test->{like};
++
++}
++
++done_testing;
++
++
++
++sub get_tests{
++ {
++ title => "Hello World Request ... it works as expected",
++ path => "hello-world",
++ status => 200,
++ like => qr/^Hello World$/,
++ },
++ {
++ title => "Positive Content Length",
++ method => "POST",
++ headers => {
++ 'Content-Length' => '+1', # quotes are needed to retain plus-sign
++ },
++ status => 400,
++ like => qr/value must be an unsigned integer/,
++ },
++ {
++ title => "Negative Content Length",
++ method => "POST",
++ headers => {
++ 'Content-Length' => '-1',
++ },
++ status => 400,
++ like => qr/value must be an unsigned integer/,
++ },
++ {
++ title => "Non Integer Content Length",
++ method => "POST",
++ headers => {
++ 'Content-Length' => '3.14',
++ },
++ status => 400,
++ like => qr/value must be an unsigned integer/,
++ },
++ {
++ title => "Explicit Content Length ... with exact length",
++ method => "POST",
++ headers => {
++ 'Content-Length' => '8',
++ },
++ body => "ABCDEFGH",
++ status => 200,
++ like => qr/^ABCDEFGH$/,
++ },
++ {
++ title => "Implicit Content Length ... will always pass",
++ method => "POST",
++ body => "ABCDEFGH",
++ status => 200,
++ like => qr/^ABCDEFGH$/,
++ },
++ {
++ title => "Shorter Content Length ... gets truncated",
++ method => "POST",
++ headers => {
++ 'Content-Length' => '4',
++ },
++ body => "ABCDEFGH",
++ status => 200,
++ like => qr/^ABCD$/,
++ },
++ {
++ title => "Different Content Length ... must fail",
++ method => "POST",
++ headers => {
++ 'Content-Length' => ['8', '4'],
++ },
++ body => "ABCDEFGH",
++ status => 400,
++ like => qr/values are not the same/,
++ },
++ {
++ title => "Underscore Content Length ... must match",
++ method => "POST",
++ headers => {
++ 'Content_Length' => '4',
++ },
++ body => "ABCDEFGH",
++ status => 400,
++ like => qr/values are not the same/,
++ },
++ {
++ title => "Longer Content Length ... gets timeout",
++ method => "POST",
++ headers => {
++ 'Content-Length' => '9',
++ },
++ body => "ABCDEFGH",
++ status => 599, # silly code !!!
++ like => qr/^Timeout/,
++ },
++
++}
++
++
++
++sub router_table {
++ {
++ '/hello-world' => {
++ 'GET' => sub {
++ my $resp = HTTP::Response->new(200);
++ $resp->content('Hello World');
++ return $resp;
++ },
++ },
++
++ '/' => {
++ 'POST' => sub {
++ my $rqst = shift;
++
++ my $body = $rqst->content();
++
++ my $resp = HTTP::Response->new(200);
++ $resp->content($body);
++
++ return $resp
++ },
++ },
++ }
++}
++
++
++
++sub can_fork {
++ $Config{d_fork} || (($^O eq 'MSWin32' || $^O eq 'NetWare')
++ and $Config{useithreads}
++ and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
++}
++
++
++
++# run the mini HTTP dispatcher that can handle various routes / methods
++sub accept_requests{
++ my $http_daemon = shift;
++ while (my $conn = $http_daemon->accept) {
++ while (my $rqst = $conn->get_request) {
++ if (my $resp = dispatch_request($rqst)) {
++ $conn->send_response($resp);
++ }
++ }
++ $conn->close;
++ undef($conn);
++ $http_daemon->close;
++ exit 1;
++ }
++}
++
++
++
++sub dispatch_request{
++ my $rqst = shift
++ or return;
++ my $path = $rqst->uri->path
++ or return;
++ my $meth = $rqst->method
++ or return;
++ my $code = router_table()->{$path}{$meth}
++ or return HTTP::Response->new(RC_NOT_FOUND);
++ my $resp = $code->($rqst);
++ return $resp;
++}
++
++
++
++sub http_test_request {
++ my $test = shift;
++ my $http_client = HTTP::Tiny->new(
++ timeout => 5,
++ proxy => undef,
++ http_proxy => undef,
++ https_proxy => undef,
++ );
++ my $resp;
++ eval {
++ local $SIG{ALRM} = sub { die "Timeout\n" };
++ alarm 2;
++ $resp = $http_client->request(
++ $test->{method} || "GET",
++ $BASE_URL . ($test->{path} || ""),
++ {
++ headers => $test->{headers},
++ content => $test->{body}
++ },
++ );
++ };
++ my $err = $@;
++ alarm 0;
++ diag $err if $err;
++
++ return $resp
++}
++
++
++
++sub patch_http_tiny {
++
++ # we need to patch write_content_body
++ # this is part of HTTP::Tiny internal module HTTP::Tiny::Handle
++ #
++ # the below code is from the original HTTP::Tiny module, where just two lines
++ # have been commented out
++
++ no strict 'refs';
++
++ *HTTP::Tiny::Handle::write_content_body = sub {
++ @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
++ my ($self, $request) = @_;
++
++ my ($len, $content_length) = (0, $request->{headers}{'content-length'});
++ while () {
++ my $data = $request->{cb}->();
++
++ defined $data && length $data
++ or last;
++
++ if ( $] ge '5.008' ) {
++ utf8::downgrade($data, 1)
++ or die(qq/Wide character in write_content()\n/);
++ }
++
++ $len += $self->write($data);
++ }
++
++# this should not be checked during our tests, we want to forge bad requests
++#
++# $len == $content_length
++# or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);
++
++ return $len;
++ };
++}
diff -Nru libhttp-daemon-perl-6.12/debian/patches/series libhttp-daemon-perl-6.12/debian/patches/series
--- libhttp-daemon-perl-6.12/debian/patches/series 1970-01-01 01:00:00.000000000 +0100
+++ libhttp-daemon-perl-6.12/debian/patches/series 2022-07-26 20:08:59.000000000 +0200
@@ -0,0 +1,4 @@
+CVE-2022-31081-testcase.patch
+CVE-2022-31081-rename.patch
+CVE-2022-31081-1.patch
+CVE-2022-31081-2.patch
Reply to: