view release on metacpan or  search on metacpan

lib/Net/Amazon/Glacier.pm  view on Meta::CPAN

	# identify $part as filehandle or string and get content
	my $content = '';

	if ( ref $part eq 'SCALAR' ) {
		# keep scalar reference
		$content = $part;
		croak "no data supplied" unless length $$content;
	} else {
		#try to read any other content as supported by File::Slurp
		eval {
			$content = File::Slurp::read_file( $part, bin_mode => ':raw', err_mode => 'carp', scalar_ref => 1 );
		};
		croak "\$part interpreted as file (GLOB, IO::Handle/File) but error occured while reading: $@" if ( $@ );

		croak "no data read from file" unless length $$content;
	}

	my $upload_part_size = length $$content;

	# compute part hash
	my $th = Net::Amazon::TreeHash->new();

	$th->eat_data( $content );

	$th->calc_tree();

	# range end must not be ( $part_size * ( $part_index + 1 ) - 1 ) or last part
	# will fail.
	my $res = $self->_send_receive(
		PUT => "/-/vaults/$vault_name/multipart-uploads/$multipart_upload_id",
		[
			'Content-Range' => 'bytes ' . ( $part_size * $part_index ) . '-' .  ( ( $part_size * $part_index ) + $upload_part_size - 1 ) . '/*',
			'Content-Length' => $upload_part_size,
			'Content-Type' => 'application/octet-stream',
			'x-amz-sha256-tree-hash' => $th->get_final_hash(),
			'x-amz-content-sha256' => Digest::SHA::sha256_hex( $$content ),
			# documentation seems to suggest x-amz-content-sha256 may not be needed but it is!
		],
		$$content
	);
	# updated error severity
	croak 'multipart_upload_upload_part failed with error ' . $res->status_line unless $res->is_success;

	# check glacier tree-hash = local tree-hash
	# updated error severity; multipart upload id must be returned
	croak 'request succeeded, but reported and computed tree-hash for part do not match' unless ( $th->get_final_hash() eq $res->header('x-amz-sha256-tree-hash') );
	# return computed tree-hash for this part
	return $res->header('x-amz-sha256-tree-hash');
}

=head2 multipart_upload_complete( $vault_name, $multipart_upload_id, $tree_hash_array_ref, $archive_size )

Signals completion of multipart upload.

$tree_hash_array_ref must be an ordered list (same order as final assembled online
archive, as opposed to upload order) of partial tree hashes as returned by
multipart_upload_upload_part

$archive_size is provided at completion to check all parts make up an archive an
not before hand to allow for archive streaming a.k.a. upload archives of unknown
size. Beware of dead ends when choosing part size. Use
calculate_multipart_upload_partsize to select a part size that will work.

Returns an archive id that can be used to request a job to retrieve the archive
at a later time on success and 0 on failure.

On failure multipart_upload_list_parts could be used to determine the missing
part or recover the partial tree hashes, complete the missing parts and
recalculate the correct archive tree hash and call multipart_upload_complete
with a successful result.

L<Complete Multipart Upload (POST uploadID)|http://docs.aws.amazon.com/amazonglacier/latest/dev/api-multipart-complete-upload.html>.

=cut

sub multipart_upload_complete {
	my ( $self, $vault_name, $multipart_upload_id, $tree_hash_array_ref, $archive_size ) = @_;

	croak "no vault name given" unless $vault_name;
	croak "no multipart upload id given" unless $multipart_upload_id;
	croak "no tree hash object given" unless ref $tree_hash_array_ref eq 'ARRAY';
	croak "parameter number mismatch" unless @_ == 5;

	my $archive_tree_hash = $self->_tree_hash_from_array_ref( $tree_hash_array_ref );

	my $res = $self->_send_receive(
		POST => "/-/vaults/$vault_name/multipart-uploads/$multipart_upload_id",
		[
			'x-amz-sha256-tree-hash' => $archive_tree_hash ,
			'x-amz-archive-size' => $archive_size,
		],
	);
	# updated error severity
	croak 'multipart_upload_complete failed with error ' . $res->status_line unless $res->is_success;

	my $rec_archive_id;
	unless ( $res->header('location') =~ m{^/[^/]+/vaults/[^/]+/archives/(.*)$} ) {
		# update severity of error. This method must return an archive id
		croak 'request succeeded, but reported archive location does not match regex: ' . $res->header('location');
	} else {
		$rec_archive_id = $1;
	}

	return $rec_archive_id;
}

=head2 multipart_upload_abort( $vault_name, $multipart_upload_id )

Aborts multipart upload releasing the id and related online resources of
a partially uploaded archive.

L<Abort Multipart Upload (DELETE uploadID)|http://docs.aws.amazon.com/amazonglacier/latest/dev/api-multipart-abort-upload.html>.

=cut

sub multipart_upload_abort {
	my ( $self, $vault_name, $multipart_upload_id ) = @_;

	croak "no vault name given" unless $vault_name;
	croak "no multipart_upload_id given" unless $multipart_upload_id;