From eea2ccc3ab52ee588d6f894d291931bd9aa52147 Mon Sep 17 00:00:00 2001 From: David Steele Date: Sun, 3 Sep 2017 16:48:41 -0400 Subject: [PATCH] Add HTTP retries to harden against transient S3 network errors. --- doc/xml/release.xml | 4 + lib/pgBackRest/Common/Http/Client.pm | 279 ++++++++++-------- lib/pgBackRest/Storage/S3/Request.pm | 3 +- test/lib/pgBackRestTest/Common/DefineTest.pm | 2 +- .../Module/Common/CommonHttpClientTest.pm | 27 ++ 5 files changed, 198 insertions(+), 117 deletions(-) diff --git a/doc/xml/release.xml b/doc/xml/release.xml index 6b618b5e8..9333f612a 100644 --- a/doc/xml/release.xml +++ b/doc/xml/release.xml @@ -57,6 +57,10 @@

Increase HTTP timeout for S3.

 + + +

Add HTTP retries to harden against transient S3 network errors.

+ diff --git a/lib/pgBackRest/Common/Http/Client.pm b/lib/pgBackRest/Common/Http/Client.pm index af0551e1f..45114075a 100644 --- a/lib/pgBackRest/Common/Http/Client.pm +++ b/lib/pgBackRest/Common/Http/Client.pm @@ -54,7 +54,9 @@ sub new $hQuery, $hRequestHeader, $rstrRequestBody, + $bResponseBodyPrefetch, $iProtocolTimeout, + $iTryTotal, $lBufferMax, $bVerifySsl, $strCaPath, @@ -70,138 +72,182 @@ sub new {name => 'hQuery', optional => true, trace => true}, {name => 'hRequestHeader', optional => true, trace => true}, {name => 'rstrRequestBody', optional => true, trace => true}, - {name => 'iProtocolTimeout', optional => true, default => 90, trace => true}, + {name => 'bResponseBodyPrefetch', optional => true, default => false, trace => true}, + {name => 'iProtocolTimeout', optional => true, default => 300, trace => true}, + {name => 'iTryTotal', optional => true, default => 3, trace => true}, {name => 'lBufferMax', optional => true, default => 32768, trace => true}, {name => 'bVerifySsl', optional => true, default => true, trace => true}, {name => 'strCaPath', optional => true, trace => true}, {name => 'strCaFile', optional => true, trace => true}, ); - # Connect to the server - my $oSocket; + # Retry as many times as requested + my $self; + my $iTry = 1; + my $bRetry; - eval + do { - $oSocket = IO::Socket::SSL->new( - PeerHost => $strHost, PeerPort => $iPort, SSL_verify_mode => $bVerifySsl ? SSL_VERIFY_PEER : SSL_VERIFY_NONE, - SSL_ca_path => $strCaPath, SSL_ca_file => $strCaFile); + # Disable logging if a failure will be retried + logDisable() if $iTry < $iTryTotal; + $bRetry = false; - return 1; - } - or do - { - logErrorResult(ERROR_HOST_CONNECT, $EVAL_ERROR); - }; - - # Check for errors - if (!defined($oSocket)) - { - logErrorResult( - ERROR_HOST_CONNECT, coalesce(length($!) == 0 ? undef : $!, $SSL_ERROR), length($!) > 0 ? $SSL_ERROR : undef); - } - - # Create the buffered IO object - my $self = new pgBackRest::Common::Io::Buffered( - new pgBackRest::Common::Io::Handle('httpClient', $oSocket, $oSocket), $iProtocolTimeout, $lBufferMax); - - # Bless with the class - @ISA = $self->isA(); ## no critic (ClassHierarchies::ProhibitExplicitISA) - bless $self, $class; - - # Store socket - $self->{oSocket} = $oSocket; - - # Generate the query string - my $strQuery = httpQuery($hQuery); - - # Construct the request headers - $self->{strRequestHeader} = "${strVerb} ${strUri}?${strQuery} HTTP/1.1" . "\r\n"; - - foreach my $strHeader (sort(keys(%{$hRequestHeader}))) - { - $self->{strRequestHeader} .= "${strHeader}: $hRequestHeader->{$strHeader}\r\n"; - } - - $self->{strRequestHeader} .= "\r\n"; - - # Write request headers - $self->write(\$self->{strRequestHeader}); - - # Write content - if (defined($rstrRequestBody)) - { - my $iTotalSize = length($$rstrRequestBody); - my $iTotalSent = 0; - - # Write the request body in buffer-sized chunks - do + eval { - my $strBufferWrite = substr($$rstrRequestBody, $iTotalSent, $lBufferMax); - $iTotalSent += $self->write(\$strBufferWrite); - } while ($iTotalSent < $iTotalSize); - } + # Connect to the server + my $oSocket; - # Read response code - ($self->{strResponseProtocol}, $self->{iResponseCode}, $self->{strResponseMessage}) = split(' ', trim($self->readLine())); - - # Read the response headers - $self->{iContentLength} = undef; - - $self->{strResponseHeader} = ''; - my $strHeader = trim($self->readLine()); - - while ($strHeader ne '') - { - # Validate header - $self->{strResponseHeader} .= "${strHeader}\n"; - - my $iColonPos = index($strHeader, ':'); - - if ($iColonPos == -1) - { - confess &log(ERROR, "http header '${strHeader}' requires colon separator", ERROR_PROTOCOL); - } - - # Parse header - my $strHeaderKey = lc(substr($strHeader, 0, $iColonPos)); - my $strHeaderValue = trim(substr($strHeader, $iColonPos + 1)); - - # Store the header - $self->{hResponseHeader}{$strHeaderKey} = $strHeaderValue; - - # Process content length - if ($strHeaderKey eq HTTP_HEADER_CONTENT_LENGTH) - { - $self->{iContentLength} = $strHeaderValue + 0; - $self->{iContentRemaining} = $self->{iContentLength}; - } - # Process transfer encoding (only chunked is supported) - elsif ($strHeaderKey eq HTTP_HEADER_TRANSFER_ENCODING) - { - if ($strHeaderValue eq 'chunked') + eval { - $self->{iContentLength} = -1; + $oSocket = IO::Socket::SSL->new( + PeerHost => $strHost, PeerPort => $iPort, SSL_verify_mode => $bVerifySsl ? SSL_VERIFY_PEER : SSL_VERIFY_NONE, + SSL_ca_path => $strCaPath, SSL_ca_file => $strCaFile); + + return 1; } - else + or do { - confess &log(ERROR, "invalid value '${strHeaderValue} for http header '${strHeaderKey}'", ERROR_PROTOCOL); + logErrorResult(ERROR_HOST_CONNECT, $EVAL_ERROR); + }; + + # Check for errors + if (!defined($oSocket)) + { + logErrorResult( + ERROR_HOST_CONNECT, coalesce(length($!) == 0 ? undef : $!, $SSL_ERROR), length($!) > 0 ? $SSL_ERROR : undef); } + + # Create the buffered IO object + $self = new pgBackRest::Common::Io::Buffered( + new pgBackRest::Common::Io::Handle('httpClient', $oSocket, $oSocket), $iProtocolTimeout, $lBufferMax); + + # Bless with the class + @ISA = $self->isA(); ## no critic (ClassHierarchies::ProhibitExplicitISA) + bless $self, $class; + + # Store socket + $self->{oSocket} = $oSocket; + + # Generate the query string + my $strQuery = httpQuery($hQuery); + + # Construct the request headers + $self->{strRequestHeader} = "${strVerb} ${strUri}?${strQuery} HTTP/1.1" . "\r\n"; + + foreach my $strHeader (sort(keys(%{$hRequestHeader}))) + { + $self->{strRequestHeader} .= "${strHeader}: $hRequestHeader->{$strHeader}\r\n"; + } + + $self->{strRequestHeader} .= "\r\n"; + + # Write request headers + $self->write(\$self->{strRequestHeader}); + + # Write content + if (defined($rstrRequestBody)) + { + my $iTotalSize = length($$rstrRequestBody); + my $iTotalSent = 0; + + # Write the request body in buffer-sized chunks + do + { + my $strBufferWrite = substr($$rstrRequestBody, $iTotalSent, $lBufferMax); + $iTotalSent += $self->write(\$strBufferWrite); + } while ($iTotalSent < $iTotalSize); + } + + # Read response code + ($self->{strResponseProtocol}, $self->{iResponseCode}, $self->{strResponseMessage}) = + split(' ', trim($self->readLine())); + + # Read the response headers + $self->{iContentLength} = undef; + + $self->{strResponseHeader} = ''; + my $strHeader = trim($self->readLine()); + + while ($strHeader ne '') + { + # Validate header + $self->{strResponseHeader} .= "${strHeader}\n"; + + my $iColonPos = index($strHeader, ':'); + + if ($iColonPos == -1) + { + confess &log(ERROR, "http header '${strHeader}' requires colon separator", ERROR_PROTOCOL); + } + + # Parse header + my $strHeaderKey = lc(substr($strHeader, 0, $iColonPos)); + my $strHeaderValue = trim(substr($strHeader, $iColonPos + 1)); + + # Store the header + $self->{hResponseHeader}{$strHeaderKey} = $strHeaderValue; + + # Process content length + if ($strHeaderKey eq HTTP_HEADER_CONTENT_LENGTH) + { + $self->{iContentLength} = $strHeaderValue + 0; + $self->{iContentRemaining} = $self->{iContentLength}; + } + # Process transfer encoding (only chunked is supported) + elsif ($strHeaderKey eq HTTP_HEADER_TRANSFER_ENCODING) + { + if ($strHeaderValue eq 'chunked') + { + $self->{iContentLength} = -1; + } + else + { + confess &log(ERROR, "invalid value '${strHeaderValue} for http header '${strHeaderKey}'", ERROR_PROTOCOL); + } + } + + # Read next header + $strHeader = trim($self->readLine()); + } + + # Test response code + if ($self->{iResponseCode} == 200) + { + # Content length should have been defined either by content-length or transfer encoding + if (!defined($self->{iContentLength})) + { + confess &log(ERROR, + HTTP_HEADER_CONTENT_LENGTH . ' or ' . HTTP_HEADER_TRANSFER_ENCODING . ' must be defined', ERROR_PROTOCOL); + } + } + + # Prefetch response - mostly useful when the response is known to be short + if ($bResponseBodyPrefetch) + { + $self->{strResponseBody} = $self->responseBody(); + } + + # Enable logging if a failure will be retried + logEnable() if $iTry < $iTryTotal; + return 1; } - - # Read next header - $strHeader = trim($self->readLine()); - } - - # Test response code - if ($self->{iResponseCode} == 200) - { - # Content length should have been defined either by content-length or transfer encoding - if (!defined($self->{iContentLength})) + or do { - confess &log(ERROR, - HTTP_HEADER_CONTENT_LENGTH . ' or ' . HTTP_HEADER_TRANSFER_ENCODING . ' must be defined', ERROR_PROTOCOL); - } + # Enable logging if a failure will be retried + logEnable() if $iTry < $iTryTotal; + + # If tries reaches total allowed then error + if ($iTry == $iTryTotal) + { + confess $EVAL_ERROR; + } + + # Try again + $iTry++; + $bRetry = true; + }; } + while ($bRetry); # Return from function and log return values if any return logDebugReturn @@ -261,9 +307,12 @@ sub responseBody __PACKAGE__ . '->responseBody' ); + # Return prefetched response body if it exists + return $self->{strResponseBody} if exists($self->{strResponseBody}); + + # Fetch response body if content length is not 0 my $strResponseBody = undef; - # Nothing to do if content length is 0 if ($self->{iContentLength} != 0) { # Transfer encoding is chunked diff --git a/lib/pgBackRest/Storage/S3/Request.pm b/lib/pgBackRest/Storage/S3/Request.pm index a8cab9df3..abea2dc06 100644 --- a/lib/pgBackRest/Storage/S3/Request.pm +++ b/lib/pgBackRest/Storage/S3/Request.pm @@ -163,7 +163,8 @@ sub request $self->{strHost}, $strVerb, {iPort => $self->{iPort}, strUri => $strUri, hQuery => $hQuery, hRequestHeader => $hHeader, rstrRequestBody => $rstrBody, bVerifySsl => $self->{bVerifySsl}, strCaPath => $self->{strCaPath}, - strCaFile => $self->{strCaFile}, lBufferMax => $self->{lBufferMax}}); + strCaFile => $self->{strCaFile}, bResponseBodyPrefetch => $strResponseType eq S3_RESPONSE_TYPE_XML, + lBufferMax => $self->{lBufferMax}}); # Check response code my $iResponseCode = $oHttpClient->responseCode(); diff --git a/test/lib/pgBackRestTest/Common/DefineTest.pm b/test/lib/pgBackRestTest/Common/DefineTest.pm index f03524a9f..c12253960 100644 --- a/test/lib/pgBackRestTest/Common/DefineTest.pm +++ b/test/lib/pgBackRestTest/Common/DefineTest.pm @@ -90,7 +90,7 @@ my $oTestDef = [ { &TESTDEF_NAME => 'http-client', - &TESTDEF_TOTAL => 1, + &TESTDEF_TOTAL => 2, &TESTDEF_COVERAGE => { diff --git a/test/lib/pgBackRestTest/Module/Common/CommonHttpClientTest.pm b/test/lib/pgBackRestTest/Module/Common/CommonHttpClientTest.pm index f2ed7499f..4ae7b2eb3 100644 --- a/test/lib/pgBackRestTest/Module/Common/CommonHttpClientTest.pm +++ b/test/lib/pgBackRestTest/Module/Common/CommonHttpClientTest.pm @@ -141,6 +141,33 @@ sub run $self->testResult(sub {${$oHttpClient->responseBody()}}, $strTestData, 'response body read'); } + + ################################################################################################################################ + if ($self->begin('retry')) + { + $self->httpsServer(sub + { + $self->httpsServerAccept(); + $self->{oConnection}->write("HTTP/1.1 200 NoContentLengthMessage1\r\n\r\n"); + + $self->httpsServerAccept(); + $self->{oConnection}->write("HTTP/1.1 200 NoContentLengthMessage2\r\n\r\n"); + + $self->httpsServerAccept(); + $self->httpsServerResponse(200, $strTestData); + }); + + #--------------------------------------------------------------------------------------------------------------------------- + $self->testException( + sub {new pgBackRest::Common::Http::Client( + $strTestHost, HTTP_VERB_GET, {iPort => HTTPS_TEST_PORT, bVerifySsl => false, iTryTotal => 1})}, + ERROR_PROTOCOL, 'content-length or transfer-encoding must be defined'); + + $self->testResult( + sub {new pgBackRest::Common::Http::Client( + $strTestHost, HTTP_VERB_GET, {iPort => HTTPS_TEST_PORT, bVerifySsl => false, iTryTotal => 2})}, + '[object]', 'successful retries'); + } } 1;