Bug #37917 for Net-Amazon-S3: PATCH: Copy support

On Thu Jul 24 21:30:36 2008, BDONLAN wrote: Show quoted text
Sorry, generated the patch incorrectly. This one should work a bit better.

commit 19f83417558e83b060cada55772abe5261b43d2a Author: Bryan Donlan <bdonlan@fushizen.net> Date: Thu Jul 24 19:58:29 2008 -0400 Add support for S3 copy operations diff --git a/lib/Net/Amazon/S3/Bucket.pm b/lib/Net/Amazon/S3/Bucket.pm index 41158ae..fbe79f1 100644 --- a/lib/Net/Amazon/S3/Bucket.pm +++ b/lib/Net/Amazon/S3/Bucket.pm @@ -89,6 +89,20 @@ sub _uri { : $self->bucket . "/"; } +sub _conf_to_headers { + my ($self, $conf) = @_; + $conf = {} unless defined $conf; + $conf = { %$conf }; # clone it so as not to clobber the caller's copy + + if ( $conf->{acl_short} ) { + $self->account->_validate_acl_short( $conf->{acl_short} ); + $conf->{'x-amz-acl'} = $conf->{acl_short}; + delete $conf->{acl_short}; + } + + return $conf; +} + =head2 add_key Takes three positional parameters: @@ -113,12 +127,7 @@ Returns a boolean. sub add_key { my ( $self, $key, $value, $conf ) = @_; croak 'must specify key' unless $key && length $key; - - if ( $conf->{acl_short} ) { - $self->account->_validate_acl_short( $conf->{acl_short} ); - $conf->{'x-amz-acl'} = $conf->{acl_short}; - delete $conf->{acl_short}; - } + $conf = $self->_conf_to_headers($conf); if ( ref($value) eq 'SCALAR' ) { $conf->{'Content-Length'} ||= -s $$value; @@ -165,6 +174,80 @@ sub add_key_filename { return $self->add_key( $key, \$value, $conf ); } +=head2 copy_key + +Creates (or replaces) a key, copying its contents from another key elsewhere in S3. +Takes the following parameters: + +=over + +=item key + +The key to (over)write + +=item source + +Where to copy the key from. Should be in the form C</I<bucketname>/I<keyname>>/. + +=item conf + +Optional configuration hash. If present and defined, the configuration (ACL +and headers) there will be used for the new key; otherwise it will be copied +from the source key. + +=back + +=cut + +sub copy_key { + my ( $self, $key, $source, $conf ) = @_; + + if (defined $conf) { + $conf = $self->_conf_to_headers($conf); + $conf->{'x-amz-metadata-directive'} = 'REPLACE'; + } else { + $conf = {}; + } + + $conf->{'x-amz-copy-source'} = $source; + + my $acct = $self->account; + my $request = $acct->_make_request('PUT', $self->_uri($key), $conf); + my $response = $acct->_do_http($request); + + if (!$response->is_success) { + $acct->_remember_errors($response->content); + return 0; + } + + return 1; +} + +=head2 edit_metadata + +Changes the metadata associated with an existing key. Arguments: + +=over + +=item key + +The key to edit + +=item conf + +The new configuration hash to use + +=back + +=cut + +sub edit_metadata { + my ($self, $key, $conf) = @_; + croak "Need configuration hash" unless defined $conf; + + return $self->copy_key($key, "/".$self->bucket."/".$key, $conf); +} + =head2 head_key KEY Takes the name of a key in this bucket and returns its configuration hash diff --git a/t/01api.t b/t/01api.t index c2d58e1..12742bb 100644 --- a/t/01api.t +++ b/t/01api.t @@ -9,7 +9,7 @@ use Test::More; unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) { plan skip_all => 'Testing this module for real costs money.'; } else { - plan tests => 63 * 2 + 4; + plan tests => 67 * 2 + 4; } use_ok('Net::Amazon::S3'); @@ -178,6 +178,39 @@ for my $location ( undef, 'EU' ) { } + { + # Copy a key, keeping metadata + my $keyname2 = 'testing2.txt'; + + $bucket_obj->copy_key($keyname2, "/$bucketname/$keyname"); + + is_request_response_code( + "http://$bucketname.s3.amazonaws.com/$keyname2", + 403, "cannot access the private key"); + + # Overwrite, making publically readable + $bucket_obj->copy_key($keyname2, "/$bucketname/$keyname", { acl_short => 'public-read' }); + + sleep 1; + is_request_response_code( + "http://$bucketname.s3.amazonaws.com/$keyname2", + 200, "can access the publicly readable key" ); + + # Now copy it over itself, making it private + $bucket_obj->edit_metadata($keyname2, { short_acl => 'private' }); + + is_request_response_code( + "http://$bucketname.s3.amazonaws.com/$keyname2", + 403, "cannot access the private key"); + + # Get rid of it, bringing us back to only one key + $bucket_obj->delete_key($keyname2); + + # Expect a nonexistent key copy to fail + ok (!$bucket_obj->copy_key("newkey", "/$bucketname/$keyname2"), + "Copying a nonexistent key fails"); + } + # list keys in the bucket $response = $bucket_obj->list or die $s3->err . ": " . $s3->errstr;

Slight fix - need to detect <Error> even in a 200 response

diff --git a/lib/Net/Amazon/S3/Bucket.pm b/lib/Net/Amazon/S3/Bucket.pm index 41158ae..186270d 100644 --- a/lib/Net/Amazon/S3/Bucket.pm +++ b/lib/Net/Amazon/S3/Bucket.pm @@ -89,6 +89,20 @@ sub _uri { : $self->bucket . "/"; } +sub _conf_to_headers { + my ($self, $conf) = @_; + $conf = {} unless defined $conf; + $conf = { %$conf }; # clone it so as not to clobber the caller's copy + + if ( $conf->{acl_short} ) { + $self->account->_validate_acl_short( $conf->{acl_short} ); + $conf->{'x-amz-acl'} = $conf->{acl_short}; + delete $conf->{acl_short}; + } + + return $conf; +} + =head2 add_key Takes three positional parameters: @@ -113,12 +127,7 @@ Returns a boolean. sub add_key { my ( $self, $key, $value, $conf ) = @_; croak 'must specify key' unless $key && length $key; - - if ( $conf->{acl_short} ) { - $self->account->_validate_acl_short( $conf->{acl_short} ); - $conf->{'x-amz-acl'} = $conf->{acl_short}; - delete $conf->{acl_short}; - } + $conf = $self->_conf_to_headers($conf); if ( ref($value) eq 'SCALAR' ) { $conf->{'Content-Length'} ||= -s $$value; @@ -165,6 +174,81 @@ sub add_key_filename { return $self->add_key( $key, \$value, $conf ); } +=head2 copy_key + +Creates (or replaces) a key, copying its contents from another key elsewhere in S3. +Takes the following parameters: + +=over + +=item key + +The key to (over)write + +=item source + +Where to copy the key from. Should be in the form C</I<bucketname>/I<keyname>>/. + +=item conf + +Optional configuration hash. If present and defined, the configuration (ACL +and headers) there will be used for the new key; otherwise it will be copied +from the source key. + +=back + +=cut + +sub copy_key { + my ( $self, $key, $source, $conf ) = @_; + + if (defined $conf) { + $conf = $self->_conf_to_headers($conf); + $conf->{'x-amz-metadata-directive'} = 'REPLACE'; + } else { + $conf = {}; + } + + $conf->{'x-amz-copy-source'} = $source; + + my $acct = $self->account; + my $request = $acct->_make_request('PUT', $self->_uri($key), $conf); + my $response = $acct->_do_http($request); + my $xpc = $acct->_xpc_of_content($response->content); + + if (!$response->is_success || !$xpc || $xpc->findnodes("//Error")) { + $acct->_remember_errors($response->content); + return 0; + } + + return 1; +} + +=head2 edit_metadata + +Changes the metadata associated with an existing key. Arguments: + +=over + +=item key + +The key to edit + +=item conf + +The new configuration hash to use + +=back + +=cut + +sub edit_metadata { + my ($self, $key, $conf) = @_; + croak "Need configuration hash" unless defined $conf; + + return $self->copy_key($key, "/".$self->bucket."/".$key, $conf); +} + =head2 head_key KEY Takes the name of a key in this bucket and returns its configuration hash diff --git a/t/01api.t b/t/01api.t index c2d58e1..12742bb 100644 --- a/t/01api.t +++ b/t/01api.t @@ -9,7 +9,7 @@ use Test::More; unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) { plan skip_all => 'Testing this module for real costs money.'; } else { - plan tests => 63 * 2 + 4; + plan tests => 67 * 2 + 4; } use_ok('Net::Amazon::S3'); @@ -178,6 +178,39 @@ for my $location ( undef, 'EU' ) { } + { + # Copy a key, keeping metadata + my $keyname2 = 'testing2.txt'; + + $bucket_obj->copy_key($keyname2, "/$bucketname/$keyname"); + + is_request_response_code( + "http://$bucketname.s3.amazonaws.com/$keyname2", + 403, "cannot access the private key"); + + # Overwrite, making publically readable + $bucket_obj->copy_key($keyname2, "/$bucketname/$keyname", { acl_short => 'public-read' }); + + sleep 1; + is_request_response_code( + "http://$bucketname.s3.amazonaws.com/$keyname2", + 200, "can access the publicly readable key" ); + + # Now copy it over itself, making it private + $bucket_obj->edit_metadata($keyname2, { short_acl => 'private' }); + + is_request_response_code( + "http://$bucketname.s3.amazonaws.com/$keyname2", + 403, "cannot access the private key"); + + # Get rid of it, bringing us back to only one key + $bucket_obj->delete_key($keyname2); + + # Expect a nonexistent key copy to fail + ok (!$bucket_obj->copy_key("newkey", "/$bucketname/$keyname2"), + "Copying a nonexistent key fails"); + } + # list keys in the bucket $response = $bucket_obj->list or die $s3->err . ": " . $s3->errstr;