Commit | Line | Data |
---|---|---|
1a6a8453 PM |
1 | |
2 | use lib 't'; | |
3 | use strict; | |
4 | use warnings; | |
5 | use bytes; | |
6 | ||
7 | use Test::More ; | |
25f0751f | 8 | use CompTestUtils; |
1a6a8453 PM |
9 | |
10 | sub run | |
11 | { | |
12 | my $CompressClass = identify(); | |
13 | my $UncompressClass = getInverse($CompressClass); | |
14 | my $Error = getErrorRef($CompressClass); | |
15 | my $UnError = getErrorRef($UncompressClass); | |
16 | ||
17 | my $hello = <<EOM ; | |
18 | hello world | |
19 | this is a test | |
20 | some more stuff on this line | |
21 | and finally... | |
22 | EOM | |
23 | ||
24 | my $blocksize = 10 ; | |
25 | ||
26 | ||
27 | my ($info, $compressed) = mkComplete($CompressClass, $hello); | |
28 | ||
29 | my $header_size = $info->{HeaderLength}; | |
30 | my $trailer_size = $info->{TrailerLength}; | |
31 | my $fingerprint_size = $info->{FingerprintLength}; | |
32 | ok 1, "Compressed size is " . length($compressed) ; | |
33 | ok 1, "Fingerprint size is $fingerprint_size" ; | |
34 | ok 1, "Header size is $header_size" ; | |
35 | ok 1, "Trailer size is $trailer_size" ; | |
36 | ||
37 | for my $trans ( 0 .. 1) | |
38 | { | |
39 | title "Truncating $CompressClass, Transparent $trans"; | |
40 | ||
41 | ||
42 | foreach my $i (1 .. $fingerprint_size-1) | |
43 | { | |
44 | my $lex = new LexFile my $name ; | |
45 | ||
25f0751f | 46 | title "Fingerprint Truncation - length $i, Transparent $trans"; |
1a6a8453 PM |
47 | |
48 | my $part = substr($compressed, 0, $i); | |
49 | writeFile($name, $part); | |
50 | ||
51 | my $gz = new $UncompressClass $name, | |
52 | -BlockSize => $blocksize, | |
53 | -Transparent => $trans; | |
54 | if ($trans) { | |
55 | ok $gz; | |
56 | ok ! $gz->error() ; | |
57 | my $buff ; | |
25f0751f | 58 | is $gz->read($buff), length($part) ; |
1a6a8453 PM |
59 | ok $buff eq $part ; |
60 | ok $gz->eof() ; | |
61 | $gz->close(); | |
62 | } | |
63 | else { | |
64 | ok !$gz; | |
65 | } | |
66 | ||
67 | } | |
68 | ||
69 | # | |
70 | # Any header corruption past the fingerprint is considered catastrophic | |
71 | # so even if Transparent is set, it should still fail | |
72 | # | |
73 | foreach my $i ($fingerprint_size .. $header_size -1) | |
74 | { | |
75 | my $lex = new LexFile my $name ; | |
76 | ||
25f0751f | 77 | title "Header Truncation - length $i, Transparent $trans"; |
1a6a8453 PM |
78 | |
79 | my $part = substr($compressed, 0, $i); | |
80 | writeFile($name, $part); | |
81 | ok ! defined new $UncompressClass $name, | |
82 | -BlockSize => $blocksize, | |
83 | -Transparent => $trans; | |
84 | #ok $gz->eof() ; | |
85 | } | |
86 | ||
87 | ||
88 | foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size) | |
89 | { | |
25f0751f PM |
90 | next if $i == 0 ; |
91 | ||
1a6a8453 PM |
92 | my $lex = new LexFile my $name ; |
93 | ||
25f0751f | 94 | title "Compressed Data Truncation - length $i, Transparent $trans"; |
1a6a8453 PM |
95 | |
96 | my $part = substr($compressed, 0, $i); | |
97 | writeFile($name, $part); | |
98 | ok my $gz = new $UncompressClass $name, | |
25f0751f | 99 | -Strict => 1, |
1a6a8453 | 100 | -BlockSize => $blocksize, |
25f0751f PM |
101 | -Transparent => $trans |
102 | or diag $$UnError; | |
103 | ||
1a6a8453 | 104 | my $un ; |
25f0751f PM |
105 | my $status = 1 ; |
106 | $status = $gz->read($un) while $status > 0 ; | |
107 | cmp_ok $status, "<", 0 ; | |
1a6a8453 | 108 | ok $gz->error() ; |
25f0751f | 109 | ok $gz->eof() ; |
1a6a8453 PM |
110 | $gz->close(); |
111 | } | |
112 | ||
113 | # RawDeflate does not have a trailer | |
114 | next if $CompressClass eq 'IO::Compress::RawDeflate' ; | |
115 | ||
116 | title "Compressed Trailer Truncation"; | |
117 | foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 ) | |
118 | { | |
119 | foreach my $lax (0, 1) | |
120 | { | |
121 | my $lex = new LexFile my $name ; | |
122 | ||
25f0751f | 123 | ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ; |
1a6a8453 PM |
124 | my $part = substr($compressed, 0, $i); |
125 | writeFile($name, $part); | |
126 | ok my $gz = new $UncompressClass $name, | |
127 | -BlockSize => $blocksize, | |
128 | -Strict => !$lax, | |
129 | -Append => 1, | |
130 | -Transparent => $trans; | |
131 | my $un = ''; | |
132 | my $status = 1 ; | |
133 | $status = $gz->read($un) while $status > 0 ; | |
134 | ||
135 | if ($lax) | |
136 | { | |
137 | is $un, $hello; | |
138 | is $status, 0 | |
139 | or diag "Status $status Error is " . $gz->error() ; | |
140 | ok $gz->eof() | |
141 | or diag "Status $status Error is " . $gz->error() ; | |
142 | ok ! $gz->error() ; | |
143 | } | |
144 | else | |
145 | { | |
25f0751f | 146 | cmp_ok $status, "<", 0 |
1a6a8453 PM |
147 | or diag "Status $status Error is " . $gz->error() ; |
148 | ok $gz->eof() | |
149 | or diag "Status $status Error is " . $gz->error() ; | |
150 | ok $gz->error() ; | |
151 | } | |
152 | ||
153 | $gz->close(); | |
154 | } | |
155 | } | |
156 | } | |
157 | } | |
158 | ||
159 | 1; | |
160 |