App-MtAws
view release on metacpan or search on metacpan
t/unit/queue_job/fetch_and_download_inventory.t
t/unit/queue_job/iterator.t
t/unit/queue_job/list_vaults.t
t/unit/queue_job/multipart_create.t
t/unit/queue_job/multipart_finish.t
t/unit/queue_job/multipart_part.t
t/unit/queue_job/retrieve.t
t/unit/queue_job/retrieve_inventory.t
t/unit/queue_job/upload.t
t/unit/queue_job/upload_multipart.t
t/unit/queue_job/verify.t
t/unit/queue_job/verify_and_upload.t
t/unit/queue_job_result.t
t/unit/shahash.t
t/unit/string_escape.t
t/unit/sysread_syswrite_unit.t
t/unit/test_test.t
t/unit/u_treehash.t
test.t
lib/App/MtAws/ChildWorker.pm view on Meta::CPAN
my $r = $req->delete_vault($data->{name});
confess unless $r;
$result = { };
$console_out = "Deleted vault $data->{name}";
} elsif ($action eq 'list_vaults') {
my $req = App::MtAws::GlacierRequest->new($self->{options});
my $r = $req->list_vaults($data->{marker});
confess unless $r;
$result = { response => $r };
$console_out = "Getting vault list (".($data->{marker} ? "next page: $data->{marker}" : "first page").")";
} elsif ($action eq 'verify_file') {
my $th = App::MtAws::TreeHash->new();
my $binaryfilename = binaryfilename $data->{filename};
die exception file_is_zero => "File size is zero (and it was not when we read directory listing). Filename: %string filename%",
filename => $data->{filename}
unless -s $binaryfilename;
open_file(my $F, $data->{filename}, mode => '<', binary => 1) or
die exception upload_file_open_error => "Unable to open task file %string filename% for reading, errno=%errno%",
filename => $data->{filename}, 'ERRNO'; # TODO: test
lib/App/MtAws/GlacierRequest.pm view on Meta::CPAN
$self->_sign();
my $ua = LWP::UserAgent->new(timeout => $self->{timeout});
$ua->protocols_allowed ( [ 'https' ] ) if $self->{protocol} eq 'https'; # Lets hard code this.
$ua->agent("mt-aws-glacier/${App::MtAws::VERSION} (http://mt-aws.com/) "); # use of App::MtAws::VERSION_MATURITY produce warning
my $req = undef;
my $url = $self->{protocol} ."://$self->{host}$self->{url}";
$url = $self->{protocol} ."://$ENV{MTGLACIER_FAKE_HOST}$self->{url}" if $ENV{MTGLACIER_FAKE_HOST};
if ($self->{protocol} eq 'https') {
if ($ENV{MTGLACIER_FAKE_HOST}) {
$ua->ssl_opts( verify_hostname => 0, SSL_verify_mode=>0); #Hostname mismatch causes LWP to error.
} else {
$ua->ssl_opts( verify_hostname => 1, SSL_verify_mode=>1);
}
}
$url .= "?$self->{params_s}" if $self->{params_s};
if ($self->{method} eq 'PUT') {
$req = HTTP::Request->new(PUT => $url, undef, $self->{dataref});
} elsif ($self->{method} eq 'POST') {
if ($self->{dataref}) {
$req = HTTP::Request->new(POST => $url, [Content_Type => 'form-data'], ${$self->{dataref}});
} else {
$req = HTTP::Request->new(POST => $url );
lib/App/MtAws/GlacierRequest.pm view on Meta::CPAN
}
$self->{writer}->add_data($_[0]);
1;
});
} else {
$resp = $ua->request($req);
}
my $dt = time()-$t0;
if (($resp->code eq '500') && $resp->header('Client-Warning') && ($resp->header('Client-Warning') eq 'Internal response')) {
if ($resp->content =~ /Can't verify SSL peers without knowing which Certificate Authorities to trust/i) {
die exception 'lwp_ssl_ca_exception' =>
'Can\'t verify SSL peers without knowing which Certificate Authorities to trust. Probably "Mozilla::CA" module is missing';
} else {
print "PID $$ HTTP connection problem (timeout?). Will retry ($dt seconds spent for request)\n";
$self->{last_retry_reason} = 'Internal response';
throttle($i);
}
} elsif ($resp->code =~ /^(500|408)$/) {
print "PID $$ HTTP ".$resp->code." This might be normal. Will retry ($dt seconds spent for request)\n";
$self->{last_retry_reason} = $resp->code;
throttle($i);
} elsif (defined($resp->header('X-Died')) && (get_exception($resp->header('X-Died')))) {
lib/App/MtAws/QueueJob/Verify.pm view on Meta::CPAN
use App::MtAws::QueueJobResult;
use base 'App::MtAws::QueueJob';
sub init
{
my ($self) = @_;
defined($self->{filename}) || confess "no filename";
defined($self->{relfilename}) || confess "no relfilename";
$self->{treehash}||confess;
$self->enter('verify');
}
sub on_verify
{
my ($self) = @_;
return state "wait", task "verify_file", { map { $_ => $self->{$_} } qw/filename relfilename treehash/ } => sub {
my ($args) = @_;
defined($self->{match} = $args->{match}) or confess;
state("done")
}
}
1;
lib/App/MtAws/QueueJob/VerifyAndUpload.pm view on Meta::CPAN
defined($self->{filename})||confess "no filename";
defined($self->{relfilename}) || confess "no relfilename";
defined($self->{delete_after_upload}) || confess "delete_after_upload must be defined";
$self->{partsize}||confess;
$self->{treehash}||confess;
if ($self->{delete_after_upload}) {
confess "archive_id must present if you're deleting" unless $self->{archive_id};
} else {
confess "archive_id not needed here" if $self->{archive_id};
}
$self->enter("verify");
return $self;
}
sub on_verify
{
my ($self) = @_;
return
state("wait"),
job( App::MtAws::QueueJob::Verify->new( map { $_ => $self->{$_} } qw/filename relfilename treehash/ ), sub {
my $j = shift;
confess unless defined $j->{match};
$j->{match} ? state("done") : state("upload");
});
}
t/lib/DownloadSegmentsTest.pm view on Meta::CPAN
my %args = (size => $size, archive_id => 'abc', jobid => 'somejob', file_downloads => { 'segment-size' => $segment_size},
relfilename => 'def', filename => '/path/def', mtime => 456, treehash => 'wedontneedit');
my $j = App::MtAws::QueueJob::Download->new(%args);
$test_cb->($j, 0, { %args, tempfile => "sometempfilename" });
}
}
sub verify_parts
{
my ($parts, $size, $segment_size, $expected_sizes) = @_;
my @expected = $expected_sizes ? @$expected_sizes : ();
# auto check that position that we're got are correct
my $expect_position = 0;
my $odd_size_seen = 0;
for my $part (@$parts) {
is $part->{position}, $expect_position;
t/lib/DownloadSegmentsTest.pm view on Meta::CPAN
if ($part->{download_size} != $segment_size * ONE_MB) {
ok !$odd_size_seen, "current size down not match segment-size, but it's first time";
$odd_size_seen = 1;
}
}
is $expect_position, $size;
is scalar @expected, 0;
}
sub verify_res
{
my ($res, $args) = @_;
cmp_deeply $res,
App::MtAws::QueueJobResult->full_new(
task => {
args => {
(map { $_ => $args->{$_} } qw/filename jobid relfilename archive_id tempfile/),
download_size => code(sub{ shift > 0 }),
position => code(sub{ defined shift }),
},
t/lib/DownloadSegmentsTest.pm view on Meta::CPAN
confess if $i++ > 1000; # protection
my $res = $j->next;
if ($res->{code} eq JOB_OK) {
push @parts, { download_size => $res->{task}{args}{download_size}, position => $res->{task}{args}{position} };
} elsif ($res->{code} eq JOB_WAIT) {
last;
} else {
confess;
}
}
verify_parts(\@parts, $size, $segment_size, $expected_sizes);
});
}
sub test_case_late_finish
{
my ($prepare_cb, $size, $segment_size, $expected_sizes) = @_;
$prepare_cb->($size, $segment_size, sub {
my ($j, $check_tmpfile, $args) = @_;
t/lib/DownloadSegmentsTest.pm view on Meta::CPAN
my $i = 0;
while() {
confess if $i++ > 1000;
my $res = $j->next;
ok $j->{i_tmp}, "tempfile object is defined" if $check_tmpfile;
if ($res->{code} eq JOB_OK) {
verify_res($res, $args);
push @parts, { download_size => $res->{task}{args}{download_size}, position => $res->{task}{args}{position}, cb => $res->{task}{cb_task_proxy} };
} elsif ($res->{code} eq JOB_WAIT) {
last;
} else {
confess;
}
}
verify_parts(\@parts, $size, $segment_size, $expected_sizes);
my $remember_tempfile;
if ($check_tmpfile) {
$remember_tempfile = $j->{i_tmp};
ok $remember_tempfile, "tempfile object is defined";
}
expect_wait($j); # again, wait
$_->{cb}->() for (@parts);
expect_done($j);
if ($check_tmpfile) {
t/lib/DownloadSegmentsTest.pm view on Meta::CPAN
confess if $i++ > 1000;
my $res = $j->next;
if ($check_tmpfile && !$remember_tempfile) {
ok $j->{i_tmp}, "tempfile object is defined";
$remember_tempfile = $j->{i_tmp};
}
if ($res->{code} eq JOB_OK) {
verify_res($res, $args);
push @parts, { download_size => $res->{task}{args}{download_size}, position => $res->{task}{args}{position} };
$res->{task}{cb_task_proxy}->();
} elsif ($res->{code} eq JOB_DONE) {
last;
} else {
confess;
}
}
verify_parts(\@parts, $size, $segment_size, $expected_sizes);
ok $remember_tempfile->{_mock_permanent}, "tempfile now permanent" if $check_tmpfile; # it's undef in $j, but we remembered it
ok ! defined $j->{i_tmp}, "tempfile removed from job";
});
}
{
package QE;
use MyQueueEngine;
use base q{MyQueueEngine};
t/lib/DownloadSegmentsTest.pm view on Meta::CPAN
}
};
sub test_case_random_finish
{
my ($prepare_cb, $size, $segment_size, $workers, $expected_sizes) = @_;
$prepare_cb->($size, $segment_size, sub {
my ($j, $args) = @_;
my $q = QE->new(n => $workers);
$q->process($j);
verify_parts([ sort { $a->{position} <=> $b->{position} } @{ $q->{res} } ], $size, $segment_size, $expected_sizes);
});
}
sub test_case_full
{
my ($prepare_cb, $size, $segment_size, $expected_sizes) = @_;
test_case_late_finish($prepare_cb, $size, $segment_size, $expected_sizes);
test_case_early_finish($prepare_cb, $size, $segment_size, $expected_sizes);
t/lib/VerifyTest.pm view on Meta::CPAN
package VerifyTest;
use strict;
use warnings;
use Test::Deep;
use App::MtAws::QueueJobResult;
use App::MtAws::QueueJob::Verify;
use QueueHelpers;
sub expect_verify
{
my ($j, $filename, $relfilename, $treehash, %args_opts) = @_;
my %args = (verify_value => 42, %args_opts);
cmp_deeply my $res = $j->next,
App::MtAws::QueueJobResult->full_new(
task => {
args => {
filename => $filename,
relfilename => $relfilename,
treehash => $treehash,
},
action => 'verify_file',
cb => test_coderef,
cb_task_proxy => test_coderef,
},
code => JOB_OK,
);
expect_wait($j);
call_callback($res, match => $args{verify_value});
}
1;
t/unit/cmd_sync.t view on Meta::CPAN
my ($options, $j, $file, $toreturn) = @_;
App::MtAws::Command::Sync->expects("should_upload")->returns(sub {
my ($opt, $f, $absfilename) = @_;
cmp_deeply $opt, $options;
cmp_deeply $f, $file;
is $absfilename, $j->absfilename($file->{relfilename});
return $toreturn;
})->once;
}
sub verify_create_job
{
my ($options, $j, $file, $rec) = @_;
ok $rec->isa('App::MtAws::QueueJob::Upload');
is $rec->{partsize}, $options->{partsize}*1024*1024;
is $rec->{relfilename}, $file->{relfilename};
is $rec->{filename}, $j->absfilename($file->{relfilename});
ok $rec->{delete_after_upload};
is $rec->{archive_id}, $file->{archive_id};
}
sub verify_treehash_job
{
my ($options, $j, $file, $rec) = @_;
ok $rec->isa('App::MtAws::QueueJob::VerifyAndUpload');
is $rec->{filename}, $j->absfilename($file->{relfilename});
is $rec->{relfilename}, $file->{relfilename};
ok $rec->{delete_after_upload};
is $rec->{archive_id}, $file->{archive_id};
is $rec->{treehash}, $file->{treehash};
is $rec->{partsize}, $options->{partsize}*1024*1024;
}
t/unit/cmd_sync.t view on Meta::CPAN
$j->{listing}{existing} = [];
ok !defined App::MtAws::Command::Sync::next_modified($options, $j);
};
it "should work when should_upload returns SHOULD_CREATE" => sub {
my $file = {relfilename => 'file1', archive_id => 'zz1'};
$j->{listing}{existing} = [$file];
$j->_add_filename($file);
expect_should_upload($options, $j, $file, App::MtAws::Command::Sync::SHOULD_CREATE());
my $rec = App::MtAws::Command::Sync::next_modified($options, $j);
verify_create_job($options, $j, $file, $rec);
is scalar @{ $j->{listing}{existing} }, 0;
ok !defined (App::MtAws::Command::Sync::next_modified($options, $j));
};
it "should work with two files" => sub {
my $file1 = {relfilename => 'file1', archive_id => 'zz1'};
my $file2 = {relfilename => 'file2', archive_id => 'zz2'};
$j->{listing}{existing} = [$file1, $file2];
$j->_add_filename($file1);
$j->_add_filename($file2);
expect_should_upload($options, $j, $file1, App::MtAws::Command::Sync::SHOULD_CREATE());
my $rec = App::MtAws::Command::Sync::next_modified($options, $j);
verify_create_job($options, $j, $file1, $rec);
is scalar @{ $j->{listing}{existing} }, 1;
expect_should_upload($options, $j, $file2, App::MtAws::Command::Sync::SHOULD_CREATE());
$rec = App::MtAws::Command::Sync::next_modified($options, $j);
verify_create_job($options, $j, $file2, $rec);
};
it "should work with latest version of file" => sub {
my $file = {relfilename => 'file1', size => 123};
$j->{listing}{existing} = [$file];
$j->_add_filename({relfilename => 'file1', archive_id => 'zz1', size => 123, time => 42, mtime => 111, , treehash => 'abc0'});
$j->_add_filename(my $r = {relfilename => 'file1', archive_id => 'zz2', size => 123, time => 42, mtime => 113, treehash => 'abc'});
$j->_add_filename({relfilename => 'file1', archive_id => 'zz3', size => 123, time => 42, mtime => 112, , treehash => 'abc2'});
expect_should_upload($options, $j, $r, App::MtAws::Command::Sync::SHOULD_TREEHASH());
my $rec = App::MtAws::Command::Sync::next_modified($options, $j);
verify_treehash_job($options, $j, $r, $rec);
is scalar @{ $j->{listing}{existing} }, 0;
};
it "should call latest() to get latest version of file" => sub {
my $file = {relfilename => 'file1', size => 123};
$j->{listing}{existing} = [$file];
$j->_add_filename({relfilename => 'file1', archive_id => 'zz1', size => 123, time => 42, mtime => 111, , treehash => 'abc0'});
$j->_add_filename(my $r = {relfilename => 'file1', archive_id => 'zz2', size => 123, time => 42, mtime => 113, treehash => 'abc'});
$j->_add_filename({relfilename => 'file1', archive_id => 'zz3', size => 123, time => 42, mtime => 112, , treehash => 'abc2'});
expect_should_upload($options, $j, $r, App::MtAws::Command::Sync::SHOULD_TREEHASH());
App::MtAws::Journal->expects("latest")->returns(sub{ is $_[1], "file1"; $r})->once;
App::MtAws::Command::Sync::next_modified($options, $j);
};
it "should work when should_upload returns SHOULD_TREEHASH" => sub {
my $file = {relfilename => 'file1', archive_id => 'zz1', treehash => 'abcdef'};
$j->{listing}{existing} = [$file];
$j->_add_filename($file);
expect_should_upload($options, $j, $file, App::MtAws::Command::Sync::SHOULD_TREEHASH());
my $rec = App::MtAws::Command::Sync::next_modified($options, $j);
verify_treehash_job($options, $j, $file, $rec);
is scalar @{ $j->{listing}{existing} }, 0;
ok !defined (App::MtAws::Command::Sync::next_modified($options, $j));
};
it "should skip to next file when should_upload returns SHOULD_NOACTION" => sub {
for (1..10) {
my $file = {relfilename => "file$_", archive_id => "zz$_"};
push @{ $j->{listing}{existing} }, $file;
$j->_add_filename($file);
}
my $file;
App::MtAws::Command::Sync->expects("should_upload")->returns(sub {
my ($opt, $f, $absfilename) = @_;
$file = $f;
return $f->{relfilename} eq 'file7' ? App::MtAws::Command::Sync::SHOULD_CREATE() : App::MtAws::Command::Sync::SHOULD_NOACTION();
})->exactly(10);
my $rec = App::MtAws::Command::Sync::next_modified($options, $j);
verify_create_job($options, $j, $file, $rec);
is scalar @{ $j->{listing}{existing} }, 3;
ok !defined App::MtAws::Command::Sync::next_modified($options, $j);
};
it "should confess when should_upload returns something else" => sub {
my $file = {relfilename => 'file1', archive_id => 'zz1'};
$j->{listing}{existing} = [$file];
$j->_add_filename($file);
expect_should_upload($options, $j, $file, 7656348);
t/unit/glacier_request.t view on Meta::CPAN
}
}, exception 'http_unexpected_reply' => "Unexpected reply from remote server";
}
};
};
describe "should detect CA error" => sub {
it "should raise exception if CA error found" => sub {
my $g = App::MtAws::GlacierRequest->new({%common_options});
($g->{method}, $g->{url}) = ('GET', 'test');
## no Test::Tabs
LWP::UserAgent->expects('request')->returns(HTTP::Response->new(500, "Can't verify SSL peers without knowing which Certificate Authorities to trust", ["Client-Warning" => "Internal response"], <<"END"))->once;
Can't verify SSL peers without knowing which Certificate Authorities to trust
This problem can be fixed by either setting the PERL_LWP_SSL_CA_FILE
envirionment variable or by installing the Mozilla::CA module.
To disable verification of SSL peers set the PERL_LWP_SSL_VERIFY_HOSTNAME
envirionment variable to 0. If you do this you can't be sure that you
communicate with the expected peer.
END
## use Test::Tabs
assert_raises_exception sub {
$g->perform_lwp();
}, exception 'lwp_ssl_ca_exception' =>
'Can\'t verify SSL peers without knowing which Certificate Authorities to trust. Probably "Mozilla::CA" module is missing';
};
};
};
sub header
{
{ name => $_[0], value => $_[1] }
}
sub headers {
t/unit/queue_job/verify.t view on Meta::CPAN
ok !eval { App::MtAws::QueueJob::Verify->new( map { $_ => $opts{$_} } qw/relfilename treehash/); 1; };
ok eval { App::MtAws::QueueJob::Verify->new((map { $_ => $opts{$_} } qw/relfilename treehash/), filename => 0); 1; };
ok !eval { App::MtAws::QueueJob::Verify->new(map { $_ => $opts{$_} } qw/filename treehash/); 1; };
ok eval { App::MtAws::QueueJob::Verify->new((map { $_ => $opts{$_} } qw/filename treehash/), relfilename => 0); 1; };
}
sub test_case
{
my ($filename, $relfilename) = @_;
my $j = App::MtAws::QueueJob::Verify->new( treehash => $opts{treehash}, filename => $filename, relfilename => $relfilename);
VerifyTest::expect_verify($j, $filename, $relfilename, $opts{treehash}, verify_value => 42);
expect_done($j);
is $j->{match}, 42;
}
test_case $opts{filename}, $opts{relfilename};
test_case 0, 0;
1;
t/unit/queue_job/verify_and_upload.t view on Meta::CPAN
} else {
$opts{filename} = '0';
$opts{relfilename} = '0';
}
my @main_opts = (map { $_ => $opts{$_} } qw/filename relfilename treehash partsize/);
{
my @opts = (@main_opts, delete_after_upload => 1, archive_id => 'def');
{
my $j = App::MtAws::QueueJob::VerifyAndUpload->new(@opts);
VerifyTest::expect_verify($j, $opts{filename}, $opts{relfilename}, $opts{treehash}, verify_value => 1);
expect_done($j);
}
{
my $j = App::MtAws::QueueJob::VerifyAndUpload->new(@opts);
VerifyTest::expect_verify($j, $opts{filename}, $opts{relfilename}, $opts{treehash}, verify_value => 0);
UploadMultipartTest::expect_upload_multipart($j, 123, $opts{partsize}, $opts{relfilename}, 'xyz');
DeleteTest::expect_delete($j, $opts{relfilename}, $opts{archive_id});
expect_done($j);
}
}
{
my @opts = (@main_opts, delete_after_upload => 0);
{
my $j = App::MtAws::QueueJob::VerifyAndUpload->new(@opts);
VerifyTest::expect_verify($j, $opts{filename}, $opts{relfilename}, $opts{treehash}, verify_value => 1);
expect_done($j);
}
{
my $j = App::MtAws::QueueJob::VerifyAndUpload->new(@opts);
VerifyTest::expect_verify($j, $opts{filename}, $opts{relfilename}, $opts{treehash}, verify_value => 0);
UploadMultipartTest::expect_upload_multipart($j, 123, $opts{partsize}, $opts{relfilename}, 'xyz');
expect_done($j);
}
}
}
# test dry-run
{
my $j = App::MtAws::QueueJob::VerifyAndUpload->new( map { $_ => $opts{$_} } @all);
( run in 2.221 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )