From 322714f123a9884e288c2f1156ba6d56cf58cf2e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 2 Sep 2015 13:15:03 -0600
Subject: [PATCH] untar and unzip: reject paths that contain ".."

Also, for unzip, reject absolute paths.
---
 racket/collects/file/private/check-path.rkt | 11 +++++++++++
 racket/collects/file/untar.rkt              |  6 +++---
 racket/collects/file/unzip.rkt              |  7 +++++--
 3 files changed, 19 insertions(+), 5 deletions(-)
 create mode 100644 racket/collects/file/private/check-path.rkt

diff --git a/racket/collects/file/private/check-path.rkt b/racket/collects/file/private/check-path.rkt
new file mode 100644
index 0000000000..90a4d219ab
--- /dev/null
+++ b/racket/collects/file/private/check-path.rkt
@@ -0,0 +1,11 @@
+#lang racket/base
+
+(provide check-unpack-path)
+
+(define (check-unpack-path who filename)
+  (when (absolute-path? filename)
+    (error who "won't extract a file with an absolute path\n  path: ~e" filename))
+  (for ([e (in-list (explode-path filename))])
+    (when (eq? e 'up)
+      (error who "won't extract a file with an up-directory element\n  path: ~e" filename))))
+
diff --git a/racket/collects/file/untar.rkt b/racket/collects/file/untar.rkt
index 10a35216d6..bce385eb9b 100644
--- a/racket/collects/file/untar.rkt
+++ b/racket/collects/file/untar.rkt
@@ -2,7 +2,8 @@
 (require racket/file
          racket/contract/base
          racket/port
-         "private/strip-prefix.rkt")
+         "private/strip-prefix.rkt"
+         "private/check-path.rkt")
 
 (provide
  (contract-out
@@ -78,8 +79,7 @@
                                      name
                                      (bytes-append prefix #"/" name)))
                                name))))
-  (when (absolute-path? base-filename)
-    (error 'untar "won't extract a file with an absolute path: ~e" base-filename))
+  (check-unpack-path 'untar base-filename)
   (define stripped-filename (strip-prefix base-filename strip-count))
   (define filename (and stripped-filename
                         (if dest
diff --git a/racket/collects/file/unzip.rkt b/racket/collects/file/unzip.rkt
index fa962f3f06..189afcf059 100644
--- a/racket/collects/file/unzip.rkt
+++ b/racket/collects/file/unzip.rkt
@@ -4,7 +4,8 @@
          racket/file
          racket/date
          file/gunzip
-         "private/strip-prefix.rkt")
+         "private/strip-prefix.rkt"
+         "private/check-path.rkt")
 
 (provide
  (struct-out exn:fail:unzip:no-such-entry)
@@ -359,7 +360,9 @@
 (define make-filesystem-entry-reader
   (lambda (#:dest [dest-dir #f] #:strip-count [strip-count 0] #:exists [flag 'error])
     (lambda (name dir? in [timestamp #f])
-      (let* ([base-path (strip-prefix (bytes->path name) strip-count)]
+      (define path (bytes->path name))
+      (check-unpack-path 'unzip path)
+      (let* ([base-path (strip-prefix path strip-count)]
              [path (and base-path
                         (if dest-dir
                             (build-path dest-dir base-path)