## @file
# (Enter your file info here)
#
# $Id: S3.pm 432 2008-05-02 19:17:09Z damjan $
# sample usage:
# my $response;
# my $s3 = RWDE::DB::S3->new($AWS_ACCESS_KEY_ID, $AWS_SECRET_ACCESS_KEY);
# $response = $s3->createBucket($BUCKET_NAME);
# $response = $s3->putObject($BUCKET_NAME, $KEY_NAME, 'text/plain', 'file data string');
# $response = $s3->getObject($BUCKET_NAME, $KEY_NAME);
# print "response: -".$response->content."-\n";
# $response = $s3->deleteObject($BUCKET_NAME, $KEY_NAME);
# $response = $s3->deleteBucket($BUCKET_NAME);
## @class RWDE::DB::S3
# (Enter RWDE::DB::S3 info here)
package RWDE::DB::S3;
use strict;
use warnings;
use Error qw(:try);
use RWDE::Exceptions;
use Data::Dumper;
use LWP::UserAgent;
use Digest::HMAC_SHA1;
use HTTP::Date;
use MIME::Base64 qw(encode_base64);
use RWDE::Configuration;
## @cmethod object new()
# (Enter new info here)
# @return (Enter explanation for return value here)
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
$self->{AWS_ACCESS_KEY_ID} = RWDE::Configuration->AccessKeyID;
$self->{AWS_SECRET_ACCESS_KEY} = RWDE::Configuration->SecretAccessKey;
$self->{AGENT} = LWP::UserAgent->new();
bless($self, $class);
return $self;
}
## @method object setACL()
# (Enter setACL info here)
# @return (Enter explanation for return value here)
sub setACL {
my ($self, $bucketName, $keyName, $acl) = @_;
my $xml_acl = ''; #replace with xml data string
return $self->_create_message('PUT', "$bucketName/$keyName?acl", {}, $xml_acl);
}
## @method object listBucket()
# (Enter listBucket info here)
# @return (Enter explanation for return value here)
sub listBucket {
my ($self, $bucketName) = @_;
#options can be added to the path here, $bucketName?...
return $self->_create_message('GET', $bucketName);
}
## @method object createBucket()
# (Enter createBucket info here)
# @return (Enter explanation for return value here)
sub createBucket {
my ($self, $bucketName) = @_;
return $self->_create_message('PUT', $bucketName);
}
## @method object deleteBucket()
# (Enter deleteBucket info here)
# @return (Enter explanation for return value here)
sub deleteBucket {
my ($self, $bucketName) = @_;
return $self->_create_message('DELETE', $bucketName);
}
## @method object putObject()
# (Enter putObject info here)
# @return (Enter explanation for return value here)
sub putObject {
my ($self, $bucketName, $keyName, $contentType, $data, $acl) = @_;
$acl ||= 'public-read';
return $self->_create_message('PUT', "$bucketName/$keyName", { "Content-Type" => $contentType }, $data, $acl);
}
## @method object getObject()
# (Enter getObject info here)
# @return (Enter explanation for return value here)
sub getObject {
my ($self, $bucketName, $keyName) = @_;
return $self->_create_message('GET', "$bucketName/$keyName");
}
## @method object deleteObject()
# (Enter deleteObject info here)
# @return (Enter explanation for return value here)
sub deleteObject {
my ($self, $bucketName, $keyName) = @_;
return $self->_create_message('DELETE', "$bucketName/$keyName");
}
## @method protected object _create_message()
# (Enter _create_message info here)
# @return (Enter explanation for return value here)
sub _create_message {
my ($self, $method, $path, $headers, $data, $acl) = @_;
$headers ||= {};
$data ||= '';
# $acl ||= 'public-read';
# add any headers we were given to our header object
my $http_header = HTTP::Headers->new;
while (my ($k, $v) = each %$headers) {
$http_header->header($k => $v);
}
# header must have a date, add if it we don't have one yet
if (not $http_header->header('Date')) {
$http_header->header(Date => time2str(time));
}
#Make the objects readable
if(defined($acl)) {
$http_header->header('x-amz-acl' => $acl);
}
# add content length header
if (length($data) > 0) {
$http_header->header('content-length' => length($data));
}
# hash our request with our secret access key so amazon knows we're legit
my $canonical_string = canonical_string($method, $path, $http_header);
my $hmac = Digest::HMAC_SHA1->new($self->{AWS_SECRET_ACCESS_KEY});
$hmac->add($canonical_string);
my $signature = encode_base64($hmac->digest, '');
$http_header->header(Authorization => "AWS $self->{AWS_ACCESS_KEY_ID}:$signature");
# create the actual request
my $url = "https://s3.amazonaws.com:443/$path";
my $request = HTTP::Request->new($method, $url, $http_header);
$request->content($data);
# adios, bon voyage
my $response = $self->{AGENT}->request($request);
throw RWDE::DataBadException({ info => $response->content }) unless $response->is_success;
return $response;
}
## @method object trim()
# (Enter trim info here)
# @return (Enter explanation for return value here)
sub trim {
my ($value) = @_;
$value =~ s/^\s+//;
$value =~ s/\s+$//;
return $value;
}
## @method object canonical_string()
# (Enter canonical_string info here)
# @return (Enter explanation for return value here)
sub canonical_string {
my ($method, $path, $headers, $expires) = @_;
my %interesting_headers = ();
while (my ($key, $value) = each %$headers) {
my $lk = lc $key;
if ( $lk eq 'content-md5'
or $lk eq 'content-type'
or $lk eq 'date'
or $lk =~ /^x-amz-/) {
$interesting_headers{$lk} = trim($value);
}
}
# these keys get empty strings if they don't exist
$interesting_headers{'content-type'} ||= '';
$interesting_headers{'content-md5'} ||= '';
# just in case someone used this. it's not necessary in this lib.
$interesting_headers{'date'} = '' if $interesting_headers{'x-amz-date'};
# if you're using expires for query string auth, then it trumps date
# (and x-amz-date)
$interesting_headers{'date'} = $expires if $expires;
my $buf = "$method\n";
foreach my $key (sort keys %interesting_headers) {
if ($key =~ /^x-amz-/) {
$buf .= "$key:$interesting_headers{$key}\n";
}
else {
$buf .= "$interesting_headers{$key}\n";
}
}
# don't include anything after the first ? in the resource...
$path =~ /^([^?]*)/;
$buf .= "/$1";
# ...unless there is an acl or torrent parameter
if ($path =~ /[&?]acl($|=|&)/) {
$buf .= '?acl';
}
elsif ($path =~ /[&?]torrent($|=|&)/) {
$buf .= '?torrent';
}
elsif ($path =~ /[&?]logging($|=|&)/) {
$buf .= '?logging';
}
return $buf;
}
1;