view release on metacpan or  search on metacpan

lib/App/MtAws/GlacierRequest.pm  view on Meta::CPAN

#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    mt-aws-glacier is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.

package App::MtAws::GlacierRequest;

our $VERSION = '1.120';

use strict;
use warnings;
use utf8;
use POSIX;
use LWP 5.803;
use LWP::UserAgent;
use URI::Escape;
use HTTP::Request;
use Digest::SHA qw/hmac_sha256 hmac_sha256_hex sha256_hex/;
use App::MtAws::MetaData;
use App::MtAws::Utils;
use App::MtAws::Exceptions;
use App::MtAws::HttpSegmentWriter;
use App::MtAws::SHAHash qw/large_sha256_hex/;
use Carp;

sub new
{
	my ($class, $options) = @_;
	my $self = {};
	bless $self, $class;

	defined($self->{$_} = $options->{$_})||confess $_ for (qw/region key secret protocol timeout/);
	defined($options->{$_}) and $self->{$_} = $options->{$_} for (qw/vault token/); # TODO: validate vault later

	confess unless $self->{protocol} =~ /^https?$/; # we check external data here, even if it's verified in the beginning, especially if it's used to construct URL
	$self->{service} ||= 'glacier';
	$self->{account_id} = '-';
	$self->{host} = "$self->{service}.$self->{region}.amazonaws.com";

	$self->{headers} = [];

	$self->add_header('Host', $self->{host});
	$self->add_header('x-amz-glacier-version', '2012-06-01') if $self->{service} eq 'glacier';
	$self->add_header('x-amz-security-token', $self->{token}) if defined $self->{token};

	return $self;
}

sub add_header
{
	my ($self, $name, $value) = @_;
	push @{$self->{headers}}, { name => $name, value => $value};
}

sub create_multipart_upload
{
	my ($self, $partsize, $relfilename, $mtime) = @_;

	defined($relfilename)||confess;
	defined($mtime)||confess;
	$partsize||confess;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/multipart-uploads";
	$self->{method} = 'POST';

	$self->add_header('x-amz-part-size', $partsize);

	# currently meat_encode only returns undef if filename is too big
	defined($self->{description} = App::MtAws::MetaData::meta_encode($relfilename, $mtime)) or
		die exception 'file_name_too_big' =>
		"Either relative filename %string filename% is too big to store in Amazon Glacier metadata. ".
		"(Limit is about 700 ASCII characters or 350 2-byte UTF-8 characters) or file modification time %string mtime% out of range".
		"(Only years from 1000 to 9999 are supported)",
		filename => $relfilename, mtime => $mtime; # TODO: more clear error
	$self->add_header('x-amz-archive-description', $self->{description});

	my $resp = $self->perform_lwp();
	return $resp ? $resp->header('x-amz-multipart-upload-id') : undef;
}

sub upload_part
{
	my ($self, $uploadid, $dataref, $offset, $part_final_hash) = @_;

	$uploadid||confess;
	($self->{dataref} = $dataref)||confess;
	defined($offset)||confess;
	($self->{part_final_hash} = $part_final_hash)||confess;

	$self->_calc_data_hash;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/multipart-uploads/$uploadid";
	$self->{method} = 'PUT';
	$self->add_header('Content-Type', 'application/octet-stream');
	$self->add_header('Content-Length', length(${$self->{dataref}}));
	$self->add_header('x-amz-content-sha256', $self->{data_sha256});
	$self->add_header('x-amz-sha256-tree-hash', $self->{part_final_hash});
	my ($start, $end) = ($offset, $offset+length(${$self->{dataref}})-1 );
	$self->add_header('Content-Range', "bytes ${start}-${end}/*");

	my $resp = $self->perform_lwp();
	return $resp ? 1 : undef;
}


sub finish_multipart_upload
{
	my ($self, $uploadid, $size, $treehash) = @_;

	$uploadid||confess;
	$size||confess;
	$treehash||confess;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/multipart-uploads/$uploadid";
	$self->{method} = 'POST';
	$self->add_header('x-amz-sha256-tree-hash', $treehash);
	$self->add_header('x-amz-archive-size', $size);

	my $resp = $self->perform_lwp();
	return $resp ? $resp->header('x-amz-archive-id') : undef;
}


sub delete_archive
{
	my ($self, $archive_id) = @_;

	$archive_id||confess;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/archives/$archive_id";
	$self->{method} = 'DELETE';

	my $resp = $self->perform_lwp();
	return $resp ? 1 : undef;
}


sub retrieve_archive
{
	my ($self, $archive_id) = @_;

	$archive_id||confess;

	$self->add_header('Content-Type', 'application/x-www-form-urlencoded; charset=utf-8');
	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/jobs";
	$self->{method} = 'POST';

	#  add "SNSTopic": "sometopic"
	# no Test::Tabs
	my $body = <<"END";
{
  "Type": "archive-retrieval",
  "ArchiveId": "$archive_id"
}
END

	# use Test::Tabs
	$self->{dataref} = \$body;

	my $resp = $self->perform_lwp();
	return $resp ? $resp->header('x-amz-job-id') : undef;
}

sub retrieve_inventory
{
	my ($self, $format) = @_;

	$format or confess;

	if ($format eq 'json') {
		$format = 'JSON';
	} elsif ($format eq 'csv') {
		$format = 'CSV';
	} else {