Amazon-S3

 view release on metacpan or  search on metacpan

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

  return
    if !$self->retry;

  # In the field we are seeing issue of Amazon returning with 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();
  $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 ) = @_;

  # reset signer's region, if the region wasn't us-east-1...note this
  # is probably not needed anymore since bucket operations now send
  # the region of the bucket to the signer
  if ( $self->cache_signer ) {
    if ( $self->region && $self->region ne $DEFAULT_REGION ) {
      if ( $self->signer->can('region') ) {
        $self->signer->region($region);
      }
    }
  }
  else {
    $self->region($region);
  }

  return $self->region;
}

########################################################################
sub add_bucket {
########################################################################
  my ( $self, $conf ) = @_;

  my $bucket = $conf->{bucket};

  croak 'must specify bucket'
    if !$bucket;

  my $headers = $conf->{headers} // {};

  if ( $conf->{acl_short} ) {
    $self->_validate_acl_short( $conf->{acl_short} );

    $headers->{'x-amz-acl'}              //= $conf->{acl_short};
    $headers->{'x-amz-object-ownership'} //= 'ObjectWriter';
  }

  my $region = $conf->{location_constraint} // $conf->{region};

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

}

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

  my $parameters = get_parameters(@args);

  my ( $bucket, $headers, $region, $availability_zone )
    = @{$parameters}{qw(bucket headers region availability_zone)};

  $region  //= $EMPTY;
  $headers //= {};

  my $request
    = { CreateBucketConfiguration => { LocationConstraint => $region, } };

  if ($availability_zone) {
    $request->{CreateBucketConfiguration}->{Location} = {
      Name => $availability_zone,
      Type => 'AvailabilityZone',
    };

    $request->{CreateBucketConfiguration}->{Bucket} = {
      DataRedundancy => 'SingleAvailabilityZone',
      Type           => 'Directory',
    };

    delete $request->{CreateBucketConfiguration}->{LocationConstraint};
  }

  $self->dns_bucket_names(0);

  my $data
    = ( $region || $availability_zone )
    ? create_xml_request($request)
    : $EMPTY;

  $headers->{'Content-Length'} = length $data;

  my $retval = $self->_send_request_expect_nothing(
    { method  => 'PUT',
      path    => "$bucket/",
      headers => $headers,
      data    => $data,
      region  => $region,
    },
  );

  my $bucket_obj = $retval ? $self->bucket($bucket) : undef;

  return $bucket_obj;
}

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

  my ( $bucketname, $region, $verify_region );

  if ( ref $args[0] && reftype( $args[0] ) eq 'HASH' ) {
    ( $bucketname, $region, $verify_region )
      = @{ $args[0] }{qw(bucket region verify_region)};
  }
  else {
    ( $bucketname, $region ) = @args;
  }

  # only set to default region if a region wasn't passed or region
  # verification not requested
  if ( !$region && !$verify_region ) {
    $region = $self->region;
  }

  return Amazon::S3::Bucket->new(
    { bucket        => $bucketname,
      account       => $self,
      region        => $region,
      verify_region => $verify_region,
    },
  );
}

########################################################################
sub delete_bucket {
########################################################################
  my ( $self, $conf ) = @_;

  my $bucket;
  my $region;
  my $headers;

  if ( eval { return $conf->isa('Amazon::S3::Bucket'); } ) {
    $bucket = $conf->bucket;
    $region = $conf->region;
  }
  else {
    $bucket  = $conf->{bucket};
    $region  = $conf->{region} || $self->get_bucket_location($bucket);
    $headers = $conf->{headers};
  }

  croak 'must specify bucket'
    if !$bucket;

  return $self->_send_request_expect_nothing(
    { method  => 'DELETE',
      path    => $bucket . $SLASH,
      headers => $headers // {},
      region  => $region,
    },
  );
}

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

  my $parameters = get_parameters(@args);

  my $express = $self->use_express_one_zone;

  my $result = $self->_send_request(
    { method     => 'GET',
      headers    => {},
      path       => $SLASH,
      uri_params => $parameters->{uri_params} // {},
      region     => $self->region,
    }
  );

  $self->express($express);

  return $result;
}

########################################################################
sub list_bucket_v2 {

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

  );

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

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

  my $content;

  if ( $response->code !~ /\A2\d{2}\z/xsm ) {
    $self->_remember_errors( $response->content, 1 );
    $content = undef;
  }
  elsif ( is_xml_response($response) ) {
    $content = $self->_xpc_of_content( $response->content, $keep_root );
  }

  return $content;
}

