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

path->url: ensure directory paths have a trailing slash

Browse Source 
If a path to a directory is converted to an URL it loses
           its trailing path separator.
           This can lead to a bug if the URL is used as a base URL to
           build other URLs (e.g. combine-url/relative).
This commit is contained in:
Philippe Mechai 2012-11-06 22:59:12 +01:00 committed by Matthew Flatt
parent 36bfae9497
commit d8ff661118
1 changed files with 47 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/net/url.rkt
View File

@ -558,8 +558,13 @@
";")) ";"))
(define (path->url path) (define (path->url path)
(let ([url-path (let* ([spath (simplify-path path #f)]
(let loop ([path (simplify-path path #f)][accum null]) [dir? (let-values ([(b n dir?) (split-path spath)]) dir?)]
;; If original path is a directory the resulting URL
;; should have a trailing forward slash
[url-tail (if dir? (list (make-path/param "" null)) null)]
[url-path
(let loop ([path spath][accum null])
(let-values ([(base name dir?) (split-path path)]) (let-values ([(base name dir?) (split-path path)])
(cond (cond
[(not base) [(not base)
@ -598,7 +603,8 @@
(if (eq? base 'relative) (if (eq? base 'relative)
accum accum
(loop base accum)))])))]) (loop base accum)))])))])
(make-url "file" #f "" #f (absolute-path? path) url-path '() #f))) (make-url "file" #f "" #f (absolute-path? path) (append url-path url-tail) '() #f)))
(define (url->path url [kind (system-path-convention-type)]) (define (url->path url [kind (system-path-convention-type)])
(file://->path url kind)) (file://->path url kind))