endpoint results from the CPAN

Amazon-S3

  # code in the case of timeout.  From AWS S3 logs: REST.PUT.PART
  # Backups/2017-05-04/<account>.tar.gz "PUT
  # /Backups<path>?partNumber=27&uploadId=<id> - HTTP/1.1" 400
  # RequestTimeout 360 20971520 20478 - "-" "libwww-perl/6.15"
  my $http_codes_hr = $self->ua->codes_to_determinate();
  $http_codes_hr->{$HTTP_BAD_REQUEST} = $TRUE;

  return;
}

########################################################################
sub turn_off_special_retry {
########################################################################
  my ($self) = @_;

  return
    if !$self->retry;

  # In the field we are seeing issue with Amazon returning a 400
  # code in the case of timeout.  From AWS S3 logs: REST.PUT.PART
  # Backups/2017-05-04/<account>.tar.gz "PUT
  # /Backups<path>?partNumber=27&uploadId=<id> - HTTP/1.1" 400
  # RequestTimeout 360 20971520 20478 - "-" "libwww-perl/6.15"
  my $http_codes_hr = $self->ua->codes_to_determinate();
  delete $http_codes_hr->{$HTTP_BAD_REQUEST};

  return;
}

########################################################################
sub region {
########################################################################
  my ( $self, @args ) = @_;

  if (@args) {
    $self->_region( $args[0] );
  }

  $self->get_logger->debug(
    sub { return 'region: ' . ( $self->_region // $EMPTY ) } );

  if ( $self->_region ) {
    my $host = $self->host;
    $self->get_logger->debug( sub { return 'host: ' . $self->host } );

    if ( $host =~ /\As3[.](.*)?amazonaws/xsm ) {
      $self->host( sprintf 's3.%s.amazonaws.com', $self->_region );
    }
  }

  return $self->_region;
}

########################################################################
sub buckets {
########################################################################
  my ( $self, $verify_region ) = @_;

  # The "default" region for Amazon is us-east-1
  # This is the region to set it to for listing buckets
  # You may need to reset the signer's endpoint to 'us-east-1'

  # temporarily cache signer
  my $region = $self->_region;
  my $bucket_list;

  $self->reset_signer_region($DEFAULT_REGION); # default region for buckets op

  my $r = $self->_send_request(
    { method  => 'GET',
      path    => $EMPTY,
      headers => {},
      region  => $DEFAULT_REGION,
    },
  );

  return $bucket_list
    if !$r || $self->errstr;

  my $owner_id          = $r->{Owner}{ID};
  my $owner_displayname = $r->{Owner}{DisplayName};

  my @buckets;

  if ( ref $r->{Buckets} ) {
    my $buckets = $r->{Buckets}{Bucket};

    if ( !ref $buckets || reftype($buckets) ne 'ARRAY' ) {
      $buckets = [$buckets];
    }

    foreach my $node ( @{$buckets} ) {
      push @buckets,
        Amazon::S3::Bucket->new(
        { bucket        => $node->{Name},
          creation_date => $node->{CreationDate},
          account       => $self,
          buffer_size   => $self->buffer_size,
          verify_region => $verify_region // $FALSE,
        },
        );

    }
  }

  $self->reset_signer_region($region); # restore original region

  $bucket_list = {
    owner_id          => $owner_id,
    owner_displayname => $owner_displayname,
    buckets           => \@buckets,
  };

  return $bucket_list;
}

########################################################################
sub reset_signer_region {
########################################################################
  my ( $self, $region ) = @_;

lib/Amazon/S3.pm view on Meta::CPAN


  #  if ( $path =~ m{\A([^/?]+)([^?]+)(.*)}xsm
  if ( $path =~ /\A([^\/?]+)([^?]+)(.*)/xsm
    && $self->dns_bucket_names
    && is_domain_bucket($1) ) {

    my $bucket = $1;
    $path = $2;

    my $query_string = $3;

    $self->logger->debug(
      sub {
        return Dumper(
          [ bucket       => $bucket,
            path         => $path,
            query_string => $query_string,
          ]
        );
      }
    );

    if ( $host =~ /([^:]+):([^:]\d+)$/xsm ) {

      my $port;

      $url = eval {
        $port = $2;
        $host = $1;

        my $uri = URI->new;

        $uri->scheme('http');
        $uri->host("$bucket.$host");
        $uri->port($port);
        $uri->path($path);

        return $uri . $query_string;
      };

      die sprintf
        "error creating uri for bucket: [%s], host: [%s], path: [%s], port: [%s]\n%s",
        $bucket, $host, $path, $port, $EVAL_ERROR

        if !$url || $EVAL_ERROR;
    }
    else {
      $url = sprintf '%s://%s.%s%s%s', $protocol, $bucket, $host, $path,
        $query_string;
    }
  }

  my $request = HTTP::Request->new( $method, $url, $http_headers );

  $self->last_request($request);

  if ($data) {
    $request->content($data);
  }

  $self->signer->region($region); # always set regional endpoint for signing

  $self->signer->sign($request);

  return $request;
}

# $self->_send_request($HTTP::Request)
# $self->_send_request(@params_to_make_request)
# $self->_send_request($params_to_make_request)
########################################################################
sub _send_request {
########################################################################
  my ( $self, @args ) = @_;

  my $logger = $self->get_logger;

  $logger->trace(
    sub {
      return Dumper( [ args => \@args ] );
    },
  );

  my $keep_root = $FALSE;

  my $request = eval {
    return $args[0]
      if ref( $args[0] ) =~ /HTTP::Request/xsm;

    return {@args}
      if @args > 1 && !@args % 2;

    return $args[0]
      if ref $args[0];

    croak 'invalid argument to _send_request';
  };

  if ( ref($request) !~ /HTTP::Request/xsm ) {
    $keep_root = delete $request->{keep_root};

    $request = $self->_make_request($request);
  }

  my $response = $self->_do_http($request);

  $self->last_response($response);

  $logger->debug(
    sub {
      return Dumper( [ response => $response ] );
    }
  );

  return $self->_decode_response( $response, $keep_root );
}

########################################################################
sub _decode_response {
########################################################################
  my ( $self, $response, $keep_root ) = @_;

lib/Amazon/S3.pm view on Meta::CPAN

sub is_xml_response {
########################################################################
  my ($rsp) = @_;

  return $FALSE
    if !$rsp->content;

  return $TRUE
    if $rsp->content_type eq 'application/xml';

  return $TRUE
    if $rsp->content =~ /\A\s*<[?]xml/xsm;

  return $FALSE;
}

#
# This is the necessary to find the region for a specific bucket
# and set the signer object to use that region when signing requests
########################################################################
sub adjust_region {
########################################################################
  my ( $self, $bucket, $called_from_redirect ) = @_;

  my $url = sprintf 'https://%s.%s', $bucket, $self->host;

  my $request = HTTP::Request->new( GET => $url );

  $self->{'signer'}->sign($request);

  # We have to turn off our special retry since this will deliberately
  # trigger that code
  $self->turn_off_special_retry();

  # If the bucket name has a period in it, the certificate validation
  # will fail since it will expect a certificate for a subdomain.
  # Setting it to verify against the expected host guards against
  # that while still being secure since we will have verified
  # the response as coming from the expected server.
  $self->ua->ssl_opts( SSL_verifycn_name => $self->host );

  my $response = $self->_do_http($request);

  # Turn this off, since all other requests have the bucket after
  # the host in the URL, and the host may change depending on the region
  $self->ua->ssl_opts( SSL_verifycn_name => undef );

  $self->turn_on_special_retry();

  # If No error, then nothing to do
  return $TRUE
    if $response->is_success();

  # If the error is due to the wrong region, then we will get
  # back a block of XML with the details
  return $FALSE
    if !is_xml_response($response);

  my $error_hash = $self->_xpc_of_content( $response->content );

  my ( $endpoint, $code, $region, $message )
    = @{$error_hash}{qw(Endpoint Code Region Message)};

  my $condition = eval {
    return 'PermanentRedirect'
      if $code eq 'PermanentRedirect' && $endpoint;

    return 'AuthorizationHeaderMalformed'
      if $code eq 'AuthorizationHeaderMalformed' && $region;

    return 'IllegalLocationConstraintException'
      if $code eq 'IllegalLocationConstraintException';

    return 'Other';
  };

  my %error_handlers = (
    PermanentRedirect => sub {
      # Don't recurse through multiple redirects
      return $FALSE
        if $called_from_redirect;

      # With a permanent redirect error, they are telling us the explicit
      # host to use.  The endpoint will be in the form of bucket.host
      my $host = $endpoint;

      # Remove the bucket name from the front of the host name
      # All the requests will need to be of the form https://host/bucket
      $host =~ s/\A$bucket[.]//xsm;
      $self->host($host);

      # We will need to call ourselves again in order to trigger the
      # AuthorizationHeaderMalformed error in order to get the region
      return $self->adjust_region( $bucket, $TRUE );
    },
    AuthorizationHeaderMalformed => sub {
      # Set the signer to use the correct reader evermore
      $self->{signer}->{endpoint} = $region;

      # Only change the host if we haven't been called as a redirect
      # where an exact host has been given
      if ( !$called_from_redirect ) {
        $self->host( sprintf 's3-%s-amazonaws.com', $region );
      }

      return $TRUE;
    },
    IllegalLocationConstraintException => sub {
      # This is hackish; but in this case the region name only appears in the message
      if ( $message =~ /The (\S+) location/xsm ) {
        my $new_region = $1;

        # Correct the region for the signer
        $self->{signer}->{endpoint} = $new_region;

        # Set the proper host for the region
        $self->host( sprintf 's3.%s.amazonaws.com', $new_region );

        return $TRUE;
      }
    },
    'Other' => sub {
      # Some other error
      $self->_remember_errors( $response->content, 1 );
      return $FALSE;
    },
  );

  return $error_handlers{$condition}->();
}

########################################################################
sub reset_errors {
########################################################################
  my ($self) = @_;

  $self->err(undef);
  $self->errstr(undef);
  $self->error(undef);

  return $self;
}

########################################################################
sub _do_http {
########################################################################
  my ( $self, $request, $filename ) = @_;

  # convenient time to reset any error conditions
  $self->reset_errors;

  my $response = $self->ua->request( $request, $filename );

  # For new buckets at non-standard locations, amazon will sometimes
  # respond with a temporary redirect.  In this case it is necessary
  # to try again with the new URL
  my $location = $response->header('Location');

  if ( $response->code =~ /\A3/xsm and defined $location ) {

    $self->get_logger->debug(
      sub {
        return { sprintf 'Redirecting to:  %s', $location };
      }
    );

    $request->uri($location);
    $response = $self->ua->request( $request, $filename );
  }

  $self->get_logger->debug( sub { return Dumper( [$response] ) } );

  $self->last_response($response);

lib/Amazon/S3.pm view on Meta::CPAN

This module is rather dated, however with some help from a few
contributors it has had some recent updates. Recent changes include
implementations of:

=over 5

=item ListObjectsV2

=item CopyObject

=item DeleteObjects

=item ListObjectVersions

=back

Additionally, this module now implements Signature Version 4 signing,
unit tests have been updated and more documentation has been added or
corrected. Credentials are encrypted if you have encryption modules installed.

I<NEW!>

The C<Amazon::S3> modules have been heavily refactored over the last
few releases to increase maintainability and to add new features. New
features include:

=over 5

=item L<Amazon::S3::BucketV2>

This new module implements a mechanism to invoke I<almost> all of the
S3 APIs using a standard calling method.

The module will format your Perl objects as XML payloads and enable
you to provide all of the parameters required to make an API
call. Headers and URI parameters can also be passed to the
methods. L<Amazon::S3::BucketV2> is a subclass of
L<Amazon::S3::Bucket>, meaning you can still invoke all of the same
methods found there.

See L<Amazon::S3::BucketV2> for more details.

=item Limited Support for Directory Buckets

This version include limited support for directory buckets.

You can create and list directory buckets.

I<Directory buckets use the S3 Express One Zone storage class, which
is recommended if your application is performance sensitive and
benefits from single-digit millisecond PUT and GET latencies.> -
L<https://docs.aws.amazon.com/AmazonS3/latest/userguide/directory-buckets-overview.html>

=over 10

=item list_directory_buckets

List the directory buckets. Note this only returns a list of you
directory buckets, not their contents. In order to list the contents
of a directory bucket you must first create a session that establishes
temporary credentials used to acces the Zonal endpoints. You then use
those credentials for signing requests using the ListObjectV2 API.

This process is currently B<not supported> by this class.

L<https://docs.aws.amazon.com/AmazonS3/latest/API/API_CreateSession.html>

<Lhttps://docs.aws.amazon.com/AmazonS3/latest/API/API_ListObjectsV2.html>

=item add_bucket

You can add a regin and availability zone to this call in order to
create a directory bucket.

 $bucket->add_bucket({ bucket => $bucket_name, availability_zone => 'use1-az5' });

Note that your bucket name must conform to the naming conventions for
directory buckets. -
L<https://docs.aws.amazon.com/AmazonS3/latest/userguide/directory-buckets-overview.html#directory-buckets-name>
 
=back

=item Addition of version parameter for C<delete_key>

You can now delete a version of a key by including its verion ID.

 $bucket->delete_key($key, $version_id);

=item Methods that accept a hash reference can now accept a
C<headers> object that may contain any additional headers you might want
to send with a request. Some of the methods that now allow you to pass
a header object include:

=over 10

=item add_bucket

=item add_key

=item get_key

Can now be called with a hashref which may include both a C<headers>
and C<uri_params> object.

=item delete_bucket

=item list_bucket

=item list_object_versions

=item upload_multipart_object

=back

=back

=head2 Comparison to Other Perl S3 Modules

Other implementations for accessing Amazon's S3 service include
C<Net::Amazon::S3> and the C<Paws> project. C<Amazon::S3> ostensibly
was intended to be a drop-in replacement for C<Net:Amazon::S3> that

lib/Amazon/S3.pm view on Meta::CPAN

I<You are strongly encourage to use a class that provides getters. If
you choose to provide your credentials to this class then they will be
stored in this object. If you dump the class you will likely expose
those credentials.>

=item aws_access_key_id

Use your Access Key ID as the value of the AWSAccessKeyId parameter
in requests you send to Amazon Web Services (when required). Your
Access Key ID identifies you as the party responsible for the
request.

=item aws_secret_access_key 

Since your Access Key ID is not encrypted in requests to AWS, it
could be discovered and used by anyone. Services that are not free
require you to provide additional information, a request signature,
to verify that a request containing your unique Access Key ID could
only have come from you.

B<DO NOT INCLUDE THIS IN SCRIPTS OR APPLICATIONS YOU
DISTRIBUTE. YOU'LL BE SORRY.>

I<Consider using a credential class as described above to provide
credentials, otherwise this class will store your credentials for
signing the requests. If you dump this object to logs your credentials
could be discovered.>

=item token

An optional temporary token that will be inserted in the request along
with your access and secret key.  A token is used in conjunction with
temporary credentials when your EC2 instance has
assumed a role and you've scraped the temporary credentials from
I<http://169.254.169.254/latest/meta-data/iam/security-credentials>

=item secure

Set this to a true value if you want to use SSL-encrypted connections
when connecting to S3. Starting in version 0.49, the default is true.

default: true

=item timeout

Defines the time, in seconds, your script should wait or a
response before bailing.

default: 30s

=item retry

Enables or disables the library to retry upon errors. This
uses exponential backoff with retries after 1, 2, 4, 8, 16,
32 seconds, as recommended by Amazon.

default: off

=item host

Defines the S3 host endpoint to use.

default: s3.amazonaws.com

Note that requests are made to domain buckets when possible.  You can
prevent that behavior if either the bucket name does not conform to
DNS bucket naming conventions or you preface the bucket name with '/'
or explicitly turn off domain buckets by setting C<dns_bucket_names>
to false.

If you set a region then the host name will be modified accordingly if
it is an Amazon endpoint.

=item region

The AWS region you where your bucket is located.

default: us-east-1

=item buffer_size

The default buffer size when reading or writing files.

default: 4096

=back

=head2 signer

Sets or retrieves the signer object. API calls must be signed using
your AWS credentials. By default, starting with version 0.54 the
module will use L<Net::Amazon::Signature::V4> as the signer and
instantiate a signer object in the constructor. Note however, that
signers need your credentials and they I<will> get stored by that
class, making them susceptible to inadvertant exfiltration. You have a
few options here:

=over 5

=item 1. Use your own signer.

You may have noticed that you can also provide your own credentials
object forcing this module to use your object for retrieving
credentials. Likewise, you can use your own signer so that this
module's signer never sees or stores those credentials.

=item 2. Pass the credentials object and set C<cache_signer> to a
false value.

If you pass a credentials object and set C<cache_signer> to a false
value, the module will use the credentials object to retrieve
credentials and create a new signer each time an API call is made that
requires signing. This prevents your credentials from being stored
inside of the signer class.

I<Note that using your own credentials object that stores your
credentials in plaintext is also going to expose your credentials when
someone dumps the class.>

=item 3. Pass credentials, set C<cache_signer> to a false value.

Unfortunately, while this will prevent L<Net::Amazon::Signature::V4>
from hanging on to your credentials, you credentials will be stored in
the C<Amazon::S3> object.

Starting with version 0.55 of this module, if you have installed
L<Crypt::CBC> and L<Crypt::Blowfish>, your credentials will be
encrypted using a random key created when the class is
instantiated. While this is more secure than leaving them in
plaintext, if the key is discovered (the key however is not stored in
the object's hash) and the object is dumped, your I<encrypted>
credentials can be exposed.

( run in 0.481 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )