• Your recent searches
App-MtAws
8 results

 view release on metacpan or  search on metacpan

ChangeLog  view on Meta::CPAN 

  suite failure) under OpenBSD 5.1

### 2013-07-30 v0.975 beta

  * Fixed: files with content "0" caused crash (unexpected error), issue #42

  * Documentation: small update for Fedora install instructions

  * When downloading from glacier, temporary files were created, download performed, then temp files were renamed to
  target filename (this is atomic), then target file attributes were adjusted and file modification time changed.
  Now chmod/mtime performed before file is renamed. So more atomic now.

  * Fixed: File::Temp required version decreased, so can work on perl-5.8.8 without upgrading this module

  * Internal: Code to work with temporary files reworked, testsuite added. IPC small refactoring + testsuite added.

### 2013-07-21 v0.974 beta

  * Deprecations (deprecated options produce warning, and can start producing errors some day)
  --to-dir, --from-dir deprecated in faviour of --dir
  --from-vault, --to-vault deprecated in faviour of --vault

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

{
	my $self = shift;
	confess "unknown arguments" if @_;
	my $binary_target_filename = binaryfilename($self->{target_file});

	my $character_tempfile = delete $self->{tempfile} or confess "file already permanent or not initialized";
	$self->{tmp}->unlink_on_destroy(0);
	undef $self->{tmp};
	my $binary_tempfile = binaryfilename($character_tempfile);

	chmod((0666 & ~umask), $binary_tempfile) or confess "cannot chmod file $character_tempfile";
	utime $self->{mtime}, $self->{mtime}, $binary_tempfile or confess "cannot change mtime for $character_tempfile" if defined $self->{mtime};
	rename $binary_tempfile, $binary_target_filename or
		die exception "cannot_rename_file" => "Cannot rename file %string from% to %string to%",
		from => $character_tempfile, to => $self->{target_file};
}

# File::Temp < 0.19 does not have protection from calling destructor in fork'ed child
# and forking can happen any moments, some code in File::Spec/Cwd etc call it to exec external commands
# this workaround prevents this, however destruction order is undefined so that might just fail

t/integration/cmd_check_local_hash.t  view on Meta::CPAN 

	my $J = App::MtAws::Journal->new(journal_file=> $journal, root_dir => $rootdir);
	$J->open_for_write();
	$J->add_entry({ type=> 'CREATED', time => $data->{time}, mtime => $data->{mtime}, archive_id => $data->{archive_id},
		size => length($content), treehash => $data->{treehash}, relfilename => $data->{relfilename} });
}

SKIP: {
	skip "Cannot run under root", 5 if is_posix_root;
	my $file = "$rootdir/def/abc";
	mkpath "$rootdir/def";
	chmod 0744, $file;
	open F, '>', $file or die $!;
	print F $content;
	close F;
	chmod 0000, $file;

	my $options = {
		region => 'reg',
		journal => $journal,
		dir => $rootdir,
		journal_encoding => 'UTF-8',
	};

	my $j = App::MtAws::Journal->new(journal_encoding => $options->{'journal-encoding'},
		journal_file => $options->{journal},

t/integration/cmd_check_local_hash.t  view on Meta::CPAN 

	my $err = $@;

	cmp_deeply $err, superhashof { code => 'check_local_hash_errors',
		message => "check-local-hash reported errors"};

	ok $out =~ m!CANNOT OPEN file def/abc!;
	ok $out =~ m!1 ERRORS!;
	ok index($out, get_errno(strerror(EACCES))) != -1;
	# TODO: check also that 'next' is called!

	chmod 0744, $file;
	unlink $file;
1;

}


1;

t/integration/config_engine_config_file.t  view on Meta::CPAN 

rmtree($file);


my @line = (qw!purge-vault --key=k --secret=s --region=myregion -to-vault=myvault --journal x --config!, $file);
SKIP: {
	skip "Cannot run under root", 6 if is_posix_root;
	rmtree($file);
	open F, ">", $file;
	print F " ";
	close F;
	chmod 0000, $file;
	disable_validations sub {
		ok ! defined eval { config_create_and_parse(@line); 1; };
		my $err = get_exception();
		ok $err;
		is $err->{code}, 'cannot_read_config';
		is $err->{config}, hex_dump_string($file);
		is $err->{errno}, get_errno(POSIX::strerror(EACCES));
		is exception_message($err), "Cannot read config file: ".hex_dump_string($file).", errno=".get_errno(POSIX::strerror(EACCES));
	};
}

t/integration/config_engine_upload_file_real.t  view on Meta::CPAN 

		ok -d $normal_rel;
		ok -d $normal_rel;


		test_file_and_dir "dir/filename should work",
			"another/..", $file_rel, $file_rel;

		test_file_and_dir "dir/filename should work",
			"$mtroot/restricted/normal", $file_rel, $file_rel;

		chmod 000, $restricted_abs;

		ok  -f $file_rel;
		ok !-f $file_abs;
		ok !-d $normal_rel;
		ok !-d $normal_abs;

		fails_file_and_dir "filename inside dir - dir is unresolvable",
			"another/..", $file_rel, 'cannot_resolve_dir', a => 'dir';

		fails_file_and_dir "filename inside dir - file is unresolvable",
			$mtroot, $file_rel, 'cannot_resolve_file', a => 'filename';

		chmod 700, $restricted_abs;
	}
};

# TODO: also test with non-ascii filenames
with_my_dir "d1", sub {
	touch "myfile";
	touch "unreadable";
	touch "empty", "";

	chmod 000, "unreadable";

	assert_fails_on_filesystem "should check --filename for readability",
		[qw!upload-file --config glacier.cfg --vault myvault --journal j --set-rel-filename somefile!, '--filename', "notafile"],
		[],
		'%option a% not a file', a => 'filename', value => 'notafile';

	assert_fails_on_filesystem "should check --filename for readability",
		[qw!upload-file --config glacier.cfg --vault myvault --journal j --set-rel-filename somefile!, '--filename', "empty"],
		[],
		'%option a% file size is zero', a => 'filename', value => 'empty';

t/integration/queue_job/multipart_create_files.t  view on Meta::CPAN 

	open F, ">", $file;
	print F $content if defined $content;
	close F;

}

my $mtroot = get_temp_dir();
my $relfilename = 'multipart_create';
my $filename = "$mtroot/$relfilename";

chmod 0744, $filename;
unlink $filename;

{
	create($filename, '');
	my $job = App::MtAws::QueueJob::MultipartCreate->new(filename => $filename, relfilename => $relfilename, partsize => 2);
	ok ! eval { $job->init_file(); 1; };
	my $err = $@;
	cmp_deeply $err, superhashof { code => 'file_is_zero',
		message => "File size is zero (and it was not when we read directory listing). Filename: %string filename%",
		filename => $filename };

t/integration/queue_job/multipart_create_files.t  view on Meta::CPAN 

	my $job = App::MtAws::QueueJob::MultipartCreate->new(filename => $fullfilename, relfilename => $relfilename, partsize => 2);
	$job->init_file();
	is $job->{mtime}, stat($koi_filename)->mtime;
	unlink $koi_filename;
}

SKIP: {
	skip "Cannot run under root", 3 if is_posix_root;

	create($filename, 'x');
	chmod 0000, $filename;
	my $job = App::MtAws::QueueJob::MultipartCreate->new(filename => $filename, relfilename => $relfilename, partsize => 2);
	ok ! eval { $job->init_file(); 1; };
	my $err = $@;
	cmp_deeply $err, superhashof { code => 'upload_file_open_error',
		message => "Unable to open task file %string filename% for reading, errno=%errno%",
		filename => $filename };

	is $err->{errno}, get_errno(POSIX::strerror(EACCES));
	chmod 0744, $filename;
	unlink $filename;
}

chmod 0744, $filename;
unlink $filename;


{
	create($filename, 'x');

	for my $partsize_mb (1, 2, 4) {
		my $partsize = $partsize_mb*1024*1024;
		my $edge_size = $partsize*10_000;

t/unit/intermediate_file.t  view on Meta::CPAN 

		$permanent_name;
	}, "permanent file not discarded";

}

SKIP: {
	skip "Cannot run under root", 5 if is_posix_root;
	my $dir = "$rootdir/denied1";
	ok mkpath($dir), "path is created";
	ok -d $dir, "path is created";;
	chmod 0444, $dir;
	ok ! defined eval { App::MtAws::IntermediateFile->new(target_file => "$dir/somefile"); 1 }, "File::Temp should throw exception";
	is get_exception->{code}, 'cannot_create_tempfile', "File::Temp correct code for exception";
	is get_exception->{dir}, $dir, "File::Temp correct dir for exception";
}

SKIP: {
	skip "Cannot run under root", 5 if is_posix_root;
	my $dir = "$rootdir/denied2";
	ok mkpath($dir), "path is created";
	ok -d $dir, "path is created";;
	chmod 0444, $dir;
	ok ! defined eval { App::MtAws::IntermediateFile->new(target_file => "$dir/b/c/somefile"); 1 }, "mkpath() should throw exception";
	is get_exception->{code}, 'cannot_create_directory', "mkpath correct code for exception";
	is get_exception->{dir}, "$dir/b/c", "mkpath correct dir for exception";
}

SKIP: {
	skip "Cannot run under root", 7 if is_posix_root;
	my $dir = "$rootdir/testpermanent";
	ok ! -e $dir, "not yet exists";
	ok mkpath($dir), "path is created";

t/unit/intermediate_file.t  view on Meta::CPAN 

SKIP: {
	for (5) {
		skip "Test cannot be performed on character-oriented filesystem", $_ unless can_work_with_non_utf8_files;
		skip "Cannot run under root", $_ if is_posix_root;
	}
	local $App::MtAws::Utils::_filename_encoding = 'KOI8-R';
	is get_filename_encoding, 'KOI8-R', "assume encoding is set";
	my $basedir = "$rootdir/base1";
	ok ! -e $basedir, "basedir not yet exists";
	ok mkpath($basedir), "basedir created";
	chmod 0444, $basedir;
	my $dir = "$basedir/тест1";
	my $koidir = encode("KOI8-R", $dir);
	ok ! defined eval { App::MtAws::IntermediateFile->new(target_file => "$dir/somefile"); 1 }, "should fail with exception";
	my $msg = exception_message(get_exception);
	$msg =~ s/[[:ascii:]]//g;
	like $msg, qr/^(тест)+$/, "the only non-ascii characters should be utf name";
}

SKIP: {
	for (6) {
		skip "Test cannot be performed on character-oriented filesystem", $_ unless can_work_with_non_utf8_files;
		skip "Cannot run under root", $_ if is_posix_root;
	}
	local $App::MtAws::Utils::_filename_encoding = 'KOI8-R';
	is get_filename_encoding, 'KOI8-R', "assume encoding is set";
	my $basedir = "$rootdir/тест42";
	my $koidir = encode("KOI8-R", $basedir);
	ok ! -e $koidir, "basedir not yet exists";
	ok mkpath($koidir), "basedir created";
	ok chmod(0444, $koidir), "permissions 0444 ok";
	ok ! defined eval { App::MtAws::IntermediateFile->new(target_file => "$basedir/somefile"); 1 }, "should fail with exception";
	my $msg = exception_message(get_exception);
	$msg =~ s/[[:ascii:]]//g;
	like $msg, qr/^(тест)+$/, "the only non-ascii characters should be utf name";
}


1;

t/unit/journal_openmodes.t  view on Meta::CPAN 





my $mtroot = get_temp_dir();
my $rootdir = 'def';
my $file = "$mtroot/journal_open_mode";
my $fixture = "A\t123\tCREATED\tasfaf\t1123\t1223\tahdsgBd\tabc/def";


chmod 0744, $file if -e $file;


# checking when reading journal

{
	my $J = App::MtAws::Journal->new(journal_file=>$file, root_dir => $rootdir);

	create($file, $fixture);
	eval {
		$J->read_journal();

t/unit/journal_openmodes.t  view on Meta::CPAN 

	};
	ok $@ ne '', "should_exist should work when true and file missing";
}

SKIP: {
	skip "Cannot run under root", 6 if is_posix_root;

	my $J = App::MtAws::Journal->new(journal_file=>$file, root_dir => $rootdir);

	create($file, $fixture);
	chmod 0000, $file;
	my $err_expected = get_errno(POSIX::strerror(EACCES));
	ok ! defined eval {
		$J->read_journal(should_exist => 1);
		1;
	};
	chmod 0744, $file;
	unlink($file);
	ok is_exception('journal_open_error'), "should_exist should work when true and file missing";
	is get_exception->{message}, "Unable to open journal file %string filename% for reading, errno=%errno%";

	is get_exception->{errno}, $err_expected;
	ok length(get_exception->{errno}) > 4; # should be a string, not a number
	is get_exception->{filename}, $file;
}

{

t/unit/journal_openmodes.t  view on Meta::CPAN 

	$J->open_for_write();

	$J->_write_line($fixture);
	ok -s $file, "should write to file, even without closing file";
}

SKIP: {
	skip "Cannot run under root", 6 if is_posix_root;
	unlink($file);
	create($file, $fixture);
	chmod 0444, $file;
	my $J = App::MtAws::Journal->new(journal_file=>$file, root_dir => $rootdir);
	ok ! defined eval {
		$J->open_for_write();
		1;
	};
	chmod 0744, $file;
	unlink($file);

	ok is_exception('journal_open_error'), "should_exist should work when true and file missing";
	is get_exception->{message}, "Unable to open journal file %string filename% for writing, errno=%errno%";
	is get_exception->{errno}, get_errno(POSIX::strerror(EACCES));
	ok length(get_exception->{errno}) > 4; # should be a string, not a number
	is get_exception->{filename}, $file;
}

{



( run in 0.464 second using v1.01-cache-2.11-cpan-8d75d55dd25 )