Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package perl-HTTP-Daemon for openSUSE:Factory checked in at 2022-07-31 23:00:35 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-HTTP-Daemon (Old) and /work/SRC/openSUSE:Factory/.perl-HTTP-Daemon.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "perl-HTTP-Daemon" Sun Jul 31 23:00:35 2022 rev:17 rq:991013 version:6.14 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-HTTP-Daemon/perl-HTTP-Daemon.changes 2022-03-11 11:49:46.746873801 +0100 +++ /work/SRC/openSUSE:Factory/.perl-HTTP-Daemon.new.1533/perl-HTTP-Daemon.changes 2022-07-31 23:00:48.847669107 +0200 @@ -1,0 +2,9 @@ +Wed Jul 13 09:04:49 UTC 2022 - Otto Hollmann <otto.hollmann@suse.com> + +- Fix request smuggling in HTTP::Daemon + (CVE-2022-31081, bsc#1201157) + * CVE-2022-31081.patch + * CVE-2022-31081-2.patch + * CVE-2022-31081-Add-new-test-for-Content-Length-issues.patch + +------------------------------------------------------------------- New: ---- CVE-2022-31081-2.patch CVE-2022-31081-Add-new-test-for-Content-Length-issues.patch CVE-2022-31081.patch ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-HTTP-Daemon.spec ++++++ --- /var/tmp/diff_new_pack.z8GnTO/_old 2022-07-31 23:00:49.427670792 +0200 +++ /var/tmp/diff_new_pack.z8GnTO/_new 2022-07-31 23:00:49.427670792 +0200 @@ -20,11 +20,16 @@ Name: perl-HTTP-Daemon Version: 6.14 Release: 0 -License: Artistic-1.0 OR GPL-1.0-or-later Summary: Simple http server class +License: Artistic-1.0 OR GPL-1.0-or-later URL: https://metacpan.org/release/%{cpan_name} Source0: https://cpan.metacpan.org/authors/id/O/OA/OALDERS/%{cpan_name}-%{version}.tar.gz Source1: cpanspec.yml +# PATCH-FIX-SECURITY bsc#1201157 otto.hollmann@suse.com +# Fix request smuggling in HTTP::Daemon +Patch0: CVE-2022-31081.patch +Patch1: CVE-2022-31081-2.patch +Patch2: CVE-2022-31081-Add-new-test-for-Content-Length-issues.patch BuildArch: noarch BuildRequires: perl BuildRequires: perl-macros @@ -65,7 +70,7 @@ back various responses. %prep -%autosetup -n %{cpan_name}-%{version} +%autosetup -n %{cpan_name}-%{version} -p1 find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path "*/script/*" ! -name "configure" -print0 | xargs -0 chmod 644 %build ++++++ CVE-2022-31081-2.patch ++++++ From 8dc5269d59e2d5d9eb1647d82c449ccd880f7fd0 Mon Sep 17 00:00:00 2001 From: Theo van Hoesel <tvanhoesel@perceptyx.com> Date: Tue, 21 Jun 2022 20:00:47 +0000 Subject: [PATCH] Include reason in response body content --- lib/HTTP/Daemon.pm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) 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 $len = shift @nums; foreach (@nums) { next if $_ == $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 ++++++ CVE-2022-31081-Add-new-test-for-Content-Length-issues.patch ++++++ From faebad54455c2c2919e234202362570925fb99d1 Mon Sep 17 00:00:00 2001 From: Theo van Hoesel <tvanhoesel@perceptyx.com> Date: Tue, 21 Jun 2022 20:30:36 +0000 Subject: [PATCH] Add new test for Content-Length issues prove we fixed CVE-2022-31081 From 211a29732760c9887c15e8dc344e15cf8cdf2807 Mon Sep 17 00:00:00 2001 From: Theo van Hoesel <tvanhoesel@perceptyx.com> Date: Mon, 27 Jun 2022 22:42:31 +0200 Subject: [PATCH 1/3] Fix tests to match with correct grammar in error message From 2b7fd55a55313b6f04c92fbfee6458d1f7b908fd Mon Sep 17 00:00:00 2001 From: Theo van Hoesel <tvanhoesel@perceptyx.com> Date: Mon, 27 Jun 2022 22:44:11 +0200 Subject: [PATCH 2/3] Remove warnings about Subroutine write_content_body redefined From cfa63717a3aeedf6aaec16c4091098c05c2d7e01 Mon Sep 17 00:00:00 2001 From: Theo van Hoesel <tvanhoesel@perceptyx.com> Date: Mon, 27 Jun 2022 23:33:05 +0200 Subject: [PATCH 3/3] Send some body to see what we get returned --- t/content_length.t | 282 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 282 insertions(+) create mode 100644 t/content_length.t --- /dev/null +++ b/t/content_length.t @@ -0,0 +1,282 @@ +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", + body => "ABCDEFGH", + headers => { + 'Content-Length' => '+6', # quotes are needed to retain plus-sign + }, + status => 400, + like => qr/value must be an unsigned integer/, + }, + { + title => "Negative Content Length", + method => "POST", + body => "ABCDEFGH", + headers => { + 'Content-Length' => '-5', + }, + status => 400, + like => qr/value must be an unsigned integer/, + }, + { + title => "Non Integer Content Length", + method => "POST", + body => "ABCDEFGH", + 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'; + no warnings; + + *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; + }; +} ++++++ CVE-2022-31081.patch ++++++ From e84475de51d6fd7b29354a997413472a99db70b2 Mon Sep 17 00:00:00 2001 From: Theo van Hoesel <tvanhoesel@perceptyx.com> Date: Thu, 16 Jun 2022 08:28:30 +0000 Subject: [PATCH] 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 --- lib/HTTP/Daemon.pm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) 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 ($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 ',', $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 $len = shift @nums; + foreach (@nums) { + next if $_ == $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' => $len); + # Plain body specified by "Content-Length" my $missing = $len - length($buf); while ($missing > 0) {