From 0d3b5b61f0181e74fa1a7f4b5c018cd8c6682fc9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 11 Sep 2015 16:52:36 -0600 Subject: [PATCH] untar, untgz, and unzip: add `#:permissive?` Also, strengthen the checking that `#:permissive?` (off by default) performs for `untar` and `untgz` to disallow a link whose target is an absolute path or has an up-directory element. --- pkgs/racket-doc/file/scribblings/untar.scrbl | 11 ++++++++- pkgs/racket-doc/file/scribblings/untgz.scrbl | 5 +++- pkgs/racket-doc/file/scribblings/unzip.scrbl | 11 ++++++++- pkgs/racket-test/tests/file/unpackers.rkt | 24 ++++++++++++++++++-- racket/collects/file/private/check-path.rkt | 11 +++++---- racket/collects/file/untar.rkt | 12 +++++++--- racket/collects/file/untgz.rkt | 4 +++- racket/collects/file/unzip.rkt | 6 +++-- 8 files changed, 68 insertions(+), 16 deletions(-) diff --git a/pkgs/racket-doc/file/scribblings/untar.scrbl b/pkgs/racket-doc/file/scribblings/untar.scrbl index b055ddd77b..7987015795 100644 --- a/pkgs/racket-doc/file/scribblings/untar.scrbl +++ b/pkgs/racket-doc/file/scribblings/untar.scrbl @@ -9,6 +9,7 @@ a function to extract items from a TAR/USTAR archive.} @defproc[(untar [in (or/c path-string? input-port?)] [#:dest dest-path (or/c path-string? #f) #f] [#:strip-count strip-count exact-nonnegative-integer? 0] + [#:permissive? permissive? any/c #f] [#:filter filter-proc (path? (or/c path? #f) symbol? exact-integer? (or/c path? #f) @@ -28,6 +29,12 @@ elements are removed from the item path from the archive (before prefixing the path with @racket[dest-path]); if the item's path contains @racket[strip-count] elements, then it is not extracted. +Unless @racket[permissive?] is true, then archive items with paths containing +an up-directory indicator are disallowed, and a link item whose target +is an absolute path or contains an up-directory indicator is also +disallowed. Absolute paths are always disallowed. A disallowed +path triggers an exception. + For each item in the archive, @racket[filter-proc] is applied to @itemlist[ @@ -60,4 +67,6 @@ For each item in the archive, @racket[filter-proc] is applied to ] If the result of @racket[filter-proc] is @racket[#f], then the item is -not unpacked.} +not unpacked. + +@history[#:changed "6.2.900.17" @elem{Added the @racket[#:permissive?] argument.}]} diff --git a/pkgs/racket-doc/file/scribblings/untgz.scrbl b/pkgs/racket-doc/file/scribblings/untgz.scrbl index 4be9ee0ed0..479865af2e 100644 --- a/pkgs/racket-doc/file/scribblings/untgz.scrbl +++ b/pkgs/racket-doc/file/scribblings/untgz.scrbl @@ -11,6 +11,7 @@ a function to extract items from a possible @exec{gzip}ped TAR/USTAR archive.} @defproc[(untgz [in (or/c path-string? input-port?)] [#:dest dest-path (or/c path-string? #f) #f] [#:strip-count strip-count exact-nonnegative-integer? 0] + [#:permissive? permissive? any/c #f] [#:filter filter-proc (path? (or/c path? #f) symbol? exact-integer? (or/c path? #f) @@ -21,4 +22,6 @@ a function to extract items from a possible @exec{gzip}ped TAR/USTAR archive.} void?]{ The same as @racket[untar], but if @racket[in] is in @exec{gzip} form, -it is @racket[gunzip]ped as it is unpacked.} +it is @racket[gunzip]ped as it is unpacked. + +@history[#:changed "6.2.900.17" @elem{Added the @racket[#:permissive?] argument.}]} diff --git a/pkgs/racket-doc/file/scribblings/unzip.scrbl b/pkgs/racket-doc/file/scribblings/unzip.scrbl index 9db4d7e0f0..d3c619c8af 100644 --- a/pkgs/racket-doc/file/scribblings/unzip.scrbl +++ b/pkgs/racket-doc/file/scribblings/unzip.scrbl @@ -50,6 +50,7 @@ directory while returning the result of @racket[proc]. @defproc[(make-filesystem-entry-reader [#:dest dest-path (or/c path-string? #f) #f] [#:strip-count strip-count exact-nonnegative-integer? 0] + [#:permissive? permissive? any/c #f] [#:exists exists (or/c 'skip 'error 'replace 'truncate 'truncate/replace 'append 'update 'can-update 'must-truncate) @@ -72,13 +73,21 @@ elements are removed from the entry path from the archive (before prefixing the path with @racket[dest-path]); if the item's path contains @racket[strip-count] elements, then it is not extracted. +Unless @racket[permissive?] is true, then entries with paths containing +an up-directory indicator are disallowed, and a link entry whose target +is an absolute path or contains an up-directory indicator is also +disallowed. Absolute paths are always disallowed. A disallowed +path triggers an exception. + If @racket[exists] is @racket['skip] and the file for an entry already exists, then the entry is skipped. Otherwise, @racket[exists] is passed on to @racket[open-output-file] for writing the entry's inflated content. @history[#:changed "6.0.0.3" - @elem{Added support for the optional timestamp argument in the result function.}]} + @elem{Added support for the optional timestamp argument in the result function.} + #:changed "6.2.900.17" + @elem{Added the @racket[#:permissive?] argument.}]} @defproc[(read-zip-directory [in (or/c path-string? input-port?)]) zip-directory?]{ diff --git a/pkgs/racket-test/tests/file/unpackers.rkt b/pkgs/racket-test/tests/file/unpackers.rkt index 43707ce389..e30c852c09 100644 --- a/pkgs/racket-test/tests/file/unpackers.rkt +++ b/pkgs/racket-test/tests/file/unpackers.rkt @@ -98,7 +98,6 @@ (delete-directory/files "sub") (file-or-directory-permissions* more-dir "rwx") - ;; make sure top-level file extraction works (untgz (open-input-bytes ;; bytes gotten from 'tar' and 'gzip' command-line tools @@ -112,7 +111,28 @@ (test (file-exists? "L1c")) (test (file-exists? "helper.rkt")) (delete-file "L1c") - (delete-file "helper.rkt")) + (delete-file "helper.rkt") + + ;; check on [non-]permissive unpacking + (unless (eq? (system-type) 'windows) + (for ([target (in-list '("../x" "/tmp/abs" "ok"))]) + (define ok? (equal? target "ok")) + (make-directory* "ex2") + (make-file-or-directory-link target (build-path "ex2" "link")) + (tar "ex2" a.tar) + (make-directory "sub") + (test (with-handlers ([exn:fail? (lambda (exn) + (regexp-match? #rx"up-directory|absolute" (exn-message exn)))]) + (untar "a.tar" #:dest "sub") + ok?)) + (test (equal? ok? (link-exists? (build-path "sub" "ex2" "link")))) + (delete-directory/files "sub") + + (make-directory "sub") + (untar "a.tar" #:dest "sub" #:permissive? #t) + (test (link-exists? (build-path "sub" "ex2" "link"))) + (delete-directory/files "sub") + (delete-directory/files "ex2")))) (define ((make-unzip-tests* preserve-timestamps?)) (make-directory* "ex1") diff --git a/racket/collects/file/private/check-path.rkt b/racket/collects/file/private/check-path.rkt index 90a4d219ab..15e1ef10a6 100644 --- a/racket/collects/file/private/check-path.rkt +++ b/racket/collects/file/private/check-path.rkt @@ -2,10 +2,11 @@ (provide check-unpack-path) -(define (check-unpack-path who filename) +(define (check-unpack-path who filename + #:allow-up? [allow-up? #f]) (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)))) - + (unless allow-up? + (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 d524d4c1c3..c0fd1c7e1f 100644 --- a/racket/collects/file/untar.rkt +++ b/racket/collects/file/untar.rkt @@ -11,6 +11,7 @@ (#:dest (or/c #f path-string?) #:strip-count exact-nonnegative-integer? + #:permissive? any/c #:filter (path? (or/c path? #f) symbol? exact-integer? (or/c path? #f) exact-nonnegative-integer? exact-nonnegative-integer? @@ -22,6 +23,7 @@ (define (untar in #:dest [dest #f] #:strip-count [strip-count 0] + #:permissive? [permissive? #f] #:filter [filter void]) ((if (input-port? in) (lambda (in f) (f in)) @@ -34,7 +36,8 @@ (for ([delay (in-list (reverse delays))]) (delay)) (loop (untar-one-from-port in delays - dest strip-count filter))))))) + dest strip-count filter + permissive?))))))) (define (read-bytes* n in) (define s (read-bytes n in)) @@ -44,7 +47,8 @@ s) (define (untar-one-from-port in delays - dest strip-count filter) + dest strip-count filter + permissive?) (define name-bytes (read-bytes* 100 in)) (define mode (tar-bytes->number (read-bytes* 8 in) in)) (define owner (tar-bytes->number (read-bytes* 8 in) in)) @@ -79,7 +83,7 @@ name (bytes-append prefix #"/" name))) name)))) - (check-unpack-path 'untar base-filename) + (check-unpack-path 'untar base-filename #:allow-up? permissive?) (define stripped-filename (strip-prefix base-filename strip-count)) (define filename (and stripped-filename (if dest @@ -87,6 +91,8 @@ stripped-filename))) (define link-target (and (eq? type 'link) (bytes->path (nul-terminated link-target-bytes)))) + (when (and link-target (not permissive?)) + (check-unpack-path 'untar link-target)) (read-bytes* 12 in) ; padding (define create? (filter base-filename filename type size link-target mod-time mode)) diff --git a/racket/collects/file/untgz.rkt b/racket/collects/file/untgz.rkt index d8fac6e2c0..592eef7850 100644 --- a/racket/collects/file/untgz.rkt +++ b/racket/collects/file/untgz.rkt @@ -11,6 +11,7 @@ (#:dest (or/c #f path-string?) #:strip-count exact-nonnegative-integer? + #:permissive? any/c #:filter (path? (or/c path? #f) symbol? exact-integer? (or/c path? #f) exact-nonnegative-integer? exact-nonnegative-integer? @@ -20,6 +21,7 @@ (define (untgz in #:dest [dest #f] #:strip-count [strip-count 0] + #:permissive? [permissive? #f] #:filter [filter void]) ((if (input-port? in) (lambda (in f) (f in)) @@ -44,7 +46,7 @@ (thread-wait t)))] [else (values in void)])) (begin0 - (untar in2 #:dest dest #:strip-count strip-count #:filter filter) + (untar in2 #:dest dest #:strip-count strip-count #:permissive? permissive? #:filter filter) (wait))))) diff --git a/racket/collects/file/unzip.rkt b/racket/collects/file/unzip.rkt index 189afcf059..ef59ef681c 100644 --- a/racket/collects/file/unzip.rkt +++ b/racket/collects/file/unzip.rkt @@ -25,6 +25,8 @@ (or/c #f path-string?) #:strip-count exact-nonnegative-integer? + #:permissive? + any/c #:exists (or/c 'skip 'error 'replace 'truncate 'truncate/replace 'append 'update @@ -358,10 +360,10 @@ ;; make-filesystem-entry-reader : [output-flag] -> (bytes boolean input-port -> any) (define make-filesystem-entry-reader - (lambda (#:dest [dest-dir #f] #:strip-count [strip-count 0] #:exists [flag 'error]) + (lambda (#:dest [dest-dir #f] #:strip-count [strip-count 0] #:permissive? [permissive? #f] #:exists [flag 'error]) (lambda (name dir? in [timestamp #f]) (define path (bytes->path name)) - (check-unpack-path 'unzip path) + (check-unpack-path 'unzip path #:allow-up? permissive?) (let* ([base-path (strip-prefix path strip-count)] [path (and base-path (if dest-dir