AWS-S3
view release on metacpan or search on metacpan
0.040 2014-10-23
Work done by leejo
- Add signed_url method to AWS::S3::File and tests
- Fix load / hash order bugs in AWS::S3::Signer
- Resolve https://rt.cpan.org/Ticket/Display.html?id=92423
0.03_01 2012-06-14
Work done by Evan Carroll (http://www.evancarroll.com)
- Migrated to Moose & removed dependencies on VSO
- Fixed bug introduced by previous commit, reverted to contenttype & all tests pass
0.028 2012-03-01
- Fixed: AWS/S3.pm required a higher version of VSO than the Makefile.PL and META.yml.
- Strange: Local testing shows $bucket->delete_multi works, but it gives me
some problems in production.
0.027 2012-02-24
- Fixed sporadic error:
"Invalid value for AWS::S3::File.size: isn't a Int: [Str] 'contenttype': Must contain only numbers 0-9"
0.026 2012-01-30
- $bucket->file( $missing_file ) was failing silently, causing strange behavior
further upstream. Now it will confess with the http response from S3.
0.025 2012-01-12
- $bucket->delete_multi( @keys ) actually works now.
0.024 2012-01-05
- Better integration with CloudFront.
- File's S3 was a weak ref, which caused problems. No longer...
0.020 2011-12-21
- Updated to be compatible with VSO 0.21
0.019 2011-12-14
- Bucket's S3 was a weak ref, which caused problems sometimes. Not anymore...
we'll see if that fixes it.
0.018 2011-12-13
- Thanks to ukautz++ (Ulrich Kautz) for adding the ability to set the content-type
of files stored in S3.
- He even updated the POD to show how to set the content-type (via 'contenttype').
0.017 2011-12-11
- Fixed broken META.yml (again)
0.016 2011-12-10
- Fixed broken META.yml
0.015 2011-12-10
- Migrated to github.
- Added repository url to meta.
lib/AWS/S3.pm view on Meta::CPAN
default => sub { LWP::UserAgent::Determined->new }
);
has 'honor_leading_slashes' => (
is => 'ro',
isa => 'Bool',
default => sub { 0 },
);
sub request {
my ( $s, $type, %args ) = @_;
my $class = "AWS::S3::Request::$type";
load_class( $class );
return $class->new( %args, s3 => $s, type => $type );
} # end request()
sub owner {
my $s = shift;
my $type = 'ListAllMyBuckets';
my $request = $s->request( $type );
my $response = $request->request();
# Linode/Akamai E3 endpoints do not include the `xmlns` in
# ListAllMyBuckets, so use the localname to work with or
# without a declared XML namespace.
my $xml = $response->xml;
my ($node) = $xml->getElementsByLocalName('Owner');
return AWS::S3::Owner->new(
id => $node->getElementsByLocalName('ID')->string_value,
display_name => $node->getElementsByLocalName('DisplayName')->string_value,
);
} # end owner()
sub buckets {
my ( $s ) = @_;
my $type = 'ListAllMyBuckets';
my $request = $s->request( $type );
my $response = $request->request();
# Linode/Akamai E3 endpoints do not include the `xmlns` in
# ListAllMyBuckets, so use the localname to work with or
# without a declared XML namespace.
my $xml = $response->xml;
my @buckets = ();
foreach my $node ( $xml->getElementsByLocalName( 'Bucket' ) ) {
push @buckets,
AWS::S3::Bucket->new(
lib/AWS/S3.pm view on Meta::CPAN
my ( $s, $name ) = @_;
my ( $bucket ) = grep { $_->name eq $name } $s->buckets
or return;
$bucket;
} # end bucket()
sub add_bucket {
my ( $s, %args ) = @_;
my $type = 'CreateBucket';
my $request = $s->request(
$type,
bucket => $args{name},
(
$args{location} ? ( location => $args{location} )
: $s->region ? ( location => $s->region )
: ()
),
);
my $response = $request->request();
if ( my $msg = $response->friendly_error() ) {
lib/AWS/S3/Bucket.pm view on Meta::CPAN
use MooseX::Types -declare => [qw/ACLShorts/];
has 'acl' => (
is => 'rw',
isa => 'Str',
required => 0,
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;
}
else {
die "Attempt to set an invalid value for acl: '$new_val'";
}
my $type = 'SetBucketAccessControl';
my $req = $self->s3->request( $type, %acl, bucket => $self->name, );
my $response = $req->request();
return if $response->response->code == 404;
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
$self->_clear_acl;
}
);
has 'location_constraint' => (
is => 'ro',
isa => 'Str',
required => 0,
lazy => 1,
default => sub {
my $self = shift;
my $type = 'GetBucketLocationConstraint';
my $response = $self->_get_property( $type );
my $constraint = $response->xpc->findvalue( '//s3:LocationConstraint' );
if ( defined $constraint && $constraint eq '' ) {
return;
} else {
return $constraint;
}
}
);
has 'policy' => (
is => 'rw',
isa => 'Str',
required => 0,
lazy => 1,
clearer => '_clear_policy',
default => sub {
my $self = shift;
my $type = 'GetBucketPolicy';
my $req = $self->s3->request( $type, bucket => $self->name, );
my $response = $req->request();
eval { $response->_parse_errors };
if ( my $msg = $response->friendly_error() ) {
if ( $response->error_code eq 'NoSuchBucketPolicy' ) {
return '';
} else {
die $msg;
} # end if()
} # end if()
return $response->response->decoded_content();
},
trigger => sub {
my ( $self, $policy ) = @_;
my $type = 'SetBucketPolicy';
my $req = $self->s3->request(
$type,
bucket => $self->name,
policy => $policy,
);
my $response = $req->request();
#warn "NewPolicy:($policy).......\n";
#warn $response->response->as_string;
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
lib/AWS/S3/Bucket.pm view on Meta::CPAN
sub files {
my ( $s, %args ) = @_;
return AWS::S3::FileIterator->new( %args, bucket => $s, );
} # end files()
sub file {
my ( $s, $key ) = @_;
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
);
$file->contents( $args{contents} );
return $file;
} # end add_file()
sub delete {
my ( $s ) = @_;
my $type = 'DeleteBucket';
my $req = $s->s3->request( $type, bucket => $s->name, );
my $response = $req->request();
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return 1;
} # end delete()
# Working as of v0.023
sub delete_multi {
my ( $s, @keys ) = @_;
die "You can only delete up to 1000 keys at once"
if @keys > 1000;
my $type = 'DeleteMulti';
my $req = $s->s3->request(
$type,
bucket => $s->name,
keys => \@keys,
);
my $response = $req->request();
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return 1;
} # end delete_multi()
sub _get_property {
my ( $s, $type, %args ) = @_;
my $req = $s->s3->request( $type, bucket => $s->name, %args );
my $response = $req->request();
return if $response->response->code == 404;
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return $response;
} # end _get_property()
lib/AWS/S3/File.pm view on Meta::CPAN
package AWS::S3::File;
use Moose;
use Carp 'confess';
use MooseX::Types -declare => [qw/fileContents/];
use MooseX::Types::Moose qw/Str ScalarRef CodeRef/;
subtype fileContents, as ScalarRef;
coerce fileContents,
from CodeRef,
via {
my $ref = $_[0];
my $v = $ref->();
ref $v ? $v : \$v
}
;
has 'key' => (
lib/AWS/S3/File.pm view on Meta::CPAN
default => 'STANDARD',
required => 1,
);
has 'lastmodified' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has 'contenttype' => (
is => 'rw',
isa => 'Str',
required => 0,
default => 'binary/octet-stream'
);
has 'is_encrypted' => (
is => 'rw',
isa => 'Bool',
required => 1,
lazy => 1,
default => sub {
my $s = shift;
my $type = 'GetFileInfo';
my $req = $s->bucket->s3->request(
$type,
bucket => $s->bucket->name,
key => $s->key,
);
return $req->request->response->header( 'x-amz-server-side-encryption' ) ? 1 : 0;
},
);
has 'contents' => (
is => 'rw',
lib/AWS/S3/File.pm view on Meta::CPAN
return unless $s->etag;
( my $etag = $s->etag ) =~ s{^"}{};
$etag =~ s{"$}{};
$s->{etag} = $etag;
} # end BUILD()
sub update {
my $s = shift;
my %args = @_;
my @args_ok = grep { /^content(?:s|type)$/ } keys %args;
if ( @args_ok ) {
$s->{$_} = $args{$_} for @args_ok;
$s->_set_contents();
return 1;
}
return;
} # end update()
sub _get_contents {
my $s = shift;
my $type = 'GetFileContents';
my $req = $s->bucket->s3->request(
$type,
bucket => $s->bucket->name,
key => $s->key,
);
return \$req->request->response->decoded_content;
} # end contents()
sub _set_contents {
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()
lib/AWS/S3/File.pm view on Meta::CPAN
if ( $expires > time ) {
$expires -= time;
}
my $key = $s->key;
if ( ! $s->bucket->s3->honor_leading_slashes ) {
$key =~ s!^/!!;
}
my $type = "GetPreSignedUrl";
my $uri = $s->bucket->s3->request(
$type,
bucket => $s->bucket->name,
key => $key,
expires => $expires,
)->request;
return $uri;
}
sub delete {
my $s = shift;
my $type = 'DeleteFile';
my $req = $s->bucket->s3->request(
$type,
bucket => $s->bucket->name,
key => $s->key,
);
my $response = $req->request();
if ( my $msg = $response->friendly_error() ) {
die $msg;
} # end if()
return 1;
lib/AWS/S3/File.pm view on Meta::CPAN
$file->contents( \$new_contents );
# Set the contents with a coderef:
$file->contents( sub {
return \$new_contents;
});
# Alternative update
$file->update(
contents => \'New contents', # optional
contenttype => 'text/plain' # optional
);
# Get signed URL for the file for public access
print $file->signed_url( $expiry_time );
# Delete the file:
$file->delete();
=head1 DESCRIPTION
lib/AWS/S3/File.pm view on Meta::CPAN
=head2 owner
L<ASW::S3::Owner> - read-only.
The L<ASW::S3::Owner> that the file belongs to.
=head2 storage_class
String - read-only.
The type of storage used by the file.
=head2 lastmodified
String - read-only.
A date in this format:
2009-10-28T22:32:00
=head2 contents
lib/AWS/S3/File.pm view on Meta::CPAN
$file->contents( sub { return $value } );
=head1 PUBLIC METHODS
=head2 delete()
Deletes the file from Amazon S3.
=head2 update()
Update contents and/or contenttype of the file.
=head2 signed_url( $expiry_time )
Will return a signed URL for public access to the file. $expiry_time should be a
Unix seconds since epoch, and will default to now + 1 hour is not passed.
Note that the Signature parameter value will be URI encoded to prevent reserved
characters (+, =, etc) causing a bad request.
=head1 SEE ALSO
lib/AWS/S3/FileIterator.pm view on Meta::CPAN
sub _fetch {
my ( $s ) = @_;
my $path = $s->{bucket}->name . '/';
my %params = ();
$params{marker} = $s->{marker} if $s->{marker};
$params{prefix} = $s->{prefix} if $s->{prefix};
$params{max_keys} = 1000;
$params{delimiter} = $s->{delimiter} if $s->{delimiter};
my $type = 'ListBucket';
my $request = $s->{bucket}->s3->request( $type, %params, bucket => $s->{bucket}->name );
my $response = $request->request();
$s->{has_next} = ( $response->xpc->findvalue( '//s3:IsTruncated' ) || '' ) eq 'true' ? 1 : 0;
my @files = ();
foreach my $node ( $response->xpc->findnodes( '//s3:Contents' ) ) {
my ( $owner_node ) = $response->xpc->findnodes( './/s3:Owner', $node );
my $owner = {
id => $response->xpc->findvalue( './/s3:ID', $owner_node ),
display_name => $response->xpc->findvalue( './/s3:DisplayName', $owner_node )
lib/AWS/S3/HTTPRequest.pm view on Meta::CPAN
required => 1,
isa => 'HTTPMethod'
);
has 'path' => (
is => 'ro',
required => 1,
isa => 'Str',
);
class_type( 'HTTP::Headers' );
coerce 'HTTP::Headers'
=> from 'HashRef'
=> via { my $h = HTTP::Headers->new( %$_ ) };
has 'headers' => (
is => 'ro',
required => 1,
isa => 'HTTP::Headers',
lazy => 1,
lib/AWS/S3/HTTPRequest.pm view on Meta::CPAN
default => '',
);
has 'metadata' => (
is => 'ro',
required => 1,
isa => 'HashRef',
default => sub { {} },
);
has 'contenttype' => (
is => 'ro',
required => 0,
isa => 'Str',
);
# Make the HTTP::Request object:
sub http_request {
my $s = shift;
my $method = $s->method;
my $headers = $s->headers;
lib/AWS/S3/HTTPRequest.pm view on Meta::CPAN
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 );
return $request;
} # end http_request()
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/CreateBucket.pm view on Meta::CPAN
<CreateBucketConfiguration xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
<LocationConstraint>@{[ $s->location ]}</LocationConstraint>
</CreateBucketConfiguration>
XML
}
my $signer = AWS::S3::Signer->new(
s3 => $s->s3,
method => 'PUT',
uri => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/',
content_type => 'text/plain',
content_md5 => '',
content => \$xml,
);
return $s->_send_request(
$signer->method => $signer->uri => {
Authorization => $signer->auth_header,
Date => $signer->date,
'content-type' => 'text/plain',
},
$xml
);
}
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/DeleteMulti.pm view on Meta::CPAN
<Delete>
$objects
</Delete>
XML
my $signer = AWS::S3::Signer->new(
s3 => $s->s3,
method => 'POST',
uri => $s->_uri,
content => \$xml,
content_type => '',
);
$s->_send_request(
$signer->method => $signer->uri => {
Authorization => $signer->auth_header,
Date => $signer->date,
'content-md5' => $signer->content_md5,
},
$xml
);
lib/AWS/S3/Request/SetBucketAccessControl.pm view on Meta::CPAN
'x-amz-acl' => $s->acl_short
},
$s->acl_xml
);
} elsif ( $s->acl_xml ) {
my $signer = AWS::S3::Signer->new(
s3 => $s->s3,
method => 'PUT',
uri => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/?acl',
content => \$s->acl_xml,
'content-type' => 'text/xml',
);
return $s->_send_request(
$signer->method => $signer->uri => {
Authorization => $signer->auth_header,
Date => $signer->date,
},
$s->acl_xml
);
} # end if()
} # end request()
lib/AWS/S3/Request/SetBucketPolicy.pm view on Meta::CPAN
has '+_expect_nothing' => ( default => 1 );
sub request {
my $s = shift;
my $signer = AWS::S3::Signer->new(
s3 => $s->s3,
method => 'PUT',
uri => $s->_uri,
content => \$s->policy,
content_type => '',
content_md5 => '',
);
#warn "SetPolicy.string_to_sign(" . $signer->string_to_sign . ")";
$s->_send_request(
$signer->method => $signer->uri => {
Authorization => $signer->auth_header,
Date => $signer->date,
},
$s->policy
lib/AWS/S3/Request/SetFileContents.pm view on Meta::CPAN
isa => 'Str',
required => 1,
);
has 'file' => (
is => 'ro',
isa => 'AWS::S3::File',
required => 1,
);
has 'content_type' => (
is => 'ro',
isa => 'Str',
required => 1,
lazy => 1,
default => sub { 'binary/octet-stream' },
);
has '+_expect_nothing' => ( default => 0 );
sub request {
lib/AWS/S3/Request/SetFileContents.pm view on Meta::CPAN
$contents = $s->file->contents;
} # end if()
my %other_args = ();
$other_args{'x-amz-server-side-encryption'} = 'AES256' if $s->file->is_encrypted;
my $signer = AWS::S3::Signer->new(
s3 => $s->s3,
method => 'PUT',
uri => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/' . $s->file->key,
content_type => $s->content_type,
content => $contents,
headers => [ 'x-amz-storage-class', $s->file->storage_class ],
);
$s->_send_request(
$signer->method => $signer->uri => {
Authorization => $signer->auth_header,
Date => $signer->date,
'content-type' => $s->content_type,
'content-md5' => $signer->content_md5,
'x-amz-storage-class' => $s->file->storage_class,
},
$$contents
);
} # end request()
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
}
}
);
has 'response' => (
is => 'ro',
isa => 'HTTP::Response',
required => 1,
);
has 'type' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'libxml' => (
is => 'ro',
isa => 'XML::LibXML',
required => 1,
default => sub { return XML::LibXML->new() },
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
has 'friendly_error' => (
is => 'ro',
isa => 'Maybe[Str]',
lazy => 1,
required => 0,
default => sub {
my $s = shift;
return unless $s->error_code || $s->error_message;
$s->type . " call had errors: [" . $s->error_code . "] " . $s->error_message;
}
);
sub _parse_errors {
my $self = shift;
my $src = $self->response->content;
# Do not try to parse non-xml:
unless ( $src =~ m/^[[:space:]]*</s ) {
lib/AWS/S3/Roles/Request.pm view on Meta::CPAN
use URI::Escape qw/ uri_escape /;
use AWS::S3::Signer::V4;
use Log::Any qw( $LOG );
has 's3' => (
is => 'ro',
isa => 'AWS::S3',
required => 1,
);
has 'type' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'protocol' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
lib/AWS/S3/Roles/Request.pm view on Meta::CPAN
$signer->sign($request, $s->s3->region, $digest);
$request;
}
sub parse_response {
my ( $self, $res ) = @_;
AWS::S3::ResponseParser->new(
response => $res,
expect_nothing => $self->_expect_nothing,
type => $self->type,
);
}
1;
lib/AWS/S3/Signer.pm view on Meta::CPAN
has 'string_to_sign' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my $s = shift;
join "\n",
(
$s->method, $s->content_md5,
$s->content ? $s->content_type : '',
$s->date || '',
( join "\n", grep { $_ } ( $s->canonicalized_amz_headers, $s->canonicalized_resource ) )
);
}
);
has 'canonicalized_amz_headers' => (
is => 'ro',
isa => 'Str',
lazy => 1,
lib/AWS/S3/Signer.pm view on Meta::CPAN
if ( my ( $resource ) =
( $s->uri->query || '' ) =~ m{[&]*(acl|website|location|policy|delete|lifecycle)(?!\=)} )
{
$str .= '?' . $resource;
} # end if()
return $str;
}
);
has 'content_type' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my $s = shift;
return '' if $s->method eq 'GET';
return '' unless $s->content;
return 'text/plain';
}
);
t/010_basic.t view on Meta::CPAN
foreach( sort keys %info )
{
ok ! eval {$bucket->file($_)}, "bucket(@{[ $bucket->name ]}).file($_) doesn't exist";
}# end foreach()
# map {
# ok $bucket->file($_)->delete && ! $bucket->file($_), "bucket.file($_).delete worked"
# } sort keys %info;
};
# proof content type reading and writing
CONTENT_TYPE: {
foreach my $ct( qw( text/plain image/jpeg application/zip ) ) {
# write file with specific content type
( my $ct_name = $ct ) =~ s#/#-#;
ok( $bucket->add_file(
key => "$ct_name.dat",
contents => \( 'This is '. $ct ),
contenttype => $ct
), "Put file with content type $ct" );
# read file
my $ct_file = $bucket->file( "$ct_name.dat" );
ok( $ct_file && $ct_file->contenttype eq $ct, 'Content type '. $ct. ' read' );
# change content type
$ct_file->update( contenttype => 'text/csv' );
$ct_file = $bucket->file( "$ct_name.dat" );
ok( $ct_file && $ct_file->contenttype eq 'text/csv', 'Content type '. $ct. ' changed to text/csv' );
# remove file
$ct_file->delete();
}
};
# Cleanup:
ok $bucket->delete, 'bucket.delete succeeds when bucket IS empty.';
}# end if()
t/aws/s3/file.t view on Meta::CPAN
can_ok(
$file,
qw/
key
bucket
size
etag
owner
storage_class
lastmodified
contenttype
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 ),
qr/X-Amz-Algorithm.*X-Amz-Credential.*X-Amz-Date.*X-Amz-Signature/,
t/aws/s3/http_request.t view on Meta::CPAN
can_ok(
$request,
qw/
s3
method
path
headers
content
metadata
contenttype
/,
);
isa_ok( $request->http_request,'HTTP::Request' );
is( $request->is_dns_bucket( 'foo' ),1,'_is_dns_bucket' );
is( $request->is_dns_bucket( 'Foo' ),0,'_! is_dns_bucket' );
is( $request->is_dns_bucket( 'bar123boz' ),1,'_is_dns_bucket' );
is( $request->is_dns_bucket( 'bar123Boz' ),0,'! _is_dns_bucket' );
is( $request->is_dns_bucket( 'foo!' ),0,'! _is_dns_bucket' );
t/aws/s3/http_request.t view on Meta::CPAN
s3 => $s3,
method => 'POST',
path => '/bar/baz',
content => 'Hello World!'
),
'AWS::S3::HTTPRequest'
);
isa_ok( my $http_request_with_content = $request_with_content->http_request, 'HTTP::Request' );
my $header = $http_request_with_content->headers;
is( $header->header( 'content-type' ), 'text/plain', '... and content-type got set' );
is( $header->header( 'content-length' ), 12, '... and content-length got set' );
is( $header->header( 'host' ), 's3.baz.com', '... and host got set' );
done_testing();
t/aws/s3/signer.t view on Meta::CPAN
qw/
s3
method
bucket_name
uri
headers
date
string_to_sign
canonicalized_amz_headers
canonicalized_resource
content_type
content_md5
content
content_length
signature
/,
);
note( "attributes" );
isa_ok( $signer->s3,'AWS::S3' );
t/aws/s3/signer.t view on Meta::CPAN
isa_ok( $signer->uri,'URI' );
cmp_deeply( $signer->headers,[],'headers' );
like( $signer->date,qr/\w+, +\d{1,2} \w+ \d{4} \d{2}:\d{2}:\d{2}/,'date' );
is(
$signer->string_to_sign,
"HEAD\nXrY7u+Ae7tCTyyK7j1rNww==\ntext/plain\n".$signer->date."\n/maibucket/boz",
'string_to_sign'
);
is( $signer->canonicalized_amz_headers,'','canonicalized_amz_headers' );
is( $signer->canonicalized_resource,'/maibucket/boz','canonicalized_resource' );
is( $signer->content_type,'text/plain','content_type' );
is( $signer->content_md5,'XrY7u+Ae7tCTyyK7j1rNww==','content_md5' );
is( ${ $signer->content },'hello world','content' );
is( $signer->content_length,11,'content_length' );
like( $signer->signature,qr/^.{28}$/,'signature' );
note( "methods" );
like( $signer->auth_header,qr/AWS foo:.{28}/,'auth_header' );
done_testing();
t/aws/s3/signer/v4.t view on Meta::CPAN
is( $request->method, 'POST', 'request method correct' );
is( $request->header('Host'), 'iam.amazonaws.com', 'host correct' );
is( $request->header('X-Amz-Date'), '20140101T060000Z', 'timestamp correct' );
is(
$request->content,
'Action=ListUsers&Version=2010-05-08',
'payload correct'
);
is(
$request->header('Authorization'),
'AWS4-HMAC-SHA256 Credential=AKIDEXAMPLE/20140101/us-east-1/iam/aws4_request, SignedHeaders=content-length;content-type;host;x-amz-date, Signature=0233049369ae675cea7616efa5d2e5216c37a4b1496a36595f32181f078e3549',
'signature correct'
);
$request = GET( 'https://iam.amazonaws.com?Action=ListUsers&Version=2010-05-08',
Date => '1 January 2014 01:00:00 -0500' );
my $expected =
'https://iam.amazonaws.com?Action=ListUsers&Version=2010-05-08&X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential=AKIDEXAMPLE%2F20140101%2Fus-east-1%2Fiam%2Faws4_request&X-Amz-Date=20140101T060000Z&X-Amz-SignedHeaders=host&X-Amz-Signature=9d0b832ec5c5...
is( $signer->signed_url($request),
t/aws/s3/signer/v4.t view on Meta::CPAN
Date => '1 January 2014 01:00:00 -0500'
);
is( $signer->signed_url($request), $expected, 'domain bucket url' );
$request = POST('https://cognito-identity.us-east-1.amazonaws.com',
Date => '1 January 2014 01:00:00 -0500');
$signer->sign($request);
is($request->header('Authorization'),'AWS4-HMAC-SHA256 Credential=AKIDEXAMPLE/20140101/us-east-1/cognito-identity/aws4_request, SignedHeaders=content-length;content-type;host;x-amz-date, Signature=047c9335c6a34448efc59c2a1813711602e208dcb42ae95cd3b88...
exit 0;
( run in 2.165 seconds using v1.01-cache-2.11-cpan-39a47a84364 )