only warn when there is an invalid path when getting a prop

This commit is contained in:
Eli Barzilay 2010-04-23 20:58:22 -04:00
parent f4c08ccb08
commit 72431fda2d

View File

@ -140,7 +140,7 @@ path/s is either such a string or a list of them.
;; need updating if more characters are allowed in the future.
#rx"[^/.a-zA-Z0-9%_+-]")
(define (validate-path-string path-string who)
(define (validate-path-string path-string who [only-warn? #f])
(define (bad why)
(error* who "invalid path argument, expecting a ~a, got: ~e"
why path-string))
@ -149,10 +149,12 @@ path/s is either such a string or a list of them.
(regexp-match? rx:bad-path path-string))
(bad "relative `/'-delimited string, no `/' suffix, `//', `.', or `..'"))
(when (regexp-match? rx:bad-pathchar path-string)
(error* who "invalid path argument, ~s is not allowed, got: ~e\n~a~a"
(regexp-match rx:bad-pathchar path-string) path-string
"(note: if paths with this character are needed, then this"
" script needs to be exteded to allow them)")))
(if only-warn?
(warn "~s is a bad path argument" path-string)
(error* who "invalid path argument, ~s is not allowed, got: ~e\n~a~a"
(regexp-match rx:bad-pathchar path-string) path-string
"(note: if paths with this character are needed, then this"
" script needs to be exteded to allow them)"))))
(define (parse-prop-string prop str who)
(with-handlers ([exn? (lambda (e)
@ -162,7 +164,7 @@ path/s is either such a string or a list of them.
(define (get-prop path-string prop-name [default get-prop]
#:strict? [strict? #f] #:as-string? [as-string? #f])
(validate-path-string path-string 'get-prop)
(validate-path-string path-string 'get-prop #t) ; no errors
(let ([upchain
;; take the chain going up from the most specific node, so that
;; properties of a directory apply to subpaths