view release on metacpan or  search on metacpan

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

  "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 {
		confess "unknown inventory format $format";
	}

	$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';

	my $job_meta = App::MtAws::MetaData::meta_job_encode(META_JOB_TYPE_FULL);

	#  add "SNSTopic": "sometopic"
	# no Test::Tabs
	my $body = <<"END";
{
  "Type": "inventory-retrieval",
  "Description": "$job_meta",
  "Format": "$format"
}
END
	# use Test::Tabs
	$self->{dataref} = \$body;

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

sub retrieval_fetch_job
{
	my ($self, $marker) = @_;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/jobs";

	$self->{params} = { completed => 'true' };
	$self->{params}->{marker} = $marker if defined($marker);

	$self->{method} = 'GET';

	my $resp = $self->perform_lwp();
	return $resp->decoded_content; # TODO: return reference?
}


# TODO: rename
sub retrieval_download_job
{
	my ($self, $jobid, $relfilename, $tempfile, $size, $journal_treehash) = @_;

	$journal_treehash||confess;
	$jobid||confess;
	defined($tempfile)||confess;
	defined($relfilename)||confess;
	$size or confess "no size";

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/jobs/$jobid/output";

	$self->{expected_size} = $size;
	$self->{writer} = App::MtAws::HttpFileWriter->new(tempfile => $tempfile);

	$self->{method} = 'GET';

	my $resp = $self->perform_lwp();
	my $reported_th = $resp->header('x-amz-sha256-tree-hash') or confess;

	$self->{writer}->treehash->calc_tree();
	my $th = $self->{writer}->treehash->get_final_hash();

	$reported_th eq $th or
		die exception 'treehash_mismatch_full' =>
		'TreeHash for received file %string filename% (full file) does not match. '.
		'TreeHash reported by server: %reported%, Calculated TreeHash: %calculated%, TreeHash from Journal: %journal_treehash%',
		calculated => $th, reported => $reported_th, journal_treehash => $journal_treehash, filename => $relfilename;

	$reported_th eq $journal_treehash or
		die exception 'treehash_mismatch_journal' =>
		'TreeHash for received file %string filename% (full file) does not match TreeHash in journal. '.
		'TreeHash reported by server: %reported%, Calculated TreeHash: %calculated%, TreeHash from Journal: %journal_treehash%',
		calculated => $th, reported => $reported_th, journal_treehash => $journal_treehash, filename => $relfilename;

	return $resp ? 1 : undef;
}

sub segment_download_job
{
	my ($self, $jobid, $tempfile, $filename, $position, $size) = @_;

	$jobid||confess;
	defined($position) or confess "no position";
	$size or confess "no size";
	defined($filename)||confess;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/jobs/$jobid/output";

	$self->{expected_size} = $size;
	$self->{writer} = App::MtAws::HttpSegmentWriter->new(tempfile => $tempfile, position => $position, filename => $filename);

	$self->{method} = 'GET';
	my $end_position = $position + $size - 1;
	$self->add_header('Range', "bytes=$position-$end_position");

	my $resp = $self->perform_lwp();
	$resp && $resp->code == 206 or confess;

	my $reported_th = $resp->header('x-amz-sha256-tree-hash') or confess;
	$self->{writer}->treehash->calc_tree();
	my $th = $self->{writer}->treehash->get_final_hash();

	$reported_th eq $th or
		die exception 'treehash_mismatch_segment' =>
		'TreeHash for received segment of file %string filename% (position %position%, size %size%) does not match. '.
		'TreeHash reported by server %reported%, Calculated TreeHash %calculated%',
		calculated => $th, reported => $reported_th, filename => $filename, position => $position, size => $size;
		# TODO: better report relative filename

	my ($start, $end, $len) = $resp->header('Content-Range') =~ m!bytes\s+(\d+)\-(\d+)\/(\d+)!;

	confess unless defined($start) && defined($end) && $len;
	confess unless $end >= $start;
	confess unless $position == $start;
	confess unless $end_position == $end;

	return $resp ? 1 : undef; # $resp->decoded_content is undefined here as content_file used
}

sub retrieval_download_to_memory
{
	my ($self, $jobid) = @_;

	$jobid||confess;

	$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/jobs/$jobid/output";
	$self->{method} = 'GET';

	my $resp = $self->perform_lwp();

	$resp or confess;

	my $itype = do {
		my $ct = $resp->content_type;
		if ($ct eq 'text/csv') {
			INVENTORY_TYPE_CSV
		} elsif ($ct eq 'application/json') {
			INVENTORY_TYPE_JSON
		} else {
			confess "Unknown mime-type $ct";
		}
	};
	return ($resp->content, $itype);
}

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

	confess unless defined($vault_name);

	$self->{url} = "/$self->{account_id}/vaults/$vault_name";
	$self->{method} = 'PUT';

	my $resp = $self->perform_lwp();
	return $resp ? $resp->header('x-amzn-RequestId') : undef;
}

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

	confess unless defined($vault_name);

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

	my $resp = $self->perform_lwp();
	return $resp ? $resp->header('x-amzn-RequestId') : undef;
}

sub list_vaults
{
	my ($self, $marker) = @_;

	$self->{url} = "/$self->{account_id}/vaults";
	$self->{params}->{marker} = $marker if defined($marker);
	$self->{method} = 'GET';

	my $resp = $self->perform_lwp();
	return $resp->decoded_content; # TODO: return reference?
}


sub _calc_data_hash
{
	my ($self) = @_;

	if (length(${$self->{dataref}}) <= 1048576) {
		$self->{data_sha256} = $self->{part_final_hash};
	} else {
		$self->{data_sha256} = large_sha256_hex(${$self->{dataref}});
	}
}


sub _sign
{
	my ($self) = @_;

	my $now = time();

	$self->{last_request_time} = $now;  # we use same timestamp when writing to journal

	my $date8601 = strftime("%Y%m%dT%H%M%SZ", gmtime($now));
	my $datestr = strftime("%Y%m%d", gmtime($now));


	$self->{req_headers} = [
		{ name => 'x-amz-date', value => $date8601 },
	];


	# getting canonical URL

	my @all_headers = sort { $a->{name} cmp $b->{name} } (@{$self->{headers}}, @{$self->{req_headers}});


	my $canonical_headers = join ("\n", map { lc($_->{name}).":".trim($_->{value}) } @all_headers);
	my $signed_headers = join (';', map { lc($_->{name}) } @all_headers);

	my $bodyhash = $self->{data_sha256} ?
		$self->{data_sha256} :
		( $self->{dataref} ? large_sha256_hex(${$self->{dataref}}) : sha256_hex('') );

	$self->{params_s} = $self->{params} ? join ('&', map { "$_=".uri_escape($self->{params}->{$_}) } sort keys %{$self->{params}}) : "";
	my $canonical_query_string = $self->{params_s};

	my $canonical_url = join("\n", $self->{method}, $self->{url}, $canonical_query_string, $canonical_headers, "", $signed_headers, $bodyhash);
	my $canonical_url_hash = sha256_hex($canonical_url);


	# /getting canonical URL

	my $credentials = "$datestr/$self->{region}/$self->{service}/aws4_request";

	my $string_to_sign = join("\n", "AWS4-HMAC-SHA256", $date8601, $credentials, $canonical_url_hash);

	my ($kSigning, $kSigning_hex) = get_signature_key($self->{secret}, $datestr, $self->{region}, $self->{service});
	my $signature = hmac_sha256_hex($string_to_sign, $kSigning);