1BEGIN {
2    if ($ENV{PERL_CORE}) {
3        chdir 't' if -d 't';
4        @INC = ("../lib", "lib/compress");
5    }
6}
7
8use lib qw(t t/compress);
9use strict;
10use warnings;
11use bytes;
12
13use Test::More ;
14use File::Spec ;
15use CompTestUtils;
16
17BEGIN {
18    plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" )
19        if $] < 5.005 ;
20
21
22    # use Test::NoWarnings, if available
23    my $extra = 0 ;
24    $extra = 1
25        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
26
27    plan tests => 230 + $extra ;
28
29    #use_ok('IO::Compress::Zip', qw(zip $ZipError :zip_method)) ;
30    use_ok('IO::Compress::Zip', qw(:all)) ;
31    use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ;
32}
33
34
35sub zipGetHeader
36{
37    my $in = shift;
38    my $content = shift ;
39    my %opts = @_ ;
40
41    my $out ;
42    my $got ;
43
44    ok zip($in, \$out, %opts), "  zip ok" ;
45    ok unzip(\$out, \$got), "  unzip ok"
46        or diag $UnzipError ;
47    is $got, $content, "  got expected content" ;
48
49    my $gunz = IO::Uncompress::Unzip->new( \$out, Strict => 0 )
50        or diag "UnzipError is $IO::Uncompress::Unzip::UnzipError" ;
51    ok $gunz, "  Created IO::Uncompress::Unzip object";
52    my $hdr = $gunz->getHeaderInfo();
53    ok $hdr, "  got Header info";
54    my $uncomp ;
55    ok $gunz->read($uncomp), " read ok" ;
56    is $uncomp, $content, "  got expected content";
57    ok $gunz->close, "  closed ok" ;
58
59    return $hdr ;
60
61}
62
63{
64    title "Check zip header default NAME & MTIME settings" ;
65
66    my $lex = LexFile->new( my $file1 );
67
68    my $content = "hello ";
69    my $hdr ;
70    my $mtime ;
71
72    writeFile($file1, $content);
73    $mtime = (stat($file1))[9];
74    # make sure that the zip file isn't created in the same
75    # second as the input file
76    sleep 3 ;
77    $hdr = zipGetHeader($file1, $content);
78
79    is $hdr->{Name}, $file1, "  Name is '$file1'";
80    is $hdr->{Time}>>1, $mtime>>1, "  Time is ok";
81
82    title "Override Name" ;
83
84    writeFile($file1, $content);
85    $mtime = (stat($file1))[9];
86    sleep 3 ;
87    $hdr = zipGetHeader($file1, $content, Name => "abcde");
88
89    is $hdr->{Name}, "abcde", "  Name is 'abcde'" ;
90    is $hdr->{Time} >> 1, $mtime >> 1, "  Time is ok";
91
92    title "Override Time" ;
93
94    writeFile($file1, $content);
95    my $useTime = time + 2000 ;
96    $hdr = zipGetHeader($file1, $content, Time => $useTime);
97
98    is $hdr->{Name}, $file1, "  Name is '$file1'" ;
99    is $hdr->{Time} >> 1 , $useTime >> 1 ,  "  Time is $useTime";
100
101    title "Override Name and Time" ;
102
103    $useTime = time + 5000 ;
104    writeFile($file1, $content);
105    $hdr = zipGetHeader($file1, $content, Time => $useTime, Name => "abcde");
106
107    is $hdr->{Name}, "abcde", "  Name is 'abcde'" ;
108    is $hdr->{Time} >> 1 , $useTime >> 1 , "  Time is $useTime";
109
110    title "Filehandle doesn't have default Name or Time" ;
111    my $fh = IO::File->new( "< $file1" )
112        or diag "Cannot open '$file1': $!\n" ;
113    sleep 3 ;
114    my $before = time ;
115    $hdr = zipGetHeader($fh, $content);
116    my $after = time ;
117
118    ok ! defined $hdr->{Name}, "  Name is undef";
119    cmp_ok $hdr->{Time} >> 1, '>=', $before >> 1, "  Time is ok";
120    cmp_ok $hdr->{Time} >> 1, '<=', $after >> 1, "  Time is ok";
121
122    $fh->close;
123
124    title "Buffer doesn't have default Name or Time" ;
125    my $buffer = $content;
126    $before = time ;
127    $hdr = zipGetHeader(\$buffer, $content);
128    $after = time ;
129
130    ok ! defined $hdr->{Name}, "  Name is undef";
131    cmp_ok $hdr->{Time} >> 1, '>=', $before >> 1, "  Time is ok";
132    cmp_ok $hdr->{Time} >> 1, '<=', $after >> 1, "  Time is ok";
133}
134
135{
136    title "Check CanonicalName & FilterName";
137
138    my $lex = LexFile->new( my $file1 );
139
140    my $content = "hello" ;
141    writeFile($file1, $content);
142    my $hdr;
143
144    my $abs = File::Spec->catfile("", "fred", "joe");
145    $hdr = zipGetHeader($file1, $content, Name => $abs, CanonicalName => 1) ;
146    is $hdr->{Name}, "fred/joe", "  Name is 'fred/joe'" ;
147
148    $hdr = zipGetHeader($file1, $content, Name => $abs, CanonicalName => 0) ;
149    is $hdr->{Name}, File::Spec->catfile("", "fred", "joe"), "  Name is '/fred/joe'" ;
150
151    $hdr = zipGetHeader($file1, $content, FilterName => sub {$_ = "abcde"});
152    is $hdr->{Name}, "abcde", "  Name is 'abcde'" ;
153
154    $hdr = zipGetHeader($file1, $content, Name => $abs,
155         CanonicalName => 1,
156         FilterName => sub { s/joe/jim/ });
157    is $hdr->{Name}, "fred/jim", "  Name is 'fred/jim'" ;
158
159    $hdr = zipGetHeader($file1, $content, Name => $abs,
160         CanonicalName => 0,
161         FilterName => sub { s/joe/jim/ });
162    is $hdr->{Name}, File::Spec->catfile("", "fred", "jim"), "  Name is '/fred/jim'" ;
163}
164
165{
166    title "Detect encrypted zip file";
167
168    my $files = "./t/" ;
169    $files = "./" if $ENV{PERL_CORE} ;
170    $files .= "files/";
171
172    my $zipfile = "$files/encrypt-standard.zip" ;
173    my $output;
174
175    ok ! unzip "$files/encrypt-standard.zip" => \$output ;
176    like $UnzipError, qr/Encrypted content not supported/ ;
177
178    ok ! unzip "$files/encrypt-aes.zip" => \$output ;
179    like $UnzipError, qr/Encrypted content not supported/ ;
180}
181
182{
183    title "jar file with deflated directory";
184
185    # Create Jar as follow
186    #   echo test > file && jar c file > jar.zip
187
188    # Note the deflated directory META-INF with length 0 & size 2
189    #
190    # $ unzip -vl t/files/jar.zip
191    # Archive:  t/files/jar.zip
192    #  Length   Method    Size  Cmpr    Date    Time   CRC-32   Name
193    # --------  ------  ------- ---- ---------- ----- --------  ----
194    #        0  Defl:N        2   0% 2019-09-07 22:35 00000000  META-INF/
195    #       54  Defl:N       53   2% 2019-09-07 22:35 934e49ff  META-INF/MANIFEST.MF
196    #        5  Defl:N        7 -40% 2019-09-07 22:35 3bb935c6  file
197    # --------          -------  ---                            -------
198    #       59               62  -5%                            3 files
199
200
201    my $files = "./t/" ;
202    $files = "./" if $ENV{PERL_CORE} ;
203    $files .= "files/";
204
205    my $zipfile = "$files/jar.zip" ;
206    my $output;
207
208    ok unzip $zipfile => \$output ;
209
210    is $output, "" ;
211
212}
213
214for my $stream (0, 1)
215{
216    for my $zip64 (0, 1)
217    {
218        #next if $zip64 && ! $stream;
219
220        for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE)
221        {
222
223            title "Stream $stream, Zip64 $zip64, Method $method";
224
225            my $lex = LexFile->new( my $file1 );
226
227            my $content = "hello ";
228            #writeFile($file1, $content);
229
230            my $status = zip(\$content => $file1 ,
231                               Method => $method,
232                               Stream => $stream,
233                               Zip64  => $zip64);
234
235             ok $status, "  zip ok"
236                or diag $ZipError ;
237
238            my $got ;
239            ok unzip($file1 => \$got), "  unzip ok"
240                or diag $UnzipError ;
241
242            is $got, $content, "  content ok";
243
244            my $u = IO::Uncompress::Unzip->new( $file1 )
245                or diag $ZipError ;
246
247            my $hdr = $u->getHeaderInfo();
248            ok $hdr, "  got header";
249
250            is $hdr->{Stream}, $stream, "  stream is $stream" ;
251            is $hdr->{MethodID}, $method, "  MethodID is $method" ;
252            is $hdr->{Zip64}, $zip64, "  Zip64 is $zip64" ;
253        }
254    }
255}
256
257for my $stream (0, 1)
258{
259    for my $zip64 (0, 1)
260    {
261        next if $zip64 && ! $stream;
262        for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE)
263        {
264            title "Stream $stream, Zip64 $zip64, Method $method";
265
266            my $file1;
267            my $file2;
268            my $zipfile;
269            my $lex = LexFile->new( $file1, $file2, $zipfile );
270
271            my $content1 = "hello ";
272            writeFile($file1, $content1);
273
274            my $content2 = "goodbye ";
275            writeFile($file2, $content2);
276
277            my %content = ( $file1 => $content1,
278                            $file2 => $content2,
279                          );
280
281            ok zip([$file1, $file2] => $zipfile , Method => $method,
282                                                  Zip64  => $zip64,
283                                                  Stream => $stream), " zip ok"
284                or diag $ZipError ;
285
286            for my $file ($file1, $file2)
287            {
288                my $got ;
289                ok unzip($zipfile => \$got, Name => $file), "  unzip $file ok"
290                    or diag $UnzipError ;
291
292                is $got, $content{$file}, "  content ok";
293            }
294        }
295    }
296}
297
298{
299    title "Regression: ods streaming issue";
300
301    # The file before meta.xml in test.ods is content.xml.
302    # Issue was triggered because content.xml was stored
303    # as streamed and the code to walk the compressed streaming
304    # content assumed that all of the input buffer was consumed
305    # in a single call to "uncompr".
306
307    my $files = "./t/" ;
308    $files = "./" if $ENV{PERL_CORE} ;
309    $files .= "files/";
310
311    my $zipfile = "$files/test.ods" ;
312    my $file = "meta.xml";
313
314    my $got;
315
316    ok unzip($zipfile => \$got, Name => $file), "  unzip $file ok"
317        or diag $UnzipError ;
318
319    my $meta = '<?xml version="1.0" encoding="UTF-8"?>
320<office:document-meta xmlns:office="urn:oasis:names:tc:opendocument:xmlns:office:1.0" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:meta="urn:oasis:names:tc:opendocument:xmlns:meta:1.0" xmlns:ooo="http://openoffice.org/2004/office" xmlns:grddl="http://www.w3.org/2003/g/data-view#" office:version="1.2"><office:meta><meta:creation-date>2018-12-25T11:36:11.437260543</meta:creation-date><dc:date>2018-12-25T11:36:55.657945697</dc:date><meta:editing-duration>PT54S</meta:editing-duration><meta:editing-cycles>1</meta:editing-cycles><meta:document-statistic meta:table-count="1" meta:cell-count="3" meta:object-count="0"/><meta:generator>LibreOffice/6.0.7.3$Linux_X86_64 LibreOffice_project/00m0$Build-3</meta:generator></office:meta></office:document-meta>';
321
322    is $got, $meta, "  content ok";
323
324}
325
326{
327    title "Regression: odt non-streaming issue";
328    # https://github.com/pmqs/IO-Compress/issues/13
329
330    # Some programs (LibreOffice) mark entries as Streamed (bit 3 of the General Purpose Bit Flags field is set) ,
331    # but still fill out the Compressed Length, Uncompressed Length & CRC32 fields in the local file header
332
333    my $files = "./t/" ;
334    $files = "./" if $ENV{PERL_CORE} ;
335    $files .= "files/";
336
337    my $zipfile = "$files/testfile1.odt" ;
338    my $file = "manifest.rdf";
339
340    my $got;
341
342    ok unzip($zipfile => \$got, Name => $file), "  unzip $file ok"
343        or diag $UnzipError ;
344
345    my $meta = <<'EOM';
346<?xml version="1.0" encoding="utf-8"?>
347<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
348  <rdf:Description rdf:about="">
349    <rdf:type rdf:resource="http://docs.oasis-open.org/ns/office/1.2/meta/pkg#Document"/>
350  </rdf:Description>
351</rdf:RDF>
352EOM
353    is $got, $meta, "  content ok";
354}
355
356# TODO add more error cases
357