diff options
Diffstat (limited to 'Bugzilla/S3')
| -rw-r--r-- | Bugzilla/S3/Bucket.pm | 433 |
1 files changed, 433 insertions, 0 deletions
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. |