view release on metacpan or search on metacpan
package S3::CLI;
use strict;
use warnings;
use Getopt::Long;
use Amazon::S3::Thin;
use Data::Dumper;
sub new {
return bless {}, shift;
}
sub help {
my ($self, @args) = @_;
require Pod::Usage;
Pod::Usage::pod2usage(0);
}
sub run {
my ($self, @args) = @_;
lib/Amazon/S3/Thin.pm view on Meta::CPAN
$self->{aws_access_key_id},
$self->{aws_secret_access_key},
$self->{aws_session_token},
);
delete $self->{aws_access_key_id};
delete $self->{aws_secret_access_key};
delete $self->{aws_session_token};
}
delete $self->{credential_provider};
bless $self, $class;
$self->secure(0) unless defined $self->secure;
$self->ua($self->_default_ua) unless defined $self->ua;
$self->debug(0) unless defined $self->debug;
$self->virtual_host(0) unless defined $self->virtual_host;
$self->{signature_version} = 4 unless defined $self->{signature_version};
if ($self->{signature_version} == 4 && ! $self->{region}) {
croak "Please set region when you use signature v4";
}
lib/Amazon/S3/Thin/Credentials.pm view on Meta::CPAN
my $JSON = JSON::PP->new->utf8->canonical;
sub new {
my ($class, $key, $secret, $session_token) = @_;
my $self = {
key => $key,
secret => $secret,
session_token => $session_token,
};
return bless $self, $class;
}
=head2 from_env()
Instantiate C<Amazon::S3::Thin::Credentials> and attempts to populate the credentials from
current environment.
Croaks if either AWS_ACCESS_KEY_ID or AWS_SECRET_ACCESS_KEY are not set but supports the
optional AWS_SESSION_TOKEN variable.
lib/Amazon/S3/Thin/Credentials.pm view on Meta::CPAN
# Check the environment is configured
croak "AWS_ACCESS_KEY_ID is not set" unless $ENV{AWS_ACCESS_KEY_ID};
croak "AWS_SECRET_ACCESS_KEY is not set" unless $ENV{AWS_SECRET_ACCESS_KEY};
my $self = {
key => $ENV{AWS_ACCESS_KEY_ID},
secret => $ENV{AWS_SECRET_ACCESS_KEY},
session_token => $ENV{AWS_SESSION_TOKEN}
};
return bless $self, $class;
}
=head2 from_metadata()
Instantiate C<Amazon::S3::Thin::Credentials> and attempts to populate the credentials from
the L<EC2 metadata service|https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-instance-metadata.html>. An instance can have multiple IAM
roles applied so you may optionally specify a role, otherwise the first one will be used.
In November 2019 AWS released L<version 2|https://aws.amazon.com/blogs/security/defense-in-depth-open-firewalls-reverse-proxies-ssrf-vulnerabilities-ec2-instance-metadata-service/> of the instance metadata service which
is more secure against Server Side Request Forgery attacks. Using v2 is highly recommended thus
lib/Amazon/S3/Thin/Resource.pm view on Meta::CPAN
my $class = shift;
my $bucket = shift;
my $key = shift;
my $query_string = shift;
my $self = {
bucket => $bucket,
key => $key,
query_string => $query_string,
};
bless $self, $class;
}
sub _composer_url {
my $self = shift;
my $protocol = shift;
my $host = shift;
my $path = shift;
return "$protocol://$host/$path",
}
lib/Amazon/S3/Thin/Signer/V2.pm view on Meta::CPAN
sub new {
my ($class, $credentials, $host) = @_;
if (ref($credentials) ne 'Amazon::S3::Thin::Credentials') {
croak "credentials object is not given."
}
my $self = {
credentials => $credentials,
host => $host,
};
bless $self, $class;
}
sub sign
{
my ($self, $request) = @_;
$request->header(Date => HTTP::Date::time2str(time)) unless $request->header('Date');
if (defined $self->{credentials}->session_token) {
$request->header('X-Amz-Security-Token', $self->{credentials}->session_token);
}
my $host = $request->uri->host;
lib/Amazon/S3/Thin/Signer/V4.pm view on Meta::CPAN
use JSON::PP ();
use MIME::Base64 ();
use POSIX 'strftime';
sub new {
my ($class, $credentials, $region) = @_;
my $self = {
credentials => $credentials,
region => $region,
};
bless $self, $class;
}
=head1 METHODS
=head2 sign($request)
Signs supplied L<HTTP::Request> object, adding required AWS headers.
=cut
my $arg = +{
credential_provider => 'ecs_container',
region => 'ap-northeast-1',
ua => MockUA->new,
};
my $s3client = Amazon::S3::Thin->new($arg);
isa_ok($s3client->{signer}, 'Amazon::S3::Thin::Signer::V4', 'new v4');
package MockUA;
sub new { bless {}, shift; }
sub get { return MockResponse->new; };
package MockResponse;
sub new { bless {}, shift; }
sub is_success { !!1; }
sub decoded_content { '{"AccessKeyId": "Key", "SecretAccessKey": "Secret", "Token": "Token"}'; }
}
BEGIN {
$ENV{AWS_ACCESS_KEY_ID} = 'dummy';
$ENV{AWS_SECRET_ACCESS_KEY} = 'dummy';
}
{
diag "test from_env";
t/02_credentials_ecs_container.t view on Meta::CPAN
like $@, qr/Invalid data returned: /;
}
done_testing;
package MockUA;
sub new {
my $class = shift;
bless { requests => [] }, $class;
}
sub get {
my ($self, $uri) = @_;
my $request = {
method => 'GET',
uri => $uri,
};
t/02_credentials_ecs_container.t view on Meta::CPAN
sub requests {
my $self = shift;
$self->{requests};
}
package MockResponse;
sub new {
my ($class, $self) = @_;
bless $self, $class;
}
sub is_success {
my $self = shift;
my $latest_uri = $self->{request}->{uri};
return $latest_uri !~ qr{/internal_server_error$};
}
t/02_credentials_metadata.t view on Meta::CPAN
is $credentials->secret_access_key, 'DUMMY-SECRET-ACCESS-KEY';
is $credentials->session_token, 'DUMMY-TOKEN';
}
done_testing;
package MockUA;
sub new {
my $class = shift;
bless { requests => [], default_headers => {} }, $class;
}
sub get {
my ($self, $uri, %form) = @_;
$self->_request('GET', $uri, %form);
}
sub put {
my ($self, $uri, %form) = @_;
t/02_credentials_metadata.t view on Meta::CPAN
sub default_header {
my ($self, %headers) = @_;
$self->{default_headers}->{$_} = $headers{$_} for keys %headers;
}
package MockResponse;
sub new {
my ($class, $self) = @_;
bless $self, $class;
}
sub is_success { !!1; }
sub decoded_content {
my $self = shift;
my $latest_uri = $self->{request}->{uri};
if ($latest_uri =~ qr{/latest/api/token$}) {
t/03_request.t view on Meta::CPAN
is $req7->uri, "http://s3.ap-north-east-1.amazonaws.com/tmpfoobar/copied.txt";
is $req7->header("x-amz-copy-source"), "tmpfoobar/dir/private.txt";
is $req7->header("x-amz-acl"), "public-read";
done_testing;
package MockUA;
sub new {
my $class = shift;
bless {}, $class;
}
sub request {
my $self = shift;
my $request = shift;
return MockResponse->new({request =>$request});
}
package MockResponse;
sub new {
my ($class, $self) = @_;
bless $self, $class;
}
sub request {
my $self = shift;
return $self->{request};
}
sub code {
my $self = shift;
return 200;
t/04_request_v2.t view on Meta::CPAN
diag "test request with sigv2 and region specified";
is $req->method, "GET";
is $req->uri, "http://tmpfoobar.s3.amazonaws.com/dir/private.txt";
done_testing;
package MockUA;
sub new {
my $class = shift;
bless {}, $class;
}
sub request {
my $self = shift;
my $request = shift;
return MockResponse->new({request =>$request});
}
package MockResponse;
sub new {
my ($class, $self) = @_;
bless $self, $class;
}
sub request {
my $self = shift;
return $self->{request};
}
;
t/05_presigned_post.t view on Meta::CPAN
],
};
};
done_testing;
package MockUA;
sub new {
my $class = shift;
bless {}, $class;
}
sub request {
my $self = shift;
my $request = shift;
return MockResponse->new({request =>$request});
}
package MockResponse;
sub new {
my ($class, $self) = @_;
bless $self, $class;
}
sub request {
my $self = shift;
return $self->{request};
}
;
t/06_request_virtual_host.t view on Meta::CPAN
is $req7->uri, "http://tmpfoobar.s3.amazonaws.com/copied.txt";
is $req7->header("x-amz-copy-source"), "tmpfoobar/dir/private.txt";
is $req7->header("x-amz-acl"), "public-read";
done_testing;
package MockUA;
sub new {
my $class = shift;
bless {}, $class;
}
sub request {
my $self = shift;
my $request = shift;
return MockResponse->new({request =>$request});
}
package MockResponse;
sub new {
my ($class, $self) = @_;
bless $self, $class;
}
sub request {
my $self = shift;
return $self->{request};
}
sub code {
my $self = shift;
return 200;
t/07_copy_200_error.t view on Meta::CPAN
XML
my $res2 = $client->copy_object($bucket, $key, $bucket, "copied.txt");
is $res2->code, 500;
done_testing;
package MockUA;
sub new {
my $class = shift;
bless {}, $class;
}
sub request {
my $self = shift;
my $request = shift;
my $response = $self->response;
$response->request($request);
return $response;
}
t/07_copy_200_error.t view on Meta::CPAN
if (@_) {
$self->{response} = shift;
}
return $self->{response};
}
package MockResponse;
sub new {
my ($class) = @_;
bless {}, $class;
}
sub request {
my $self = shift;
if (@_) {
$self->{request} = shift;
}
return $self->{request};
}