Amazon-S3-Thin

 view release on metacpan or  search on metacpan

eg/s3  view on Meta::CPAN



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

t/01_new.t  view on Meta::CPAN


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



( run in 1.137 second using v1.01-cache-2.11-cpan-b32c08c6d1a )