view release on metacpan or search on metacpan
homepage => 'http://mt-aws.com/'
},
},
requires => {
'perl' => 5.008008, # 5.8.8
'Config' => 0,
'LWP' => '5.803', # ancient CentOS 5.x version
'URI' => '1.10', # even ancient LWP versions require at least 1.10, so we use it too
'HTTP::Request' => 0, # either shipped with LWP, or prereq by LWP, does not contain correct version, sometimes
'JSON::XS' => '1',
# core modules for Perl > 5.8.x
'Digest::SHA' => 0,
#
# CORE MODULES OR DUAL-LIFE MODULES
#
'Carp' => 0,
'Encode' => 0,
"File::Spec" : "3.12",
"File::Temp" : "0.16",
"File::stat" : "0",
"FindBin" : "0",
"Getopt::Long" : "2.24",
"HTTP::Request" : "0",
"I18N::Langinfo" : "0",
"IO::Handle" : "0",
"IO::Pipe" : "0",
"IO::Select" : "0",
"JSON::XS" : "1",
"LWP" : "5.803",
"List::Util" : "1.11",
"POSIX" : "0",
"PerlIO::encoding" : "0",
"Time::Local" : "0",
"Time::localtime" : "0",
"URI" : "1.10",
"bytes" : "0",
"constant" : "0",
"integer" : "0",
File::Spec: 3.12
File::Temp: 0.16
File::stat: 0
FindBin: 0
Getopt::Long: 2.24
HTTP::Request: 0
I18N::Langinfo: 0
IO::Handle: 0
IO::Pipe: 0
IO::Select: 0
JSON::XS: 1
LWP: 5.803
List::Util: 1.11
POSIX: 0
PerlIO::encoding: 0
Time::Local: 0
Time::localtime: 0
URI: 1.10
bytes: 0
constant: 0
integer: 0
###### Ubuntu 12.04+, Debian 7
`sudo apt-get install libwww-perl libjson-xs-perl`
###### RHEL/CentOS 5
1. `sudo yum install perl-Digest-SHA`
2. `sudo yum groupinstall "Development Tools"`
3. `sudo yum install openssl-devel`
4. Install `JSON::XS`, `LWP::UserAgent` and `LWP::Protocol::https` using [cpanm]
You also can install `mtglacier` prerequisites without CPAN if you have [EPEL](http://fedoraproject.org/wiki/EPEL) repository enabled and if you don't need HTTPS:
`sudo yum install perl-Digest-SHA perl-JSON-XS perl-libwww-perl`
###### RHEL/CentOS 6
1. `sudo yum install perl-core perl-CGI`
2. `sudo yum groupinstall "Development Tools"`
3. `sudo yum install openssl-devel`
4. Install `JSON::XS`, `LWP::UserAgent` and `LWP::Protocol::https` using [cpanm]
You also can install `mtglacier` prerequisites without CPAN if you have [EPEL](http://fedoraproject.org/wiki/EPEL) repository enabled and if you don't need HTTPS:
`sudo yum install perl-core perl-CGI perl-JSON-XS perl-libwww-perl`
###### Debian 6
`sudo apt-get install libwww-perl libjson-xs-perl`
To use HTTPS you also need:
###### Fedora 18+
`sudo yum install perl-core perl-CGI perl-JSON-XS perl-libwww-perl perl-LWP-Protocol-https`
###### SUSE Linux Enterprise Server 11
1. `sudo zypper install perl-libwww-perl libopenssl-devel`
2. `sudo zypper install --type pattern Basis-Devel`
3. Upgrade openssl to (at least) `0.9.8r` (to check version use `openssl version`), can be found [here](http://download.opensuse.org/repositories/security:/fips/) (more info here [RT#81575](https://rt.cpan.org/Public/Bug/Display.html?id=81575))
4. Update `ExtUtils::MakeMaker` via [cpanm]
5. Install `LWP::UserAgent`, `LWP::Protocol::https`, `JSON::XS` using [cpanm]
###### Amazon Linux 2013.03
`sudo yum install perl-core perl-JSON-XS perl-libwww-perl perl-LWP-Protocol-https`
###### MacOS X
Install the following packages:
Install `LWP::UserAgent` (`p5-libwww-perl`), `JSON::XS` (`p5-json-XS`). For HTTPS support you need `LWP::Protocol::https`, however on MacOS X
you probably need `Mozilla::CA` (it should go with `LWP::Protocol::https`, but it can be missing). Try to use HTTPS without `Mozilla::CA` - if it does not work, install
`Mozilla::CA`
#### Install mt-aws-glacier
git clone https://github.com/vsespb/mt-aws-glacier.git
(or just download and unzip `https://github.com/vsespb/mt-aws-glacier/archive/master.zip` )
After that you can execute `mtglacier` script (found in root of repository) from any directory, or create a symlink to it - it will find other package files by itself
cpan -i App::MtAws
That's it.
### Installation general instructions, troubleshooting, edge cases and misc instructions
##### In general you need the following perl modules to run *mt-aws-glacier*:
* **LWP::UserAgent** (or Debian package **libwww-perl** or RPM package **perl-libwww-perl** or MacPort **p5-libwww-perl**)
* **JSON::XS** (or Debian package **libjson-xs-perl** or RPM package **perl-JSON-XS** or MacPort **p5-json-XS**)
##### Other notes
1. for old Perl < 5.9.3 (i.e. *CentOS 5.x*), install also **Digest::SHA** (or Debian package **libdigest-sha-perl** or RPM package **perl-Digest-SHA**)
2. Some distributions with old Perl stuff (examples: *Ubuntu 10.04*, *CentOS 5/6*) to use HTTPS you need to upgrade **LWP::Protocol::https** to version 6+ via CPAN.
3. *Fedora*, *CentOS 6* etc [decoupled](http://www.nntp.perl.org/group/perl.perl5.porters/2009/08/msg149747.html) Perl,
so package named `perl`, which is a part of default installation, is not actually real, full Perl, which is misleading.
`perl-core` is looks much more like a real Perl (I [hope](https://bugzilla.redhat.com/show_bug.cgi?id=985791) so)
lib/App/MtAws/Glacier/Inventory/JSON.pm view on Meta::CPAN
package App::MtAws::Glacier::Inventory::JSON;
our $VERSION = '1.120';
use strict;
use warnings;
use utf8;
use Carp;
use JSON::XS 1.00;
use App::MtAws::Glacier::Inventory ();
use base q{App::MtAws::Glacier::Inventory};
sub new
{
my $class = shift;
my $self = { rawdata => \$_[0] };
bless $self, $class;
$self;
}
sub _parse
{
my ($self) = @_;
$self->{data} = JSON::XS->new->allow_nonref->utf8->decode(${ delete $self->{rawdata} || confess });
}
1;
lib/App/MtAws/Glacier/ListJobs.pm view on Meta::CPAN
package App::MtAws::Glacier::ListJobs;
our $VERSION = '1.120';
use strict;
use warnings;
use utf8;
use Carp;
use JSON::XS 1.00;
use App::MtAws::Utils;
use App::MtAws::MetaData;
sub new
{
my $class = shift;
my $self = { rawdata => \$_[0] };
bless $self, $class;
$self;
}
sub _parse
{
my ($self) = @_;
return if $self->{data};
$self->{data} = JSON::XS->new->allow_nonref->decode(${ delete $self->{rawdata} || confess });
# get rid of JSON::XS boolean object, just in case.
# also JSON::XS between versions 1.0 and 2.1 (inclusive) do not allow to modify this field
# (modification of read only error thrown)
$_->{Completed} = !!(delete $_->{Completed}) for @{$self->{data}{JobList}};
}
sub _completed
{
$_->{Completed} && $_->{StatusCode} eq 'Succeeded'
}
lib/App/MtAws/Glacier/ListVaults.pm view on Meta::CPAN
package App::MtAws::Glacier::ListVaults;
our $VERSION = '1.120';
use strict;
use warnings;
use utf8;
use Carp;
use JSON::XS 1.00;
use App::MtAws::Utils;
use App::MtAws::MetaData;
sub new
{
my $class = shift;
my $self = { rawdata => \$_[0] };
bless $self, $class;
$self;
}
sub _parse
{
my ($self) = @_;
return if $self->{data};
$self->{data} = JSON::XS->new->allow_nonref->decode(${ delete $self->{rawdata} || confess });
}
sub get_list_vaults
{
my ($self) = @_;
$self->_parse;
$self->{data}{Marker}, @{$self->{data}{VaultList}};
}
lib/App/MtAws/GlacierRequest.pm view on Meta::CPAN
} elsif (defined($resp->content_length) && $resp->content_length != length($resp->content)){
print "PID $$ HTTP Unexpected end of data. Will retry ($dt seconds spent for request)\n";
$self->{last_retry_reason}='Unexpected end of data';
throttle($i);
} else {
return $resp;
}
} else {
if ($resp->code =~ /^40[03]$/) {
if ($resp->content_type && $resp->content_type eq 'application/json') {
my $json = JSON::XS->new->allow_nonref;
my $scalar = eval { $json->decode( $resp->content ); }; # we assume content always in utf8
if (defined $scalar) {
my $code = $scalar->{code};
my $type = $scalar->{type};
my $message = $scalar->{message};
if ($code eq 'ThrottlingException') {
print "PID $$ ThrottlingException. Will retry ($dt seconds spent for request)\n";
$self->{last_retry_reason} = 'ThrottlingException';
throttle($i);
next;
lib/App/MtAws/LineProtocol.pm view on Meta::CPAN
package App::MtAws::LineProtocol;
our $VERSION = '1.120';
use strict;
use warnings;
use utf8;
use Carp;
use JSON::XS;
use App::MtAws::Utils;
use Exporter 'import';
our @EXPORT = qw/ get_data send_data/;
our @EXPORT_OK = qw/escape unescape encode_data decode_data/;
# yes, a module, so we can unit-test it (JSON and YAML have different serialization implementeation)
my $json_coder = JSON::XS->new->ascii(1)->allow_nonref;
sub decode_data
{
my ($data_e) = @_;
return $json_coder->decode($data_e);
}
sub encode_data
{
my ($data) = @_;
lib/App/MtAws/MetaData.pm view on Meta::CPAN
package App::MtAws::MetaData;
our $VERSION = '1.120';
use strict;
use warnings;
use utf8;
use Encode;
use MIME::Base64;
use JSON::XS;
use POSIX;
use Time::Local;
use App::MtAws::DateTime;
use constant MAX_SIZE => 1024;
use constant META_JOB_TYPE_FULL => 'full';
use Exporter 'import';
our @EXPORT = qw/meta_decode meta_job_decode meta_encode meta_job_encode META_JOB_TYPE_FULL/;
lib/App/MtAws/MetaData.pm view on Meta::CPAN
2) According to this spec. Same (FILENAME,MTIME) values can produce different x-amz-archive-description, as JSON hash is unordered.
3) This specification explains how to _encode_ data (because it's a specification). However it's easy to
understant how to decode it back.
4) Path separator in filename is '/'
=cut
my $meta_coder = ($JSON::XS::VERSION ge '1.4') ?
JSON::XS->new->utf8->max_depth(1)->max_size(MAX_SIZE) : # some additional abuse-protection
JSON::XS->new->utf8; # it's still protected by length checking below
sub meta_decode
{
my ($str) = @_;
return unless defined $str; # protect from undef $str
my ($marker, $b64) = _split_meta($str);
return unless defined $marker;
if ($marker eq 'mt1') {
return _decode_filename_and_mtime(_decode_json(_decode_utf8(_decode_b64($b64))));
t/integration/metadata.t view on Meta::CPAN
use Test::Deep;
use FindBin;
use lib map { "$FindBin::RealBin/$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use App::MtAws::MetaData;
use Carp;
use MIME::Base64 qw/encode_base64/;
use Digest::SHA qw/sha256_hex/;
use Encode;
use JSON::XS;
use Data::Dumper;
use POSIX;
use open qw/:std :utf8/; # actually, we use "UTF-8" in other places.. UTF-8 is more strict than utf8 (w/out hypen)
no warnings 'redefine';
# test _encode_b64/_decode_b64 and UTF8
t/integration/metadata.t view on Meta::CPAN
for (
['file', 1352924178],
['file/a',1351924178],
['file/a/b/c/d','1352124178'],
['диÑекÑоÑиÑ/a/b/c/d','1352124178'],
['диÑекÑоÑиÑ/Ñайл',1352124178],
['диÑекÑоÑиÑ/Ñайл',0],
['диÑекÑоÑиÑ/Ñайл','0'],
) {
my $result = App::MtAws::MetaData::_encode_json(App::MtAws::MetaData::_encode_filename_and_mtime($_->[0], $_->[1]));
my $recoded = JSON::XS->new->utf8->allow_nonref->decode($result);
ok ($result !~ /[\r\n]/m, 'no linefeed');
## ok( $result =~ /\:\s*$_->[1]/, "result should contain mtime as numeric");
is_deeply($recoded, { mtime => to_iso8601($_->[1]), filename => $_->[0]}, "jsone string should be json with correct filename and mtime");
my $result_decoded =decode("UTF-8", $result, Encode::DIE_ON_ERR|Encode::LEAVE_SRC);
ok ($result_decoded =~ /\Q$_->[0]\E/m, "json string should contain UTF without escapes");
my ($filename, $mtime) = App::MtAws::MetaData::_decode_filename_and_mtime(App::MtAws::MetaData::_decode_json($result));
ok ($filename eq $_->[0], 'filename match');
ok ($mtime == $_->[1], 'mtime match');
}
t/integration/metadata_mt1.t view on Meta::CPAN
use strict;
use warnings;
use utf8;
use Test::More tests => 4154;
use FindBin;
use lib map { "$FindBin::RealBin/$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use App::MtAws::MetaData;
use Encode;
use JSON::XS;
use POSIX;
my $meta_coder = JSON::XS->new->utf8;
for my $char1 (qw/a b c d e f _ à µ Ũ а б в г д е Ñ Ð¶ з и к л м н о п Ñ Ñ Ñ Ñ Ñ Ñ Ñ Ñ Ñ Ñ Ñ Ñ Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð Ð¡ Т У Ф Ð¥ Ц Ч Ш Щ РЮ Я/) {
test($char1);
for my $char2 (qw/a _ à µ Ũ а Ñ Ð Ð Ð¯/) {
test($char1.$char2);
test($char1.'/'.$char2);
test($char1.'A'.$char2);
}
}
t/lib/JobListEmulator.pm view on Meta::CPAN
# 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 JobListEmulator;
use strict;
use warnings;
use TestUtils 'w_fatal';
use Carp;
use JSON::XS 1.00;
sub new
{
my $class = shift;
my $self = { seq => 0, markers => {} };
bless $self, $class;
}
sub _validate_fields
{
t/lib/JobListEmulator.pm view on Meta::CPAN
$self->{page_to_marker}{$next_page} ||= do {
my $seq = ++$self->{seq};
my $m = "marker_$seq";
$self->{markers}{$m} = $next_page;
$m;
}
} else {
undef;
}
};
JSON::XS->new->utf8->allow_nonref->pretty->encode({
JobList => $self->{pages}[$page_index],
Marker => $new_marker,
});
}
sub add_archive_fixture
{
my ($self, $id) = @_;
$self->add_page(
map {
t/lib/TestUtils.pm view on Meta::CPAN
{
@_ = grep { ! (exists $SPECIAL_EXPORT{$_} && ($SPECIAL_EXPORT{$_} = 1)) } @_;
warning_fatal() if ($SPECIAL_EXPORT{w_fatal}) ; # compile time warnings fatal
goto &Exporter::import;
}
use Test::Deep; # should be last line, after EXPORT stuff, otherwise versions ^(0\.089|0\.09[0-9].*) do something nastly with exports
use constant ALARM_FOR_FORK_TESTS => 30;
# different versions of JSON::XS documents different constants to use
# what is allowed in both cases - is the use of \0 and \1
use constant JSON_XS_TRUE => \1;
use constant JSON_XS_FALSE => \0;
# run time or compile time warnings fatal
sub warning_fatal
{
my ($skip_re) = @_;
$SIG{__WARN__} = sub {
if (!defined($skip_re) || $_[0] !~ $skip_re) {
t/unit/cmd_download_inventory.t view on Meta::CPAN
sub assert_entry_json
{
my ($inp, $out) = @_;
unlink $journal;
my $jdata = {
"VaultARN" => "arn:aws:glacier:us-east-1:123456:vaults/test",
"InventoryDate" => strftime("%Y%m%dT%H%M%SZ", gmtime(time)),
"ArchiveList" => [$inp],
};
my $json = JSON::XS->new->allow_nonref->ascii->pretty->encode($jdata);
my $J = App::MtAws::Journal->new(journal_file=> $journal, root_dir => $rootdir);
no warnings 'redefine';
local *App::MtAws::Journal::add_entry = sub {
my (undef, $e) = @_;
cmp_deeply $e, $out;
};
App::MtAws::Command::DownloadInventory::parse_and_write_journal($J, INVENTORY_TYPE_JSON, \$json);
}
sub assert_entry_csv
t/unit/glacier/list_jobs.t view on Meta::CPAN
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
use Test::More tests => 53;
use Test::Deep;
use Carp;
use FindBin;
use JSON::XS;
use lib map { "$FindBin::RealBin/../$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use App::MtAws::Glacier::ListJobs;
use Data::Dumper;
#
# Unit testing
#
sub create_json
{
JSON::XS->new()->encode({JobList => [ {
Action => 'InventoryRetrieval',
ArchiveId => "somearchiveid",
ArchiveSHA256TreeHash => "sometreehash",
Completed => JSON_XS_TRUE,
CompletionDate => "2013-11-01T22:57:23.968Z",
CreationDate => "2013-11-01T19:01:19.997Z",
InventorySizeInBytes => 45012,
JobDescription => undef,
JobId => "MyJobId",
RetrievalByteRange => undef,
t/unit/glacier/list_vaults.t view on Meta::CPAN
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
use Test::More tests => 13;
use Test::Deep;
use Carp;
use FindBin;
use JSON::XS;
use lib map { "$FindBin::RealBin/../$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use App::MtAws::Glacier::ListVaults;
use Data::Dumper;
#
# Unit testing
#
sub create_json
{
JSON::XS->new()->encode({VaultList => [ {
CreationDate => "2013-11-01T19:01:19.997Z",
LastInventoryDate => "2013-10-01T19:01:19.997Z",
NumberOfArchives => 100,
SizeInBytes => 100_500,
VaultARN => "arn:aws:glacier:eu-west-1:112345678901:vaults/xyz",
VaultName => "myvault",
@_
}, {
CreationDate => "2013-10-01T19:01:19.997Z",
LastInventoryDate => "2013-09-01T19:01:19.997Z",
t/unit/metadata.t view on Meta::CPAN
use strict;
use warnings;
use utf8;
use Test::Spec;
use FindBin;
use lib map { "$FindBin::RealBin/$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use App::MtAws::MetaData;
use Encode;
use JSON::XS;
use Data::Dumper;
describe "MetaData" => sub {
it "should catch undef in _decode_json" => sub {
JSON::XS->expects("decode");
App::MtAws::MetaData::_decode_json
App::MtAws::MetaData::_encode_json(App::MtAws::MetaData::_encode_filename_and_mtime('ÑеÑÑ', 1));
JSON::XS->expects("decode")->never();
ok !defined App::MtAws::MetaData::_decode_json undef;
};
it "should not call encode" => sub {
App::MtAws::MetaData->expects("_encode_utf8")->never();
App::MtAws::MetaData::meta_encode('ÑеÑÑ', 1);
ok 1;
};
it "should not call decode for current metadata version" => sub {
App::MtAws::MetaData->expects("_decode_utf8")->never();
t/unit/test_test.t view on Meta::CPAN
ok ( (!! is_posix_root()) == (!!Win32::IsAdminUser()) );
ok ( (!! is_posix_root()) == (!!Win32::IsAdminUser()) ); # double check, as it's cached
} else {
ok ( (!! is_posix_root()) == (!! ($>==0)) );
ok ( (!! is_posix_root()) == (!! ($>==0)) ); # double check, as it's cached
}
}
{
use JSON::XS 1;
my $json = JSON::XS->new->utf8->allow_nonref;
my $s = $json->encode({myfield => JSON_XS_TRUE});
like $s, qr/\:\s*true\s*\}/;
ok $json->decode($s)->{myfield};
$s = $json->encode({myfield => JSON_XS_FALSE});
like $s, qr/\:\s*false\s*\}/;
ok !$json->decode($s)->{myfield};
}
use 5.008008; # minumum perl version is 5.8.8
use TAP::Harness;
use strict;
use warnings;
use utf8;
use FindBin;
use Config;
# build requirements
use JSON::XS ();
use Test::Deep ();
use Test::Simple ();
use File::Temp ();
use Test::More ();
use Test::MockModule ();
use LWP::UserAgent ();
use DateTime ();
use Test::Spec ();
use MIME::Base64;
# for 5.8.x stock perl