App-MtAws

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

			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,

META.json  view on Meta::CPAN

            "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",

META.yml  view on Meta::CPAN

  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

README.md  view on Meta::CPAN


###### 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:

README.md  view on Meta::CPAN

###### 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

README.md  view on Meta::CPAN

		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};
}

test.t  view on Meta::CPAN


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



( run in 1.255 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )