2017-06-12 16:52:32 +02:00
|
|
|
####################################################################################################################################
|
|
|
|
# S3 Request
|
|
|
|
####################################################################################################################################
|
|
|
|
package pgBackRest::Storage::S3::Request;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use warnings FATAL => qw(all);
|
|
|
|
use Carp qw(confess);
|
|
|
|
use English '-no_match_vars';
|
|
|
|
|
|
|
|
use Digest::SHA qw(hmac_sha256 hmac_sha256_hex sha256_hex);
|
|
|
|
use Exporter qw(import);
|
|
|
|
our @EXPORT = qw();
|
|
|
|
use IO::Socket::SSL;
|
|
|
|
|
|
|
|
use pgBackRest::Common::Exception;
|
|
|
|
use pgBackRest::Common::Http::Client;
|
|
|
|
use pgBackRest::Common::Http::Common;
|
|
|
|
use pgBackRest::Common::Io::Base;
|
|
|
|
use pgBackRest::Common::Log;
|
|
|
|
use pgBackRest::Common::String;
|
|
|
|
use pgBackRest::Common::Xml;
|
|
|
|
use pgBackRest::Storage::S3::Auth;
|
|
|
|
|
|
|
|
####################################################################################################################################
|
|
|
|
# Constants
|
|
|
|
####################################################################################################################################
|
|
|
|
use constant HTTP_VERB_GET => 'GET';
|
|
|
|
push @EXPORT, qw(HTTP_VERB_GET);
|
|
|
|
use constant HTTP_VERB_POST => 'POST';
|
|
|
|
push @EXPORT, qw(HTTP_VERB_POST);
|
|
|
|
use constant HTTP_VERB_PUT => 'PUT';
|
|
|
|
push @EXPORT, qw(HTTP_VERB_PUT);
|
|
|
|
|
|
|
|
use constant S3_HEADER_CONTENT_LENGTH => 'content-length';
|
|
|
|
push @EXPORT, qw(S3_HEADER_CONTENT_LENGTH);
|
|
|
|
use constant S3_HEADER_TRANSFER_ENCODING => 'transfer-encoding';
|
|
|
|
push @EXPORT, qw(S3_HEADER_TRANSFER_ENCODING);
|
|
|
|
use constant S3_HEADER_ETAG => 'etag';
|
|
|
|
push @EXPORT, qw(S3_HEADER_ETAG);
|
|
|
|
|
|
|
|
use constant S3_RESPONSE_TYPE_IO => 'io';
|
|
|
|
push @EXPORT, qw(S3_RESPONSE_TYPE_IO);
|
|
|
|
use constant S3_RESPONSE_TYPE_NONE => 'none';
|
|
|
|
push @EXPORT, qw(S3_RESPONSE_TYPE_NONE);
|
|
|
|
use constant S3_RESPONSE_TYPE_XML => 'xml';
|
|
|
|
push @EXPORT, qw(S3_RESPONSE_TYPE_XML);
|
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
use constant S3_RESPONSE_CODE_SUCCESS => 200;
|
|
|
|
use constant S3_RESPONSE_CODE_ERROR_NOT_FOUND => 404;
|
|
|
|
use constant S3_RESPONSE_CODE_ERROR_INTERNAL => 500;
|
|
|
|
|
|
|
|
use constant S3_RETRY_MAX => 2;
|
|
|
|
|
2017-06-12 16:52:32 +02:00
|
|
|
####################################################################################################################################
|
|
|
|
# new
|
|
|
|
####################################################################################################################################
|
|
|
|
sub new
|
|
|
|
{
|
|
|
|
my $class = shift;
|
|
|
|
|
|
|
|
# Create the class hash
|
|
|
|
my $self = {};
|
|
|
|
bless $self, $class;
|
|
|
|
|
|
|
|
# Assign function parameters, defaults, and log debug info
|
|
|
|
(
|
|
|
|
my $strOperation,
|
|
|
|
$self->{strBucket},
|
|
|
|
$self->{strEndPoint},
|
|
|
|
$self->{strRegion},
|
|
|
|
$self->{strAccessKeyId},
|
|
|
|
$self->{strSecretAccessKey},
|
|
|
|
$self->{strHost},
|
2017-08-08 23:15:01 +02:00
|
|
|
$self->{iPort},
|
2017-06-12 16:52:32 +02:00
|
|
|
$self->{bVerifySsl},
|
2017-06-23 00:22:49 +02:00
|
|
|
$self->{strCaPath},
|
|
|
|
$self->{strCaFile},
|
2017-06-12 16:52:32 +02:00
|
|
|
$self->{lBufferMax},
|
|
|
|
) =
|
|
|
|
logDebugParam
|
|
|
|
(
|
|
|
|
__PACKAGE__ . '->new', \@_,
|
|
|
|
{name => 'strBucket', trace => true},
|
|
|
|
{name => 'strEndPoint', trace => true},
|
|
|
|
{name => 'strRegion', trace => true},
|
|
|
|
{name => 'strAccessKeyId', trace => true},
|
|
|
|
{name => 'strSecretAccessKey', trace => true},
|
|
|
|
{name => 'strHost', optional => true, trace => true},
|
2017-08-08 23:15:01 +02:00
|
|
|
{name => 'iPort', optional => true, trace => true},
|
2017-06-12 16:52:32 +02:00
|
|
|
{name => 'bVerifySsl', optional => true, default => true, trace => true},
|
2017-06-23 00:22:49 +02:00
|
|
|
{name => 'strCaPath', optional => true, trace => true},
|
|
|
|
{name => 'strCaFile', optional => true, trace => true},
|
2017-06-12 16:52:32 +02:00
|
|
|
{name => 'lBufferMax', optional => true, default => COMMON_IO_BUFFER_MAX, trace => true},
|
|
|
|
);
|
|
|
|
|
|
|
|
# If host is not set then it will be bucket + endpoint
|
|
|
|
$self->{strHost} = defined($self->{strHost}) ? $self->{strHost} : "$self->{strBucket}.$self->{strEndPoint}";
|
|
|
|
|
|
|
|
# Return from function and log return values if any
|
|
|
|
return logDebugReturn
|
|
|
|
(
|
|
|
|
$strOperation,
|
|
|
|
{name => 'self', value => $self, trace => true}
|
|
|
|
);
|
|
|
|
}
|
|
|
|
|
|
|
|
####################################################################################################################################
|
|
|
|
# request - send a request to S3
|
|
|
|
####################################################################################################################################
|
|
|
|
sub request
|
|
|
|
{
|
|
|
|
my $self = shift;
|
|
|
|
|
|
|
|
# Assign function parameters, defaults, and log debug info
|
|
|
|
my
|
|
|
|
(
|
|
|
|
$strOperation,
|
|
|
|
$strVerb,
|
|
|
|
$strUri,
|
|
|
|
$hQuery,
|
|
|
|
$hHeader,
|
|
|
|
$rstrBody,
|
|
|
|
$strResponseType,
|
|
|
|
$bIgnoreMissing,
|
|
|
|
) =
|
|
|
|
logDebugParam
|
|
|
|
(
|
|
|
|
__PACKAGE__ . '->request', \@_,
|
|
|
|
{name => 'strVerb', trace => true},
|
|
|
|
{name => 'strUri', optional => true, default => '/', trace => true},
|
|
|
|
{name => 'hQuery', optional => true, trace => true},
|
|
|
|
{name => 'hHeader', optional => true, trace => true},
|
|
|
|
{name => 'rstrBody', optional => true, trace => true},
|
|
|
|
{name => 'strResponseType', optional => true, default => S3_RESPONSE_TYPE_NONE, trace => true},
|
|
|
|
{name => 'bIgnoreMissing', optional => true, default => false, trace => true},
|
|
|
|
);
|
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
# Server response
|
|
|
|
my $oResponse;
|
2017-06-12 16:52:32 +02:00
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
# Allow retries on S3 internal failures
|
|
|
|
my $bRetry = false;
|
|
|
|
my $iRetryTotal = 0;
|
2017-06-12 16:52:32 +02:00
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
do
|
|
|
|
{
|
|
|
|
# Assume that a retry will not be attempted which is true in most cases
|
|
|
|
$bRetry = false;
|
2017-06-12 16:52:32 +02:00
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
# Get datetime to be used for auth requests
|
|
|
|
my $strDateTime = s3DateTime();
|
2017-06-12 16:52:32 +02:00
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
# Set content length and hash
|
|
|
|
$hHeader->{&S3_HEADER_CONTENT_SHA256} = defined($rstrBody) ? sha256_hex($$rstrBody) : PAYLOAD_DEFAULT_HASH;
|
|
|
|
$hHeader->{&S3_HEADER_CONTENT_LENGTH} = defined($rstrBody) ? length($$rstrBody) : 0;
|
2017-06-12 16:52:32 +02:00
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
# Generate authorization header
|
|
|
|
$hHeader = s3AuthorizationHeader(
|
|
|
|
$self->{strRegion}, "$self->{strBucket}.$self->{strEndPoint}", $strVerb, $strUri, httpQuery($hQuery), $strDateTime,
|
|
|
|
$hHeader, $self->{strAccessKeyId}, $self->{strSecretAccessKey}, $hHeader->{&S3_HEADER_CONTENT_SHA256});
|
2017-06-12 16:52:32 +02:00
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
# Send the request
|
|
|
|
my $oHttpClient = new pgBackRest::Common::Http::Client(
|
|
|
|
$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}});
|
|
|
|
|
|
|
|
# Check response code
|
|
|
|
my $iReponseCode = $oHttpClient->responseCode();
|
|
|
|
|
|
|
|
if ($iReponseCode == S3_RESPONSE_CODE_SUCCESS)
|
2017-06-12 16:52:32 +02:00
|
|
|
{
|
2017-08-08 23:15:01 +02:00
|
|
|
# Save the response headers locally
|
|
|
|
$self->{hResponseHeader} = $oHttpClient->responseHeader();
|
2017-06-12 16:52:32 +02:00
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
# XML response is expected
|
|
|
|
if ($strResponseType eq S3_RESPONSE_TYPE_XML)
|
2017-06-12 16:52:32 +02:00
|
|
|
{
|
2017-08-08 23:15:01 +02:00
|
|
|
my $rtResponseBody = $oHttpClient->responseBody();
|
2017-06-12 16:52:32 +02:00
|
|
|
|
2017-08-08 23:15:01 +02:00
|
|
|
if ($oHttpClient->contentLength() == 0 || !defined($$rtResponseBody))
|
|
|
|
{
|
|
|
|
confess &log(ERROR,
|
|
|
|
"response type '${strResponseType}' was requested but content length is zero or content is missing",
|
|
|
|
ERROR_PROTOCOL);
|
|
|
|
}
|
|
|
|
|
|
|
|
$oResponse = xmlParse($$rtResponseBody);
|
|
|
|
}
|
|
|
|
# An IO object is expected for file responses
|
|
|
|
elsif ($strResponseType eq S3_RESPONSE_TYPE_IO)
|
2017-06-12 16:52:32 +02:00
|
|
|
{
|
2017-08-08 23:15:01 +02:00
|
|
|
$oResponse = $oHttpClient;
|
2017-06-12 16:52:32 +02:00
|
|
|
}
|
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
2017-08-08 23:15:01 +02:00
|
|
|
# If file was not found
|
|
|
|
if ($iReponseCode == S3_RESPONSE_CODE_ERROR_NOT_FOUND)
|
|
|
|
{
|
|
|
|
# If missing files should not be ignored then error
|
|
|
|
if (!$bIgnoreMissing)
|
|
|
|
{
|
|
|
|
confess &log(ERROR, "unable to open '${strUri}': No such file or directory", ERROR_FILE_MISSING);
|
|
|
|
}
|
|
|
|
|
|
|
|
$bRetry = false;
|
|
|
|
}
|
|
|
|
# Else a more serrious error
|
|
|
|
else
|
|
|
|
{
|
|
|
|
# Retry for S3 internal errors
|
|
|
|
if ($iReponseCode == S3_RESPONSE_CODE_ERROR_INTERNAL)
|
|
|
|
{
|
|
|
|
$iRetryTotal++;
|
|
|
|
$bRetry = $iRetryTotal <= S3_RETRY_MAX;
|
|
|
|
}
|
|
|
|
|
|
|
|
# If no retry then throw the error
|
|
|
|
if (!$bRetry)
|
|
|
|
{
|
|
|
|
my $rstrResponseBody = $oHttpClient->responseBody();
|
|
|
|
|
|
|
|
confess &log(ERROR,
|
|
|
|
"S3 request error [$iReponseCode] " . $oHttpClient->responseMessage() .
|
|
|
|
"\n*** request header ***\n" . $oHttpClient->requestHeaderText() .
|
|
|
|
"\n*** reponse header ***\n" . $oHttpClient->responseHeaderText() .
|
|
|
|
(defined($$rstrResponseBody) ? "\n*** response body ***\n${$rstrResponseBody}" : ''),
|
|
|
|
ERROR_PROTOCOL);
|
|
|
|
}
|
|
|
|
}
|
2017-06-12 16:52:32 +02:00
|
|
|
}
|
|
|
|
}
|
2017-08-08 23:15:01 +02:00
|
|
|
while ($bRetry);
|
2017-06-12 16:52:32 +02:00
|
|
|
|
|
|
|
# Return from function and log return values if any
|
|
|
|
return logDebugReturn
|
|
|
|
(
|
|
|
|
$strOperation,
|
|
|
|
{name => 'oResponse', value => $oResponse, trace => true, ref => true}
|
|
|
|
);
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|