########################################################################
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;

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

  $buf .= "/$1";

  # ...unless there any parameters we're interested in...
  if ( $path =~ /[&?](acl|torrent|location|uploads|delete)([=&]|$)/xsm ) {
    #  if ( $path =~ /[&?](acl|torrent|location|uploads|delete)([=&])?/xsm ) {
    $buf .= "?$1";
  }
  elsif ( my %query_params = URI->new($path)->query_form ) {
    # see if the remaining parsed query string provides us with any
    # query string or upload id

    if ( $query_params{partNumber} && $query_params{uploadId} ) {
      # re-evaluate query string, the order of the params is important
      # for request signing, so we can't depend on URI to do the right
      # thing
      $buf .= sprintf '?partNumber=%s&uploadId=%s',
        $query_params{partNumber},
        $query_params{uploadId};
    }
    elsif ( $query_params{uploadId} ) {
      $buf .= sprintf '?uploadId=%s', $query_params{uploadId};
    }
  }

  return $buf;
}

########################################################################
sub _trim {
########################################################################
  my ( $self, $value ) = @_;

  $value =~ s/^\s+//xsm;
  $value =~ s/\s+$//xsm;

  return $value;
}

# finds the hmac-sha1 hash of the canonical string and the aws secret access key and then
# base64 encodes the result (optionally urlencoding after that).
########################################################################
sub _encode {
########################################################################
  my ( $self, $aws_secret_access_key, $str, $urlencode ) = @_;

  my $hmac = Digest::HMAC_SHA1->new($aws_secret_access_key);
  $hmac->add($str);

  my $b64 = encode_base64( $hmac->digest, $EMPTY );

  return $urlencode ? urlencode($b64) : return $b64;
}

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

  my $parameters = get_parameters(@args);

  my ( $bucketname, $region, $verify_region )
    = @{$parameters}{qw(bucket region verify_region)};

  # only set to default region if a region wasn't passed or region
  # verification not requested
  if ( !$region && !$verify_region ) {
    $region = $self->region;
  }

  return Amazon::S3::BucketV2->new(
    { bucket        => $bucketname,
      account       => $self,
      region        => $region,
      verify_region => $verify_region,
    },
  );
}

########################################################################
sub delete_public_access_block {
########################################################################
  my ( $self, $bucket ) = @_;

  my $bucketv2 = bless $bucket, 'Amazon::S3::BucketV2';

  return $bucketv2->DeletePublicAccessBlock;
}

1;

__END__

=pod

=head1 NAME

Amazon::S3 - A portable client library for working with and
managing Amazon S3 buckets and keys.

=begin markdown

