App-MtAws
view release on metacpan or search on metacpan
* Fixed - there can be issue on MacOSX that HTTPS is not working: All requests end up with errors "HTTP connection
problem (timeout?)". Found that Apple ships LWP::Protocol::https without Mozilla::CA module (and they have no rights to
do so). So now a README install instructions updated and runtime error thrown if Mozilla::CA is missing and yo're trying
to use HTTPS. More technical info: http://blogs.perl.org/users/vsespb/2014/07/broken-lwp-in-the-wild.html
https://github.com/vsespb/mt-aws-glacier/issues/87
* Fixed - typo in error message.
### 2014-05-26 v1.115
* Fixed - crash/error when uploading large files with partsize=1024, when "old" Digest::SHA (< 5.63; shipped with most
of current linux distros) is installed. Old Digest::SHA has a bug, there was a workaround for it (i.e. message asking
to upgrade module) when it's used with large files on 32bit machines, but apparently seems 64bit machines
also affected.
Now a message removed, instead workaround code written so it now works with old buggy versions fine (i.e. splits large
chunks into smalled ones when feeding Digest::SHA).
* Since v1.113 Ubuntu Raring 13.04 PPA is discontinued (due to End of Life of Ubuntu Raring, launchpad PPA stopped
building binaries for it)
### 2014-02-20 v1.114
Fixing now inconsistency in behaviour with such metadata between different OS/perl versions.
After this fix file modification time will be restored correctly from Amazon servers to journal (via download-inventory)
on all platforms, for all years in range 1000-9999.
However if your OS/filesystem does not work with such dates, anything except correct date in journal file
is not guaranteed.
Before this fix, such dates could result in lost of filenames and modification time in journal (filename replaced
with random token) when restoring inventory (you are affected if you uploaded file on 64bit system with date
after Y2038, but then restored on 32bit system).
* Documentation: Also, note about Y2038 added to "Limitationss" section.
* CSV inventory parsing - making it 30% slower, but more consistent with what Amazon documented about its format
https://forums.aws.amazon.com/thread.jspa?threadID=141807&tstart=0
* Cosmetic changes to docs
* CPAN install - on some systems like ARM, some NAS, 32bit OSes decrease number of concurrent tests during install.
* Documentation: Fixed - installation instructions for Debian via custom repository improved - lsb_release command,
used in install instruction, was not a part of (some?) minimal Debian installs. So some users experienced problems
installing mtglacier first time. I suspect users who use FISH shell were affected too.
### 2013-12-20 v1.111
* Brittle test fixed (i386, old Digest::SHA)
### 2013-12-20 v1.110
* Compatibility: upload-file with --filename option behaviour slightly changed:
both --filename and --dir now resolved to full paths, before determining relative path from --dir` to --filename`
So f you have `/dir/ds` symlink to `/dir/d3` directory, then `--dir=/dir` `--filename=/dir/ds/file` will result in
relative filename `d3/file` not `ds/file`. Previously you would get d3/file. Also now all parent directories has
to be readable.
* Documentation: documentation for upload-file updated.
* Fixed: #63 internaly mtglacier was using absolute filenames when reading/writing file in filesystem, even if user
specified relative. Seems that was wrong. Undex Unix file can be readable by relative name but unaccessible by real,
absolute name if path components of this name are unreadable. Fixed now - always use relative filenames in all commands
except upload-file command (where it's documented that absolute names are used).
This change does not affect relative filenames stroed in journal or amazon glacier metadata in any way.
This change might affect filenames format that you see in mtglacier output.
* Fixed: some bugs related to directory traversal under old-old perl installations (RHEL 5.x, when no new
CPAN modules installed) worked around.
* Fixed: upload-file with --filename and --dir were not working correctly for most of perl installations
if dir started with "..". This due to bug https://rt.perl.org/Public/Bug/Display.html?id=111510 in File::Spec module.
Currently upload-file behaviour changed (see above in ChangeLog) so mtglacier not affected. In previous versions this
would result in wrong relative filenames in journal and Amazon glacier metadata
(precisely, those filenames are without path prefix, as if they would be in current directory, otherwise filename
part is correct).
* Workaround: Digest::SHA perl module prior to version 5.62 calculates SHA256 wrong on 32bit machines, when data
size is more than 2^29 bytes. Now mtglacier throws an error if --partsize >= 512Mb and machine is 32bit and digest-sha
version is below 5.62. Commands which don't use --partsize are unaffected.
* Fixed: Amazon CSV format parsing: Amazon escapes doublequote with backslash but.. does not escape backslash itself.
https://forums.aws.amazon.com/thread.jspa?threadID=141807
It's hard to determine inventory format until you download it, so mt-aws-glacier now supports CSV parsing.
* Fixed: download-inventory command now fetches latest inventory, not oldest
* Added --request-inventory-format option for retrieve-inventory commands
* Documentation: updated docs for retrieve-inventory and retrieve-inventory and download-inventory commands
### 2013-12-10 v1.102
* Fixed: memory/reasource leak, introduced in v1.100. Usually resulting in crash after uploading ~ 1000 files ( too
many open files error)
* Minor improvements to process termination code
### 2013-12-08 v1.101
* Fixed: CPAN install was failing for non-English locales due to brittle test related to new FSM (introduced in 1.100)
Also error message when reading from file failed in the middle of transfer was wrong for non-English locales.
* Added validation - max allowed by Amazon --partsize is 4096 Mb
* Fixed: Dry-run with restore completed was crashing.
Fixed a bug introduced in v0.971
dry-run and restore-completed used archive_id instead of relative filename and thus was crashing with message:
UNEXPECTED ERROR: SOMEARCHIVEID not found in journal at ... /lib/App/MtAws/Journal.pm line 247.
### 2013-11-08 v1.058
* Fixed - when downloading inventory there could be Perl warning message ("use initialized ..") in case when some
specific metadata (x-amz-archive-description) strings (like empty strings) met. Such metadata can appear if
archives were uploaded by 3rd party apps.
* Fixed possible deadlock before process termination (after success run or after Ctrl-C), related to issue
https://rt.perl.org/Ticket/Display.html?id=93428 - select() is not always interruptable. Issue seen
under heavy load, under perl 5.14, with concurrency=1 (unlikely affects concurrency modes > 1 )
* Fixed - when deprecated option for command (say, --vault for check-local-hash) was found in config, there was a
warning that option deprecated, however that should not happen, because everything that is in config should be
read only when such option required (you should be able to put any unneeded option into config)
### 2013-10-15 v1.056
* mtglacier now can be installed via Ubuntu PPA - install instructions updated.
### 2013-09-25 v1.055
* Fixed: sync --replace-modified were not deleting old files in Amazon Glacier in case --detect option causing a check
of treehash before upload.
Affected workflows:
--detect=treehash - when file actually uploaded after check
--detect=mtime-and-treehash (i.e. default --detect) - when file actually uploaded after check
--detect=mtime-or-treehash when mtime is same but treehash differs and thus file actually uploaded
Not affected workflows:
when file size differs and thus file uploaded,
--detect=mtime-or-treehash - when mtime differs and thus file uploaded
anything else not listed above.
* More fixes to installation instructions
* Cosmetic fixes to --detect documentation
### 2013-09-03 v1.051
* Installation instructions reworked
config file
* Enhancement: sync now acception --follow - follow symbolic links, documentation updated.
* Enhancement: --detect now accepts new value "size-only"
### 2013-07-10 v0.972 beta
* FSM potential bug fixed, can lead to possible instability
* FSM bug fixed - with --concurrency=1 it was not deleting old archives after upload replacements
* Enhancement: --detect now accepts new value "always-positive"
### 2013-07-09 v0.971 beta
* Enhancement: sync command now can synchronize modified files or propogate deletions (backward compatibility
with previous command line API preserved) - see documentation for sync command (--new, --replace-modified,
--delete-removed, --detect options)
* Compatibility: journal format modified. only backward compatibility preserved, no forward compatibility (i.e. if you
* Fix crash in 'help' command, bug was introduced a day ago.
* New version numbering for beta versions - 0.9XY. Where 'X' is a month number of year 2013. 'Y' is number a of
a release in this month. So 0.933beta is 3rd release in April 2013
### 2013-03-12: v0.89 beta
* Single-byte character encodings support for *BSD systems added (see "Configuring Character Encoding") in README.
* When uploading from STDIN and file is empty, don't create Amazon Glacier upload id before throwing error
### 2013-03-04: v0.88 beta
* upload-file command implemented (upload from STDIN or single upload from file). See README.
* Internal: New Config Engine (config/command line options processing) - will help implement
advanced functionality in the future
* Fix possible crash when read(2) system call can return partial result,
see http://www.perlmonks.org/?node_id=435814
### 2013-02-23: v0.87 beta
* More verbose error message if we found broken UTF-8 in filenames
* Compatibility - Amazon Glacier Metadata: only backward compatible with previous versions.
* Documentation improvements
* Error checking improved when reading config file
### 2013-01-21: v0.83 beta
* Bug fixed. File modification time 1970-01-01T00:00:00Z0 (i.e. epoch time = 0 ) was causing crash when
uploading and missing file report when check-local-hash
* Main script: Changed shebang from /usr/bin/perl to /usr/bin/env - this will
allow Mac Port users to work out of the box
* Main script: Cosmetic changes in --help output
* Documentation: added names of CentOS packages, better example of config
file, cosmetic changes, fixed spelling mistakes
### 2013-01-12: v0.82 beta
* Some internal changes to TreeHash implementing (does not affect
working code, but needs for future enhancements)
* Dependency removed - MIME::Base64::encode_base64url (implemented in 2010 in
MIME::Base64), This function is re-implemented. So we can use older versions of this module.
### 2012-12-27: v0.80 beta
* Storing Amazon Glacier metadata (x-amz-archive-description) when
upload files implemented (using custom format).
* More verbose output for check-local-hash command
* Internal: Huge testsuite improvements
* Internal: Refactored: command-line options
processing, Glacier requests code, main program, misc
* New Journal format: added support of file modification time, added journal
version makers (software fully works with old journal files)
* Fixed bug when restore process crashed after successful finishing (only happened when concurrency=1)
* Documentation fixes: Installation instructions improved. Help/Contribute section added.
### 2012-11-17: v0.75 beta
* Bug fixed when signature not calculated
right with retrieve requests (bug found in 0.74 after SHA256 optimization)
* Increased internal limit for maximum in-progress files while uploading (was 3 now 30)
### 2012-11-15: v0.74 beta
* Improved CPU usage apprx 30% - 1) SHA256 was calculated twice sometimes 2) In case data chunk < 1 MB we can
use that TreeHash is equal to SHA256
* Debug code removed, which were causing failing requests in 20% cases
* Some refactoring
t/integration/config_engine_filters.t
t/integration/config_engine_follow.t
t/integration/config_engine_leaf.t
t/integration/config_engine_list_vaults.t
t/integration/config_engine_lwp.t
t/integration/config_engine_partsize.t
t/integration/config_engine_segment_size.t
t/integration/config_engine_sync_new.t
t/integration/config_engine_timeout.t
t/integration/config_engine_token.t
t/integration/config_engine_upload_file.t
t/integration/config_engine_upload_file_real.t
t/integration/config_engine_v078.t
t/integration/config_engine_v082.t
t/integration/config_engine_v085.t
t/integration/config_read_config.t
t/integration/datetime.t
t/integration/fork_engine.t
t/integration/intermediate_file_ipc.t
t/integration/journal.t
t/integration/journal_follow.t
t/integration/journal_parselines.t
t/unit/queue_job/download_single.t
t/unit/queue_job/fetch_and_download.t
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
* [Journal concept](#journal-concept)
* [Specification for some commands](#specification-for-some-commands)
* [sync](#sync)
* [restore](#restore)
* [restore-completed](#restore-completed)
* [upload-file](#upload-file)
* [retrieve-inventory](#retrieve-inventory)
* [download-inventory](#download-inventory)
* [list-vaults](#list-vaults)
* [other commands](#other-commands)
* [File selection options](#file-selection-options)
* [See also](#see-also)
* [Minimum Amazon Glacier permissions](#minimum-amazon-glacier-permissions)
## Features
* Does not use any existing Amazon Glacier library, so can be flexible in implementing advanced features
* Amazon Glacier Multipart upload
* Multi-segment download (using HTTP Range header)
* Multithreaded upload/download
* Multipart+Multithreaded download/upload
* Multithreaded archive retrieval, deletion and download
* TreeHash validation while downloading
* Tracking of all uploaded files with a local journal file (opened for write in append mode only)
* Checking integrity of local files using journal
* Ability to limit number of archives to retrieve
* File selection options for all commands (using flexible rules with wildcard support)
* Full synchronization to Amazon Glacier - new file uploaded, modified files can be replaced, deletions can be propogated
* File name and modification times are stored as Glacier metadata ([metadata format for developers][mt-aws-glacier Amazon Glacier meta-data format specification])
* Ability to re-create journal file from Amazon Glacier metadata
* Full UTF-8 support (and full single-byte encoding support for *BSD systems)
* Multipart/multithreaded upload from STDIN
* User selectable HTTPS support. Currently defaults to plaintext HTTP
* Vault creation and deletion
* STS/IAM security tokens support
[mt-aws-glacier Amazon Glacier meta-data format specification]:https://github.com/vsespb/mt-aws-glacier/blob/master/lib/App/MtAws/MetaData.pm
## Important bugs/missing features
* Only multipart upload implemented, no plain upload
* Mac OS X filesystem treated as case-sensitive
## Production readiness
* After **one year** since first public version released, beta testing was finished and version 1.xxx released. Current project status is **non-beta**, **stable**.
## Installation/System requirements
Script is made for Unix OS. Tested under Linux. Should work under other POSIX OSes (*BSD, Solaris). Lightly tested under Mac OS X.
Will NOT work under Windows/Cygwin. Minimum Perl version required is 5.8.8 (pretty old, AFAIK there are no supported distributions with older Perls)
or non-empty vault in amazon console now. Also make sure you have read _all_ Amazon Glacier pricing/faq.
* Read Amazon Glacier pricing [FAQ][Amazon Glacier faq] again, really. Beware of retrieval fee.
* Before using this program, you should read Amazon Glacier documentation and understand, in general, Amazon Glacier workflows and entities. This documentation
does not define any new layer of abstraction over Amazon Glacier entities.
* In general, all Amazon Glacier clients store metadata (filenames, file metadata) in own formats, incompatible with each other. To restore backup made with `mt-aws-glacier` you'll
need `mt-aws-glacier`, other software most likely will restore your data but loose filenames.
* With low "partsize" option you pay a bit more (Amazon charges for each upload request)
* For backup created with older versions (0.7x) of mt-aws-glacier, Journal file **required to restore backup**.
* Use a **Journal file** only with **same vault** ( more info [here](#what-is-journal) and [here](#how-to-maintain-a-relation-between-my-journal-files-and-my-vaults) and [here](https://github.com/vsespb/mt-aws-glacier/issues/50))
* When work with CD-ROM/CIFS/other non-Unix/non-POSIX filesystems, you might need set `leaf-optimization` to `0`
* Please read [ChangeLog][mt-aws glacier changelog] when upgrading to new version, and especially when downgrading.
(See "Compatibility" sections when downgrading)
For files created by mt-aws-glacier version 0.8x and higher original filenames will be restored. For other files archive_id will be used as filename. See Amazon Glacier metadata format for mt-aws-glacier here: [Amazon Glacier metadata format used by ...
[Amazon Glacier metadata format used by mt-aws glacier]:https://github.com/vsespb/mt-aws-glacier/blob/master/lib/App/MtAws/MetaData.pm
## Journal concept
#### What is Journal
Journal is a file in local filesystem, which contains list of all files, uploaded to Amazon Glacier.
Strictly saying, this file contains a list of operations (list of records), performed with Amazon Glacier vault. Main operations are:
file creation, file deletion and file retrieval.
Create operation records contains: *local filename* (relative to transfer root - `--dir`), file *size*, file last *modification time* (in 1 second resolution), file *TreeHash* (Amazon
hashing algorithm, based on SHA256), file upload time, and Amazon Glacier *archive id*
Delete operation records contains *local filename* and corresponding Amazon Glacier *archive id*
Having such list of operation, we can, any time reconstruct list of files, that are currently stored in Amazon Glacier.
As you see Journal records don't contain Amazon Glacier *region*, *vault*, file permissions, last access times and other filesystem metadata.
Thus you should always use a separate Journal file for each Amazon Glacier *vault*. Also, file metadata (except filename and file *modification time*) will
be lost, if you restore files from Amazon Glacier.
`sync` accepts one or several of the following mode options: `--new`, `--replace-modified`, `--delete-removed`
If none of three above mode options provided, `--new` is implied (basically for backward compatibility).
1. `--new`
Uploads files, which exist in local filesystem (and have non-zero size), but not exist in Amazon Glacier (i.e. in Journal)
2. `--replace-modified`
Uploads modified files (i.e. which exist in local filesystem and in Amazon Glacier). After file gets successfully uploaded,
previous version of file is deleted. Logic of detection of modified files controlled by `--detect` option.
3. `--delete-removed`
Deletes files, which exist in Amazon Glacier, but missing in local filesystem (or have zero size) , from Amazon Glacier.
4. `--detect`
Controls how `--replace-modified` detect modified files. Possible values are: `treehash`, `mtime`, `mtime-or-treehash`, `mtime-and-treehash`,
`always-positive`, `size-only`.
NOTE: default mode for detect is `mtime-and-treehash`, it's more performance wise (treehash checked only for files with modification time changed),
but `mtime-or-treehash` and `treehash` are more safe in case you're not sure which programs change your files and how.
NOTE: `mtime-or-treehash` is mnemonic for *File is modified if mtime differs OR treehash differs*
`mtime-and-treehash` is mnemonic for *File is modified if mtime differs AND treehash differs*. Words
*AND* and *OR* means here logical operators with [short-circuit evaluation](http://en.wikipedia.org/wiki/Short-circuit_evaluation)
i.e. with `mtime-and-treehash` treehash never checked if mtime not differs. And with `mtime-or-treehash` treehash never checked if mtime differs.
NOTE: files with zero sizes are not supported by Amazon Glacier API, thus considered non-existing for consistency, for all `sync` modes.
NOTE: `sync` does not upload empty directories, there is no such thing as directory in Amazon Glacier.
NOTE: With `--dry-run` option TreeHash will not be calculated, instead *Will VERIFY treehash and upload...* message will be displayed.
NOTE: TreeHash calculation performed in parallel, so some of workers (defined with `--concurrency`) might be busy calculating treehash instead
of network IO.
### `restore`
Initiate Amazon Glacier RETRIEVE oparation for files listed in Journal, which don't *exist* on local filesystem and for
which RETRIEVE was not initiated during last 24 hours (that information obtained from *Journal* too - each retrieval logged
into journal together with timestamp)
started from beginning.
In case multi-segment downloads, TreeHash reported by Amazon Glacier for each segment is compared with actual TreeHash, calculated for segment at runtime.
In case of mismatch error is thrown and process stopped. Final TreeHash for whole file not checked yet.
In case full-file downloads, TreeHash reported by Amazon Glacier for whole file is compared with one calculated runtime and with one found in Journal file,
in case of mismatch, error is thrown and process stopped.
Unlike `partsize` option, `segment-size` does not allocate buffers in memory of the size specified, so you can use large `segment-size`.
### `upload-file`
Uploads a single file into Amazon Glacier. File will be tracked with Journal (just like when using `sync` command).
There are several possible combinations of options for `upload-file`:
1. **--filename** and **--dir**
_Uploads what_: a file, pointed by `filename`.
_Filename in Journal and Amazon Glacier metadata_: A relative path from `dir` to `filename`
./mtglacier upload-file --config glacier.cfg --vault myvault --journal journal.log --dir /data/backup --filename /data/backup/dir1/myfile
(this will upload content of `/data/backup/dir1/myfile` to Amazon Glacier and use `dir1/myfile` as filename for Journal )
./mtglacier upload-file --config glacier.cfg --vault myvault --journal journal.log --dir data/backup --filename data/backup/dir1/myfile
(Let's assume current directory is `/home`. Then this will upload content of `/home/data/backup/dir1/myfile` to Amazon Glacier and use `dir1/myfile` as filename for Journal)
NOTE: file `filename` should be inside directory `dir`
NOTE: both `-filename` and `--dir` resolved to full paths, before determining relative path from `--dir` to `--filename`. Thus yo'll get an error
if parent directories are unreadable. Also if you have `/dir/ds` symlink to `/dir/d3` directory, then `--dir /dir` `--filename /dir/ds/file` will result in relative
filename `d3/file` not `ds/file`
2. **--filename** and **--set-rel-filename**
_Uploads what_: a file, pointed by `filename`.
_Filename in Journal and Amazon Glacier metadata_: As specified in `set-rel-filename`
./mtglacier upload-file --config glacier.cfg --vault myvault --journal journal.log --filename /tmp/myfile --set-rel-filename a/b/c
(this will upload content of `/tmp/myfile` to Amazon Glacier and use `a/b/c` as filename for Journal )
(NOTE: `set-rel-filename` should be a _relative_ filename i.e. must not start with `/`)
3. **--stdin**, **--set-rel-filename** and **--check-max-file-size**
_Uploads what_: a file, read from STDIN
_Filename in Journal and Amazon Glacier metadata_: As specified in `set-rel-filename`
Also, as file size is not known until the very end of upload, need to be sure that file will not exceed 10 000 parts limit, and you must
specify `check-max-file-size` -- maximum possible size of file (in Megabytes), that you can expect. What this option do is simply throw error
if `check-max-file-size`/`partsize` > 10 000 parts (in that case it's recommended to adjust `partsize`). That's all. I remind that you can put this (and
any other option to config file)
./mtglacier upload-file --config glacier.cfg --vault myvault --journal journal.log --stdin --set-rel-filename path/to/file --check-max-file-size 131
(this will upload content of file read from STDIN to Amazon Glacier and use `path/to/file` as filename for Journal. )
(NOTE: `set-rel-filename` should be a _relative_ filename i.e. must not start with `/`)
NOTES:
1. In the current version of mtglacier you are disallowed to store multiple versions of same file. I.e. upload multiple files with same relative filename
to a single Amazon Glacier vault and single Journal. Simple file versioning will be implemented in the future versions.
2. You can use other optional options with this command (`concurrency`, `partsize`)
### `retrieve-inventory`
Issues inventory retrieval request for `--vault`.
You can specify inventory format with `--request-inventory-format`. Allowed values are `json` and `csv`. Defaults to `json`.
Although it's not recommended to use `csv` unless you have to. Amazon CSV format is not documented, has bugs and `mt-aws-glacier` CSV parsing
+ AND there are no INCLUDE rules before this EXCLUDE RULE
`--filter '-*.tmp -/media/ -/proc/ +*.jpeg'` - system '/proc' and huge '/media' directory is not traversed.
+ 6) Non-ASCII characters in PATTERNS are supported.
## Additional command line options
NOTE: Any command line option can be used in config file as well, but options specified on command line override options specified in config.
1. `concurrency` (with `sync`, `upload-file`, `restore`, `restore-completed` commands) - number of parallel upload streams to run. (default 4)
--concurrency 4
2. `partsize` (with `sync`, `upload-file` command) - size of file chunk to upload at once, in Megabytes. (default 16)
--partsize 16
3. `segment-size` (with `restore-completed` command) - size of download segment, in MiB (default: none)
If `segment-size` specified (greater than zero), and file size in megabytes is larger than `segment-size`, download performed in
multiple segments.
If omited or zero, multi-segment download is disabled (i.e this is default)
which are made of random bytes/garbage is not supported. usually it's not a problem).
* Filenames with CR (Carriage return, code 0x0D) LF (Line feed, code 0x0A) and TAB (0x09) are not supported (usually not a problem too).
* Length of relative filenames. Currently limit is about 700 ASCII characters or 350 2-byte UTF-8 character (.. or 230 3-byte characters).
* File modification time should be in range from year 1000 to year 9999.
(NOTE: if above requirements are not met, error will be thrown)
* If you uploaded files with file modifications dates past Y2038 on system which supports it, and then restored on system
which does not (like Linux 32bit), resulting file timestamp (of course) wrong and also
unpredictible (undefined behaviour). The only thing is guaranteed that if you restore journal from Amazon servers on affected (i.e. 32bit)
machine - journal will contain correct timestamp (same as on 64bit).
* Memory usage (for 'sync') formula is ~ min(NUMBER_OF_FILES_TO_SYNC, max-number-of-files) + partsize*concurrency
* With high partsize*concurrency there is a risk of getting network timeouts HTTP 408/500.
## Test/Play with it
lib/App/MtAws.pm view on Meta::CPAN
if ($action eq 'sync') {
die "Not a directory $options->{dir}" unless -d binaryfilename $options->{dir};
my $j = App::MtAws::Journal->new(%journal_opts, journal_file => $options->{journal}, root_dir => $options->{dir},
filter => $options->{filters}{parsed}, leaf_optimization => $options->{'leaf-optimization'}, follow => $options->{'follow'});
require App::MtAws::Command::Sync;
check_module_versions;
App::MtAws::Command::Sync::run($options, $j);
} elsif ($action eq 'upload-file') {
defined(my $relfilename = $options->{relfilename})||confess;
my $partsize = delete $options->{partsize};
my $j = App::MtAws::Journal->new(%journal_opts, journal_file => $options->{journal});
with_forks 1, $options, sub {
$j->read_journal(should_exist => 0);
lib/App/MtAws.pm view on Meta::CPAN
die <<"END"
File with same name already exists in Journal.
In the current version of mtglacier you are disallowed to store multiple versions of same file.
Multiversion will be implemented in the future versions.
END
if (defined $j->{journal_h}->{$relfilename});
## use Test::Tabs
if ($options->{'data-type'} ne 'filename') {
binmode STDIN;
check_stdin_not_empty(); # after we fork, but before we touch Journal for write and create Amazon Glacier upload id
}
$j->open_for_write();
my $ft = ($options->{'data-type'} eq 'filename') ?
App::MtAws::QueueJob::Upload->new(
filename => $options->{filename}, relfilename => $relfilename,
partsize => ONE_MB*$partsize, delete_after_upload => 0) :
App::MtAws::QueueJob::Upload->new(
stdin => 1, relfilename => $relfilename,
partsize => ONE_MB*$partsize, delete_after_upload => 0);
my ($R) = fork_engine->{parent_worker}->process_task($ft, $j);
die unless $R;
$j->close_for_write();
}
} elsif ($action eq 'purge-vault') {
my $j = App::MtAws::Journal->new(%journal_opts, journal_file => $options->{journal}, filter => $options->{filters}{parsed});
with_forks !$options->{'dry-run'}, $options, sub {
$j->read_journal(should_exist => 1);
lib/App/MtAws.pm view on Meta::CPAN
Usage: mtglacier.pl COMMAND [POSITIONAL ARGUMENTS] [OPTION]...
Common options:
--config - config file
--journal - journal file (append only)
--dir - source local directory
--vault - Glacier vault name
--concurrency - number of parallel workers to run
--max-number-of-files - max number of files to sync/restore
--protocol - Use http or https to connect to Glacier
--partsize - Glacier multipart upload part size
--filter --include --exclude - File filtering
--dry-run - Don't do anything
--token - to be used with STS/IAM
--timeout - socket timeout
Commands:
sync
--new --replace-modified --delete-removed - Sync modes
--leaf-optimization - Don't use directory hardlinks count when traverse.
--follow - Follow symbolic links
--detect treehash|mtime|mtime-or-treehash|mtime-and-treehash|always-positive|size-only
lib/App/MtAws.pm view on Meta::CPAN
restore
restore-completed
--segment-size - Size for multi-segment download, in megabytes
check-local-hash
retrieve-inventory
--request-inventory-format - json or csv
download-inventory
--new-journal - Write inventory as new journal
create-vault VAULT-NAME
delete-vault VAULT-NAME
upload-file
--filename - File to upload
--set-rel-filename - Relative filename to use in Journal (if dir not specified)
--stdin - Upload from STDIN
--check-max-file-size - Specify to ensure there will be less than 10 000 parts
list-vaults
--format for-humans|mtmsg
version - prints debug information about software installed
Config format (text file):
key=YOURKEY
secret=YOURSECRET
# region: eu-west-1, us-east-1 etc
lib/App/MtAws.pm view on Meta::CPAN
print "mt-aws-glacier version: $VERSION $VERSION_MATURITY\n";
print "Perl Version: $]\n";
print_system_modules_version();
} else {
die "Wrong usage";
}
}
sub check_stdin_not_empty
{
die "Empty input from STDIN - cannot upload empty archive"
if eof(STDIN); # we block until first byte arrive, then we put it back in to buffer
}
1;
lib/App/MtAws/ChildWorker.pm view on Meta::CPAN
};
# unreachable
}
sub process_task
{
my ($self, $action, $data, $attachmentref) = @_;
my ($result, $result_attachmentref) = (undef, undef);
my $console_out = undef;
if ($action eq 'create_upload') {
# TODO: partsize confusing, need use another name for option partsize. partsize Amazon Upload partsize vs Download 'Range' partsize
my $req = App::MtAws::GlacierRequest->new($self->{options});
my $uploadid = $req->create_multipart_upload($data->{partsize}, $data->{relfilename}, $data->{mtime});
confess unless $uploadid;
$result = { upload_id => $uploadid };
$console_out = "Created an upload_id $uploadid";
} elsif ($action eq "upload_part") {
my $req = App::MtAws::GlacierRequest->new($self->{options});
my $r = $req->upload_part($data->{upload_id}, $attachmentref, $data->{start}, $data->{part_final_hash});
confess "upload_part failed" unless $r;
$result = { uploaded => $data->{start} } ;
$console_out = "Uploaded part for $data->{relfilename} at offset [$data->{start}]";
} elsif ($action eq 'finish_upload') {
# TODO: move vault to task, not to options!
my $req = App::MtAws::GlacierRequest->new($self->{options});
my $archive_id = $req->finish_multipart_upload($data->{upload_id}, $data->{filesize}, $data->{final_hash});
confess "finish_upload failed" unless $archive_id;
$result = {
final_hash => $data->{final_hash},
archive_id => $archive_id,
journal_entry => {
type=> 'CREATED',
'time' => $req->{last_request_time},
archive_id => $archive_id,
size => $data->{filesize},
mtime => $data->{mtime},
treehash => $data->{final_hash},
lib/App/MtAws/ChildWorker.pm view on Meta::CPAN
$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
$th->eat_file($F);
close $F or confess;
$th->calc_tree();
my $treehash = $th->get_final_hash();
if ($treehash eq $data->{treehash}) {
$result = { match => 1 };
$console_out = "Checked treehash for $data->{filename} - MATCH";
lib/App/MtAws/Command/Sync.pm view on Meta::CPAN
sub is_mtime_differs
{
my ($options, $journal_file, $absfilename) = @_;
my $mtime_differs = $options->{detect} =~ /(^|[-_])mtime([-_]|$)/ ? # don't make stat() call if we don't need it
defined($journal_file->{mtime}) && file_mtime($absfilename) != $journal_file->{mtime} :
undef;
}
# implements a '--detect' logic for file (with check of file size and mtime)
# returns:
# SHOULD_CREATE - upload file
# SHOULD_TREEHASH - upload a file if treehash differs
# SHOULD_NOACTION - don't do anything
sub should_upload
{
my ($options, $journal_file, $absfilename) = @_;
if ($options->{detect} eq 'always-positive') {
SHOULD_CREATE;
} elsif ($journal_file->{size} != file_size($absfilename)) {
SHOULD_CREATE;
} elsif ($options->{detect} eq 'size-only') {
SHOULD_NOACTION; # we already checked size above, so NOACTION
} elsif ($options->{detect} eq 'mtime') {
is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_CREATE : SHOULD_NOACTION;
} elsif ($options->{detect} eq 'treehash') {
SHOULD_TREEHASH;
} elsif ($options->{detect} eq 'mtime-and-treehash') {
is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_TREEHASH : SHOULD_NOACTION;
} elsif ($options->{detect} eq 'mtime-or-treehash') {
is_mtime_differs($options, $journal_file, $absfilename) ? SHOULD_CREATE : SHOULD_TREEHASH;
} else {
confess "Invalid detect option in should_upload";
}
}
sub next_modified
{
my ($options, $j) = @_;
while (my $rec = shift @{ $j->{listing}{existing} }) {
my $relfilename = $rec->{relfilename};
my $absfilename = $j->absfilename($relfilename);
my $file = $j->latest($relfilename);
my $should_upload = should_upload($options, $file, $absfilename);
if ($should_upload == SHOULD_TREEHASH) {
return App::MtAws::QueueJob::VerifyAndUpload->new(
filename => $absfilename, relfilename => $relfilename, partsize => ONE_MB*$options->{partsize},
delete_after_upload => 1,
archive_id => $file->{archive_id},
treehash => $file->{treehash}
);
} elsif ($should_upload == SHOULD_CREATE) {
return App::MtAws::QueueJob::Upload->new(
filename => $absfilename, relfilename => $relfilename, partsize => ONE_MB*$options->{partsize},
delete_after_upload => 1,
archive_id => $file->{archive_id},
);
} elsif ($should_upload == SHOULD_NOACTION) {
next;
} else {
confess "Unknown value returned by should_upload";
}
}
return;
}
sub next_missing
{
my ($options, $j) = @_;
if (my $rec = shift @{ $j->{listing}{missing} }) {
return App::MtAws::QueueJob::Delete->new(
lib/App/MtAws/Command/Sync.pm view on Meta::CPAN
} else {
return;
}
}
sub next_new
{
my ($options, $j) = @_;
if (my $rec = shift @{ $j->{listing}{new} }) {
my ($absfilename, $relfilename) = ($j->absfilename($rec->{relfilename}), $rec->{relfilename});
App::MtAws::QueueJob::Upload->new(filename => $absfilename, relfilename => $relfilename, partsize => ONE_MB*$options->{partsize}, delete_after_upload => 0);
} else {
return;
}
}
sub print_dry_run
{
my ($itt) = @_;
while (my $rec = $itt->()) {
for ($rec->will_do()) {
lib/App/MtAws/ConfigDefinition.pm view on Meta::CPAN
}
}
return;
}
sub check_max_size
{
if (present('check-max-file-size')) {
if (value('check-max-file-size') > 10_000 * value('partsize')) {
seen('check-max-file-size'), error(message('partsize_vs_maxsize',
"With current partsize %d partsizevalue%MiB and maximum allowed file size %d maxsizevalue%MiB, upload might exceed 10 000 parts. ".
"Increase %option partsize% or decrease %option maxsize%"),
partsize => 'partsize', maxsize => 'check-max-file-size', partsizevalue => value('partsize'), maxsizevalue => value('check-max-file-size'));
} else {
seen('check-max-file-size')
}
} else {
return;
}
}
lib/App/MtAws/ConfigDefinition.pm view on Meta::CPAN
command 'sync' => sub {
validate(mandatory(
optional('config'), mandatory(@encodings), @config_opts, sync_opts, detect_opts, check_https,
qw/dir vault concurrency partsize/, writable_journal('journal'),
optional(qw/max-number-of-files leaf-optimization follow/),
filter_options, optional('dry-run')
))
};
command 'upload-file' => sub {
validate(mandatory( optional('config'), mandatory(@encodings), @config_opts, check_https, qw/vault concurrency/, writable_journal('journal'),
check_dir_or_relname, check_base_dir, mandatory('partsize'), check_max_size ))
};
command 'purge-vault' => sub {
validate(mandatory(
optional('config'), mandatory(@encodings), @config_opts, check_https, qw/vault concurrency/,
writable_journal(existing_journal('journal')),
deprecated('dir'), filter_options, optional('dry-run')
lib/App/MtAws/GlacierRequest.pm view on Meta::CPAN
return $self;
}
sub add_header
{
my ($self, $name, $value) = @_;
push @{$self->{headers}}, { name => $name, value => $value};
}
sub create_multipart_upload
{
my ($self, $partsize, $relfilename, $mtime) = @_;
defined($relfilename)||confess;
defined($mtime)||confess;
$partsize||confess;
$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/multipart-uploads";
$self->{method} = 'POST';
$self->add_header('x-amz-part-size', $partsize);
# currently meat_encode only returns undef if filename is too big
defined($self->{description} = App::MtAws::MetaData::meta_encode($relfilename, $mtime)) or
die exception 'file_name_too_big' =>
"Either relative filename %string filename% is too big to store in Amazon Glacier metadata. ".
"(Limit is about 700 ASCII characters or 350 2-byte UTF-8 characters) or file modification time %string mtime% out of range".
"(Only years from 1000 to 9999 are supported)",
filename => $relfilename, mtime => $mtime; # TODO: more clear error
$self->add_header('x-amz-archive-description', $self->{description});
my $resp = $self->perform_lwp();
return $resp ? $resp->header('x-amz-multipart-upload-id') : undef;
}
sub upload_part
{
my ($self, $uploadid, $dataref, $offset, $part_final_hash) = @_;
$uploadid||confess;
($self->{dataref} = $dataref)||confess;
defined($offset)||confess;
($self->{part_final_hash} = $part_final_hash)||confess;
$self->_calc_data_hash;
$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/multipart-uploads/$uploadid";
$self->{method} = 'PUT';
$self->add_header('Content-Type', 'application/octet-stream');
$self->add_header('Content-Length', length(${$self->{dataref}}));
$self->add_header('x-amz-content-sha256', $self->{data_sha256});
$self->add_header('x-amz-sha256-tree-hash', $self->{part_final_hash});
my ($start, $end) = ($offset, $offset+length(${$self->{dataref}})-1 );
$self->add_header('Content-Range', "bytes ${start}-${end}/*");
my $resp = $self->perform_lwp();
return $resp ? 1 : undef;
}
sub finish_multipart_upload
{
my ($self, $uploadid, $size, $treehash) = @_;
$uploadid||confess;
$size||confess;
$treehash||confess;
$self->{url} = "/$self->{account_id}/vaults/$self->{vault}/multipart-uploads/$uploadid";
$self->{method} = 'POST';
$self->add_header('x-amz-sha256-tree-hash', $treehash);
$self->add_header('x-amz-archive-size', $size);
my $resp = $self->perform_lwp();
return $resp ? $resp->header('x-amz-archive-id') : undef;
}
sub delete_archive
lib/App/MtAws/Journal.pm view on Meta::CPAN
# 'A' is not compatible, but share some common code
if (($ver, $time, $archive_id, $size, $mtime, $treehash, $relfilename) =
$line =~ /^([ABC])\t([0-9]{1,20})\tCREATED\t(\S+)\t([0-9]{1,20})\t([+-]?[0-9]{1,20}|NONE)\t(\S+)\t(.*?)$/) {
confess "invalid filename" unless is_relative_filename($relfilename);
# here goes difference between 'A' and 'B','C'
if ($ver eq 'A') {
confess if $mtime eq 'NONE'; # this is not supported by format 'A'
# version 'A' produce records with mtime set even when there is no mtime in Amazon metadata
# (this is possible when archive uploaded by 3rd party program, or mtglacier <= v0.7)
# we detect this as $archive_id eq $relfilename - this is practical impossible
# unless such record was created by download-inventory command
$mtime = undef if ($archive_id eq $relfilename);
} else {
$mtime = undef if $mtime eq 'NONE';
}
$self->_add_archive({
relfilename => $relfilename,
lib/App/MtAws/QueueJob/MultipartCreate.pm view on Meta::CPAN
defined($self->{filename}) xor $self->{stdin} or confess "filename xor stdin should be specified";
defined($self->{relfilename}) || confess "no relfilename";
$self->{partsize}||confess "no partsize";
$self->enter('create');
}
sub init_file
{
my ($self) = @_;
if ($self->{stdin}) {
$self->{mtime} = time(); # should be as close as possible to upload process time
$self->{fh} = *STDIN;
} else {
my $filesize = file_size($self->{filename});
die exception file_is_zero => "File size is zero (and it was not when we read directory listing). Filename: %string filename%",
filename => $self->{filename}
unless $filesize;
$self->{mtime} = file_mtime($self->{filename}); # TODO: how could we assure file not modified when uploading btw?
die exception too_many_parts =>
"With current partsize=%d partsize%MiB we will exceed 10000 parts limit for the file %string filename% (file size %size%)",
partsize => $self->{partsize}, filename => $self->{filename}, size => $filesize
if ($filesize / $self->{partsize} > 10000);
open_file($self->{fh}, $self->{filename}, mode => '<', binary => 1) or
die exception upload_file_open_error => "Unable to open task file %string filename% for reading, errno=%errno%",
filename => $self->{filename}, 'ERRNO';
}
}
sub on_create
{
my ($self) = @_;
$self->init_file;
return state "wait", task "create_upload", { partsize => $self->{partsize}, relfilename => $self->{relfilename}, mtime => $self->{mtime} } => sub {
my ($args) = @_;
$self->{upload_id} = $args->{upload_id} or confess;
state("done")
}
}
1;
lib/App/MtAws/QueueJob/MultipartFinish.pm view on Meta::CPAN
use warnings;
use Carp;
use App::MtAws::QueueJobResult;
use App::MtAws::Exceptions;
use base 'App::MtAws::QueueJob';
sub init
{
my ($self) = @_;
$self->{upload_id}||confess;
$self->{filesize}||confess;
defined($self->{mtime})||confess;
defined($self->{relfilename})||confess;
$self->{th}||confess;
return $self;
}
sub on_default
{
my ($self) = @_;
$self->{th}->calc_tree();
$self->{final_hash} = $self->{th}->get_final_hash();
return state "wait", task "finish_upload", {
upload_id => $self->{upload_id},
filesize => $self->{filesize},
mtime => $self->{mtime},
relfilename => $self->{relfilename},
final_hash => $self->{final_hash}
} => sub { state "done" };
}
1;
lib/App/MtAws/QueueJob/MultipartPart.pm view on Meta::CPAN
use App::MtAws::TreeHash;
use base 'App::MtAws::QueueJob';
sub init
{
my ($self) = @_;
defined($self->{relfilename})||confess;
$self->{partsize}||confess;
defined($self->{mtime})||confess;
$self->{upload_id}||confess;
$self->{fh}||confess;
exists($self->{stdin})||confess;
$self->{all_raised} = 0;
$self->{position} = 0;
$self->{th} = App::MtAws::TreeHash->new();
$self->{uploadparts} = {};
$self->enter('fist_part');
}
sub close_file
{
my ($self) = @_;
close($self->{fh}) or confess;
}
lib/App/MtAws/QueueJob/MultipartPart.pm view on Meta::CPAN
}
sub get_part
{
my ($self) = @_;
my ($ok, $start, $part_final_hash, $attachment) = $self->read_part;
if ($ok) {
$self->{uploadparts}->{$start} = 1;
return task "upload_part",
{
start => $start,
upload_id => $self->{upload_id},
part_final_hash => $part_final_hash,
relfilename => $self->{relfilename},
mtime => $self->{mtime},
} => $attachment => sub {
delete $self->{uploadparts}->{$start} or confess;
return;
};
} else {
return;
}
}
sub on_fist_part
{
my ($self) = @_;
my @res = $self->get_part();
confess "Unexpected: zero-size archive" unless @res;
return state("other_parts"), @res;
}
sub on_other_parts
{
my ($self) = @_;
my @res = $self->get_part();
return @res ? @res : (keys %{$self->{uploadparts}} ? JOB_WAIT : state('close'));
}
sub on_close
{
my ($self) = @_;
$self->{stdin} or $self->close_file; # close file after EOF found
state("done");
}
1;
lib/App/MtAws/QueueJob/Upload.pm view on Meta::CPAN
use App::MtAws::QueueJobResult;
use App::MtAws::QueueJob::UploadMultipart;
use App::MtAws::QueueJob::Delete;
use base 'App::MtAws::QueueJob';
sub init
{
my ($self) = @_;
defined($self->{filename}) xor $self->{stdin} or confess "filename xor stdin should be specified";
defined($self->{relfilename}) || confess "no relfilename";
defined($self->{delete_after_upload}) || confess "delete_after_upload must be defined";
$self->{partsize}||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("multipart_upload");
return $self;
}
sub on_multipart_upload
{
my ($self) = @_;
return
state("wait"),
job( App::MtAws::QueueJob::UploadMultipart->new(map { $_ => $self->{$_} } qw/filename stdin relfilename partsize/), sub {
$self->{delete_after_upload} ? state("delete") : state("done");
});
}
sub on_delete
{
my ($self) = @_;
return
state("wait"),
job( App::MtAws::QueueJob::Delete->new(map { $_ => $self->{$_} } qw/relfilename archive_id/), sub {
lib/App/MtAws/QueueJob/UploadMultipart.pm view on Meta::CPAN
}
sub on_create
{
my ($self) = @_;
return
state("wait"),
job( App::MtAws::QueueJob::MultipartCreate->new(map { $_ => $self->{$_} } qw/filename stdin relfilename partsize/), sub {
my $j = shift;
defined($self->{$_} = $j->{$_}) or confess for qw/fh upload_id mtime/;
state("part")
});
}
sub on_part
{
my ($self) = @_;
return
state("wait"),
job( App::MtAws::QueueJob::MultipartPart->new(map { $_ => $self->{$_} } qw/relfilename stdin partsize mtime upload_id fh/), sub {
my $j = shift;
$self->{filesize} = $j->{position} || confess;
$self->{th} = $j->{th} || confess;
state("finish")
});
}
sub on_finish
{
my ($self) = @_;
return
state("wait"),
job( App::MtAws::QueueJob::MultipartFinish->new(map { $_ => $self->{$_} } qw/upload_id filesize mtime relfilename th/), sub {
state("done")
});
}
1;
__END__
lib/App/MtAws/QueueJob/VerifyAndUpload.pm view on Meta::CPAN
use App::MtAws::QueueJobResult;
use App::MtAws::QueueJob::Verify;
use App::MtAws::QueueJob::Upload;
use base 'App::MtAws::QueueJob';
sub init
{
my ($self) = @_;
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");
});
}
sub on_upload
{
my ($self) = @_;
return
state("wait"),
job( App::MtAws::QueueJob::Upload->new(map { $_ => $self->{$_} } qw/filename relfilename partsize delete_after_upload archive_id/), sub { # archive_id can be undef
state("done");
});
}
sub will_do
{
my ($self) = @_;
"Will VERIFY treehash and UPLOAD $self->{filename} if modified";
}
t/integration/config_engine_timeout.t view on Meta::CPAN
my $mtroot = get_temp_dir();
open my $f, ">", "$mtroot/file"; print $f "1"; close $f;
for (
[qw!create-vault --config glacier.cfg myvault!],
[qw!delete-vault --config glacier.cfg myvault!],
[qw!sync --config glacier.cfg --vault myvault --journal j!, '--dir', $mtroot],
[qw!upload-file --config glacier.cfg --vault myvault --journal j!, '--dir', $mtroot, '--filename', "$mtroot/file"],
[qw!purge-vault --config glacier.cfg --vault myvault --journal j!],
[qw!restore --config glacier.cfg --vault myvault --journal j --max-number-of-files 1!, '--dir', $mtroot],
[qw!restore-completed --config glacier.cfg --vault myvault --journal j!, '--dir', $mtroot],
[qw!retrieve-inventory --config glacier.cfg --vault myvault!],
[qw!download-inventory --config glacier.cfg --vault myvault --new-journal j!],
) {
fake_config sub {
disable_validations qw/journal secret key/ => sub {
my $timeout = 60;
my $res = config_create_and_parse(@$_, qq!--timeout!, $timeout);
t/integration/config_engine_token.t view on Meta::CPAN
use TestUtils 'w_fatal';
my $mtroot = get_temp_dir();
open my $f, ">", "$mtroot/file"; print $f "1"; close $f;
for (
[qw!create-vault --config glacier.cfg myvault!],
[qw!delete-vault --config glacier.cfg myvault!],
[qw!sync --config glacier.cfg --vault myvault --journal j!,'--dir', $mtroot],
[qw!upload-file --config glacier.cfg --vault myvault --journal j!, '--dir', $mtroot, '--filename', "$mtroot/file"],
[qw!purge-vault --config glacier.cfg --vault myvault --journal j!],
[qw!restore --config glacier.cfg --vault myvault --journal j --max-number-of-files 1!, '--dir', $mtroot],
[qw!restore-completed --config glacier.cfg --vault myvault --journal j!, '--dir', $mtroot],
[qw!retrieve-inventory --config glacier.cfg --vault myvault!],
[qw!download-inventory --config glacier.cfg --vault myvault --new-journal j!],
) {
fake_config sub {
disable_validations qw/journal secret key/ => sub {
my $token = ('x' x 330);
my $res = config_create_and_parse(@$_, qq!--token!, $token);
t/integration/config_engine_upload_file.t view on Meta::CPAN
use lib map { "$FindBin::RealBin/$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use Test::MockModule;
use File::Path;
use File::stat;
use Data::Dumper;
# upload_file command parsing test
my ($default_concurrency, $default_partsize) = (4, 16);
# upload-file
my %common = (
journal => 'j',
partsize => $default_partsize,
concurrency => $default_concurrency,
key=>'mykey',
secret => 'mysecret',
region => 'myregion',
protocol => 'http',
t/integration/config_engine_upload_file.t view on Meta::CPAN
#### PASS
sub assert_passes($$%)
{
my ($msg, $query, %result) = @_;
fake_config sub {
disable_validations qw/journal secret key filename dir/ => sub {
my $res = config_create_and_parse(split(' ', $query));
print Dumper $res->{errors} if $res->{errors};
ok !($res->{errors}||$res->{warnings}), $msg;
is $res->{command}, 'upload-file', $msg;
is_deeply($res->{options}, {
%common,
%result
}, $msg);
}
}
}
###
### filename
###
## set-rel-filename
assert_passes "should work with filename and set-rel-filename",
qq!upload-file --config glacier.cfg --vault myvault --journal j --filename /tmp/dir/a/myfile --set-rel-filename x/y/z!,
'name-type' => 'rel-filename',
relfilename => 'x/y/z',
'data-type' => 'filename',
'set-rel-filename' => 'x/y/z',
filename => '/tmp/dir/a/myfile';
##
## stdin
##
## set-rel-filename
assert_passes "should work with stdin and set-rel-filename",
qq!upload-file --config glacier.cfg --vault myvault --journal j --stdin --set-rel-filename x/y/z --check-max-file-size 100!,
'name-type' => 'rel-filename',
'data-type' => 'stdin',
stdin => 1,
'check-max-file-size' => 100,
relfilename => 'x/y/z',
'set-rel-filename' => 'x/y/z';
#### FAIL
t/integration/config_engine_upload_file.t view on Meta::CPAN
my $res = config_create_and_parse(split(' ', $query));
ok $res->{errors}, $msg;
ok !defined $res->{warnings}, $msg;
ok !defined $res->{command}, $msg;
cmp_deeply [grep { $_->{format} eq $error } @{ $res->{errors} }], [{%opts, format => $error}], $msg;
}
}
}
assert_fails "filename, set-rel-filename should fail with dir",
qq!upload-file --config glacier.cfg --vault myvault --journal j!,
[],
'Please specify filename or stdin';
###
### filename
###
assert_fails "filename with fail without set-rel-filename or dir",
qq!upload-file --config glacier.cfg --vault myvault --journal j --filename /tmp/dir/a/myfile!,
['filename'],
'either', a => 'set-rel-filename', b => 'dir';
## set-rel-filename
assert_fails "filename, set-rel-filename should fail with dir",
qq!upload-file --config glacier.cfg --vault myvault --journal j --filename /tmp/dir/a/myfile --set-rel-filename x/y/z --dir abc!,
['filename', 'dir'],
'mutual', a => 'set-rel-filename', b => 'dir';
for (qw!/x/y/z x/../y/z ../y x/./y!) {
assert_fails "should check set-rel-filename to be relative filename for $_",
qq!upload-file --config glacier.cfg --vault myvault --journal j --filename /tmp/dir/a/myfile --set-rel-filename $_!,
['filename'],
'require_relative_filename', a => 'set-rel-filename', value => $_;
}
##
## stdin
##
assert_fails "filename, set-rel-filename should be used with stdin",
qq!upload-file --config glacier.cfg --vault myvault --journal j --stdin!,
[],
'mandatory_with', a => 'set-rel-filename', b => 'stdin';
assert_fails "check-max-file-size should be used with stdin",
qq!upload-file --config glacier.cfg --vault myvault --journal j --stdin --set-rel-filename x/y/z!,
['dir'],
'mandatory_with', a => 'check-max-file-size', b => 'stdin';
##
## test for check-max-file-size calculation
##
{
{
for my $partsize (1, 2, 4, 8, 1024, 2048, 4096) {
my $edge_size = $partsize * 10_000;
for my $filesize ($edge_size + 1, $edge_size + 2, $edge_size + 100) {
assert_fails "check-max-file-size should catch wrong partsize ($partsize, $filesize)",
qq!upload-file --config glacier.cfg --vault myvault --journal j --stdin --set-rel-filename x/y/z --partsize $partsize --check-max-file-size $filesize!,
['dir'],
'partsize_vs_maxsize', 'maxsize' => 'check-max-file-size', 'partsize' => 'partsize', 'partsizevalue' => $partsize, 'maxsizevalue' => $filesize;
}
for my $filesize ($edge_size - 100, $edge_size - 2, $edge_size - 1, $edge_size) {
assert_passes "should work with filename and set-rel-filename",
qq!upload-file --config glacier.cfg --vault myvault --journal j --stdin --set-rel-filename x/y/z --partsize $partsize --check-max-file-size $filesize!,
'name-type' => 'rel-filename',
'data-type' => 'stdin',
stdin => 1,
'check-max-file-size' => $filesize,
partsize => $partsize,
relfilename => 'x/y/z',
'set-rel-filename' => 'x/y/z';
}
}
}
{
my $partsize = 4096;
my $edge_size = $partsize * 10_000;
for my $filesize ($edge_size + 1, $edge_size + 2, $edge_size + 100) {
assert_fails "check-max-file-size too big ($filesize)",
qq!upload-file --config glacier.cfg --vault myvault --journal j --stdin --set-rel-filename x/y/z --partsize $partsize --check-max-file-size $filesize!,
['dir'],
'maxsize_too_big', 'a' => 'check-max-file-size', value => $filesize;
}
}
}
## set-rel-filename
assert_fails "set-rel-filename and dir as mutual exclusize",
qq!upload-file --config glacier.cfg --vault myvault --journal j --stdin --set-rel-filename x/y/z --dir abc --check-max-file-size 100!,
['dir'],
'mutual', a => 'set-rel-filename', b => 'dir';
1;
t/integration/config_engine_upload_file_real.t view on Meta::CPAN
use File::stat;
use Encode;
use Data::Dumper;
use App::MtAws::Utils;
my $mtroot = get_temp_dir();
# upload_file command parsing test
my ($default_concurrency, $default_partsize) = (4, 16);
# upload-file
my %common = (
journal => 'j',
partsize => $default_partsize,
concurrency => $default_concurrency,
key=>'mykey',
secret => 'mysecret',
region => 'myregion',
protocol => 'http',
t/integration/config_engine_upload_file_real.t view on Meta::CPAN
#
sub assert_passes_on_filesystem($$%)
{
my ($msg, $query, %result) = @_;
fake_config sub {
disable_validations qw/journal secret key/ => sub {
my $res = config_create_and_parse(@$query);
print Dumper $res->{error_texts} if $res->{errors};
ok !($res->{errors}||$res->{warnings}), $msg;
is $res->{command}, 'upload-file', $msg;
is_deeply($res->{options}, {
%common,
%result
}, $msg);
}
}
}
sub assert_fails_on_filesystem($$%)
{
t/integration/config_engine_upload_file_real.t view on Meta::CPAN
sub test_file_and_dir
{
my ($msg, $dir, $filename, $expected, $encoding) = @_;
my $filename_enc = encode("UTF-8", $filename, Encode::DIE_ON_ERR|Encode::LEAVE_SRC);
my $dir_enc = encode("UTF-8", $dir, Encode::DIE_ON_ERR|Encode::LEAVE_SRC);
$encoding ||= "UTF-8";
local $App::MtAws::Utils::_filename_encoding = undef;
assert_passes_on_filesystem $msg,
[qw!upload-file --config glacier.cfg --vault myvault --journal j!, '--filename', $filename_enc, '--dir', $dir_enc,'--filenames-encoding', $encoding],
'name-type' => 'dir',
'data-type' => 'filename',
relfilename => $expected,
dir => $dir,
filename => $filename,
'filenames-encoding' => $encoding;
}
sub fails_file_and_dir
{
my ($msg, $dir, $filename, $error, %opts) = @_;
assert_fails_on_filesystem $msg,
[qw!upload-file --config glacier.cfg --vault myvault --journal j!, '--filename', $filename, '--dir', $dir],
[],
$error, %opts;
}
sub with_save_dir(&)
{
my $curdir = Cwd::getcwd;
shift->();
t/integration/config_engine_upload_file_real.t view on Meta::CPAN
# 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';
SKIP: {
skip "Cannot run under root", 4 if is_posix_root;
assert_fails_on_filesystem "should check --filename for readability",
[qw!upload-file --config glacier.cfg --vault myvault --journal j --set-rel-filename somefile!, '--filename', "unreadable"],
[],
'%option a% file not readable', a => 'filename', value => 'unreadable';
}
assert_passes_on_filesystem "should check --filename for readability",
[qw!upload-file --config glacier.cfg --vault myvault --journal j --set-rel-filename somefile!, '--filename', "myfile"],
'name-type' => 'rel-filename',
'data-type' => 'filename',
'set-rel-filename' => 'somefile',
'relfilename' => 'somefile',
filename => 'myfile',
'filenames-encoding' => 'UTF-8';
};
1;
t/integration/queue_job/multipart_create_files.t view on Meta::CPAN
}
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;
t/lib/UploadMultipartTest.pm view on Meta::CPAN
use strict;
use warnings;
use Test::Deep;
use App::MtAws::QueueJobResult;
use App::MtAws::QueueJob::UploadMultipart;
use App::MtAws::TreeHash;
use QueueHelpers;
sub expect_upload_multipart
{
my ($j, $mtime, $partsize, $relfilename, $upload_id, %args_opts) = @_;
my %args = (%args_opts);
# TODO: also test that it works with mtime=0
no warnings 'redefine';
my $stdin_state = undef;
local *App::MtAws::QueueJob::MultipartCreate::init_file = sub {
$stdin_state = $_[0]->{stdin};
$_[0]->{fh} = 'filehandle';
$_[0]->{mtime} = $mtime;
};
local *App::MtAws::QueueJob::MultipartPart::close_file = sub {};
cmp_deeply my $create_resp = $j->next, App::MtAws::QueueJobResult->full_new(code => JOB_OK, task => {
args => { partsize => $partsize, mtime => $mtime, relfilename => $relfilename},
action => 'create_upload', cb=> test_coderef, cb_task_proxy => test_coderef
});
expect_wait($j);
$create_resp->{task}{cb_task_proxy}->({upload_id => $upload_id});
my $n = 5;
my @orig_parts = map { [$_*10, "hash $_", \"file $_"] } (1..$n);
my @parts = @orig_parts;
no warnings 'redefine';
local *App::MtAws::QueueJob::MultipartPart::read_part = sub {
my $p = shift @parts;
if ($p) {
shift->{position} += $partsize;
t/lib/UploadMultipartTest.pm view on Meta::CPAN
};
my @callbacks;
for (@orig_parts) {
my $res = $j->next;
cmp_deeply $res,
App::MtAws::QueueJobResult->full_new(
task => {
args => {
start => $_->[0],
upload_id => $upload_id,
part_final_hash => $_->[1],
relfilename => $relfilename,
mtime => $mtime,
},
attachment => $_->[2],
action => 'upload_part',
cb => test_coderef,
cb_task_proxy => test_coderef,
},
code => JOB_OK,
);
push @callbacks, $res->{task}{cb_task_proxy};
}
local *App::MtAws::TreeHash::calc_tree = sub { shift->{tree} = "my_final_hash" };
local *App::MtAws::TreeHash::get_final_hash = sub { shift->{tree} };
t/lib/UploadMultipartTest.pm view on Meta::CPAN
while (my $cb = shift @callbacks) {
$cb->();
if (@callbacks) {
expect_wait($j);
} else {
cmp_deeply my $finish_resp = $j->next,
App::MtAws::QueueJobResult->full_new(
task => {
args => {
filesize => $n*$partsize,
upload_id => $upload_id,
relfilename => $relfilename,
final_hash => 'my_final_hash',
mtime => $mtime,
},
action => 'finish_upload',
cb => test_coderef,
cb_task_proxy => test_coderef,
},
code => JOB_OK,
);
call_callback($finish_resp);
last;
}
}
t/unit/cmd_sync.t view on Meta::CPAN
}
};
it "should work when detect does not contain mtime" => sub {
for (@detect_without_mtime) {
App::MtAws::Command::Sync->expects("file_mtime")->never;
ok ! defined App::MtAws::Command::Sync::is_mtime_differs({detect => $_},{mtime => 123}, 'file1');
}
};
};
describe "should_upload" => sub {
it "should define unique constants" => sub {
ok App::MtAws::Command::Sync::SHOULD_CREATE() != App::MtAws::Command::Sync::SHOULD_TREEHASH();
ok App::MtAws::Command::Sync::SHOULD_CREATE() != App::MtAws::Command::Sync::SHOULD_NOACTION();
ok App::MtAws::Command::Sync::SHOULD_CREATE();
ok App::MtAws::Command::Sync::SHOULD_TREEHASH();
ok !App::MtAws::Command::Sync::SHOULD_NOACTION(); # one should be FALSE
# numeric eq only
ok looks_like_number App::MtAws::Command::Sync::SHOULD_CREATE();
ok looks_like_number App::MtAws::Command::Sync::SHOULD_TREEHASH();
ok looks_like_number App::MtAws::Command::Sync::SHOULD_NOACTION();
};
it "should almost always return create if file size differs" => sub {
for (grep $_ ne 'always-positive', @all_detect) {
App::MtAws::Command::Sync->expects("is_mtime_differs")->never;
App::MtAws::Command::Sync->expects("file_size")->returns(42)->once;
is App::MtAws::Command::Sync::should_upload({detect => $_},{mtime => 123, size => 43}, 'file1'),
App::MtAws::Command::Sync::SHOULD_CREATE();
}
};
sub test_should_upload
{
my ($detect, $mtime_differs, $size_differs, $expected) = @_;
my $opts = {detect => $detect};
my $file = {mtime => 123, size => 42};
if (defined $mtime_differs) {
App::MtAws::Command::Sync->expects("is_mtime_differs")->returns(sub {
cmp_deeply [$opts, $file, 'file1'], [@_];
return $mtime_differs;
})->once
} else {
App::MtAws::Command::Sync->expects("is_mtime_differs")->never;
}
if (defined $size_differs) {
App::MtAws::Command::Sync->expects("file_size")->returns(sub {
cmp_deeply ['file1'], [@_];
return $size_differs ? 43 : 42;
})->once
} else {
App::MtAws::Command::Sync->expects("file_size")->never;
}
cmp_deeply App::MtAws::Command::Sync::should_upload($opts, $file, 'file1'), $expected;
}
describe "detect=mtime" => sub {
it "should return 'create' when mtime differs" => sub {
test_should_upload('mtime', 1, 0, App::MtAws::Command::Sync::SHOULD_CREATE());
};
it "should return FALSE when mtime same" => sub {
test_should_upload('mtime', 0, 0, App::MtAws::Command::Sync::SHOULD_NOACTION());
};
};
describe "detect=treehash" => sub {
it "should return 'treehash' mtime is irrelevant" => sub {
test_should_upload('treehash', undef, 0, App::MtAws::Command::Sync::SHOULD_TREEHASH());
};
};
describe "detect=mtime-and-treehash" => sub {
it "should return 'treehash' when mtime differs" => sub {
test_should_upload('mtime-and-treehash', 1, 0, App::MtAws::Command::Sync::SHOULD_TREEHASH());
};
it "should return FALSE when mtime same" => sub {
test_should_upload('mtime-and-treehash', 0, 0, App::MtAws::Command::Sync::SHOULD_NOACTION());
};
};
describe "detect=mtime-or-treehash" => sub {
it "should return 'create' when mtime differs" => sub {
test_should_upload('mtime-or-treehash', 1, 0, App::MtAws::Command::Sync::SHOULD_CREATE());
};
it "should return 'treehash' when mtime same" => sub {
test_should_upload('mtime-or-treehash', 0, 0, App::MtAws::Command::Sync::SHOULD_TREEHASH());
};
};
describe "detect=always-positive" => sub {
it "should return 'create' always" => sub {
test_should_upload('always-positive', undef, undef, App::MtAws::Command::Sync::SHOULD_CREATE());
};
};
describe "detect=size-only" => sub {
it "should return 'create' if size differs" => sub {
test_should_upload('size-only', undef, 1, App::MtAws::Command::Sync::SHOULD_CREATE());
};
it "should return 'no action' if size same" => sub {
test_should_upload('size-only', undef, 0, App::MtAws::Command::Sync::SHOULD_NOACTION());
};
};
describe "detect is unknown" => sub {
my $file = {mtime => 123, size => 42};
App::MtAws::Command::Sync->expects("file_size")->returns(42)->once;
ok ! defined eval { App::MtAws::Command::Sync::should_upload({detect => 'xyz'}, $file, 'file1'); 1; };
ok $@ =~ /Invalid detect option in should_upload/;
}
};
describe "next_modified" => sub {
my $options;
before each => sub {
$options = { partsize => 2};
};
sub expect_should_upload
{
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;
}
it "should work with zero files" => sub {
$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);
ok !defined eval{ App::MtAws::Command::Sync::next_modified($options, $j); 1};
ok $@ =~ /Unknown value returned by should_upload/;
};
};
};
describe "next_new" => sub {
my $options;
before each => sub {
$options = { partsize => 2};
};
it "should work with one file" => sub {
$j->{listing}{new} = [{relfilename => 'file1'}];
my $rec = App::MtAws::Command::Sync::next_new($options, $j);
ok $rec->isa('App::MtAws::QueueJob::Upload');
is $rec->{partsize}, $options->{partsize}*1024*1024;
is $rec->{relfilename}, 'file1';
is $rec->{filename}, $j->absfilename('file1');
ok !$rec->{delete_after_upload};
is scalar @{ $j->{listing}{new} }, 0;
ok !defined (App::MtAws::Command::Sync::next_new($options, $j));
};
it "should work with two files" => sub {
$j->{listing}{new} = [{relfilename => 'file1'}, {relfilename => 'file2'}];
my $rec = App::MtAws::Command::Sync::next_new($options, $j);
ok $rec->isa('App::MtAws::QueueJob::Upload');
is $rec->{relfilename}, 'file1';
is scalar @{ $j->{listing}{new} }, 1;
$rec = App::MtAws::Command::Sync::next_new($options, $j);
t/unit/cmd_sync.t view on Meta::CPAN
expect_process_task($j, sub {
my ($job) = @_;
ok $job->isa('App::MtAws::QueueJob::Iterator');
ok ! keys %{$job->{jobs}}; # no pending jobs
my $itt = $job->{iterator}->()->{iterator}; # resolve iterator of iterators
for (@files) {
my $task = $itt->();
is $task->{relfilename}, $_;
is $task->{partsize}, $options->{partsize}*1024*1024;
ok ! $task->{delete_after_upload};
ok $task->isa('App::MtAws::QueueJob::Upload');
}
return (1)
});
expect_journal_close;
$j->{listing}{existing} = [];
$j->{listing}{new} = [ map { relfilename => $_ }, @files ];
App::MtAws::Command::Sync::run($options, $j);
t/unit/cmd_sync.t view on Meta::CPAN
expect_process_task($j, sub {
my ($job) = @_;
ok $job->isa('App::MtAws::QueueJob::Iterator');
ok ! keys %{$job->{jobs}}; # no pending jobs
my $itt = $job->{iterator}->()->{iterator}; # resolve iterator of iterators
for (sort keys %files) {
my $task = $itt->();
is $task->{relfilename}, $_;
is $task->{partsize}, $options->{partsize}*1024*1024;
ok $task->{delete_after_upload};
is $task->{archive_id}, $files{$_}{archive_id};
ok $task->isa('App::MtAws::QueueJob::Upload');
}
return (1)
});
expect_journal_close;
$j->{listing}{new} = [];
for (sort keys %files) {
t/unit/glacier_request.t view on Meta::CPAN
it "should die with wrong protocol" => sub {
ok ! eval { App::MtAws::GlacierRequest->new({key=>'key', region=>'region', secret=>'secret', protocol => 'xyz', timeout => 180}) };
};
it "should not die with https" => sub {
ok eval { App::MtAws::GlacierRequest->new({key=>'key', region=>'region', secret=>'secret', protocol => 'https', timeout => 180}) };
};
};
describe "create_multipart_upload" => sub {
it "should throw exception if filename too long" => sub {
my $g = App::MtAws::GlacierRequest->new({%common_options});
my $filename = 'x' x 2000;
my $t = time();
ok ! defined eval { $g->create_multipart_upload(2, $filename, $t); 1 };
ok is_exception('file_name_too_big');
is get_exception->{filename}, $filename;
is exception_message(get_exception),
"Either relative filename \"$filename\" is too big to store in Amazon Glacier metadata. ".
"(Limit is about 700 ASCII characters or 350 2-byte UTF-8 characters)".
" or file modification time \"$t\" out of range".
"(Only years from 1000 to 9999 are supported)";
};
};
t/unit/queue_job/multipart_create.t view on Meta::CPAN
use QueueHelpers;
use Data::Dumper;
# test args validation
my %opts = (filename => '/path/somefile', relfilename => 'somefile', partsize => 1024*1024, stdin=>1);
{
ok eval { App::MtAws::QueueJob::MultipartCreate->new( map { $_ => $opts{$_} } qw/filename relfilename partsize delete_after_upload/); 1; };
# check for zero
ok eval { App::MtAws::QueueJob::MultipartCreate->new((map { $_ => $opts{$_} } qw/relfilename partsize/), filename => 0); 1; };
ok eval { App::MtAws::QueueJob::MultipartCreate->new((map { $_ => $opts{$_} } qw/filename partsize/), relfilename => 0); 1; };
ok !eval { App::MtAws::QueueJob::MultipartCreate->new((map { $_ => $opts{$_} } qw/filename relfilename/), partsize => 0); 1; };
ok !eval { App::MtAws::QueueJob::MultipartCreate->new( map { $_ => $opts{$_} } qw/relfilename partsize/); 1; };
ok !eval { App::MtAws::QueueJob::MultipartCreate->new( map { $_ => $opts{$_} } qw/filename partsize/); 1; };
ok !eval { App::MtAws::QueueJob::MultipartCreate->new( map { $_ => $opts{$_} } qw/filename relfilename/); 1; };
t/unit/queue_job/multipart_create.t view on Meta::CPAN
my ($filename, $relfilename, $mtime, $partsize) = @_;
no warnings 'redefine';
local *App::MtAws::QueueJob::MultipartCreate::init_file = sub {
$_[0]->{fh} = 'filehandle';
$_[0]->{mtime} = $mtime;
};
my $j = App::MtAws::QueueJob::MultipartCreate->new(filename => $filename, relfilename => $relfilename, partsize => $partsize);
cmp_deeply my $res = $j->next,
App::MtAws::QueueJobResult->full_new(code => JOB_OK,
task => { args => {partsize => $partsize, relfilename => $relfilename, mtime => $mtime},
action => 'create_upload', cb => test_coderef, cb_task_proxy => test_coderef});
cmp_deeply $j->next, App::MtAws::QueueJobResult->full_new(code => JOB_WAIT);
expect_wait($j);
call_callback($res, upload_id => "someuploadid");
expect_done($j);
is $j->{upload_id}, "someuploadid";
}
test_case('/path/somefile', 'somefile', 123456, 2*1024*1024);
test_case('/path/somefile', 'somefile', 0, 2*1024*1024);
test_case('0', '0', 123456, 2*1024*1024);
1;
t/unit/queue_job/multipart_finish.t view on Meta::CPAN
use Data::Dumper;
# test args validation
{
my %opts = (
relfilename => 'somefile',
mtime => 456,
upload_id => 'abc',
filesize => 123,
th => { mock=> 1 }
);
ok eval { my $j = App::MtAws::QueueJob::MultipartFinish->new(%opts); 1 };
for my $exclude_opt (sort keys %opts) {
ok exists $opts{$exclude_opt};
ok ! eval { App::MtAws::QueueJob::MultipartFinish->new( map { $_ => $opts{$_} } grep { $_ ne $exclude_opt } keys %opts ); 1; },
"should not work without $exclude_opt";
}
for my $non_zero_opt (qw/filesize upload_id th/) {
ok exists $opts{$non_zero_opt};
ok ! eval { App::MtAws::QueueJob::MultipartFinish->new(%opts, $non_zero_opt => 0); 1; },
}
for my $zero_opt (qw/relfilename mtime/) {
ok exists $opts{$zero_opt};
local $opts{$zero_opt} = 0;
ok eval { App::MtAws::QueueJob::MultipartFinish->new( %opts ); 1; }, "should work with $zero_opt=0";
}
}
sub test_case
{
my ($relfilename, $mtime) = @_;
my $th = bless { mock => "mytreehash" }, 'App::MtAws::TreeHash';
my $j = App::MtAws::QueueJob::MultipartFinish->new(relfilename => $relfilename, upload_id => "someid", filesize => 123, mtime => $mtime, th => $th );
no warnings 'redefine';
local *App::MtAws::TreeHash::calc_tree = sub { shift->{tree} = "my_final_hash" };
local *App::MtAws::TreeHash::get_final_hash = sub { shift->{tree} };
cmp_deeply my $res = $j->next,
App::MtAws::QueueJobResult->full_new(code => JOB_OK,
task => { args => {relfilename => $relfilename, upload_id => "someid", filesize => 123, mtime => $mtime, final_hash => "my_final_hash" },
action => 'finish_upload', cb => test_coderef, cb_task_proxy => test_coderef});
cmp_deeply $j->next, App::MtAws::QueueJobResult->full_new(code => JOB_WAIT);
cmp_deeply $j->next, App::MtAws::QueueJobResult->full_new(code => JOB_WAIT);
expect_wait($j);
call_callback($res);
expect_done($j);
}
test_case "somefile", 123456;
test_case "0", 123456;
test_case "somefile2", 0;
t/unit/queue_job/multipart_part.t view on Meta::CPAN
use Data::Dumper;
# test args validation
{
my %opts = (
relfilename => 'somefile',
partsize => 2,
mtime => 456,
upload_id => 'abc',
fh => { mock => 1},
stdin => 0,
);
ok eval { my $j = App::MtAws::QueueJob::MultipartPart->new(%opts); 1 };
for my $exclude_opt (sort keys %opts) {
ok exists $opts{$exclude_opt};
ok ! eval { App::MtAws::QueueJob::MultipartPart->new( map { $_ => $opts{$_} } grep { $_ ne $exclude_opt } keys %opts ); 1; },
"should not work without $exclude_opt";
}
for my $non_zero_opt (qw/partsize upload_id fh/) {
ok exists $opts{$non_zero_opt};
ok ! eval { App::MtAws::QueueJob::MultipartPart->new(%opts, $non_zero_opt => 0); 1; },
}
for my $zero_opt (qw/relfilename mtime/) {
ok exists $opts{$zero_opt};
local $opts{$zero_opt} = 0;
ok eval { App::MtAws::QueueJob::MultipartPart->new( %opts ); 1; }, "should work with $zero_opt=0";
}
t/unit/queue_job/multipart_part.t view on Meta::CPAN
delete $opts{stdin};
ok !eval { App::MtAws::QueueJob::MultipartPart->new( %opts); 1; }, "should not work without stdin";
}
}
sub test_case
{
my ($n, $relfilename, $mtime, $test_cb) = @_;
my @orig_parts = map { [$_*10, "hash $_", \"file $_"] } (0..$n);
my @parts = @orig_parts;
my %args = (relfilename => $relfilename, partsize => 2*1024*1024, upload_id => "someuploadid", fh => "somefh", mtime => $mtime, stdin => 1);
no warnings 'redefine';
local *App::MtAws::QueueJob::MultipartPart::read_part = sub {
my $p = shift @parts;
if ($p) {
return (1, @$p)
} else {
return;
}
};
t/unit/queue_job/multipart_part.t view on Meta::CPAN
test_case 15, $relfilename, $mtime, sub {
my ($j, $args, $parts) = @_;
my @callbacks;
for (@$parts) {
my $res = $j->next;
cmp_deeply $res,
App::MtAws::QueueJobResult->full_new(
task => {
args => {
start => $_->[0],
upload_id => $args->{upload_id},
part_final_hash => $_->[1],
relfilename => $args->{relfilename},
mtime => $args->{mtime},
},
attachment => $_->[2],
action => 'upload_part',
cb => test_coderef,
cb_task_proxy => test_coderef,
},
code => JOB_OK,
);
push @callbacks, $res->{task}{cb_task_proxy};
}
lcg_srand 444242 => sub {
@callbacks = lcg_shuffle @callbacks; # late finish, but in random order
t/unit/queue_job/multipart_part.t view on Meta::CPAN
test_case 11, $relfilename, $mtime, sub {
my ($j, $args, $parts) = @_;
for (@$parts) {
my $res = $j->next;
cmp_deeply $res,
App::MtAws::QueueJobResult->full_new(
task => {
args => {
start => $_->[0],
upload_id => $args->{upload_id},
part_final_hash => $_->[1],
relfilename => $args->{relfilename},
mtime => $args->{mtime},
},
attachment => $_->[2],
action => 'upload_part',
cb => test_coderef,
cb_task_proxy => test_coderef,
},
code => JOB_OK,
);
$res->{task}{cb_task_proxy}->();
}
cmp_deeply $j->next, App::MtAws::QueueJobResult->full_new(code => JOB_DONE);
};
t/unit/queue_job/multipart_part.t view on Meta::CPAN
test_with_filename_and_mtime 0, 12345;
# test case with early/late/random finish
{
{
package QE;
use MyQueueEngine;
use base q{MyQueueEngine};
sub on_upload_part
{
my ($self, %args) = @_;
push @{$self->{res}}, $args{part_final_hash};
}
};
lcg_srand 4672 => sub {
for my $n (1, 2, 15) {
for my $workers (1, 2, 10, 20) {
test_case $n, "somefile", 12345, sub {
t/unit/queue_job/upload.t view on Meta::CPAN
use UploadMultipartTest;
use DeleteTest;
use QueueHelpers;
use Data::Dumper;
my %opts = (filename => '/path/somefile', relfilename => 'somefile', delete_after_upload => 0, partsize => 1024*1024, stdin=>1);
my $mtime = 123456;
my $upload_id = "someuploadid";
# test args validation
{
ok eval { App::MtAws::QueueJob::Upload->new( map { $_ => $opts{$_} } qw/filename relfilename partsize delete_after_upload/); 1; };
# check for zero
ok eval { App::MtAws::QueueJob::Upload->new((map { $_ => $opts{$_} } qw/relfilename partsize delete_after_upload/), filename => 0); 1; };
ok eval { App::MtAws::QueueJob::Upload->new((map { $_ => $opts{$_} } qw/filename partsize delete_after_upload/), relfilename => 0); 1; };
ok eval { App::MtAws::QueueJob::Upload->new((map { $_ => $opts{$_} } qw/filename relfilename partsize/), delete_after_upload => 0); 1; };
ok !eval { App::MtAws::QueueJob::Upload->new((map { $_ => $opts{$_} } qw/filename relfilename delete_after_upload/), partsize => 0); 1; };
ok !eval { App::MtAws::QueueJob::Upload->new( map { $_ => $opts{$_} } qw/filename relfilename partsize/); 1; };
ok !eval { App::MtAws::QueueJob::Upload->new( map { $_ => $opts{$_} } qw/filename relfilename delete_after_upload/); 1; };
ok !eval { App::MtAws::QueueJob::Upload->new( map { $_ => $opts{$_} } qw/filename partsize delete_after_upload/); 1; };
ok !eval { App::MtAws::QueueJob::Upload->new( map { $_ => $opts{$_} } qw/relfilename partsize delete_after_upload/); 1; };
ok eval { App::MtAws::QueueJob::Upload->new((map { $_ => $opts{$_} } qw/filename relfilename partsize/), delete_after_upload =>1, archive_id => 'abc' ); 1; };
ok !eval { App::MtAws::QueueJob::Upload->new((map { $_ => $opts{$_} } qw/filename relfilename partsize/), delete_after_upload =>1 ); 1; };
ok !eval { App::MtAws::QueueJob::Upload->new((map { $_ => $opts{$_} } qw/filename relfilename partsize/), delete_after_upload =>0, archive_id => 'abc' ); 1; };
# stdin stuff
{
my %o = map { $_ => $opts{$_} } qw/filename relfilename partsize delete_after_upload stdin/;
for (qw/stdin filename/) {
local $o{$_}; delete $o{$_}; # perl 5.8/10 compat.
ok eval { App::MtAws::QueueJob::Upload->new(%o); 1; };
}
{
ok ! eval { App::MtAws::QueueJob::Upload->new(%o); 1; };
like "$@", qr/filename xor stdin/;
}
{
delete $o{stdin};
t/unit/queue_job/upload.t view on Meta::CPAN
ok ! eval { App::MtAws::QueueJob::Upload->new(%o); 1; };
like "$@", qr/filename xor stdin/;
}
}
}
sub test_case
{
my ($filename, $relfilename, $mtime) = @_;
{
my ($partsize, $upload_id) = (2*1024*1024, 'someid');
my $j = App::MtAws::QueueJob::Upload->new(filename => $filename, relfilename => $relfilename, partsize => $partsize, delete_after_upload =>0 );
UploadMultipartTest::expect_upload_multipart($j, $mtime, $partsize, $relfilename, $upload_id, expect_stdin => 0);
expect_done($j);
}
{
my ($partsize, $upload_id) = (2*1024*1024, 'someid');
my $j = App::MtAws::QueueJob::Upload->new(filename => $filename, relfilename => $relfilename, partsize => $partsize, delete_after_upload =>1, archive_id => 'abc' );
UploadMultipartTest::expect_upload_multipart($j, $mtime, $partsize, $relfilename, $upload_id, expect_stdin => 0, is_finished => 0);
DeleteTest::expect_delete($j, $relfilename, 'abc');
expect_done($j);
}
}
test_case '/path/somefile', 'somefile', 123456;
test_case '/path/somefile', 'somefile', 0;
test_case '0', 0, 123456;
# test stdin
{
my ($partsize, $upload_id) = (2*1024*1024, 'someid');
my $j = App::MtAws::QueueJob::Upload->new(relfilename => "somefile", stdin => 1, partsize => $partsize, delete_after_upload =>0 );
UploadMultipartTest::expect_upload_multipart($j, 12345, 2*1024*1024, "somefile", "someid", expect_stdin => 1);
expect_done($j);
}
# test dry-run
{
my $j = App::MtAws::QueueJob::Upload->new( map { $_ => $opts{$_} } qw/filename relfilename partsize delete_after_upload/);
is $j->will_do(), "Will UPLOAD $opts{filename}"
}
{
my $j = App::MtAws::QueueJob::Upload->new( map { $_ => $opts{$_} } qw/stdin relfilename partsize delete_after_upload/);
is $j->will_do(), "Will UPLOAD stream from STDIN"
}
1;
__END__
t/unit/queue_job/upload_multipart.t view on Meta::CPAN
use App::MtAws::QueueJobResult;
use Data::Dumper;
# test args validation
my %opts = (filename => '/path/somefile', relfilename => 'somefile', partsize => 1024*1024, stdin=>1);
{
ok eval { App::MtAws::QueueJob::UploadMultipart->new( map { $_ => $opts{$_} } qw/filename relfilename partsize delete_after_upload/); 1; };
# check for zero
ok eval { App::MtAws::QueueJob::UploadMultipart->new((map { $_ => $opts{$_} } qw/relfilename partsize/), filename => 0); 1; };
ok eval { App::MtAws::QueueJob::UploadMultipart->new((map { $_ => $opts{$_} } qw/filename partsize/), relfilename => 0); 1; };
ok !eval { App::MtAws::QueueJob::UploadMultipart->new((map { $_ => $opts{$_} } qw/filename relfilename/), partsize => 0); 1; };
ok !eval { App::MtAws::QueueJob::UploadMultipart->new( map { $_ => $opts{$_} } qw/relfilename partsize/); 1; };
ok !eval { App::MtAws::QueueJob::UploadMultipart->new( map { $_ => $opts{$_} } qw/filename partsize/); 1; };
ok !eval { App::MtAws::QueueJob::UploadMultipart->new( map { $_ => $opts{$_} } qw/filename relfilename/); 1; };
t/unit/queue_job/upload_multipart.t view on Meta::CPAN
delete $o{filename};
ok ! eval { App::MtAws::QueueJob::UploadMultipart->new(%o); 1; };
like "$@", qr/filename xor stdin/;
}
}
}
{
# TODO: also test that it works with mtime=0
my ($mtime, $partsize, $relfilename, $upload_id) = (123456, 2*1024*1024, 'somefile', 'someid');
my $j = App::MtAws::QueueJob::UploadMultipart->new(filename => '/somedir/somefile', relfilename => $relfilename, partsize => $partsize );
UploadMultipartTest::expect_upload_multipart($j, $mtime, $partsize, $relfilename, $upload_id, expect_stdin => 0);
expect_done($j);
}
{
my ($mtime, $partsize, $relfilename, $upload_id) = (123456, 2*1024*1024, 'somefile', 'someid');
my $j = App::MtAws::QueueJob::UploadMultipart->new(stdin => 1, relfilename => $relfilename, partsize => $partsize );
UploadMultipartTest::expect_upload_multipart($j, $mtime, $partsize, $relfilename, $upload_id, expect_stdin => 1);
expect_done($j);
}
1;
t/unit/queue_job/verify_and_upload.t view on Meta::CPAN
use App::MtAws::QueueJob::VerifyAndUpload;
use VerifyTest;
use UploadMultipartTest;
use DeleteTest;
use QueueHelpers;
use Data::Dumper;
my %opts = (filename => '/path/somefile', relfilename => 'somefile', treehash => 'abc', archive_id => 'def', partsize => 4*1024*1024, delete_after_upload => 1);
my @all = keys %opts;
# test args validation
{
ok eval { App::MtAws::QueueJob::VerifyAndUpload->new( map { $_ => $opts{$_} } @all); 1; };
for my $exclude (@all) {
ok !eval { App::MtAws::QueueJob::VerifyAndUpload->new( map { $_ => $opts{$_} } grep { $_ ne $exclude} @all); 1; }, $exclude;
}
for my $zero (qw/filename relfilename/) {
ok eval { App::MtAws::QueueJob::VerifyAndUpload->new( (map { $_ => $opts{$_} } grep { $_ ne $zero} @all), $zero => 0); 1; }, $zero;
}
ok eval { App::MtAws::QueueJob::VerifyAndUpload->new( (map { $_ => $opts{$_} } qw/filename relfilename treehash partsize/), delete_after_upload => 0); 1; };
}
for (0, 1) {
if ($_) {
$opts{filename} = '/path/somefile';
$opts{relfilename} = 'somefile';
} 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);
is $j->will_do(), "Will VERIFY treehash and UPLOAD $opts{filename} if modified";;
( run in 2.326 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )