BEGIN {
chdir
't'
if
-d
't'
}
use
open
':std'
,
':encoding(UTF-8)'
;
my
@alg
=
qw( md5 sha512)
;
my
@prefix_manifestfiles
=
qw(tagmanifest manifest)
;
sub
_prepare_bag {
my
(
$bag_dir
) =
@_
;
mkpath(
$bag_dir
.
"/data"
);
write_file(
"$bag_dir/data/payload1.txt"
,
"PAYLOAD1"
);
write_file(
"$bag_dir/data/payload2.txt"
,
"PAYLOAD2"
);
write_file(
"$bag_dir/data/payload3.txt"
,
"PAYLOAD3"
);
return
;
}
sub
_modify_bag {
my
(
$file_to_modify
) =
@_
;
my
(
$tm
,
$invalid_checksum
);
$tm
= read_file(
$file_to_modify
);
$invalid_checksum
=
"0"
x 32;
$tm
=~ s/^([\S]+)/
$invalid_checksum
/;
write_file(
$file_to_modify
,
$tm
);
return
;
}
note
"base tests"
;
my
$Class_base
=
'Archive::BagIt'
;
use_ok(
$Class_base
);
foreach
my
$prefix
(
@prefix_manifestfiles
) {
foreach
my
$alg
(
@alg
) {
my
$bag_dir
= File::Temp::tempdir(
CLEANUP
=> 1);
_prepare_bag(
$bag_dir
);
my
$bag_ok
= Archive::BagIt->make_bag(
$bag_dir
);
isa_ok(
$bag_ok
,
'Archive::BagIt'
,
"create new valid IE bagit"
);
ok(
$bag_ok
->verify_bag(),
"check if bag is verified correctly"
);
my
$bag_ok2
= Archive::BagIt->make_bag(
"$bag_dir/"
);
isa_ok(
$bag_ok2
,
'Archive::BagIt'
,
"create new valid IE bagit (with slash)"
);
ok(
$bag_ok2
->verify_bag(),
"check if bag is verified correctly (with slash)"
);
_modify_bag(
"$bag_dir/$prefix-$alg.txt"
);
my
$bag_invalid1
= new_ok(
"Archive::BagIt"
=> [
bag_path
=>
$bag_dir
]);
throws_ok(
sub
{
$bag_invalid1
->verify_bag(
{
return_all_errors
=> 1 }
)
},
qr{bag verify for bagit version '1.0' failed with invalid files}
,
"check if bag fails verification of broken $prefix-$alg.txt (all errors, standard)"
);
my
$bag_invalid2
= new_ok(
"Archive::BagIt"
=> [
bag_path
=>
$bag_dir
]);
throws_ok(
sub
{
$bag_invalid2
->verify_bag()
},
qr{digest \($alg\) calculated=.*, but expected=}
,
"check if bag fails verification of broken $prefix-$alg.txt (first error, standard)"
);
}
}
note
"return_all_errors tests"
;
{
my
$bag_dir
= File::Temp::tempdir(
CLEANUP
=> 1);
_prepare_bag(
$bag_dir
);
SKIP: {
skip
"skipped because testbag could not created"
, 1
unless
-d
$bag_dir
;
my
$bag_ok
= Archive::BagIt->make_bag(
$bag_dir
);
isa_ok(
$bag_ok
,
'Archive::BagIt'
,
"create new valid IE bagit"
);
ok(
$bag_ok
->verify_bag(),
"check if bag is verified correctly"
);
write_file(
"$bag_dir/data/payload1.txt"
,
"PAYLOAD_MODIFIED1"
);
write_file(
"$bag_dir/data/payload3.txt"
,
"PAYLOAD3_MODIFIED3"
);
_modify_bag(
"$bag_dir/tagmanifest-sha512.txt"
);
_modify_bag(
"$bag_dir/tagmanifest-md5.txt"
);
my
$bag_invalid1
= new_ok(
"Archive::BagIt"
=> [
bag_path
=>
$bag_dir
]);
throws_ok(
sub
{
$bag_invalid1
->verify_bag()
},
qr{file.*'data/payload1.txt'.* invalid, digest.*'}
s,
"check if bag fails verification of broken fixity for payload (all errors)"
);
my
$bag_invalid2
= new_ok(
"Archive::BagIt"
=> [
bag_path
=>
$bag_dir
]);
throws_ok(
sub
{
$bag_invalid2
->verify_bag(
{
return_all_errors
=> 1 }
)
},
qr{bag verify for bagit version '1.0' failed with invalid files.*file.*normalized='data/payload1.txt'.*file.*normalized='data/payload3.txt'.*file.*normalized='bag-info.txt'}
s,
"check if bag fails verification of broken fixity for payload (all errors)"
);
}
}
{
my
@should_fail_bags_097
= (
[
qw(../bagit_conformance_suite/v0.97/invalid/baginfo-missing-encoding)
,
qr{Encoding line missed}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/bom-in-bagit.txt)
,
qr{Version string '.+BagIt-Version: 0\.97'.* is incorrect}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/corrupt-data-file)
,
qr{file '.*' \(normalized='data/bare-filename'\) invalid, digest \(md5\).*}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/corrupt-tag-file)
,
qr{file 'bag-info\.txt' \(normalized='.*'\) invalid, digest \(md5\).*}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/extra-file-in-bag)
,
qr{file '.*' \(normalized='data/bar'\) found, which is not in 'manifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/invalid-version-number)
,
qr{Version string 'BagIt-Version: \.97'.* is incorrect}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/missing-baginfo)
,
qr{file 'bag-info\.txt' NOT found, but expected via 'tagmanifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/missing-bagit.txt)
,
qr{Cannot read.*bagit\.txt}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/out-of-scope-file-paths-using-dot-notation-for-fetch)
,
qr{Fetching via file .*fetch\.txt.*not supported}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/out-of-scope-file-paths-using-dot-notation)
,
qr{file .*\./README\.md' not allowed in 'manifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/invalid/same-filename-listed-twice-with-different-hashes)
,
qr{Manifest.*manifest-md5\.txt.*does not exist for given bagit version '0\.97'}
],
[
qw(../bagit_conformance_suite/v0.97/linux-only/out-of-scope-file-paths-using-absolute-path)
,
qr{file '/tmp/foo' not allowed in 'manifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/linux-only/out-of-scope-file-paths-using-shortcut-username-for-fetch)
,
qr{Fetching via file .*fetch\.txt.*not supported}
],
[
qw(../bagit_conformance_suite/v0.97/linux-only/out-of-scope-file-paths-using-shortcut-username)
,
qr{file '~root/foo' not allowed in 'manifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/linux-only/out-of-scope-file-paths-using-shortcut-for-fetch)
,
qr{Fetching via file .*fetch\.txt.*not supported}
],
[
qw(../bagit_conformance_suite/v0.97/linux-only/out-of-scope-file-paths-using-shortcut)
,
qr{file '~/foo' not allowed in 'manifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/linux-only/out-of-scope-file-paths-using-absolute-path-for-fetch)
,
qr{Fetching via file .*fetch\.txt.*not supported}
],
[
qw(../bagit_conformance_suite/v0.97/windows-only/out-of-scope-file-paths-using-absolute-path)
,
qr{file 'C:\\Windows\\System32\\setx\.exe' not allowed in 'manifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/windows-only/out-of-scope-file-paths-using-shortcut-for-fetch)
,
qr{Fetching via file .*fetch\.txt.*not supported}
],
[
qw(../bagit_conformance_suite/v0.97/windows-only/out-of-scope-file-paths-using-unc)
,
qr{file '.*UNC\\server\\Windows\\System32\\setx\.exe' not allowed in 'manifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/windows-only/out-of-scope-file-paths-using-shortcut)
,
qr{file '%HomeDrive%\\Windows\\System32\\setx\.exe' not allowed in 'manifest-md5\.txt'}
],
[
qw(../bagit_conformance_suite/v0.97/windows-only/out-of-scope-file-paths-using-unc-for-fetch)
,
qr{Fetching via file .*fetch\.txt.*not supported}
],
[
qw(../bagit_conformance_suite/v0.97/windows-only/out-of-scope-file-paths-using-absolute-path-for-fetch)
,
qr{Fetching via file .*fetch\.txt.*not supported}
],
[
qw(../bagit_conformance_suite/v0.97/warning/made-with-md5sum-tools)
,
qr{file '.*' \(normalized='data/hello.txt'\) found, which is not in 'manifest-md5.txt'}
],
);
my
@should_fail_bags_100
= (
[
qw(../bagit_conformance_suite/v1.0/invalid/missing-from-manifest)
,
qr{file '.*' \(normalized='data/missingFromManifest\.txt'\) found, which is not in 'manifest-sha512\.txt'}
],
[
qw(../bagit_conformance_suite/v1.0/invalid/bagit-with-invalid-whitespace)
,
qr{Version string 'BagIt-Version : 1.0'.* is incorrect}
],
);
my
@should_pass_bags_100
= (
[
qw(../bagit_conformance_suite/v1.0/valid/basicBag)
,
"bagit_conformance_suite/v1.0/valid/basicBag"
],
);
my
@should_pass_bags_097
= (
[
qw(../bagit_conformance_suite/v0.97/valid/uncommon-metadata-separators)
,
"bagit_conformance_suite/v0.97/valid/uncommon-metadata-separators"
],
[
qw(../bagit_conformance_suite/v0.97/valid/minimal-bag)
,
"bagit_conformance_suite/v0.97/valid/minimal-bag"
],
[
qw(../bagit_conformance_suite/v0.97/valid/basic-bag)
,
"bagit_conformance_suite/v0.97/valid/basic-bag"
],
[
qw(../bagit_conformance_suite/v0.97/valid/duplicate-metadata-entries)
,
"bagit_conformance_suite/v0.97/valid/duplicate-metadata-entries"
],
[
qw(../bagit_conformance_suite/v0.97/valid/bag-with-escapable-characters)
,
"bagit_conformance_suite/v0.97/valid/bag-with-escapable-characters"
],
[
qw(../bagit_conformance_suite/v0.97/valid/holey-bag)
,
"bagit_conformance_suite/v0.97/valid/holey-bag"
],
[
qw(../bagit_conformance_suite/v0.97/valid/bag-with-encoded-names)
,
"bagit_conformance_suite/v0.97/valid/bag-with-encoded-names"
],
[
qw(../bagit_conformance_suite/v0.97/valid/UTF-16-encoded-tag-files)
,
"bagit_conformance_suite/v0.97/valid/UTF-16-encoded-tag-files"
],
[
qw(../bagit_conformance_suite/v0.97/valid/bag-in-a-bag)
,
"bagit_conformance_suite/v0.97/valid/bag-in-a-bag"
],
[
qw(../bagit_conformance_suite/v0.97/valid/ISO-8859-1-encoded-tag-files)
,
"bagit_conformance_suite/v0.97/valid/ISO-8859-1-encoded-tag-files"
],
[
qw(../bagit_conformance_suite/v0.97/valid/bag-with-leading-dot-slash-in-manifest)
,
"bagit_conformance_suite/v0.97/valid/bag-with-leading-dot-slash-in-manifest"
],
[
qw(../bagit_conformance_suite/v0.97/valid/bag-with-space)
,
"bagit_conformance_suite/v0.97/valid/bag-with-space"
],
);
note
"version 0.97 conformance tests"
;
foreach
my
$entry
(
@should_fail_bags_097
) {
my
$bagdir
=
$entry
->[0];
my
$descr
=
$bagdir
;
$descr
=~ s|../bagit_conformance_suite/||;
my
$expected
=
$entry
->[1];
my
$bag
= new_ok (
"Archive::BagIt"
=> [
bag_path
=>
$bagdir
]);
throws_ok(
sub
{
$bag
->verify_bag();},
$expected
,
"conformance v0.97, fail: $descr"
);
}
foreach
my
$entry
(
@should_pass_bags_097
) {
my
$bagdir
=
$entry
->[0];
my
$descr
=
$bagdir
;
$descr
=~ s|../bagit_conformance_suite/||;
my
$expected
=
$entry
->[1];
my
$bag
= new_ok (
"Archive::BagIt"
=> [
bag_path
=>
$bagdir
]);
ok(
sub
{
$bag
->verify_bag();},
"conformance v0.97, pass: $descr"
);
}
note
"version 1.0 conformance tests"
;
foreach
my
$entry
(
@should_fail_bags_100
) {
my
$bagdir
=
$entry
->[0];
my
$descr
=
$bagdir
;
$descr
=~ s|../bagit_conformance_suite/||;
my
$expected
=
$entry
->[1];
my
$bag
= new_ok (
"Archive::BagIt"
=> [
bag_path
=>
$bagdir
]);
throws_ok(
sub
{
$bag
->verify_bag();},
$expected
,
"conformance v1.0, fail: $descr"
);
}
foreach
my
$entry
(
@should_pass_bags_100
) {
my
$bagdir
=
$entry
->[0];
my
$descr
=
$bagdir
;
$descr
=~ s|../bagit_conformance_suite/||;
my
$expected
=
$entry
->[1];
my
$bag
= new_ok (
"Archive::BagIt"
=> [
bag_path
=>
$bagdir
]);
ok(
sub
{
$bag
->verify_bag();},
"conformance v1.0, pass: $descr"
);
}
{
my
$bag_dir
= File::Temp::tempdir(
CLEANUP
=> 1);
_prepare_bag(
$bag_dir
);
my
$bag_ok
= Archive::BagIt->make_bag(
$bag_dir
);
isa_ok(
$bag_ok
,
'Archive::BagIt'
,
"create new valid IE bagit"
);
ok(
$bag_ok
->verify_bag(),
"check if bag is verified correctly"
);
my
$bif
= File::Spec->catfile(
$bag_dir
,
"bag-info.txt"
);
my
$bi
= read_file(
$bif
);
$bi
=~ s/Payload-Oxum: .*/Payload-Oxum: 0.0/;
write_file(
$bif
,
$bi
);
my
$bag
= Archive::BagIt->new(
$bag_dir
);
foreach
my
$algorithm
(
keys
%{
$bag
->manifests }) {
ok(
$bag
->manifests->{
$algorithm
}->create_tagmanifest(),
"rewrite tagmanifests for $algorithm"
);
}
my
$bag_invalid
= Archive::BagIt->new(
$bag_dir
);
throws_ok(
sub
{
$bag_invalid
->verify_bag(
{
return_all_errors
=> 1 }
)
},
qr{bag verify for bagit version '1.0' failed with invalid files}
,
"check if bag fails verification of broken Payload-Oxum"
);
}
}
1;