Mercurial > repo

comparison bin/unzip @ 11862:8af93d121629 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<ais523> ` mv unzip.pl bin/unzip
author HackEso <hackeso@esolangs.org>
date Tue, 16 Jul 2019 21:35:17 +0000
parents unzip.pl@8970d544f2b3
children d054de7f80f2
comparison
equal deleted inserted replaced
11861:8970d544f2b3 11862:8af93d121629
1 #!/usr/bin/perl
2 # example perl code, this may not actually run without tweaking, especially on Windows
3
4 use strict;
5 use warnings;
6
7 =pod
8
9 IO::Uncompress::Unzip works great to process zip files; but, it doesn't include a routine to actually
10 extract an entire zip file.
11
12 Other modules like Archive::Zip include their own unzip routines, which aren't as robust as IO::Uncompress::Unzip;
13 eg. they don't work on zip64 archive files.
14
15 So, the following is code to actually use IO::Uncompress::Unzip to extract a zip file.
16
17 =cut
18
19 use File::Spec::Functions qw(splitpath);
20 use IO::File;
21 use IO::Uncompress::Unzip qw($UnzipError);
22 use File::Path qw(mkpath);
23
24 # example code to call unzip:
25 unzip(shift);
26
27 =head2 unzip
28
29 Extract a zip file, using IO::Uncompress::Unzip.
30
31 Arguments: file to extract, destination path
32
33 unzip('stuff.zip', '/tmp/unzipped');
34
35 =cut
36
37 sub unzip {
38 my ($file, $dest) = @_;
39
40 die 'Need a file argument' unless defined $file;
41 $dest = "." unless defined $dest;
42
43 my $u = IO::Uncompress::Unzip->new($file)
44 or die "Cannot open $file: $UnzipError";
45
46 my $status;
47 for ($status = 1; $status > 0; $status = $u->nextStream()) {
48 my $header = $u->getHeaderInfo();
49 my (undef, $path, $name) = splitpath($header->{Name});
50 my $destdir = "$dest/$path";
51
52 unless (-d $destdir) {
53 mkpath($destdir) or die "Couldn't mkdir $destdir: $!";
54 }
55
56 if ($name =~ m!/$!) {
57 last if $status < 0;
58 next;
59 }
60
61 my $destfile = "$dest/$path/$name";
62 # https://cwe.mitre.org/data/definitions/37.html
63 # CWE-37: Path Traversal
64 die "unsafe $destfile" if $destfile =~ m!\Q..\E(/|\\)!;
65
66 my $buff;
67 my $fh = IO::File->new($destfile, "w")
68 or die "Couldn't write to $destfile: $!";
69 while (($status = $u->read($buff)) > 0) {
70 $fh->write($buff);
71 }
72 $fh->close();
73 my $stored_time = $header->{'Time'};
74 utime ($stored_time, $stored_time, $destfile)
75 or die "Couldn't touch $destfile: $!";
76 }
77
78 die "Error processing $file: $!\n"
79 if $status < 0 ;
80
81 return;
82 }
83
84 1;