AWS-S3

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

  - Adds new session_token and region attributes to the constructor (see perldoc)

0.19 2024-01-08
  - Fix "bad hostname" test may fail in presence of wildcard DNS records (GH #19)

0.18 2019-03-01
  - Fix leading slashes defaults to off, see honor_leading_slashes arg

0.17 2019-03-01
  - Fix leading slashes in key names (GH #12)
  - Fix lack of location shouldn't set it to undef (GH #11)

0.16 2019-01-03
  - Remove dependency on Iterator::Paged

0.15 2018-04-20
  - More fixes for ->add_bucket. Fix an error when no location is provided or
    us-east-1 is explicitly asked for. Patch by Dave Rolsky. (GH #9)

0.14 2018-04-13
  - Fix sending of undefined location param in ->add_bucket (GH #9)

0.13 2017-02-06
  - Add documentation for parameter 'prefix' for AWS::S3::FileIterator
  - Add test coverage (GH #8, thanks to simbabque for these changes)
  - Fix over encoding of characters in path (GH #6)

0.12 2016-03-07
  - Fix DNS bucket name checking for non-valid DNS bucket nams (GH #4)
  - Fix URI escaping for filenames to avoid infinite loop on spaces (GH #5)

lib/AWS/S3/Bucket.pm  view on Meta::CPAN

    lazy     => 1,
    clearer  => '_clear_acl',
    default  => sub {
        my $self = shift;
        my $type = 'GetBucketAccessControl';
        return $self->_get_property( $type )->response->decoded_content();
    },
    trigger  => sub {
        my ( $self, $new_val, $old_val ) = @_;

        my %shorts = map { $_ => undef } qw(
          private public-read public-read-write authenticated-read
        );

        my %acl = ();
        if ( $new_val =~ m{<} ) {
            $acl{acl_xml} = $new_val;
        }
        elsif ( exists $shorts{$new_val} ) {
            $acl{acl_short} = $new_val;
        }

lib/AWS/S3/Bucket.pm  view on Meta::CPAN


    my $type = 'GetFileInfo';

    my $parser = $s->_get_property( $type, key => $key )
      or return;

    my $res = $parser->response;
    confess "Cannot get file: ", $res->as_string, " " unless $res->is_success;
    return AWS::S3::File->new(
        bucket       => $s,
        key          => $key || undef,
        size         => $res->header( 'content-length' ) || 0,
        contenttype  => $res->header( 'content-type' ) || 'application/octet-stream',
        etag         => $res->header( 'etag' ) || undef,
        lastmodified => $res->header( 'last-modified' ) || undef,
        is_encrypted => ( $res->header( 'x-amz-server-side-encryption' ) || '' ) eq 'AES256' ? 1 : 0,
    );
}    # end file()

sub add_file {
    my ( $s, %args ) = @_;

    my $file = AWS::S3::File->new(
        %args,
        bucket => $s

lib/AWS/S3/Bucket.pm  view on Meta::CPAN

=item * us-west-1

=item * us-west-2

=item * ap-southeast-1

=item * ap-northeast-1

=back

The default value is undef which means 'US'.

See also L<PUT Bucket|http://docs.amazonwebservices.com/AmazonS3/latest/API/index.html?RESTBucketPUT.html>

=head2 policy

Read-only.  String of JSON.

Looks something like this:

  {

lib/AWS/S3/File.pm  view on Meta::CPAN

    my ( $s, $ref ) = @_;

    my $type     = 'SetFileContents';
    my %args     = ();
    my $response = $s->bucket->s3->request(
        $type,
        bucket                 => $s->bucket->name,
        file                   => $s,
        contents               => $ref,
        content_type           => $s->contenttype,
        server_side_encryption => $s->is_encrypted ? 'AES256' : undef,
    )->request();

    ( my $etag = $response->response->header( 'etag' ) ) =~ s{^"}{};
    $etag =~ s{"$}{};
    $s->{etag} = $etag;

    if ( my $msg = $response->friendly_error() ) {
        die $msg;
    }    # end if()
}    # end _set_contents()

lib/AWS/S3/HTTPRequest.pm  view on Meta::CPAN

    my $headers  = $s->headers;
    my $content  = $s->content;
    my $metadata = $s->metadata;

    my $uri = $s->bucket_uri( $s->path );

    my $signer = AWS::S3::Signer->new(
        s3      => $s->s3,
        method  => $method,
        uri     => $uri,
        content => $content ? \$content : undef,
        headers => [ $headers->flatten ],
    );

    $headers->header( 'Authorization'  => $signer->auth_header );
    $headers->header( 'Date'           => $signer->date );
    $headers->header( 'Host'           => URI->new( $uri )->host );
    $headers->header( 'content-length' => $signer->content_length ) if $content;
    $headers->header( 'content-type'   => $signer->content_type ) if $content;

    my $request = HTTP::Request->new( $method, $uri, $headers, $content );

lib/AWS/S3/Request/DeleteMulti.pm  view on Meta::CPAN


has 'keys' => (
    is       => 'ro',
    isa      => 'ArrayRef[Str]',
    required => 1,
);

has '_subresource' => (
    is       => 'ro',
    isa      => 'Str',
    init_arg => undef,
    default  => 'delete'
);



has '+_expect_nothing' => ( default => 0 );

sub request {
    my $s = shift;

lib/AWS/S3/Request/GetBucketAccessControl.pm  view on Meta::CPAN


with 'AWS::S3::Roles::BucketAction';

has '+_action' => ( default => 'GET' );

has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );

has '_subresource' => (
  is       => 'ro',
  isa      => 'Str',
  init_arg => undef,
  default  => 'acl'
);

has '+_expect_nothing' => ( default => 0 );

__PACKAGE__->meta->make_immutable;

lib/AWS/S3/Request/GetBucketLocationConstraint.pm  view on Meta::CPAN


with 'AWS::S3::Roles::BucketAction';

has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );

has '+_action' => ( default => 'GET' );

has '_subresource' => (
  is       => 'ro',
  isa      => 'Str',
  init_arg => undef,
  default  => 'location'
);

has '+_expect_nothing' => ( default => 0 );

__PACKAGE__->meta->make_immutable;

lib/AWS/S3/Request/GetBucketPolicy.pm  view on Meta::CPAN


with 'AWS::S3::Roles::BucketAction';

has '+_action' => ( default => 'GET' );

has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );

has '_subresource' => (
  is       => 'ro',
  isa      => 'Str',
  init_arg => undef,
  default  => 'policy'
);

has '+_expect_nothing' => ( default => 0 );

__PACKAGE__->meta->make_immutable;

lib/AWS/S3/Request/SetBucketPolicy.pm  view on Meta::CPAN

use AWS::S3::ResponseParser;
use JSON::XS;

with 'AWS::S3::Roles::Request';

has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );

has '_subresource' => (
    is       => 'ro',
    isa      => 'Str',
    init_arg => undef,
    default  => 'policy'
);

has 'policy' => (
    is       => 'ro',
    isa      => 'Maybe[Str]',
    required => 1,

    # Evan Carroll 6/14/2012
    # COMMENTED THIS OUT, not sure if it ever worked on VSO

lib/AWS/S3/Roles/Request.pm  view on Meta::CPAN

    lazy    => 1,
    default => sub {
        shift->s3->endpoint;
    }
);

# XXX should be required=>1; https://rt.cpan.org/Ticket/Display.html?id=77863
has "_action" => (
    isa       => 'Str',
    is        => 'ro',
    init_arg  => undef,
    #required  => 1
);

has '_expect_nothing' => ( isa => 'Bool', is => 'ro', init_arg => undef );

has '_uri' => (
    isa     => Uri,
    is      => 'ro',
    lazy    => 1,
    default => sub {
        my $self = shift;
        my $m = $self->meta;

        my $uri = URI->new(

lib/AWS/S3/Signer/V4.pm  view on Meta::CPAN


    if ( defined( $self->{security_token} ) ) {
        $uri->query_param( 'X-Amz-Security-Token' => $self->{security_token} );
    }

# Since we're providing auth via query parameters, we need to include UNSIGNED-PAYLOAD
# http://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html
# it seems to only be needed for S3.

    if ( $scope =~ /\/s3\/aws4_request$/ ) {
        $self->_sign( $request, undef, 'UNSIGNED-PAYLOAD' );
    }
    else {
        $self->_sign($request);
    }

    my ( $algorithm, $credential, $signedheaders, $signature ) =
      $request->header('Authorization') =~
      /^(\S+) Credential=(\S+), SignedHeaders=(\S+), Signature=(\S+)/;
    $uri->query_param_append( 'X-Amz-Signature' => $signature );
    return $uri;

t/aws/s3.t  view on Meta::CPAN

isa_ok(
	$s3->request( 'CreateBucket',bucket => 'foo' ),
	'AWS::S3::Request::CreateBucket'
);

subtest 'create bucket strange temporary redirect' => sub {
    plan tests => 8;    # make sure all tests in here get run

    my $i = 1;
    local *LWP::UserAgent::Determined::request = sub {
        my ( undef, $req ) = @_;

        if ( $i == 1 ) {

            # first PUT request, send a forward
            is( $req->method, 'PUT', 'bucket creation with PUT request' );
            is( $req->uri->as_string, 'http://bar.bad.hostname./', '... and with correct URI' );

            $i++;
            return HTTP::Response->new(
                307,

t/aws/s3/file.t  view on Meta::CPAN

        is_encrypted
        contents
    /,
);

note( "attributes" );
isa_ok( $file->bucket,'AWS::S3::Bucket','bucket' );
is( $file->key,$path . $key,'key' );
is( $file->size,'18','size' );
isa_ok( $file->etag,'main','etag' );
is( $file->owner,undef,'owner' );
is( $file->storage_class,'STANDARD','storage_class' );
is( $file->lastmodified,undef,'lastmodified' );
is( $file->contenttype,'binary/octet-stream','contenttype' );
is( $file->is_encrypted,0,'is_encrypted' );
isa_ok( $file->contents,'SCALAR','contents' );

note( "methods" );
ok( !$file->update,'update without args' );
ok( $file->update( contents => \'new contents' ),'update with args' );

like(
    $file->signed_url( 1406712744 ),

t/aws/s3/file_iterator.t  view on Meta::CPAN

            prefix      => 'img',
        ),
        'AWS::S3::FileIterator'
    );

    is( $iterator->marker,'','marker' );
    is( $iterator->pattern,qr/.*/,'pattern' );
    isa_ok( $iterator->bucket,'AWS::S3::Bucket' );
    is( $iterator->page_size,1,'page_size' );
    is( $iterator->has_prev,'','has_prev' );
    is( $iterator->has_next,undef,'has_next' );
    is( $iterator->page_number,1,'get page_number' );
    is( $iterator->page_number(1),0,'set page_number' );
    is( $iterator->prefix,'img','prefix' );

    {
        my $iterator2 = AWS::S3::FileIterator->new(
            page_number => 1,
            page_size   => 1,
            bucket      => $bucket,
            marker      => 'foo',
            pattern     => qr/\d/,
        );
        is( $iterator2->marker,'foo','marker passed');
        is( $iterator2->pattern,qr/\d/,'pattern passed');
        is( $iterator2->prefix,undef,'!prefix' );
    }

    my $mocked_response = Mocked::HTTP::Response->new( 200,get_data_section('ListBucketResult.xml') );
    local *LWP::UserAgent::Determined::request = sub { $mocked_response };
    
    my @pages = $iterator->next_page; # to check wantarray
    cmp_deeply( \@pages,[ obj_isa('AWS::S3::File') ],'next_page returns one ::File' );
    is( $pages[0]->key,'img/my image.jpg','... and it is the one expected' );
    is( $iterator->next_page->[0]->key,'img/my-third-image.jpg','next_page second item' );
    is( $iterator->next_page->[0]->key,'img/my image.jpg','next_page new request, first item' );

t/aws/s3/signer/v4_parse_host.t  view on Meta::CPAN

            );
        }
    }
}

my $paapi_region = AWS::S3::Signer::V4::PAAPI_REGION();

foreach my $host ( sort keys %{ $paapi_region } ) {
    cmp_deeply(
        [ $signer->parse_host( $host ) ],
        [ 'ProductAdvertisingAPI',$paapi_region->{$host},undef ],
        "ProductAdvertisingAPI ($host)",
    );
}



( run in 1.686 second using v1.01-cache-2.11-cpan-d80b1682f3f )