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

cs & io: fix security-guard call in current-directory

Browse Source
This commit is contained in:
Matthew Flatt 2019-07-07 08:27:33 -06:00
parent 79d6b9bc18
commit 839fb84eec
1 changed files with 23 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
racket/src/io/path/api.rkt
View File

@ -37,30 +37,34 @@
;; ---------------------------------------- ;; ----------------------------------------
(define (make-guard-paths who normalize?) (define (make-guard-paths who normalize?)
(case-lambda (lambda (path)
[()
(security-guard-check-file who #f '(exists))
(values)]
[(path)
(cond (cond
[(path-string? path) [(path-string? path)
(->host path who '(exists)) (->host path who '(exists))
(if normalize? (if normalize?
(path->directory-path (simplify-path path)) (path->directory-path (simplify-path path))
path)] path)]
[else path])])) [else path])))
(define (make-wrap-paths who)
(lambda (path)
(security-guard-check-file who #f '(exists))
path))
(define/who current-directory (define/who current-directory
(let ([guard (make-guard-paths who #t)]) (make-derived-parameter raw:current-directory
(make-derived-parameter raw:current-directory guard guard))) (make-guard-paths who #t)
(make-wrap-paths who)))
(define/who current-directory-for-path->complete-path (define current-directory-for-path->complete-path
(let ([guard (make-guard-paths 'path->complete-path #f)]) (make-derived-parameter raw:current-directory
(make-derived-parameter raw:current-directory guard guard))) (make-guard-paths 'path->complete-path #f)
(make-wrap-paths 'path->complete-path)))
(define/who current-directory-for-user (define/who current-directory-for-user
(let ([guard (make-guard-paths who #t)]) (make-derived-parameter raw:current-directory-for-user
(make-derived-parameter raw:current-directory-for-user guard guard))) (make-guard-paths who #t)
(make-wrap-paths who)))
(define/who current-load-relative-directory (define/who current-load-relative-directory
(let ([guard (make-guard-paths who #f)]) (let ([guard (make-guard-paths who #f)])