suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

untar, untgz, and unzip: add #:permissive?

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2015-09-11 16:52:36 -06:00
parent c7fac6e98e
commit 0d3b5b61f0
8 changed files with 68 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/racket-doc/file/scribblings/untar.scrbl
View File

@ -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.}]}

5
pkgs/racket-doc/file/scribblings/untgz.scrbl
View File

@ -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.}]}

11
pkgs/racket-doc/file/scribblings/unzip.scrbl
View File

@ -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?]{

24
pkgs/racket-test/tests/file/unpackers.rkt
View File

@ -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")

11
racket/collects/file/private/check-path.rkt
View File

@ -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)))))

12
racket/collects/file/untar.rkt
View File

@ -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))

4
racket/collects/file/untgz.rkt
View File

@ -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)))))

6
racket/collects/file/unzip.rkt
View File

@ -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