![Amazon::S3](https://github.com/rlauer6/perl-amazon-s3/actions/workflows/build.yml/badge.svg?event=push)

=end markdown

=head1 SYNOPSIS

  use Amazon::S3;
  
  my $aws_access_key_id     = "Fill me in!";
  my $aws_secret_access_key = "Fill me in too!";
  
  my $s3 = Amazon::S3->new(
      {   aws_access_key_id     => $aws_access_key_id,
          aws_secret_access_key => $aws_secret_access_key,
          retry                 => 1
      }
  );
  
  my $response = $s3->buckets;
  
  # create a bucket
  my $bucket_name = $aws_access_key_id . '-net-amazon-s3-test';

  my $bucket = $s3->add_bucket( { bucket => $bucket_name } )
      or die $s3->err . ": " . $s3->errstr;
  
  # store a key with a content-type and some optional metadata
  my $keyname = 'testing.txt';

  my $value   = 'T';

  $bucket->add_key(
      $keyname, $value,

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


=item Signature Version 2

L<https://docs.aws.amazon.com/AmazonS3/latest/userguide/RESTAuthentication.html>

=back

=item Multipart Upload Support

There are some recently added unit tests for multipart uploads that
seem to indicate this feature is working as expected.  Please report
any deviation from expected results if you are using those methods.

For more information regarding multipart uploads visit the link below.

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

=back

=head1 METHODS AND SUBROUTINES

Unless otherwise noted methods will return an C<undef> if an error
occurs.  You can get more information about the error by calling
C<err()> and C<errstr()>.

=head2 new 

Create a new S3 client object. Takes some arguments:

=over

=item credentials (optional)

Reference to a class (like C<Amazon::Credentials>) that can provide
credentials via the methods:

 get_aws_access_key_id()
 get_aws_secret_access_key()
 get_token()

If you do not provide a credential class you must provide the keys
when you instantiate the object. See below.

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

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

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.

=item 4. Use very granular credentials for bucket access only.

Use credentials that only allow access to a bucket or portions of a
bucket required for your application. This will at least limit the
I<blast radius> of any potential security breach.

=item 5. Do nothing...send the credentials, use the default signer.

In this case, both the C<Amazon::S3> class and the
L<Net::Amazon::Signature::V4> have your credentials. Caveat Emptor.

See also L<Amazon::Credentials> for more information about safely
storing your credentials and preventing exfiltration.

=back

=head2 region

Sets the region for the API calls. This will also be the
default when instantiating the bucket object unless you pass the
region parameter in the C<bucket> method or use the C<verify_region>
flag that will I<always> verify the region of the bucket using the
C<get_location_constraint> method.

default: us-east-1

=head2 buckets

 buckets([verify-region])

=over

=item verify-region (optional)

C<verify-region> is a boolean value that indicates if the
bucket's region should be verified when the bucket object is
instantiated.

If set to true, this method will call the C<bucket> method with
C<verify_region> set to true causing the constructor to call the
C<get_location_constraint> for each bucket to set the bucket's
region. This will cause a significant decrease in the peformance of
the C<buckets()> method. Setting the region for each bucket is
necessary since API operations on buckets require the region of the
bucket when signing API requests. If all of your buckets are in the
same region and you have passed a region parameter to your S3 object,
then that region will be used when calling the constructor of your
bucket objects.

default: false

=back

Returns a reference to a hash containing the metadata for all of the
buckets owned by the accout or (see below) or C<undef> on error.

=over

=item owner_id

The owner ID of the bucket's owner.

=item owner_display_name

The name of the owner account. 

=item buckets

An array of L<Amazon::S3::Bucket> objects for the account. Returns
C<undef> if there are not buckets or an error occurs.

=back

=head2 add_bucket

 add_bucket(bucket-configuration)

C<bucket-configuration> is a reference to a hash with bucket
configuration parameters.

I<Note that since April of 2023, new buckets are created that block
public access by default. If you attempt to set an ACL with public
permissions the create operation will fail. To create a public bucket
you must first create the bucket with private permissions, remove the
public block and subsequently apply public permissions.>

See L</delete_public_access_block>.

=over

=item bucket

The name of the bucket. See L<Bucket name
rules|https://docs.aws.amazon.com/AmazonS3/latest/userguide/bucketnamingrules.html>
for more details on bucket naming rules.

=item acl_short (optional)

See the set_acl subroutine for documenation on the acl_short
options. Note that starting in April of 2023 new buckets are
configured to automatically block public access. Trying to create a
bucket with public permissions will fail. In order to create a public
bucket you must first create a private bucket, then call the
DeletePublicAccessBlock API. You can then set public permissions for
your bucket using ACLs or a bucket policy.

=item location_constraint

=item region

The region the bucket is to be created in.

=item headers

Additional headers to send with request.

=back

Returns a L<Amazon::S3::Bucket> object on success or C<undef> on failure.

=head2 bucket

 bucket(bucket, [region])

 bucket({ bucket => bucket-name, verify_region => boolean, region => region });

Takes a scalar argument or refernce to a hash of arguments.

You can pass the region or set C<verify_region> indicating that
you want the bucket constructor to detemine the bucket region.

If you do not pass the region or set the C<verify_region> value, the
region will be set to the default region set in your C<Amazon::S3>
object.

See L<Amazon::S3::Bucket> for a complete description of the C<bucket>
method.

=head2 delete_bucket

Takes either a L<Amazon::S3::Bucket> object or a reference to a hash
containing:

=over

=item bucket

The name of the bucket to remove

=item region

Region the bucket is located in. If not provided, the method will
determine the bucket's region by calling C<get_bucket_location>.

=back

Returns a boolean indicating the success or failure of the API
call. Check C<err> or C<errstr> for error messages.

Note from the L<Amazon's documentation|https://docs.aws.amazon.com/AmazonS3/latest/userguide/BucketRestrictions.html>

=over 10

If a bucket is empty, you can delete it. After a bucket is deleted,
the name becomes available for reuse. However, after you delete the
bucket, you might not be able to reuse the name for various reasons.

For example, when you delete the bucket and the name becomes available
for reuse, another AWS account might create a bucket with that
name. In addition, B<some time might pass before you can reuse the name
of a deleted bucket>. If you want to use the same bucket name, we
recommend that you don't delete the bucket.

=back

=head2 delete_public_access_block

 delete_public_access_block(bucket-obj)

Removes the public access block flag for the bucket.

=head2 dns_bucket_names

Set or get a boolean that indicates whether to use DNS bucket
names.

default: true

=head2 err

Returns the last error. Usually this is the error code returned from
an API call or a short message that the describes the error. Use



( run in 2.205 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )