diff options
Diffstat (limited to 'Bugzilla')
| -rw-r--r-- | Bugzilla/Attachment.pm | 4 | ||||
| -rw-r--r-- | Bugzilla/Attachment/S3.pm | 56 | ||||
| -rw-r--r-- | Bugzilla/Config/Attachment.pm | 104 | ||||
| -rw-r--r-- | Bugzilla/Install/Requirements.pm | 16 | ||||
| -rw-r--r-- | Bugzilla/S3.pm | 538 | ||||
| -rw-r--r-- | Bugzilla/S3/Bucket.pm | 433 |
6 files changed, 1118 insertions, 33 deletions
diff --git a/Bugzilla/Attachment.pm b/Bugzilla/Attachment.pm index c3e48b899..0cdec6bf0 100644 --- a/Bugzilla/Attachment.pm +++ b/Bugzilla/Attachment.pm @@ -908,6 +908,10 @@ sub get_storage_by_name { require Bugzilla::Attachment::FileSystem; return Bugzilla::Attachment::FileSystem->new(); } + elsif ($name eq 's3') { + require Bugzilla::Attachment::S3; + return Bugzilla::Attachment::S3->new(); + } else { return undef; } diff --git a/Bugzilla/Attachment/S3.pm b/Bugzilla/Attachment/S3.pm new file mode 100644 index 000000000..6d11f423e --- /dev/null +++ b/Bugzilla/Attachment/S3.pm @@ -0,0 +1,56 @@ +# This Source Code Form is subject to the terms of the Mozilla Public +# License, v. 2.0. If a copy of the MPL was not distributed with this +# file, You can obtain one at http://mozilla.org/MPL/2.0/. +# +# This Source Code Form is "Incompatible With Secondary Licenses", as +# defined by the Mozilla Public License, v. 2.0. + +package Bugzilla::Attachment::S3; +use strict; +use warnings; + +use Bugzilla::Error; +use Bugzilla::S3; + +sub new { + my $s3 = Bugzilla::S3->new({ + aws_access_key_id => Bugzilla->params->{aws_access_key_id}, + aws_secret_access_key => Bugzilla->params->{aws_secret_access_key}, + secure => 1, + }); + return bless({ + s3 => $s3, + bucket => $s3->bucket(Bugzilla->params->{s3_bucket}), + }, shift); +} + +sub store { + my ($self, $attach_id, $data) = @_; + unless ($self->{bucket}->add_key($attach_id, $data)) { + warn "Failed to add attachment $attach_id to S3: " . $self->{bucket}->errstr . "\n"; + ThrowCodeError('s3_add_failed', { attach_id => $attach_id, reason => $self->{bucket}->errstr }); + } +} + +sub retrieve { + my ($self, $attach_id) = @_; + my $response = $self->{bucket}->get_key($attach_id); + if (!$response) { + warn "Failed to retrieve attachment $attach_id from S3: " . $self->{bucket}->errstr . "\n"; + ThrowCodeError('s3_get_failed', { attach_id => $attach_id, reason => $self->{bucket}->errstr }); + } + return $response->{value}; +} + +sub remove { + my ($self, $attach_id) = @_; + $self->{bucket}->delete_key($attach_id) + or warn "Failed to remove attachment $attach_id from S3: " . $self->{bucket}->errstr . "\n"; +} + +sub exists { + my ($self, $attach_id) = @_; + return !!$self->{bucket}->head_key($attach_id); +} + +1; diff --git a/Bugzilla/Config/Attachment.pm b/Bugzilla/Config/Attachment.pm index cf87f4c89..20cde0b01 100644 --- a/Bugzilla/Config/Attachment.pm +++ b/Bugzilla/Config/Attachment.pm @@ -38,42 +38,82 @@ use Bugzilla::Config::Common; our $sortkey = 400; sub get_param_list { - my $class = shift; - my @param_list = ( - { - name => 'allow_attachment_display', - type => 'b', - default => 0 - }, + my $class = shift; + my @param_list = ( + { + name => 'allow_attachment_display', + type => 'b', + default => 0 + }, + { + name => 'attachment_base', + type => 't', + default => '', + checker => \&check_urlbase + }, + { + name => 'allow_attachment_deletion', + type => 'b', + default => 0 + }, + { + name => 'maxattachmentsize', + type => 't', + default => '1000', + checker => \&check_maxattachmentsize + }, + { + name => 'attachment_storage', + type => 's', + choices => ['database', 'filesystem', 's3'], + default => 'database', + checker => \&check_storage + }, + { + name => 's3_bucket', + type => 't', + default => '', + }, + { + name => 'aws_access_key_id', + type => 't', + default => '', + }, + { + name => 'aws_secret_access_key', + type => 't', + default => '', + }, + ); + return @param_list; +} - { - name => 'attachment_base', - type => 't', - default => '', - checker => \&check_urlbase - }, +sub check_params { + my ($class, $params) = @_; + return unless $params->{attachment_storage} eq 's3'; - { - name => 'allow_attachment_deletion', - type => 'b', - default => 0 - }, + if ($params->{s3_bucket} eq '' + || $params->{aws_access_key_id} eq '' + || $params->{aws_secret_access_key} eq '' + ) { + return "You must set s3_bucket, aws_access_key_id, and aws_secret_access_key when attachment_storage is set to S3"; + } + return ''; +} - { - name => 'maxattachmentsize', - type => 't', - default => '1000', - checker => \&check_maxattachmentsize - }, +sub check_storage { + my ($value, $param) = (@_); + my $check_multi = check_multi($value, $param); + return $check_multi if $check_multi; - { - name => 'attachment_storage', - type => 's', - choices => ['database', 'filesystem'], - default => 'database', - checker => \&check_multi - } ); - return @param_list; + if ($value eq 's3') { + return Bugzilla->feature('s3') + ? '' + : 'The perl modules required for S3 support are not installed'; + } + else { + return ''; + } } 1; diff --git a/Bugzilla/Install/Requirements.pm b/Bugzilla/Install/Requirements.pm index 71c01b9be..4b3e8aa76 100644 --- a/Bugzilla/Install/Requirements.pm +++ b/Bugzilla/Install/Requirements.pm @@ -332,6 +332,20 @@ sub OPTIONAL_MODULES { feature => ['detect_charset'], }, + # S3 attachments + { + package => 'Class-Accessor-Fast', + module => 'Class::Accessor::Fast', + version => 0, + feature => ['s3'], + }, + { + package => 'XML-Simple', + module => 'XML::Simple', + version => 0, + feature => ['s3'], + }, + # Inbound Email { package => 'Email-MIME-Attachment-Stripper', @@ -381,7 +395,7 @@ sub OPTIONAL_MODULES { package => 'URI-Escape', module => 'URI::Escape', version => 0, - feature => ['memcached'], + feature => ['memcached', 's3'], }, { package => 'Cache-Memcached', diff --git a/Bugzilla/S3.pm b/Bugzilla/S3.pm new file mode 100644 index 000000000..eb30816a4 --- /dev/null +++ b/Bugzilla/S3.pm @@ -0,0 +1,538 @@ +package Bugzilla::S3; + +# Forked from Amazon::S3, which appears to be abandoned. +# +# changes for Bugzilla: +# - fixed error handling +# (https://rt.cpan.org/Ticket/Display.html?id=93033) +# - made LWP::UserAgent::Determined optional +# (https://rt.cpan.org/Ticket/Display.html?id=76471) +# - replaced croaking with returning undef in Bucket->get_key and Bucket->get_acl +# (https://rt.cpan.org/Public/Bug/Display.html?id=40281) +# - default to secure (https) connections to AWS +# + +use strict; +use warnings; + +use Bugzilla::S3::Bucket; +use Bugzilla::Util qw(trim); +use Carp; +use Digest::HMAC_SHA1; +use HTTP::Date; +use LWP::UserAgent; +use MIME::Base64 qw(encode_base64); +use URI::Escape qw(uri_escape_utf8); +use XML::Simple; + +use base qw(Class::Accessor::Fast); +__PACKAGE__->mk_accessors( + qw(aws_access_key_id aws_secret_access_key secure ua err errstr timeout retry host) +); +our $VERSION = '0.45bmo'; + +my $AMAZON_HEADER_PREFIX = 'x-amz-'; +my $METADATA_PREFIX = 'x-amz-meta-'; +my $KEEP_ALIVE_CACHESIZE = 10; + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + + die "No aws_access_key_id" unless $self->aws_access_key_id; + die "No aws_secret_access_key" unless $self->aws_secret_access_key; + + $self->secure(1) if not defined $self->secure; + $self->timeout(30) if not defined $self->timeout; + $self->host('s3.amazonaws.com') if not defined $self->host; + + my $ua; + if ($self->retry) { + require LWP::UserAgent::Determined; + $ua = LWP::UserAgent::Determined->new( + keep_alive => $KEEP_ALIVE_CACHESIZE, + requests_redirectable => [qw(GET HEAD DELETE PUT)], + ); + $ua->timing('1,2,4,8,16,32'); + } + else { + $ua = LWP::UserAgent->new( + keep_alive => $KEEP_ALIVE_CACHESIZE, + requests_redirectable => [qw(GET HEAD DELETE PUT)], + ); + } + + $ua->timeout($self->timeout); + if (my $proxy = Bugzilla->params->{proxy_url}) { + $ua->proxy([ 'https', 'http' ], $proxy); + } + $self->ua($ua); + return $self; +} + +sub bucket { + my ($self, $bucketname) = @_; + return Bugzilla::S3::Bucket->new({bucket => $bucketname, account => $self}); +} + +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"; + } +} + +# EU buckets must be accessed via their DNS name. This routine figures out if +# a given bucket name can be safely used as a DNS name. +sub _is_dns_bucket { + my $bucketname = $_[0]; + + if (length $bucketname > 63) { + return 0; + } + if (length $bucketname < 3) { + return; + } + return 0 unless $bucketname =~ m{^[a-z0-9][a-z0-9.-]+$}; + my @components = split /\./, $bucketname; + for my $c (@components) { + return 0 if $c =~ m{^-}; + return 0 if $c =~ m{-$}; + return 0 if $c eq ''; + } + return 1; +} + +# make the HTTP::Request object +sub _make_request { + my ($self, $method, $path, $headers, $data, $metadata) = @_; + croak 'must specify method' unless $method; + croak 'must specify path' unless defined $path; + $headers ||= {}; + $data = '' if not defined $data; + $metadata ||= {}; + my $http_headers = $self->_merge_meta($headers, $metadata); + + $self->_add_auth_header($http_headers, $method, $path) + unless exists $headers->{Authorization}; + my $protocol = $self->secure ? 'https' : 'http'; + my $host = $self->host; + my $url = "$protocol://$host/$path"; + if ($path =~ m{^([^/?]+)(.*)} && _is_dns_bucket($1)) { + $url = "$protocol://$1.$host$2"; + } + + my $request = HTTP::Request->new($method, $url, $http_headers); + $request->content($data); + + # my $req_as = $request->as_string; + # $req_as =~ s/[^\n\r\x20-\x7f]/?/g; + # $req_as = substr( $req_as, 0, 1024 ) . "\n\n"; + # warn $req_as; + + return $request; +} + +# $self->_send_request($HTTP::Request) +# $self->_send_request(@params_to_make_request) +sub _send_request { + my $self = shift; + my $request; + if (@_ == 1) { + $request = shift; + } + else { + $request = $self->_make_request(@_); + } + + my $response = $self->_do_http($request); + my $content = $response->content; + + return $content unless $response->content_type eq 'application/xml'; + return unless $content; + return $self->_xpc_of_content($content); +} + +# centralize all HTTP work, for debugging +sub _do_http { + my ($self, $request, $filename) = @_; + + # convenient time to reset any error conditions + $self->err(undef); + $self->errstr(undef); + return $self->ua->request($request, $filename); +} + +sub _send_request_expect_nothing { + my $self = shift; + my $request = $self->_make_request(@_); + + my $response = $self->_do_http($request); + my $content = $response->content; + + return 1 if $response->code =~ /^2\d\d$/; + + # anything else is a failure, and we save the parsed result + $self->_remember_errors($response->content); + return 0; +} + +# Send a HEAD request first, to find out if we'll be hit with a 307 redirect. +# Since currently LWP does not have true support for 100 Continue, it simply +# slams the PUT body into the socket without waiting for any possible redirect. +# Thus when we're reading from a filehandle, when LWP goes to reissue the request +# having followed the redirect, the filehandle's already been closed from the +# first time we used it. Thus, we need to probe first to find out what's going on, +# before we start sending any actual data. +sub _send_request_expect_nothing_probed { + my $self = shift; + my ($method, $path, $conf, $value) = @_; + my $request = $self->_make_request('HEAD', $path); + my $override_uri = undef; + + my $old_redirectable = $self->ua->requests_redirectable; + $self->ua->requests_redirectable([]); + + my $response = $self->_do_http($request); + + if ($response->code =~ /^3/ && defined $response->header('Location')) { + $override_uri = $response->header('Location'); + } + $request = $self->_make_request(@_); + $request->uri($override_uri) if defined $override_uri; + + $response = $self->_do_http($request); + $self->ua->requests_redirectable($old_redirectable); + + my $content = $response->content; + + return 1 if $response->code =~ /^2\d\d$/; + + # anything else is a failure, and we save the parsed result + $self->_remember_errors($response->content); + return 0; +} + +sub _check_response { + my ($self, $response) = @_; + return 1 if $response->code =~ /^2\d\d$/; + $self->err("network_error"); + $self->errstr($response->status_line); + $self->_remember_errors($response->content); + return undef; +} + +sub _croak_if_response_error { + my ($self, $response) = @_; + unless ($response->code =~ /^2\d\d$/) { + $self->err("network_error"); + $self->errstr($response->status_line); + croak "Bugzilla::S3: Amazon responded with " + . $response->status_line . "\n"; + } +} + +sub _xpc_of_content { + return XMLin($_[1], 'KeepRoot' => 1, 'SuppressEmpty' => '', 'ForceArray' => ['Contents']); +} + +# returns 1 if errors were found +sub _remember_errors { + my ($self, $src) = @_; + + unless (ref $src || $src =~ m/^[[:space:]]*</) { # if not xml + (my $code = $src) =~ s/^[[:space:]]*\([0-9]*\).*$/$1/; + $self->err($code); + $self->errstr($src); + return 1; + } + + my $r = ref $src ? $src : $self->_xpc_of_content($src); + + if ($r->{Error}) { + $self->err($r->{Error}{Code}); + $self->errstr($r->{Error}{Message}); + return 1; + } + return 0; +} + +sub _add_auth_header { + my ($self, $headers, $method, $path) = @_; + my $aws_access_key_id = $self->aws_access_key_id; + my $aws_secret_access_key = $self->aws_secret_access_key; + + if (not $headers->header('Date')) { + $headers->header(Date => time2str(time)); + } + my $canonical_string = $self->_canonical_string($method, $path, $headers); + my $encoded_canonical = + $self->_encode($aws_secret_access_key, $canonical_string); + $headers->header( + Authorization => "AWS $aws_access_key_id:$encoded_canonical"); +} + +# generates an HTTP::Headers objects given one hash that represents http +# headers to set and another hash that represents an object's metadata. +sub _merge_meta { + my ($self, $headers, $metadata) = @_; + $headers ||= {}; + $metadata ||= {}; + + my $http_header = HTTP::Headers->new; + while (my ($k, $v) = each %$headers) { + $http_header->header($k => $v); + } + while (my ($k, $v) = each %$metadata) { + $http_header->header("$METADATA_PREFIX$k" => $v); + } + + return $http_header; +} + +# generate a canonical string for the given parameters. expires is optional and is +# only used by query string authentication. +sub _canonical_string { + my ($self, $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 =~ /^$AMAZON_HEADER_PREFIX/) + { + $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 =~ /^$AMAZON_HEADER_PREFIX/) { + $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 =~ /[&?]location($|=|&)/) { + $buf .= '?location'; + } + + return $buf; +} + +# finds the hmac-sha1 hash of the canonical string and the aws secret access key and then +# base64 encodes the result (optionally urlencoding after that). +sub _encode { + my ($self, $aws_secret_access_key, $str, $urlencode) = @_; + my $hmac = Digest::HMAC_SHA1->new($aws_secret_access_key); + $hmac->add($str); + my $b64 = encode_base64($hmac->digest, ''); + if ($urlencode) { + return $self->_urlencode($b64); + } + else { + return $b64; + } +} + +sub _urlencode { + my ($self, $unencoded) = @_; + return uri_escape_utf8($unencoded, '^A-Za-z0-9_-'); +} + +1; + +__END__ + +=head1 NAME + +Bugzilla::S3 - A portable client library for working with and +managing Amazon S3 buckets and keys. + +=head1 DESCRIPTION + +Bugzilla::S3 provides a portable client interface to Amazon Simple +Storage System (S3). + +This need for this module arose from some work that needed +to work with S3 and would be distributed, installed and used +on many various environments where compiled dependencies may +not be an option. L<Net::Amazon::S3> used L<XML::LibXML> +tying it to that specific and often difficult to install +option. In order to remove this potential barrier to entry, +this module is forked and then modified to use L<XML::SAX> +via L<XML::Simple>. + +Bugzilla::S3 is intended to be a drop-in replacement for +L<Net:Amazon::S3> that trades some performance in return for +portability. + +=head1 METHODS + +=head2 new + +Create a new S3 client object. Takes some arguments: + +=over + +=item aws_access_key_id + +Use your Access Key ID as the value of the AWSAccessKeyId parameter +in requests you send to Amazon Web Services (when required). Your +Access Key ID identifies you as the party responsible for the +request. + +=item aws_secret_access_key + +Since your Access Key ID is not encrypted in requests to AWS, it +could be discovered and used by anyone. Services that are not free +require you to provide additional information, a request signature, +to verify that a request containing your unique Access Key ID could +only have come from you. + +B<DO NOT INCLUDE THIS IN SCRIPTS OR APPLICATIONS YOU +DISTRIBUTE. YOU'LL BE SORRY.> + +=item secure + +Set this to C<0> if you not want to use SSL-encrypted +connections when talking to S3. Defaults to C<1>. + +=item timeout + +Defines the time, in seconds, your script should wait or a +response before bailing. Defaults is 30 seconds. + +=item retry + +Enables or disables the library to retry upon errors. This +uses exponential backoff with retries after 1, 2, 4, 8, 16, +32 seconds, as recommended by Amazon. Defaults to off, no +retries. + +=item host + +Defines the S3 host endpoint to use. Defaults to +'s3.amazonaws.com'. + +=back + +=head1 ABOUT + +This module contains code modified from Amazon that contains the +following notice: + + # This software code is made available "AS IS" without warranties of any + # kind. You may copy, display, modify and redistribute the software + # code either by itself or as incorporated into your code; provided that + # you do not remove any proprietary notices. Your use of this software + # code is at your own risk and you waive any claim against Amazon + # Digital Services, Inc. or its affiliates with respect to your use of + # this software code. (c) 2006 Amazon Digital Services, Inc. or its + # affiliates. + +=head1 TESTING + +Testing S3 is a tricky thing. Amazon wants to charge you a bit of +money each time you use their service. And yes, testing counts as using. +Because of this, the application's test suite skips anything approaching +a real test unless you set these three environment variables: + +=over + +=item AMAZON_S3_EXPENSIVE_TESTS + +Doesn't matter what you set it to. Just has to be set + +=item AWS_ACCESS_KEY_ID + +Your AWS access key + +=item AWS_ACCESS_KEY_SECRET + +Your AWS sekkr1t passkey. Be forewarned that setting this environment variable +on a shared system might leak that information to another user. Be careful. + +=back + +=head1 TO DO + +=over + +=item Continued to improve and refine of documentation. + +=item Reduce dependencies wherever possible. + +=item Implement debugging mode + +=item Refactor and consolidate request code in Bugzilla::S3 + +=item Refactor URI creation code to make use of L<URI>. + +=back + +=head1 SUPPORT + +Bugs should be reported via the CPAN bug tracker at + +<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Amazon-S3> + +For other issues, contact the author. + +=head1 AUTHOR + +Timothy Appnel <tima@cpan.org> + +=head1 SEE ALSO + +L<Bugzilla::S3::Bucket>, L<Net::Amazon::S3> + +=head1 COPYRIGHT AND LICENCE + +This module was initially based on L<Net::Amazon::S3> 0.41, by +Leon Brocard. Net::Amazon::S3 was based on example code from +Amazon with this notice: + +# This software code is made available "AS IS" without warranties of any +# kind. You may copy, display, modify and redistribute the software +# code either by itself or as incorporated into your code; provided that +# you do not remove any proprietary notices. Your use of this software +# code is at your own risk and you waive any claim against Amazon +# Digital Services, Inc. or its affiliates with respect to your use of +# this software code. (c) 2006 Amazon Digital Services, Inc. or its +# affiliates. + +The software is released under the Artistic License. The +terms of the Artistic License are described at +http://www.perl.com/language/misc/Artistic.html. Except +where otherwise noted, Amazon::S3 is Copyright 2008, Timothy +Appnel, tima@cpan.org. All rights reserved. diff --git a/Bugzilla/S3/Bucket.pm b/Bugzilla/S3/Bucket.pm new file mode 100644 index 000000000..37c61e666 --- /dev/null +++ b/Bugzilla/S3/Bucket.pm @@ -0,0 +1,433 @@ +package Bugzilla::S3::Bucket; + +# Forked from Amazon::S3, which appears to be abandoned. + +use strict; +use warnings; +use Carp; +use File::stat; +use IO::File; + +use base qw(Class::Accessor::Fast); +__PACKAGE__->mk_accessors(qw(bucket creation_date account)); + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + croak "no bucket" unless $self->bucket; + croak "no account" unless $self->account; + return $self; +} + +sub _uri { + my ($self, $key) = @_; + return ($key) + ? $self->bucket . "/" . $self->account->_urlencode($key) + : $self->bucket . "/"; +} + +# returns bool +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}; + } + + if (ref($value) eq 'SCALAR') { + $conf->{'Content-Length'} ||= -s $$value; + $value = _content_sub($$value); + } + else { + $conf->{'Content-Length'} ||= length $value; + } + + # If we're pushing to a bucket that's under DNS flux, we might get a 307 + # Since LWP doesn't support actually waiting for a 100 Continue response, + # we'll just send a HEAD first to see what's going on + + if (ref($value)) { + return $self->account->_send_request_expect_nothing_probed('PUT', + $self->_uri($key), $conf, $value); + } + else { + return $self->account->_send_request_expect_nothing('PUT', + $self->_uri($key), $conf, $value); + } +} + +sub add_key_filename { + my ($self, $key, $value, $conf) = @_; + return $self->add_key($key, \$value, $conf); +} + +sub head_key { + my ($self, $key) = @_; + return $self->get_key($key, "HEAD"); +} + +sub get_key { + my ($self, $key, $method, $filename) = @_; + $method ||= "GET"; + $filename = $$filename if ref $filename; + my $acct = $self->account; + + my $request = $acct->_make_request($method, $self->_uri($key), {}); + my $response = $acct->_do_http($request, $filename); + + if ($response->code == 404) { + $acct->err(404); + $acct->errstr('The requested key was not found'); + return undef; + } + + return undef unless $acct->_check_response($response); + + my $etag = $response->header('ETag'); + if ($etag) { + $etag =~ s/^"//; + $etag =~ s/"$//; + } + + my $return = { + content_length => $response->content_length || 0, + content_type => $response->content_type, + etag => $etag, + value => $response->content, + }; + + foreach my $header ($response->headers->header_field_names) { + next unless $header =~ /x-amz-meta-/i; + $return->{lc $header} = $response->header($header); + } + + return $return; + +} + +sub get_key_filename { + my ($self, $key, $method, $filename) = @_; + $filename = $key unless defined $filename; + return $self->get_key($key, $method, \$filename); +} + +# returns bool +sub delete_key { + my ($self, $key) = @_; + croak 'must specify key' unless $key && length $key; + return $self->account->_send_request_expect_nothing('DELETE', + $self->_uri($key), {}); +} + +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; + } + + return undef unless $acct->_check_response($response); + + return $response->content; +} + +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); + +} + +sub get_location_constraint { + my ($self) = @_; + + my $xpc = + $self->account->_send_request('GET', $self->bucket . '/?location'); + return undef unless $xpc && !$self->account->_remember_errors($xpc); + + my $lc = $xpc->{content}; + if (defined $lc && $lc eq '') { + $lc = undef; + } + return $lc; +} + +# proxy up the err requests + +sub err { $_[0]->account->err } + +sub errstr { $_[0]->account->errstr } + +sub _content_sub { + my $filename = shift; + my $stat = stat($filename); + my $remaining = $stat->size; + my $blksize = $stat->blksize || 4096; + + croak "$filename not a readable file with fixed size" + unless -r $filename + and $remaining; + + my $fh = IO::File->new($filename, 'r') + or croak "Could not open $filename: $!"; + $fh->binmode; + + return sub { + my $buffer; + + # upon retries the file is closed and we must reopen it + unless ($fh->opened) { + $fh = IO::File->new($filename, 'r') + or croak "Could not open $filename: $!"; + $fh->binmode; + $remaining = $stat->size; + } + + unless (my $read = $fh->read($buffer, $blksize)) { + croak + "Error while reading upload content $filename ($remaining remaining) $!" + if $! and $remaining; + $fh->close # otherwise, we found EOF + or croak "close of upload content $filename failed: $!"; + $buffer + ||= ''; # LWP expects an empty string on finish, read returns 0 + } + $remaining -= length($buffer); + return $buffer; + }; +} + +1; + +__END__ + +=head1 NAME + +Bugzilla::S3::Bucket - A container class for a S3 bucket and its contents. + +=head1 METHODS + +=head2 new + +Instaniates a new bucket object. + +Requires a hash containing two arguments: + +=over + +=item bucket + +The name (identifier) of the bucket. + +=item account + +The L<S3::Amazon> object (representing the S3 account) this +bucket is associated with. + +=back + +NOTE: This method does not check if a bucket actually +exists. It simply instaniates the bucket. + +Typically a developer will not call this method directly, +but work through the interface in L<S3::Amazon> that will +handle their creation. + +=head2 add_key + +Takes three positional parameters: + +=over + +=item key + +A string identifier for the resource in this bucket + +=item value + +A SCALAR string representing the contents of the resource. + +=item configuration + +A HASHREF of configuration data for this key. The configuration +is generally the HTTP headers you want to pass the S3 +service. The client library will add all necessary headers. +Adding them to the configuration hash will override what the +library would send and add headers that are not typically +required for S3 interactions. + +In addition to additional and overriden HTTP headers, this +HASHREF can have a C<acl_short> key to set the permissions +(access) of the resource without a seperate call via +C<add_acl> or in the form of an XML document. See the +documentation in C<add_acl> for the values and usage. + +=back + +Returns a boolean indicating its success. Check C<err> and +C<errstr> for error message if this operation fails. + +=head2 add_key_filename + +The method works like C<add_key> except the value is assumed +to be a filename on the local file system. The file will +be streamed rather then loaded into memory in one big chunk. + +=head2 head_key $key_name + +Returns a configuration HASH of the given key. If a key does +not exist in the bucket C<undef> will be returned. + +=head2 get_key $key_name, [$method] + +Takes a key and an optional HTTP method and fetches it from +S3. The default HTTP method is GET. + +The method returns C<undef> if the key does not exist in the +bucket. If a server error occurs C<undef> is returned and +C<err> and C<errstr> are set. + +On success, the method returns a HASHREF containing: + +=over + +=item content_type + +=item etag + +=item value + +=item @meta + +=back + +=head2 get_key_filename $key_name, $method, $filename + +This method works like C<get_key>, but takes an added +filename that the S3 resource will be written to. + +=head2 delete_key $key_name + +Permanently removes C<$key_name> from the bucket. Returns a +boolean value indicating the operations success. + +=head2 get_acl + +Retrieves the Access Control List (ACL) for the bucket or +resource as an XML document. + +=over + +=item key + +The key of the stored resource to fetch. This parameter is +optional. By default the method returns the ACL for the +bucket itself. + +=back + +=head2 set_acl $conf + +Retrieves the Access Control List (ACL) for the bucket or +resource. Requires a HASHREF argument with one of the following keys: + +=over + +=item acl_xml + +An XML string which contains access control information +which matches Amazon's published schema. + +=item acl_short + +Alternative shorthand notation for common types of ACLs that +can be used in place of a ACL XML document. + +According to the Amazon S3 API documentation the following recognized acl_short +types are defined as follows: + +=over + +=item private + +Owner gets FULL_CONTROL. No one else has any access rights. +This is the default. + +=item 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. + +=item 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. + +=item authenticated-read + +Owner gets FULL_CONTROL, and any principal authenticated as +a registered Amazon S3 user is granted READ access. + +=back + +=item key + +The key name to apply the permissions. If the key is not +provided the bucket ACL will be set. + +=back + +Returns a boolean indicating the operations success. + +=head2 get_location_constraint + +Returns the location constraint data on a bucket. + +For more information on location constraints, refer to the +Amazon S3 Developer Guide. + +=head2 err + +The S3 error code for the last error the account encountered. + +=head2 errstr + +A human readable error string for the last error the account encountered. + +=head1 SEE ALSO + +L<Bugzilla::S3> + +=head1 AUTHOR & COPYRIGHT + +Please see the L<Bugzilla::S3> manpage for author, copyright, and +license information. |