AWS-S3
view release on metacpan or search on metacpan
Changelog for perl module AWS::S3
1.00 2025-02-11
- Start using v4 signatures (resolves GH #18, GH #17, GH #16, GH #14, GH #13, GH #7)
- 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
- 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)
0.11 2015-08-31
- Fix signed_url to URI escape the Signature param value (GH #3)
0.10 2015-06-23
- dist changes related to kwalitee (no functional changes)
0.051 2015-05-23
- default size to 0 when not set in content-length (GH #1)
0.050 2014-10-23
New maintainer leejo
- Add lib/AWS/S3/Request/GetPreSignedUrl.pm to MANIFEST
- Various changes in dist related to issue tracking, testing, etc
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
README.markdown view on Meta::CPAN
# SYNOPSIS
use AWS::S3;
my $s3 = AWS::S3->new(
access_key_id => 'E654SAKIASDD64ERAF0O',
secret_access_key => 'LgTZ25nCD+9LiCV6ujofudY1D6e2vfK0R4GLsI4H',
session_token => 'IQob3JpJZ2luXJ2VjJEL7//////////wE...',
region => 'eu-west-1', # set to relevant AWS region
honor_leading_slashes => 0, # set to allow leading slashes in bucket names, defaults to 0
);
# Add a bucket:
my $bucket = $s3->add_bucket(
name => 'foo-bucket',
);
# Set the acl:
$bucket->acl( 'private' );
README.markdown view on Meta::CPAN
## ua
Optional. Should be an instance of [LWP::UserAgent](https://metacpan.org/pod/LWP%3A%3AUserAgent) or a subclass of it.
Defaults to creating a new instance of [LWP::UserAgent::Determined](https://metacpan.org/pod/LWP%3A%3AUserAgent%3A%3ADetermined)
## honor\_leading\_slashes
Optional. Boolean to set if bucket names should include any leading slashes
when sent to S3 - defaults to zero
# PUBLIC PROPERTIES
## access\_key\_id
String. Read-only
## secret\_access\_key
String. Read-only.
README.markdown view on Meta::CPAN
## bucket( $name )
Returns the [AWS::S3::Bucket](https://metacpan.org/pod/AWS%3A%3AS3%3A%3ABucket) object matching `$name` if found.
Returns nothing otherwise.
## add\_bucket( name => $name, location => 'us-west-1' )
Attempts to create a new bucket with the name provided. The location parameter is optional
and, as per the AWS docs, will default to "us-east-1".
On success, returns the new [AWS::S3::Bucket](https://metacpan.org/pod/AWS%3A%3AS3%3A%3ABucket)
On failure, dies with the error message.
See [AWS::S3::Bucket](https://metacpan.org/pod/AWS%3A%3AS3%3A%3ABucket) for details on how to use buckets (and access their files).
# SEE ALSO
[The Amazon S3 API Documentation](http://docs.amazonwebservices.com/AmazonS3/latest/API/)
lib/AWS/S3.pm view on Meta::CPAN
use AWS::S3::Bucket;
our $VERSION = '1.00';
has [qw/access_key_id secret_access_key/] => ( is => 'ro', isa => 'Str' );
has 'session_token' => (
is => 'ro',
isa => 'Maybe[Str]',
lazy => 1,
default => sub { $ENV{AWS_SESSION_TOKEN} },
);
has 'region' => (
is => 'ro',
isa => 'Maybe[Str]',
lazy => 1,
default => sub { $ENV{AWS_REGION} },
);
has 'secure' => (
is => 'ro',
isa => 'Bool',
lazy => 1,
default => 0
);
has 'endpoint' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my ( $s ) = @_;
if ( my $region = $s->region ) {
return "s3.$region.amazonaws.com"
} else {
return "s3.amazonaws.com"
}
},
);
has 'ua' => (
is => 'ro',
isa => 'LWP::UserAgent',
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()
lib/AWS/S3.pm view on Meta::CPAN
=head1 SYNOPSIS
use AWS::S3;
my $s3 = AWS::S3->new(
access_key_id => 'E654SAKIASDD64ERAF0O',
secret_access_key => 'LgTZ25nCD+9LiCV6ujofudY1D6e2vfK0R4GLsI4H',
session_token => 'IQob3JpJZ2luXJ2VjJEL7//////////wE...',
region => 'eu-west-1', # set to relevant AWS region
honor_leading_slashes => 0, # set to allow leading slashes in bucket names, defaults to 0
);
# Add a bucket:
my $bucket = $s3->add_bucket(
name => 'foo-bucket',
);
# Set the acl:
$bucket->acl( 'private' );
lib/AWS/S3.pm view on Meta::CPAN
=head2 ua
Optional. Should be an instance of L<LWP::UserAgent> or a subclass of it.
Defaults to creating a new instance of L<LWP::UserAgent::Determined>
=head2 honor_leading_slashes
Optional. Boolean to set if bucket names should include any leading slashes
when sent to S3 - defaults to zero
=head1 PUBLIC PROPERTIES
=head2 access_key_id
String. Read-only
=head2 secret_access_key
String. Read-only.
lib/AWS/S3.pm view on Meta::CPAN
=head2 bucket( $name )
Returns the L<AWS::S3::Bucket> object matching C<$name> if found.
Returns nothing otherwise.
=head2 add_bucket( name => $name, location => 'us-west-1' )
Attempts to create a new bucket with the name provided. The location parameter is optional
and, as per the AWS docs, will default to "us-east-1".
On success, returns the new L<AWS::S3::Bucket>
On failure, dies with the error message.
See L<AWS::S3::Bucket> for details on how to use buckets (and access their files).
=head1 SEE ALSO
L<The Amazon S3 API Documentation|http://docs.amazonwebservices.com/AmazonS3/latest/API/>
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
);
lib/AWS/S3/Bucket.pm view on Meta::CPAN
$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 '';
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
is => 'ro',
isa => 'AWS::S3::Bucket',
required => 1,
weak_ref => 0,
);
has 'size' => (
is => 'ro',
isa => 'Int',
required => 0,
default => sub {
my $self = shift;
return length ${$self->contents};
}
);
has 'etag' => (
is => 'ro',
isa => 'Str',
required => 0,
);
lib/AWS/S3/File.pm view on Meta::CPAN
has 'owner' => (
is => 'ro',
isa => 'AWS::S3::Owner',
required => 0,
weak_ref => 1,
);
has 'storage_class' => (
is => 'ro',
isa => 'Str',
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',
isa => fileContents,
required => 0,
lazy => 1,
coerce => 1,
default => \&_get_contents,
trigger => \&_set_contents
);
sub BUILD {
my $s = shift;
return unless $s->etag;
( my $etag = $s->etag ) =~ s{^"}{};
$etag =~ s{"$}{};
$s->{etag} = $etag;
lib/AWS/S3/File.pm view on Meta::CPAN
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
L<The Amazon S3 API Documentation|http://docs.amazonwebservices.com/AmazonS3/latest/API/>
L<AWS::S3>
lib/AWS/S3/HTTPRequest.pm view on Meta::CPAN
coerce 'HTTP::Headers'
=> from 'HashRef'
=> via { my $h = HTTP::Headers->new( %$_ ) };
has 'headers' => (
is => 'ro',
required => 1,
isa => 'HTTP::Headers',
lazy => 1,
default => sub { HTTP::Headers->new() },
coerce => 1,
);
has 'content' => (
is => 'ro',
required => 1,
isa => 'Str|ScalarRef|CodeRef',
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 {
lib/AWS/S3/Request/CreateBucket.pm view on Meta::CPAN
is => 'ro',
isa => 'Str',
required => 1,
);
has 'location' => (
is => 'ro',
isa => 'Maybe[Str]',
lazy => 1,
required => 0,
default => sub { shift->s3->region || $ENV{AWS_REGION} },
);
has '+_expect_nothing' => ( default => 1 );
sub request {
my $s = shift;
# By default the bucket is put in us-east-1. But if you _ask_ for
# us-east-1 you get an error.
my $xml = q{};
if ( $s->location && $s->location ne 'us-east-1' ) {
$xml = <<"XML";
<CreateBucketConfiguration xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
<LocationConstraint>@{[ $s->location ]}</LocationConstraint>
</CreateBucketConfiguration>
XML
}
lib/AWS/S3/Request/DeleteBucket.pm view on Meta::CPAN
package AWS::S3::Request::DeleteBucket;
use Moose;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has '+_action' => ( default => 'DELETE' );
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_expect_nothing' => ( default => 1 );
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/DeleteFile.pm view on Meta::CPAN
package AWS::S3::Request::DeleteFile;
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has '+_action' => ( default => 'DELETE' );
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_expect_nothing' => ( default => 1 );
__PACKAGE__->meta->make_immutable;
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;
my $objects = join "\n", map { "<Object><Key>@{[ $_ ]}</Key></Object>" } @{ $s->keys };
my $xml = <<"XML";
<?xml version="1.0" encoding="UTF-8"?>
<Delete>
$objects
lib/AWS/S3/Request/GetBucketAccessControl.pm view on Meta::CPAN
package AWS::S3::Request::GetBucketAccessControl;
use Moose;
use AWS::S3::ResponseParser;
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
package AWS::S3::Request::GetBucketLocationConstraint;
use Moose;
use AWS::S3::ResponseParser;
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
package AWS::S3::Request::GetBucketPolicy;
use Moose;
use AWS::S3::ResponseParser;
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/GetFileContents.pm view on Meta::CPAN
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_action' => ( default => 'GET' );
has '+_expect_nothing' => ( default => 0 );
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/GetFileInfo.pm view on Meta::CPAN
use Moose;
use AWS::S3::Signer;
use AWS::S3::ResponseParser;
with 'AWS::S3::Roles::BucketAction';
has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 );
has 'key' => ( is => 'ro', isa => 'Str', required => 1 );
has '+_action' => ( default => 'HEAD' );
has '+_expect_nothing' => ( default => 0 );
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/ListAllMyBuckets.pm view on Meta::CPAN
package AWS::S3::Request::ListAllMyBuckets;
use Moose;
use AWS::S3::Signer;
with 'AWS::S3::Roles::BucketAction';
has '+_action' => ( default => 'GET' );
has '+_expect_nothing' => ( default => 0 );
__PACKAGE__->meta->make_immutable;
lib/AWS/S3/Request/ListBucket.pm view on Meta::CPAN
isa => 'Str',
required => 0,
);
has 'delimiter' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has '+_expect_nothing' => ( default => 0 );
sub request {
my $s = shift;
my @params = ();
push @params, 'max-keys=' . $s->max_keys;
push @params, 'marker=' . uri_escape( $s->marker ) if $s->marker;
push @params, 'prefix=' . $s->prefix if $s->prefix;
push @params, 'delimiter=' . $s->delimiter if $s->delimiter;
lib/AWS/S3/Request/SetBucketAccessControl.pm view on Meta::CPAN
isa => 'Str',
required => 0,
);
has 'acl_xml' => (
is => 'ro',
isa => 'Str',
required => 0,
);
has '+_expect_nothing' => ( default => 1 );
sub request {
my $s = shift;
if ( $s->acl_short ) {
my $signer = AWS::S3::Signer->new(
s3 => $s->s3,
method => 'PUT',
uri => $s->protocol . '://' . $s->bucket . '.' . $s->endpoint . '/?acl',
headers => [ 'x-amz-acl' => $s->acl_short ]
lib/AWS/S3/Request/SetBucketPolicy.pm view on Meta::CPAN
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
# Must be able to decode the JSON string:
# where => sub {
# eval { decode_json( $_ ); 1 };
# }
);
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 => '',
lib/AWS/S3/Request/SetFileContents.pm view on Meta::CPAN
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 {
my $s = shift;
my $contents;
if ( ref( $s->file->contents ) eq 'CODE' ) {
$contents = $s->file->contents->();
} elsif ( ref( $s->file->contents ) eq 'SCALAR' ) {
$contents = $s->file->contents;
} # end if()
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
package AWS::S3::ResponseParser;
use Moose;
use XML::LibXML;
use XML::LibXML::XPathContext;
has 'expect_nothing' => (
is => 'ro',
isa => 'Bool',
required => 1,
default => 0,
trigger => sub {
my ( $self, $expect_nothing) = @_;
if ( $expect_nothing ) {
my $code = $self->response->code;
if ( $code =~ m{^2\d\d} && !$self->response->content ) {
return; # not sure what jdrago wanted this to do originally
}
else {
if ( $self->_parse_errors() ) {
# die $self->friendly_error();
lib/AWS/S3/ResponseParser.pm view on Meta::CPAN
has 'type' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'libxml' => (
is => 'ro',
isa => 'XML::LibXML',
required => 1,
default => sub { return XML::LibXML->new() },
);
has 'error_code' => (
is => 'rw',
isa => 'Str',
required => 0,
);
has 'error_message' => (
is => 'rw',
isa => 'Str',
required => 0,
);
has 'xpc' => (
is => 'ro',
isa => 'XML::LibXML::XPathContext',
required => 0,
lazy => 1,
clearer => '_clear_xpc',
default => sub {
my $self = shift;
my $src = $self->response->content;
return unless $src =~ m/^[[:space:]]*</s;
my $doc = $self->libxml->parse_string( $src );
my $xpc = XML::LibXML::XPathContext->new( $doc );
$xpc->registerNs( 's3', 'http://s3.amazonaws.com/doc/2006-03-01/' );
return $xpc;
}
);
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;
lib/AWS/S3/Roles/Request.pm view on Meta::CPAN
has 'type' => (
is => 'ro',
isa => 'Str',
required => 1,
);
has 'protocol' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
shift->s3->secure ? 'https' : 'http';
}
);
has 'endpoint' => (
is => 'ro',
isa => 'Str',
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(
$self->protocol . '://'
. ( $m->has_attribute('bucket') ? $self->bucket . '.' : '' )
. $self->endpoint
. '/'
);
lib/AWS/S3/Roles/Request.pm view on Meta::CPAN
if $m->has_attribute('_subresource');
$uri;
}
);
has 'signerv4' => (
is => 'ro',
isa => 'AWS::S3::Signer::V4',
lazy => 1,
default => sub {
my $s = shift;
AWS::S3::Signer::V4->new(
-access_key => $s->s3->access_key_id,
-secret_key => $s->s3->secret_access_key,
);
}
);
sub _send_request {
my ( $s, $method, $uri, $headers, $content ) = @_;
lib/AWS/S3/Signer.pm view on Meta::CPAN
is => 'ro',
isa => enum([qw/ HEAD GET PUT POST DELETE /]),
required => 1,
);
has 'bucket_name' => (
is => 'ro',
isa => 'Str',
required => 1,
lazy => 1,
default => sub {
my $s = shift;
my $endpoint = $s->s3->endpoint;
if ( my ( $name ) = $s->uri->host =~ m{^(.+?)\.\Q$endpoint\E} ) {
return $name;
} else {
return '';
} # end if()
}
);
lib/AWS/S3/Signer.pm view on Meta::CPAN
is => 'ro',
isa => Uri,
required => 1,
coerce => 1,
);
has 'headers' => (
is => 'ro',
isa => 'ArrayRef[Str]',
lazy => 1,
default => sub { [] },
);
has 'date' => (
is => 'ro',
isa => 'Str',
default => sub {
time2str( time );
}
);
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,
default => sub {
my $s = shift;
my @h = @{ $s->headers };
my %out = ();
while ( my ( $k, $v ) = splice( @h, 0, 2 ) ) {
$k = lc( $k );
if ( exists $out{$k} ) {
$out{$k} = [ $out{$k} ] unless ref( $out{$k} );
push @{ $out{$k} }, $v;
} else {
lib/AWS/S3/Signer.pm view on Meta::CPAN
} # end while()
return join "\n", @parts;
}
);
has 'canonicalized_resource' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my $s = shift;
my $str = $s->bucket_name ? '/' . $s->bucket_name . $s->uri->path : $s->uri->path;
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';
}
);
has 'content_md5' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my $s = shift;
return '' unless $s->content;
return encode_base64( md5( ${ $s->content } ), '' );
}
);
has 'content' => (
is => 'ro',
isa => 'Maybe[ScalarRef]',
);
has 'content_length' => (
is => 'ro',
isa => 'Int',
lazy => 1,
default => sub { length( ${ shift->content } ) }
);
has 'signature' => (
is => 'ro',
isa => 'Str',
lazy => 1,
default => sub {
my $s = shift;
my $hmac = Digest::HMAC_SHA1->new( $s->s3->secret_access_key );
$hmac->add( $s->string_to_sign() );
return encode_base64( $hmac->digest, '' );
}
);
sub auth_header {
my $s = shift;
lib/AWS/S3/Signer/V4.pm view on Meta::CPAN
-service An AWS service
-region An AWS region
If a security token is provided, it overrides any values given for
-access_key or -secret_key.
If the environment variables EC2_ACCESS_KEY and/or EC2_SECRET_KEY are
set, their contents are used as defaults for -access_key and
-secret_key.
If -service and/or -region is not provided, they are automtically determined
according to endpoint.
=cut
sub new {
my $self = shift;
my %args = @_;
lib/AWS/S3/Signer/V4.pm view on Meta::CPAN
Pass an HTTP::Request, a URI object, or just a plain URL string
containing the proper endpoint and parameters needed for an AWS REST
API Call. This method will return an appropriately signed request as a
URI object, which can be shared with non-AWS users for the purpose of,
e.g., accessing an object in a private S3 bucket.
Pass an optional $expires argument to indicate that the URL will only
be valid for a finite period of time. The value of the argument is in
seconds.
Pass an optional verb which is useful for HEAD requests, this defaults to GET.
=cut
sub signed_url {
my $self = shift;
my ( $arg1, $expires, $verb ) = @_;
my ( $request, $uri );
$verb ||= 'GET';
$verb = uc($verb);
lib/AWS/S3/Signer/V4.pm view on Meta::CPAN
my $self = shift;
my ( $request, $region ) = @_;
my $host = $request->uri->host;
my $datetime = $self->_datetime($request);
my ($date) = $datetime =~ /^(\d+)T/;
my $service;
( $service, $region ) = $self->parse_host( $host, $region );
$service ||= $self->{service} || 's3';
$region ||= $self->{region} || 'us-east-1'; # default
return "$date/$region/$service/aws4_request";
}
sub parse_host {
my $self = shift;
my $host = shift;
my $region = shift;
# this entire thing should probably refactored into its own
# distribution, a la https://github.com/zirkelc/amazon-s3-url
( run in 0.728 second using v1.01-cache-2.11-cpan-0a6323c29d9 )