Allow content-length (in addition to chunked encoding) when reading XML data to improve compatibility with third-party S3 gateways.

Suggested by Victor Gdalevich.

doc/xml/release.xml

@@ -43,6 +43,14 @@
                     <release-item>
                         <p><postgres/> 10 support.</p>
                     </release-item>
+
+                    <release-item>
+                        <release-item-contributor-list>
+                            <release-item-ideator id="gdalevich.victor"/>
+                        </release-item-contributor-list>
+
+                        <p>Allow <id>content-length</id> (in addition to chunked encoding) when reading XML data to improve compatibility with third-party S3 gateways.</p>
+                    </release-item>
                 </release-feature-list>
             </release-core-list>
 
@@ -3254,6 +3262,11 @@
             <contributor-id type="github">sfrost</contributor-id>
         </contributor>
 
+        <contributor id="gdalevich.victor">
+            <contributor-name-display>Victor Gdalevich</contributor-name-display>
+            <contributor-id type="github">ntrvic</contributor-id>
+        </contributor>
+
         <contributor id="golpayegani.navid">
             <contributor-name-display>Navid Golpayegani</contributor-name-display>
             <contributor-id type="github">golpa</contributor-id>

lib/pgBackRest/Common/Http/Client.pm

@@ -266,19 +266,28 @@ sub responseBody
     # Nothing to do if content length is 0
     if ($self->{iContentLength} != 0)
     {
-        while (1)
+        # Transfer encoding is chunked
+        if ($self->{iContentLength} == -1)
         {
-            # Read chunk length
+            while (1)
-            my $strChunkLength = trim($self->readLine());
+            {
-            my $iChunkLength = hex($strChunkLength);
+                # Read chunk length
+                my $strChunkLength = trim($self->readLine());
+                my $iChunkLength = hex($strChunkLength);
 
-            # Exit if chunk length is 0
+                # Exit if chunk length is 0
-            last if ($iChunkLength == 0);
+                last if ($iChunkLength == 0);
 
-            # Read the chunk and consume the terminating LF
+                # Read the chunk and consume the terminating LF
-            $self->SUPER::read(\$strResponseBody, $iChunkLength, true);
+                $self->SUPER::read(\$strResponseBody, $iChunkLength, true);
-            $self->readLine();
+                $self->readLine();
-        };
+            };
+        }
+        # Else content length is known
+        else
+        {
+            $self->SUPER::read(\$strResponseBody, $self->{iContentLength}, true);
+        }
 
         $self->close();
     }

test/lib/pgBackRestTest/Common/DefineTest.pm

@@ -88,6 +88,15 @@ my $oTestDef =
 
             &TESTDEF_TEST =>
             [
+                {
+                    &TESTDEF_NAME => 'http-client',
+                    &TESTDEF_TOTAL => 1,
+
+                    &TESTDEF_COVERAGE =>
+                    {
+                        'Common/Http/Client' => TESTDEF_COVERAGE_PARTIAL,
+                    },
+                },
                 {
                     &TESTDEF_NAME => 'ini',
                     &TESTDEF_TOTAL => 10,

test/lib/pgBackRestTest/Module/Common/CommonHttpClientTest.pm

@@ -0,0 +1,146 @@
+####################################################################################################################################
+# S3 Request Tests
+####################################################################################################################################
+package pgBackRestTest::Module::Common::CommonHttpClientTest;
+use parent 'pgBackRestTest::Common::RunTest';
+
+####################################################################################################################################
+# Perl includes
+####################################################################################################################################
+use strict;
+use warnings FATAL => qw(all);
+use Carp qw(confess);
+use English '-no_match_vars';
+
+    use IO::Socket::SSL;
+use POSIX qw(strftime);
+
+use pgBackRest::Common::Exception;
+use pgBackRest::Common::Http::Client;
+use pgBackRest::Common::Log;
+use pgBackRest::Common::Wait;
+
+use pgBackRestTest::Common::ContainerTest;
+use pgBackRestTest::Common::ExecuteTest;
+use pgBackRestTest::Common::RunTest;
+
+####################################################################################################################################
+# Port to use for testing
+####################################################################################################################################
+use constant HTTPS_TEST_PORT                                        => 9443;
+
+####################################################################################################################################
+# httpsServerResponse
+####################################################################################################################################
+sub httpsServerResponse
+{
+    my $self = shift;
+    my $iResponseCode = shift;
+    my $strContent = shift;
+
+    # Write header
+    $self->{oConnection}->write("HTTP/1.1 ${iResponseCode} GenericMessage\r\n");
+    $self->{oConnection}->write(HTTP_HEADER_CONTENT_LENGTH . ': ' . (defined($strContent) ? length($strContent) : 0) . "\r\n");
+
+    # Write new line before content (even if there isn't any)
+    $self->{oConnection}->write("\r\n");
+
+    # Write content
+    if (defined($strContent))
+    {
+        $self->{oConnection}->write($strContent);
+    }
+
+    # This will block until the connection is closed by the client
+    $self->{oConnection}->read();
+}
+
+####################################################################################################################################
+# httpsServerAccept
+####################################################################################################################################
+sub httpsServerAccept
+{
+    my $self = shift;
+
+    # Wait for a connection
+    $self->{oConnection} = $self->{oSocketServer}->accept()
+        or confess "failed to accept or handshake $!, $SSL_ERROR";
+    &log(INFO, "    * socket server connected");
+}
+
+####################################################################################################################################
+# httpsServer
+####################################################################################################################################
+sub httpsServer
+{
+    my $self = shift;
+    my $fnServer = shift;
+
+    # Fork off the server
+    if (fork() == 0)
+    {
+        # Run server function
+        $fnServer->();
+
+        exit 0;
+    }
+}
+
+####################################################################################################################################
+# Start the https testing server
+####################################################################################################################################
+sub initModule
+{
+    my $self = shift;
+
+    # Open the domain socket
+    $self->{oSocketServer} = IO::Socket::SSL->new(
+        LocalAddr => '127.0.0.1', LocalPort => HTTPS_TEST_PORT, Listen => 1, SSL_cert_file => CERT_FAKE_SERVER,
+        SSL_key_file => CERT_FAKE_SERVER_KEY)
+        or confess "unable to open https server for testing: $!";
+    &log(INFO, "    * socket server open");
+}
+
+####################################################################################################################################
+# Stop the https testing server
+####################################################################################################################################
+sub cleanModule
+{
+    my $self = shift;
+
+    # Shutdown server
+    $self->{oSocketServer}->close();
+    &log(INFO, "    * socket server closed");
+}
+
+####################################################################################################################################
+# run
+####################################################################################################################################
+sub run
+{
+    my $self = shift;
+
+    # Test variables
+    my $strTestHost = '127.0.0.1';
+    my $strTestData = 'TESTDATA';
+
+    ################################################################################################################################
+    if ($self->begin('content-length defined'))
+    {
+        $self->httpsServer(sub
+        {
+            $self->httpsServerAccept();
+            $self->httpsServerResponse(200, $strTestData);
+        });
+
+        #---------------------------------------------------------------------------------------------------------------------------
+        my $oHttpClient = $self->testResult(
+            sub {new pgBackRest::Common::Http::Client(
+                $strTestHost, HTTP_VERB_GET, {iPort => HTTPS_TEST_PORT, bVerifySsl => false})},
+            '[object]', 'new http client');
+
+        $self->testResult(sub {${$oHttpClient->responseBody()}}, $strTestData, 'response body read');
+    }
+}
+
+1;