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

fixed processing of file: URLs to not assume Unix conventions and to distinguish relative and absolute paths

Browse Source 
svn: r1463
This commit is contained in:
Matthew Flatt 2005-12-01 20:07:04 +00:00
parent dca5615927
commit b41c9de014
2 changed files with 41 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/net/doc.txt
View File

@ -48,10 +48,15 @@ TYPES ----------------------------------------------------------------
5 = path, 6 = param, 7 = query, 8 = fragment
If the scheme is "file", then the path is a platform-dependent
string assumed to have been constructed using build-path. The library
does, however, check for the presence of a fragment designator and, if
there is one, separates it from the rest of the path. For non-"file"
schemes, the path is a URL path as defined in the standard.
string. The library does, however, check for the presence of a
fragment designator and, if there is one, separates it from the rest
of the path. If the path is syntactically a directory, the last
string the resulting structure's `path' list is an empty string.
If the path is absolute, the `host' is the root path, otherwise
`host' is #f.
For non-"file" schemes, the path is a URL path as defined in the
standard.
If a path segment has a parameter, it is represented with
an instance of the path/param struct. Otherwise, it is
@ -156,6 +161,8 @@ PROCEDURES -----------------------------------------------------------
> (url->string url) -> string
Generates a string corresponding to the contents of the url struct.
For a "file:" URL, empty strings in the path list are treated as
'same for `build-path'.
The `url->string' procedure uses `alist->form-urlencoded' when
formatting the query, so it it sensitive to the

33
collects/net/url-unit.ss
View File

@ -61,6 +61,11 @@
args)))))
(raise (make-url-exception s (current-continuation-marks))))))
(define (url->file-path url)
(path->string
(apply build-path (or (url-host url) 'same)
(map (lambda (x) (if (equal? x "") 'same x)) (url-path url)))))
(define url->string
(lambda (url)
(let ((scheme (url-scheme url))
@ -72,7 +77,8 @@
(fragment (url-fragment url)))
(cond
((and scheme (string=? scheme "file"))
(string-append "file:" (combine-path-strings path)
(string-append "file:"
(url->file-path url)
(or (and (not fragment) "")
(string-append "#" fragment))))
(else
@ -142,9 +148,7 @@
;; file://get-pure-port : url -> in-port
(define file://get-pure-port
(lambda (url)
(when (url-host url)
(url-error "Don't know how to get files from remote hosts"))
(open-input-file (apply build-path (url-path url)))))
(open-input-file (url->file-path url))))
(define (schemeless-url url)
(url-error "Missing protocol (usually \"http:\") at the beginning of URL: ~a" url))
@ -343,13 +347,28 @@
[fragment (caddr path+fragment)])
(if (or (relative-path? path)
(absolute-path? path))
(let-values ([(root elems kind)
(let loop ([path (simplify-path path)][accum null][kind #f])
(let-values ([(base name dir?) (split-path path)])
(let ([kind (or kind
(if dir? 'dir 'file))])
(cond
[(path? base)
(loop base (cons name accum) kind)]
[(eq? base 'relative)
(values #f (cons name accum) kind)]
[else
(values path accum kind)]))))])
(make-url "file"
#f ; user
#f ; host
(and root (path->string root)) ; host
#f ; port
(separate-path-strings path)
(append (map path->string elems)
(if (eq? kind 'dir)
'("")
null))
'() ; query
fragment)
fragment))
(url-error "scheme 'file' path ~s neither relative nor absolute" path))))
;; Other scheme:
(let ((match (regexp-match-positions rx str)))