[prev in list] [next in list] [prev in thread] [next in thread]
List: opensuse-commit
Subject: commit perl-HTTP-Daemon for openSUSE:Factory
From: "Source-Sync" <autobuild () suse ! de>
Date: 2022-07-31 20:56:42
Message-ID: 165930125327.1118.21748549333957258 () mailman3 ! infra ! opensuse ! org
[Download RAW message or body]
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) {
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic