path->url: ensure directory paths have a trailing slash
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:
parent
36bfae9497
commit
d8ff661118
|
@ -558,8 +558,13 @@
|
|||
";"))
|
||||
|
||||
(define (path->url path)
|
||||
(let ([url-path
|
||||
(let loop ([path (simplify-path path #f)][accum null])
|
||||
(let* ([spath (simplify-path path #f)]
|
||||
[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)])
|
||||
(cond
|
||||
[(not base)
|
||||
|
@ -598,7 +603,8 @@
|
|||
(if (eq? base 'relative)
|
||||
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)])
|
||||
(file://->path url kind))
|
||||
|
|
Loading…
Reference in New Issue
Block a user