r6643 - in /trunk/libnet-amazon-s3-perl: CHANGES META.yml Makefile debian/changelog lib/Net/Amazon/S3.pm lib/Net/Amazon/S3/Bucket.pm t/01api.t
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Wed Aug 15 05:11:39 UTC 2007
Author: dmn
Date: Wed Aug 15 05:11:39 2007
New Revision: 6643
URL: http://svn.debian.org/wsvn/?sc=1&rev=6643
Log:
* New upstream release
Removed:
trunk/libnet-amazon-s3-perl/Makefile
Modified:
trunk/libnet-amazon-s3-perl/CHANGES
trunk/libnet-amazon-s3-perl/META.yml
trunk/libnet-amazon-s3-perl/debian/changelog
trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm
trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm
trunk/libnet-amazon-s3-perl/t/01api.t
Modified: trunk/libnet-amazon-s3-perl/CHANGES
URL: http://svn.debian.org/wsvn/trunk/libnet-amazon-s3-perl/CHANGES?rev=6643&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/CHANGES (original)
+++ trunk/libnet-amazon-s3-perl/CHANGES Wed Aug 15 05:11:39 2007
@@ -1,4 +1,14 @@
Revision history for Perl module Net::Amazon::S3:
+
+0.38 Sun Mar 4 16:43:28 GMT 2007
+ - use http_proxy and https_proxy environment variables for proxy
+ settings (Ask Bjoern Hansen)
+ - don't add the Authorization header if one is already specified
+ when making a request - good for allowing caching to resources
+ that are public. (Ask Bjoern Hansen)
+
+0.37 Fri Oct 13 19:14:57 BST 2006
+ - added support for ACLs (thanks to Gordon McCreight)
0.36 Sun Sep 10 16:30:39 BST 2006
- remove extra warning
Modified: trunk/libnet-amazon-s3-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libnet-amazon-s3-perl/META.yml?rev=6643&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/META.yml (original)
+++ trunk/libnet-amazon-s3-perl/META.yml Wed Aug 15 05:11:39 2007
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Net-Amazon-S3
-version: 0.36
+version: 0.38
author:
- Leon Brocard <acme at astray.com> and unknown Amazon Digital Services programmers.
- Brad Fitzpatrick <brad at danga.com> - return values, Bucket object
Modified: trunk/libnet-amazon-s3-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libnet-amazon-s3-perl/debian/changelog?rev=6643&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/debian/changelog (original)
+++ trunk/libnet-amazon-s3-perl/debian/changelog Wed Aug 15 05:11:39 2007
@@ -1,3 +1,9 @@
+libnet-amazon-s3-perl (0.38-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Damyan Ivanov <dmn at debian.org> Wed, 15 Aug 2007 08:11:39 +0300
+
libnet-amazon-s3-perl (0.36-2) UNRELEASED; urgency=low
[ Frank Lichtenheld ]
Modified: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm?rev=6643&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3.pm Wed Aug 15 05:11:39 2007
@@ -158,7 +158,7 @@
__PACKAGE__->mk_accessors(
qw(libxml aws_access_key_id aws_secret_access_key secure ua err errstr timeout)
);
-our $VERSION = '0.36';
+our $VERSION = '0.38';
my $AMAZON_HEADER_PREFIX = 'x-amz-';
my $METADATA_PREFIX = 'x-amz-meta-';
@@ -215,6 +215,7 @@
my $ua = LWP::UserAgent->new( keep_alive => $KEEP_ALIVE_CACHESIZE );
$ua->timeout( $self->timeout );
+ $ua->env_proxy;
$self->ua($ua);
$self->libxml( XML::LibXML->new );
return $self;
@@ -264,6 +265,10 @@
The name of the bucket you want to add
+=item acl_short (optional)
+
+See the set_acl subroutine for documenation on the acl_short options
+
=back
Returns 0 on failure, Net::Amazon::S3::Bucket object on success
@@ -274,7 +279,18 @@
my ( $self, $conf ) = @_;
my $bucket = $conf->{bucket};
croak 'must specify bucket' unless $bucket;
- return 0 unless $self->_send_request_expect_nothing( 'PUT', $bucket, {} );
+
+ if ($conf->{acl_short}){
+ $self->_validate_acl_short($conf->{acl_short});
+ }
+
+ my $header_ref = ($conf->{acl_short})
+ ? {'x-amz-acl' => $conf->{acl_short}}
+ : {};
+
+ return 0 unless $self->_send_request_expect_nothing( 'PUT', $bucket,
+ $header_ref );
+
return $self->bucket($bucket);
}
@@ -605,6 +621,15 @@
return $bucket->delete_key( $conf->{key} );
}
+sub _validate_acl_short {
+ my ( $self, $policy_name ) = @_;
+
+ if ( ! grep( { $policy_name eq $_ }
+ qw(private public-read public-read-write authenticated-read) ) ){
+ croak "$policy_name is not a supported canned access policy";
+ }
+}
+
# make the HTTP::Request object
sub _make_request {
my ( $self, $method, $path, $headers, $data, $metadata ) = @_;
@@ -616,7 +641,8 @@
my $http_headers = $self->_merge_meta( $headers, $metadata );
- $self->_add_auth_header( $http_headers, $method, $path );
+ $self->_add_auth_header( $http_headers, $method, $path )
+ unless exists $headers->{Authorization};
my $protocol = $self->secure ? 'https' : 'http';
my $url = "$protocol://s3.amazonaws.com/$path";
my $request = HTTP::Request->new( $method, $url, $http_headers );
@@ -671,6 +697,16 @@
# anything else is a failure, and we save the parsed result
$self->_remember_errors( $response->content );
return 0;
+}
+
+sub _croak_if_response_error {
+ my ( $self, $response ) = @_;
+ unless ( $response->code =~ /^2\d\d$/ ) {
+ $self->err("network_error");
+ $self->errstr( $response->status_line );
+ croak "Net::Amazon::S3: Amazon responded with "
+ . $response->status_line . "\n";
+ }
}
sub _xpc_of_content {
Modified: trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm
URL: http://svn.debian.org/wsvn/trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm?rev=6643&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm (original)
+++ trunk/libnet-amazon-s3-perl/lib/Net/Amazon/S3/Bucket.pm Wed Aug 15 05:11:39 2007
@@ -31,7 +31,10 @@
sub _uri {
my ( $self, $key ) = @_;
- return $self->bucket . "/" . $self->account->_urlencode($key);
+ return ($key)
+ ? $self->bucket . "/" . $self->account->_urlencode($key)
+ : $self->bucket
+ ;
}
=head2 add_key
@@ -59,6 +62,12 @@
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};
+ }
+
return $self->account->_send_request_expect_nothing( 'PUT',
$self->_uri($key), $conf, $value );
}
@@ -101,12 +110,7 @@
return undef;
}
- unless ( $response->code =~ /^2\d\d$/ ) {
- $acct->err("network_error");
- $acct->errstr( $response->status_line );
- croak "Net::Amazon::S3: Amazon responded with "
- . $response->status_line . "\n";
- }
+ $acct->_croak_if_response_error($response);
my $etag = $response->header('ETag');
if ($etag) {
@@ -192,6 +196,107 @@
return $self->account->list_bucket_all($conf);
}
+=head2 get_acl
+
+Takes one optional positional parameter
+
+=over
+
+=item key (optional)
+
+If no key is specified, it returns the acl for the bucket.
+
+=back
+
+Returns an acl in XML format.
+
+=cut
+
+sub get_acl {
+ my ( $self, $key ) = @_;
+ my $acct = $self->account;
+
+ my $request = $acct->_make_request( 'GET', $self->_uri($key) . '?acl', {} );
+ my $response = $acct->_do_http($request);
+
+ if ( $response->code == 404 ) {
+ return undef;
+ }
+
+ $acct->_croak_if_response_error($response);
+
+ return $response->content;
+}
+
+=head2 set_acl
+
+Takes a configuration hash_ref containing:
+
+=over
+
+=item acl_xml (cannot be used in conjuction with acl_short)
+
+An XML string which contains access control information which matches
+Amazon's published schema. There is an example of one of these XML strings
+in the tests for this module.
+
+=item acl_short (cannot be used in conjuction with acl_xml)
+
+You can use the shorthand notation instead of specifying XML for
+certain 'canned' types of acls.
+
+(from the Amazon API documentation)
+
+private: Owner gets FULL_CONTROL. No one else has any access rights.
+This is the default.
+
+public-read:Owner gets FULL_CONTROL and the anonymous principal is granted
+READ access. If this policy is used on an object, it can be read from a
+browser with no authentication.
+
+public-read-write:Owner gets FULL_CONTROL, the anonymous principal is
+granted READ and WRITE access. This is a useful policy to apply to a bucket,
+if you intend for any anonymous user to PUT objects into the bucket.
+
+authenticated-read:Owner gets FULL_CONTROL, and any principal authenticated
+as a registered Amazon S3 user is granted READ access.
+
+=item key (optional)
+
+If the key is not set, it will apply the acl to the bucket.
+
+=back
+
+Returns a boolean.
+
+=cut
+
+sub set_acl {
+ my ( $self, $conf ) = @_;
+ $conf ||= {};
+
+ unless ($conf->{acl_xml} || $conf->{acl_short}){
+ croak "need either acl_xml or acl_short";
+ }
+
+ if ($conf->{acl_xml} && $conf->{acl_short}){
+ croak "cannot provide both acl_xml and acl_short";
+ }
+
+ my $path = $self->_uri($conf->{key}) . '?acl';
+
+ my $hash_ref = ($conf->{acl_short})
+ ? { 'x-amz-acl' => $conf->{acl_short} }
+ : { }
+ ;
+
+ my $xml = $conf->{acl_xml} || '';
+
+ return $self->account->_send_request_expect_nothing( 'PUT',
+ $path, $hash_ref, $xml );
+
+}
+
# proxy up the err requests
=head2 err
Modified: trunk/libnet-amazon-s3-perl/t/01api.t
URL: http://svn.debian.org/wsvn/trunk/libnet-amazon-s3-perl/t/01api.t?rev=6643&op=diff
==============================================================================
--- trunk/libnet-amazon-s3-perl/t/01api.t (original)
+++ trunk/libnet-amazon-s3-perl/t/01api.t Wed Aug 15 05:11:39 2007
@@ -1,4 +1,5 @@
#!/usr/bin/perl -w
+
use warnings;
use strict;
use Test::More;
@@ -7,7 +8,7 @@
plan skip_all => 'Testing this module for real costs money.';
}
else {
- plan tests => 31;
+ plan tests => 51;
}
@@ -30,10 +31,11 @@
# list all buckets that i own
my $response = $s3->buckets;
+$OWNER_ID = $response->{owner_id};
+$OWNER_DISPLAYNAME = $response->{owner_displayname};
+
TODO: {
local $TODO = "These tests only work if you're leon";
- $OWNER_ID = $response->{owner_id};
- $OWNER_DISPLAYNAME = $response->{owner_displayname};
like( $response->{owner_id}, qr/^46a801915a1711f/ );
is( $response->{owner_displayname}, '_acme_' );
@@ -42,9 +44,14 @@
# create a bucket
my $bucketname = $aws_access_key_id . '-net-amazon-s3-test';
-my $bucket_obj = $s3->add_bucket( { bucket => $bucketname } )
+my $bucket_obj
+ = $s3->add_bucket( { bucket => $bucketname, acl_short => 'public-read' } )
or die $s3->err . ": " . $s3->errstr;
is( ref $bucket_obj, "Net::Amazon::S3::Bucket" );
+
+like_acl_allusers_read($bucket_obj);
+ok( $bucket_obj->set_acl( { acl_short => 'private' } ) );
+unlike_acl_allusers_read($bucket_obj);
# another way to get a bucket object (does no network I/O,
# assumes it already exists). Read Net::Amazon::S3::Bucket.
@@ -62,15 +69,96 @@
is( $response->{is_truncated}, 0 );
is_deeply( $response->{keys}, [] );
-# store a key with a content-type and some optional metadata
+is(undef, $bucket_obj->get_key("non-existing-key"));
+
my $keyname = 'testing.txt';
-my $value = 'T';
-$bucket_obj->add_key(
- $keyname, $value,
- { content_type => 'text/plain',
- 'x-amz-meta-colour' => 'orange',
- }
-);
+
+{
+ # Create a publicly readable key, then turn it private with a short acl.
+ # This key will persist past the end of the block.
+ my $value = 'T';
+ $bucket_obj->add_key(
+ $keyname, $value,
+ { content_type => 'text/plain',
+ 'x-amz-meta-colour' => 'orange',
+ acl_short => 'public-read',
+ }
+ );
+
+ is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
+ 200, "can access the publicly readable key" );
+
+ like_acl_allusers_read($bucket_obj, $keyname);
+
+ ok( $bucket_obj->set_acl(
+ { key => $keyname, acl_short => 'private' }
+ )
+ );
+
+ is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
+ 403, "cannot access the private key" );
+
+ unlike_acl_allusers_read($bucket_obj, $keyname);
+
+ ok( $bucket_obj->set_acl(
+ { key => $keyname,
+ acl_xml => acl_xml_from_acl_short('public-read')
+ }
+ )
+ );
+
+ is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
+ 200, "can access the publicly readable key after acl_xml set" );
+
+ like_acl_allusers_read($bucket_obj, $keyname);
+
+ ok( $bucket_obj->set_acl(
+ { key => $keyname,
+ acl_xml => acl_xml_from_acl_short('private')
+ }
+ )
+ );
+
+ is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname",
+ 403, "cannot access the private key after acl_xml set" );
+
+ unlike_acl_allusers_read($bucket_obj, $keyname);
+
+}
+
+{
+ # Create a private key, then make it publicly readable with a short
+ # acl. Delete it at the end so we're back to having a single key in
+ # the bucket.
+
+ my $keyname2 = 'testing2.txt';
+ my $value = 'T2';
+ $bucket_obj->add_key(
+ $keyname2, $value,
+ { content_type => 'text/plain',
+ 'x-amz-meta-colour' => 'blue',
+ acl_short => 'private',
+ }
+ );
+
+ is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname2",
+ 403, "cannot access the private key" );
+
+ unlike_acl_allusers_read($bucket_obj, $keyname2);
+
+ ok( $bucket_obj->set_acl(
+ { key => $keyname2, acl_short => 'public-read' }
+ )
+ );
+
+ is_request_response_code( "http://s3.amazonaws.com/$bucketname/$keyname2",
+ 200, "can access the publicly readable key" );
+
+ like_acl_allusers_read($bucket_obj, $keyname2);
+
+ $bucket_obj->delete_key($keyname2);
+
+}
# list keys in the bucket
$response = $bucket_obj->list
@@ -111,3 +199,68 @@
ok( $bucket_obj->delete_bucket() );
# see more docs in Net::Amazon::S3::Bucket
+
+# local test methods
+sub is_request_response_code {
+ my ($url, $code, $message) = @_;
+ my $request = HTTP::Request->new( 'GET', $url );
+ #warn $request->as_string();
+ my $response = $s3->ua->request($request);
+ is( $response->code, $code, $message );
+}
+
+sub like_acl_allusers_read {
+ my ($bucketobj, $keyname) = @_;
+ my $message = acl_allusers_read_message('like', @_);
+ like ($bucket_obj->get_acl($keyname) , qr(AllUsers.+READ), $message);
+}
+
+sub unlike_acl_allusers_read {
+ my ($bucketobj, $keyname) = @_;
+ my $message = acl_allusers_read_message('unlike', @_);
+ unlike ($bucket_obj->get_acl($keyname) , qr(AllUsers.+READ), $message);
+}
+
+sub acl_allusers_read_message {
+ my ($like_or_unlike, $bucketobj, $keyname) = @_;
+ my $message = $like_or_unlike ."_acl_allusers_read: "
+ . $bucketobj->bucket;
+ $message .= " - $keyname" if $keyname;
+ return $message;
+}
+
+sub acl_xml_from_acl_short {
+ my $acl_short = shift || 'private';
+
+ my $public_read = '';
+ if ($acl_short eq 'public-read'){
+ $public_read = qq~
+ <Grant>
+ <Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xsi:type="Group">
+ <URI>http://acs.amazonaws.com/groups/global/AllUsers</URI>
+ </Grantee>
+ <Permission>READ</Permission>
+ </Grant>
+ ~;
+ }
+
+ return qq~<?xml version="1.0" encoding="UTF-8"?>
+ <AccessControlPolicy xmlns="http://s3.amazonaws.com/doc/2006-03-01/">
+ <Owner>
+ <ID>$OWNER_ID</ID>
+ <DisplayName>$OWNER_DISPLAYNAME</DisplayName>
+ </Owner>
+ <AccessControlList>
+ <Grant>
+ <Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
+ xsi:type="CanonicalUser">
+ <ID>$OWNER_ID</ID>
+ <DisplayName>$OWNER_DISPLAYNAME</DisplayName>
+ </Grantee>
+ <Permission>FULL_CONTROL</Permission>
+ </Grant>
+ $public_read
+ </AccessControlList>
+ </AccessControlPolicy>~;
+}
More information about the Pkg-perl-cvs-commits
mailing list