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

Improve error message for disallowed links.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2020-05-14 09:54:22 -04:00
parent b5660ce0dc
commit f5f2cd9345
3 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,10 +3,11 @@
(provide check-unpack-path)
(define (check-unpack-path who filename
#:allow-up? [allow-up? #f])
#:allow-up? [allow-up? #f]
#:kind [kind "file"])
(when (absolute-path? filename)
(error who "won't extract a file with an absolute path\n path: ~e" filename))
(error who "won't extract a ~a with an absolute path\n path: ~e" kind 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)))))
(error who "won't extract a ~a with an up-directory element\n path: ~e" kind filename)))))

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

@ -101,7 +101,7 @@
(or link-target-from-extended-attributes
(bytes->path (nul-terminated link-target-bytes)))))
(when (and link-target (not permissive?))
(check-unpack-path 'untar link-target))
(check-unpack-path 'untar link-target #:kind "link"))
(read-bytes* 12 in) ; padding
(define create?
(filter base-filename filename type size link-target mod-time mode))

2
racket/collects/net/git-checkout.rkt
View File

@ -730,7 +730,7 @@
[(#"120000")
(define target (bytes->path (object->bytes tmp (this-object-location))))
(when strict-links?
(check-unpack-path 'git-checkout target))
(check-unpack-path 'git-checkout target #:kind "link"))
(make-file-or-directory-link target (build-path dest-dir fn))]
[(#"160000")
;; submodule; just make a directory placeholder