From 248fd48db0066cb2d3cbfb887b5719cda9cbd4a03e3da0096990b1b07d67d809 Mon Sep 17 00:00:00 2001 From: Pedro Monreal Gonzalez Date: Mon, 25 Jul 2022 11:50:51 +0000 Subject: [PATCH] Accepting request 991012 from home:ohollmann:branches:devel:languages:perl Add test for CVE-2022-31081. OBS-URL: https://build.opensuse.org/request/show/991012 OBS-URL: https://build.opensuse.org/package/show/devel:languages:perl/perl-HTTP-Daemon?expand=0&rev=20 --- ...d-new-test-for-Content-Length-issues.patch | 312 ++++++++++++++++++ perl-HTTP-Daemon.changes | 1 + perl-HTTP-Daemon.spec | 1 + 3 files changed, 314 insertions(+) create mode 100644 CVE-2022-31081-Add-new-test-for-Content-Length-issues.patch diff --git a/CVE-2022-31081-Add-new-test-for-Content-Length-issues.patch b/CVE-2022-31081-Add-new-test-for-Content-Length-issues.patch new file mode 100644 index 0000000..a628cc2 --- /dev/null +++ b/CVE-2022-31081-Add-new-test-for-Content-Length-issues.patch @@ -0,0 +1,312 @@ +From faebad54455c2c2919e234202362570925fb99d1 Mon Sep 17 00:00:00 2001 +From: Theo van Hoesel +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 +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 +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 +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; ++ }; ++} diff --git a/perl-HTTP-Daemon.changes b/perl-HTTP-Daemon.changes index 192f1d2..013af6c 100644 --- a/perl-HTTP-Daemon.changes +++ b/perl-HTTP-Daemon.changes @@ -5,6 +5,7 @@ Wed Jul 13 09:04:49 UTC 2022 - Otto Hollmann (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 ------------------------------------------------------------------- Fri Mar 4 03:07:35 UTC 2022 - Tina Müller diff --git a/perl-HTTP-Daemon.spec b/perl-HTTP-Daemon.spec index 795097b..fc40853 100644 --- a/perl-HTTP-Daemon.spec +++ b/perl-HTTP-Daemon.spec @@ -29,6 +29,7 @@ Source1: cpanspec.yml # 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