Amazon-S3
view release on metacpan or search on metacpan
Fri Feb 10 07:47:22 2023 Rob Lauer <rlauer6@comcast.net>>
[0.60 - logging]:
* VERSION: bump
* NEWS.md: updated
* bootstrap: support M.rr style versions
* src/main/perl/lib/Amazon/S3.pm.in
- removed all end of block indicators inserted by perltidy
(new)
- only consider 'debug' flag when internal logger used
* src/main/perl/lib/Amazon/S3.pm.in
(new): new
* configure.ac
- fix email addres
- remove -Wall to prevent warning during configure
* s3-perl.pl: new
* src/main/perl/test.localstack: new
* .gitignore: added some of the files created by `make cpan`
Wed Jan 25 11:54:59 2023 Rob Lauer <rlauer6@comcast.net>
Tue Nov 29 10:39:43 2022 Rob Lauer <rlauer6@comcast.net>
[0.56 - minor bug, 0.55 issues #8]:
* buildspec.yml: files should be relative to project home
* VERSION: bump
* NEWS.md: updated
* README-TESTING.md: more documentation
* Makefile.am: rpm, not rpmbuild directory
* src/main/perl/Makefile.am: comments re: testing
* src/main/perl/t/04-list-buckets.t
- enable debug mode if $ENV{DEBUG}
- dump response if error
* src/main/perl/lib/Amazon/S3.pm.in
- pod tweaks
(new)
- set -key and -pass for legacy Crypt::CBC
(buckets): avoid return explicit undef
(list_bucket)
- remove undefined hash members from input
(_make_request)
- use URI to set path, host, port if domain bucket ame
(get_bucket_location): $bucket, not $self
(buckets)
- verify region option
- pass hash of options and region to _send_request
(add_bucket)
- do not add region constraint if us-east-1
- refactored, send region to _send_request_expect_nothing
(delete_bucket): likewise refactored
(list_bucket): likewise refactored
(_make_request): use region() method of signer
(_do_http): debug statements, set last_reponse, reset_errors
(_do_http_no_redirect): likewise
(_send_request_expect_nothing): likewise
(_send_request_expect_nothing_probed)
- accept hash argument
- debug statements
- croak if redirect, but no Location
(error): new
(reset_errors): new
(_remember_error): set error
* src/main/perl/lib/Amazon/S3/Bucket.pm.in
- pod tweaks, corrections
(new)
- + logger attribute
- + verify_region attribute, verify region if true
(_uri): remove leading '/'
(add_key): correct region if 301 response
(upload_multipart_object): debug messages
(upload_part_of_multipart_upload): likewise
(complete_multipart_upload): likewise
(get_key): remove redundant debug message
(delete_key): pass region to _send_request_expect_nothing
(set_acl): likewise
* src/main/perl/t/01-api.t: do not bailout on early tests
(error): new
(last_response): new
* src/main/perl/t/03-region.t: default region is us-east-1
Fri Jul 22 14:47:30 2022 Rob Lauer <rlauer6@comcast.net>
[0.55 - testing, revert to XML::Simple]:
(get_default_region): new
(get_aws_access_key_id): new
(get_aws_secret_access_key): new
(get_token): new
(_decrypt): new
(_encrypt): new
(signer)
- accesses _signer now
- set default region to caller's value or default
(buckets): set region to us-east-1 temporarily
(debug): new convenience method for level => 'debug'
(_make_request): allow disabling of domain buckets
* src/main/perl/lib/Amazon/S3/Bucket.pm.in: comment tweak
* src/main/perl/lib/Amazon/S3/Constant.pm.in: $DOT
* src/main/perl/t/01-api.t: set $dns_bucket_names to true?
* cpan/test-requires: +Test::Output
* cpan/requires: -Test::Output
* configure.ac
- ads_PERL_MODULE XML::LibXML::Simple, XML::LibXML, Test::Output
Wed Jul 13 13:09:04 2022 Rob Lauer <rlauer6@comcast.net>
my $bucket = $s3->bucket('my-bucket');
my $bucket_region = $bucket->region;
## get\_logger
Returns the logger object. If you did not set a logger when you
created the object then an instance of `Amazon::S3::Logger` is
returned. You can log to STDERR using this logger. For example:
$s3->get_logger->debug('this is a debug message');
$s3->get_logger->trace(sub { return Dumper([$response]) });
## list\_bucket\_all, list\_bucket\_all\_v2
List all keys in this bucket without having to worry about
'marker'. This is a convenience method, but may make multiple requests
to S3 under the hood.
Takes the same arguments as `list_bucket`.
To run the tests...clone the project and build the software.
cd src/main/perl
./test.localstack
# ADDITIONAL INFORMATION
## LOGGING AND DEBUGGING
Additional debugging information can be output to STDERR by setting
the `level` option when you instantiate the `Amazon::S3`
object. Levels are represented as a string. The valid levels are:
fatal
error
warn
info
debug
trace
You can set an optionally pass in a logger that implements a subset of
the `Log::Log4perl` interface. Your logger should support at least
these method calls. If you do not supply a logger the default logger
(`Amazon::S3::Logger`) will be used.
get_logger()
fatal()
error()
warn()
info()
debug()
trace()
level()
At the `trace` level, every HTTP request and response will be output
to STDERR. At the `debug` level information regarding the higher
level methods will be output to STDERR. There currently is no
additional information logged at lower levels.
## S3 LINKS OF INTEREST
- [Bucket restrictions and limitations](https://docs.aws.amazon.com/AmazonS3/latest/userguide/BucketRestrictions.html)
- [Bucket naming rules](https://docs.aws.amazon.com/AmazonS3/latest/userguide/bucketnamingrules.html)
- [Amazon S3 REST API](https://docs.aws.amazon.com/AmazonS3/latest/API/Welcome.html)
- [Authenticating Requests (AWS Signature Version 4)](https://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-authenticating-requests.html)
- [Authenticating Requests (AWS Signature Version 2)](https://docs.aws.amazon.com/AmazonS3/latest/userguide/RESTAuthentication.html)
lib/Amazon/S3.pm view on Meta::CPAN
$options{timeout} //= $DEFAULT_TIMEOUT;
$options{secure} //= $TRUE;
$options{host} //= $DEFAULT_HOST;
$options{dns_bucket_names} //= $TRUE;
$options{cache_signer} //= $FALSE;
$options{retry} //= $FALSE;
$options{_region} = delete $options{region};
$options{_signer} = delete $options{signer};
# convenience for level => 'debug' & for consistency with
# Amazon::Credentials only do this if we are using internal logger,
# call should NOT use debug flag but rather use their own logger's
# level to turn on higher levels of logging...
if ( !$options{logger} ) {
if ( delete $options{debug} ) {
$options{level} = 'debug';
}
$options{log_level} = delete $options{level};
$options{log_level} //= $DEFAULT_LOG_LEVEL;
$options{logger}
= Amazon::S3::Logger->new( log_level => $options{log_level} );
}
my $self = $class->SUPER::new( \%options );
# setup logger internal logging
$self->get_logger->debug(
sub {
my %safe_options = %options;
if ( $safe_options{aws_secret_access_key} ) {
$safe_options{aws_secret_access_key} = '****';
$safe_options{aws_access_key_id} = '****';
}
return Dumper( [ options => \%safe_options ] );
},
lib/Amazon/S3.pm view on Meta::CPAN
########################################################################
sub region {
########################################################################
my ( $self, @args ) = @_;
if (@args) {
$self->_region( $args[0] );
}
$self->get_logger->debug(
sub { return 'region: ' . ( $self->_region // $EMPTY ) } );
if ( $self->_region ) {
my $host = $self->host;
$self->get_logger->debug( sub { return 'host: ' . $self->host } );
if ( $host =~ /\As3[.](.*)?amazonaws/xsm ) {
$self->host( sprintf 's3.%s.amazonaws.com', $self->_region );
}
}
return $self->_region;
}
########################################################################
lib/Amazon/S3.pm view on Meta::CPAN
}
my $query_string = $QUESTION_MARK . join $AMPERSAND,
map { $_ . $EQUAL_SIGN . $self->_urlencode( $conf->{$_} ) }
keys %{$conf};
$path .= $query_string;
}
$self->get_logger->debug( sprintf 'PATH: %s', $path );
my $r = $self->_send_request(
{ method => 'GET',
path => $path,
headers => {}, # { 'Content-Length' => 0 },
region => $self->region,
},
);
$self->get_logger->trace(
lib/Amazon/S3.pm view on Meta::CPAN
};
die "could not a uri for bucket: $bucket, host: $host, path: $path\n"
if !$url || $EVAL_ERROR;
}
else {
$url = "$protocol://$bucket.$host$path$query_string";
}
}
$self->get_logger->debug( sprintf 'URL (uri): %s', $url );
my $request = HTTP::Request->new( $method, $url, $http_headers );
$self->last_request($request);
$request->content($data);
$self->signer->region($region); # always set regional endpoint for signing
$self->signer->sign($request);
lib/Amazon/S3.pm view on Meta::CPAN
else {
if ( ref $args[0] ) {
$keep_root = delete $args[0]->{keep_root};
}
$request = $self->_make_request(@args);
}
my $response = $self->_do_http($request);
$self->get_logger->debug( Dumper( [$response] ) );
$self->last_response($response);
my $content = $response->content;
if ( $response->code !~ /\A2\d\d\z/xsm ) {
$self->_remember_errors( $response->content, 1 );
$content = undef;
}
elsif ( $content && $response->content_type eq 'application/xml' ) {
lib/Amazon/S3.pm view on Meta::CPAN
$self->reset_errors;
my $response = $self->ua->request( $request, $filename );
# For new buckets at non-standard locations, amazon will sometimes
# respond with a temporary redirect. In this case it is necessary
# to try again with the new URL
if ( $response->code =~ /\A3/xsm and defined $response->header('Location') )
{
$self->get_logger->debug(
'Redirecting to: ' . $response->header('Location') );
$request->uri( $response->header('Location') );
$response = $self->ua->request( $request, $filename );
}
$self->get_logger->debug( Dumper( [$response] ) );
$self->last_response($response);
return $response;
}
# Call this if handling any temporary redirect issues
# (Like needing to probe with a HEAD request when file handle are involved)
########################################################################
sub _do_http_no_redirect {
########################################################################
my ( $self, $request, $filename ) = @_;
# convenient time to reset any error conditions
$self->reset_errors;
my $response = $self->ua->request( $request, $filename );
$self->get_logger->debug( Dumper( [$response] ) );
$self->last_response($response);
return $response;
}
########################################################################
sub _send_request_expect_nothing {
########################################################################
my ( $self, @args ) = @_;
my $request = $self->_make_request(@args);
my $response = $self->_do_http($request);
$self->get_logger->debug( Dumper( [$response] ) );
my $content = $response->content;
return $TRUE
if $response->code =~ /^2\d\d$/xsm;
# anything else is a failure, and we save the parsed result
$self->_remember_errors( $response->content, $TRUE );
return $FALSE;
lib/Amazon/S3.pm view on Meta::CPAN
my $response = $self->_do_http_no_redirect($request);
if ( $response->code =~ /^3/xsm ) {
if ( defined $response->header('Location') ) {
$override_uri = $response->header('Location');
}
else {
$self->_croak_if_response_error($response);
}
$self->get_logger->debug( 'setting override URI to ', $override_uri );
}
$request = $self->_make_request(
{ method => $method,
path => $path,
headers => $conf,
data => $value,
region => $region,
},
);
lib/Amazon/S3.pm view on Meta::CPAN
my $bucket = $s3->bucket('my-bucket');
my $bucket_region = $bucket->region;
=head2 get_logger
Returns the logger object. If you did not set a logger when you
created the object then an instance of C<Amazon::S3::Logger> is
returned. You can log to STDERR using this logger. For example:
$s3->get_logger->debug('this is a debug message');
$s3->get_logger->trace(sub { return Dumper([$response]) });
=head2 list_bucket_all, list_bucket_all_v2
List all keys in this bucket without having to worry about
'marker'. This is a convenience method, but may make multiple requests
to S3 under the hood.
Takes the same arguments as C<list_bucket>.
lib/Amazon/S3.pm view on Meta::CPAN
To run the tests...clone the project and build the software.
cd src/main/perl
./test.localstack
=head1 ADDITIONAL INFORMATION
=head2 LOGGING AND DEBUGGING
Additional debugging information can be output to STDERR by setting
the C<level> option when you instantiate the C<Amazon::S3>
object. Levels are represented as a string. The valid levels are:
fatal
error
warn
info
debug
trace
You can set an optionally pass in a logger that implements a subset of
the C<Log::Log4perl> interface. Your logger should support at least
these method calls. If you do not supply a logger the default logger
(C<Amazon::S3::Logger>) will be used.
get_logger()
fatal()
error()
warn()
info()
debug()
trace()
level()
At the C<trace> level, every HTTP request and response will be output
to STDERR. At the C<debug> level information regarding the higher
level methods will be output to STDERR. There currently is no
additional information logged at lower levels.
=head2 S3 LINKS OF INTEREST
=over 5
=item L<Bucket restrictions and limitations|https://docs.aws.amazon.com/AmazonS3/latest/userguide/BucketRestrictions.html>
=item L<Bucket naming rules|https://docs.aws.amazon.com/AmazonS3/latest/userguide/bucketnamingrules.html>
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
}
# now each bucket maintains its own region
if ( !$self->region && $self->verify_region ) {
my $region;
if ( !$self->account->err ) {
$region = $self->get_location_constraint() // 'us-east-1';
}
$self->logger->debug( sprintf "bucket: %s region: %s\n",
$self->bucket, ( $region // $EMPTY ) );
$self->region($region);
}
elsif ( !$self->region ) {
$self->region( $self->account->region );
}
return $self;
}
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
# Make sure length and md5 are set
my $md5 = md5($data);
my $md5_hex = unpack 'H*', $md5;
my $md5_base64 = encode_base64($md5);
$conf->{'Content-MD5'} = $md5_base64;
$conf->{'Content-Length'} = $length;
my $params = "?partNumber=${part_number}&uploadId=${upload_id}";
$self->logger->debug( 'uploading ' . sprintf 'part: %s length: %s',
$part_number, length $data );
my $request = $acct->_make_request(
{ region => $self->region,
method => 'PUT',
path => $self->_uri($key) . $params,
headers => $conf,
data => $data,
},
);
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
#
# Inform Amazon that the multipart upload has been completed
# You must supply a hash of part Numbers => eTags
# For amazon to use to put the file together on their servers.
#
########################################################################
sub complete_multipart_upload {
########################################################################
my ( $self, $key, $upload_id, $parts_hr ) = @_;
$self->logger->debug( Dumper( [ $key, $upload_id, $parts_hr ] ) );
croak 'Object key is required'
if !$key;
croak 'Upload id is required'
if !$upload_id;
croak 'Part number => etag hashref is required'
if ref $parts_hr ne 'HASH';
# The complete command requires sending a block of xml containing all
# the part numbers and their associated etags (returned from the upload)
# build XML doc
my $content = make_xml_document_simple($parts_hr);
$self->logger->debug("content: \n$content");
my $md5 = md5($content);
my $md5_base64 = encode_base64($md5);
chomp $md5_base64;
my $conf = {
'Content-MD5' => $md5_base64,
'Content-Length' => length $content,
'Content-Type' => 'application/xml',
};
lib/Amazon/S3/Bucket.pm view on Meta::CPAN
If no region is set and C<verify_region> is set to true, the region of
the bucket will be determined by calling the
C<get_location_constraint> method. Note that this will decrease
performance of the constructor. If you know the region or are
operating in only 1 region, set the region in the C<account> object
(C<Amazon::S3>).
=item logger
Sets the logger. The logger should be a blessed reference capable of
providing at least a C<debug> and C<trace> method for recording log
messages. If no logger object is passed the C<account> object's logger
object will be used.
=item verify_region
Indicates that the bucket's region should be determined by calling the
C<get_location_constraint> method.
default: false
lib/Amazon/S3/Constants.pm view on Meta::CPAN
Readonly our $DEFAULT_LOG_LEVEL => 'error';
Readonly our $MAX_DELETE_KEYS => 1000;
Readonly our $MAX_RETRIES => 5;
Readonly our $DEFAULT_REGION => 'us-east-1';
Readonly our $XMLDECL => '<?xml version="1.0" encoding="UTF-8"?>';
Readonly our $S3_XMLNS => 'http://s3.amazonaws.com/doc/2006-03-01/';
Readonly::Hash our %LOG_LEVELS => (
trace => 5,
debug => 4,
info => 3,
warn => 2,
error => 1,
fatal => 0,
);
Readonly::Hash our %LIST_OBJECT_MARKERS => (
'2' => [qw(ContinuationToken NextContinuationToken continuation-token)],
'1' => [qw(Marker NextMarker marker)],
);
lib/Amazon/S3/Logger.pm view on Meta::CPAN
use English qw{-no_match_vars};
use POSIX;
use Readonly;
use Scalar::Util qw{ reftype };
our $VERSION = '0.65'; ## no critic (RequireInterpolationOfMetachars)
Readonly::Hash our %LOG_LEVELS => (
trace => 5,
debug => 4,
info => 3,
warn => 2,
error => 1,
fatal => 0,
);
{
no strict 'refs'; ## no critic (ProhibitNoStrict)
foreach my $level (qw{fatal error warn info debug trace}) {
*{ __PACKAGE__ . $DOUBLE_COLON . $level } = sub {
my ( $self, @message ) = @_;
$self->_log_message( $level, @message );
};
}
}
########################################################################
sub new {
t/02-logger.t view on Meta::CPAN
use_ok('Amazon::S3');
########################################################################
sub test_levels {
########################################################################
my ($s3) = @_;
print {*STDERR} "\n---[" . $s3->level . "]---\n";
$s3->get_logger->trace("test trace\n");
$s3->get_logger->debug("test debug\n");
$s3->get_logger->info("test info\n");
$s3->get_logger->warn("test warn\n");
$s3->get_logger->error("test error\n");
$s3->get_logger->fatal("test fatal\n");
return;
} ## end sub test_levels
########################################################################
sub test_all_levels {
########################################################################
my ($s3) = @_;
$s3->level('trace');
stderr_like( sub { test_levels($s3); },
qr/trace\n.*debug\n.*info\n.*warn\n.*error\n.*fatal\n/xsm, 'trace' );
$s3->level('debug');
stderr_like( sub { test_levels($s3); },
qr/debug\n.*info\n.*warn\n.*error\n.*fatal\n/xsm, 'debug' );
stderr_unlike( sub { test_levels($s3); },
qr/trace/, 'debug - not like trace' );
$s3->level('info');
stderr_like( sub { test_levels($s3); },
qr/info\n.*warn\n.*error\n.*fatal\n/xsm, 'info' );
stderr_unlike( sub { test_levels($s3); },
qr/trace|debug/, 'info - not like trace, debug' );
$s3->level('warn');
stderr_like( sub { test_levels($s3); },
qr/warn\n.*error\n.*fatal\n/xsm, 'warn' );
stderr_unlike( sub { test_levels($s3); },
qr/trace|debug|info/, 'warn - not like trace, debug, info' );
$s3->level('error');
stderr_like( sub { test_levels($s3); }, qr/error\n.*fatal\n/xsm, 'error' );
stderr_unlike( sub { test_levels($s3); },
qr/trace|debug|info|warn/, 'error - not like trace, debug, info, warn' );
$s3->level('fatal');
stderr_like( sub { test_levels($s3); }, qr/fatal\n/xsm, 'fatal' );
stderr_unlike(
sub { test_levels($s3); },
qr/trace|debug|info|warn|error/,
'fatal - not like trace, debug, info, warn, error'
);
} ## end sub test_all_levels
########################################################################
my $s3 = Amazon::S3->new(
{ aws_access_key_id => 'test',
aws_secret_access_key => 'test',
}
t/03-region.t view on Meta::CPAN
use Test::More;
plan tests => 7;
use_ok('Amazon::S3');
my $s3 = Amazon::S3->new(
{ aws_access_key_id => 'test',
aws_secret_access_key => 'test',
log_level => $ENV{DEBUG} ? 'debug' : undef,
}
);
ok( $s3->region, 'us-east-1' );
is( $s3->host, 's3.us-east-1.amazonaws.com',
'default host is s3.us-east-1.amazonaws.com' );
$s3 = Amazon::S3->new(
{ aws_access_key_id => 'test',
aws_secret_access_key => 'test',
region => 'us-west-2',
log_level => $ENV{DEBUG} ? 'debug' : undef,
}
);
is( $s3->region, 'us-west-2', 'region is set' );
is( $s3->host, 's3.us-west-2.amazonaws.com',
'host is modified during creation' );
$s3->region('us-east-1');
( run in 0.663 second using v1.01-cache-2.11-cpan-49f99fa48dc )