changeset 11862:8af93d121629 draft

<ais523> ` mv unzip.pl bin/unzip
author HackEso <hackeso@esolangs.org>
date Tue, 16 Jul 2019 21:35:17 +0000
parents 8970d544f2b3
children f9a75cd614b3
files bin/unzip unzip.pl
diffstat 2 files changed, 84 insertions(+), 84 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/unzip	Tue Jul 16 21:35:17 2019 +0000
@@ -0,0 +1,84 @@
+#!/usr/bin/perl
+# example perl code, this may not actually run without tweaking, especially on Windows
+
+use strict;
+use warnings;
+
+=pod
+
+IO::Uncompress::Unzip works great to process zip files; but, it doesn't include a routine to actually
+extract an entire zip file.
+
+Other modules like Archive::Zip include their own unzip routines, which aren't as robust as IO::Uncompress::Unzip;
+eg. they don't work on zip64 archive files.
+
+So, the following is code to actually use IO::Uncompress::Unzip to extract a zip file.
+
+=cut
+
+use File::Spec::Functions qw(splitpath);
+use IO::File;
+use IO::Uncompress::Unzip qw($UnzipError);
+use File::Path qw(mkpath);
+
+# example code to call unzip:
+unzip(shift);
+
+=head2 unzip
+
+Extract a zip file, using IO::Uncompress::Unzip.
+
+Arguments: file to extract, destination path
+
+    unzip('stuff.zip', '/tmp/unzipped');
+
+=cut
+
+sub unzip {
+    my ($file, $dest) = @_;
+
+    die 'Need a file argument' unless defined $file;
+    $dest = "." unless defined $dest;
+
+    my $u = IO::Uncompress::Unzip->new($file)
+        or die "Cannot open $file: $UnzipError";
+
+    my $status;
+    for ($status = 1; $status > 0; $status = $u->nextStream()) {
+        my $header = $u->getHeaderInfo();
+        my (undef, $path, $name) = splitpath($header->{Name});
+        my $destdir = "$dest/$path";
+
+        unless (-d $destdir) {
+            mkpath($destdir) or die "Couldn't mkdir $destdir: $!";
+        }
+
+        if ($name =~ m!/$!) {
+            last if $status < 0;
+            next;
+        }
+
+        my $destfile = "$dest/$path/$name";
+        # https://cwe.mitre.org/data/definitions/37.html
+        # CWE-37: Path Traversal
+        die "unsafe $destfile" if $destfile =~ m!\Q..\E(/|\\)!;
+
+        my $buff;
+        my $fh = IO::File->new($destfile, "w")
+            or die "Couldn't write to $destfile: $!";
+        while (($status = $u->read($buff)) > 0) {
+            $fh->write($buff);
+        }
+        $fh->close();
+        my $stored_time = $header->{'Time'};
+        utime ($stored_time, $stored_time, $destfile)
+            or die "Couldn't touch $destfile: $!";
+    }
+
+    die "Error processing $file: $!\n"
+        if $status < 0 ;
+
+    return;
+}
+
+1;
--- a/unzip.pl	Tue Jul 16 21:35:05 2019 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,84 +0,0 @@
-#!/usr/bin/perl
-# example perl code, this may not actually run without tweaking, especially on Windows
-
-use strict;
-use warnings;
-
-=pod
-
-IO::Uncompress::Unzip works great to process zip files; but, it doesn't include a routine to actually
-extract an entire zip file.
-
-Other modules like Archive::Zip include their own unzip routines, which aren't as robust as IO::Uncompress::Unzip;
-eg. they don't work on zip64 archive files.
-
-So, the following is code to actually use IO::Uncompress::Unzip to extract a zip file.
-
-=cut
-
-use File::Spec::Functions qw(splitpath);
-use IO::File;
-use IO::Uncompress::Unzip qw($UnzipError);
-use File::Path qw(mkpath);
-
-# example code to call unzip:
-unzip(shift);
-
-=head2 unzip
-
-Extract a zip file, using IO::Uncompress::Unzip.
-
-Arguments: file to extract, destination path
-
-    unzip('stuff.zip', '/tmp/unzipped');
-
-=cut
-
-sub unzip {
-    my ($file, $dest) = @_;
-
-    die 'Need a file argument' unless defined $file;
-    $dest = "." unless defined $dest;
-
-    my $u = IO::Uncompress::Unzip->new($file)
-        or die "Cannot open $file: $UnzipError";
-
-    my $status;
-    for ($status = 1; $status > 0; $status = $u->nextStream()) {
-        my $header = $u->getHeaderInfo();
-        my (undef, $path, $name) = splitpath($header->{Name});
-        my $destdir = "$dest/$path";
-
-        unless (-d $destdir) {
-            mkpath($destdir) or die "Couldn't mkdir $destdir: $!";
-        }
-
-        if ($name =~ m!/$!) {
-            last if $status < 0;
-            next;
-        }
-
-        my $destfile = "$dest/$path/$name";
-        # https://cwe.mitre.org/data/definitions/37.html
-        # CWE-37: Path Traversal
-        die "unsafe $destfile" if $destfile =~ m!\Q..\E(/|\\)!;
-
-        my $buff;
-        my $fh = IO::File->new($destfile, "w")
-            or die "Couldn't write to $destfile: $!";
-        while (($status = $u->read($buff)) > 0) {
-            $fh->write($buff);
-        }
-        $fh->close();
-        my $stored_time = $header->{'Time'};
-        utime ($stored_time, $stored_time, $destfile)
-            or die "Couldn't touch $destfile: $!";
-    }
-
-    die "Error processing $file: $!\n"
-        if $status < 0 ;
-
-    return;
-}
-
-1;