Rename URI-PATH-LIST->PATH to URI-PATH->URI and SPLIT-URI-PATH to
SPLIT-URI.
This commit is contained in:
parent
d882315133
commit
62c597e7ec
|
@ -123,7 +123,7 @@
|
||||||
(socket-remote-address (request-socket req)))
|
(socket-remote-address (request-socket req)))
|
||||||
(format-internet-host-address host-address))
|
(format-internet-host-address host-address))
|
||||||
(request-method req) ; request method
|
(request-method req) ; request method
|
||||||
(uri-path-list->path
|
(uri-path->uri
|
||||||
(http-url-path (request-url req))) ; requested file
|
(http-url-path (request-url req))) ; requested file
|
||||||
(version->string (request-version req)) ; protocol version
|
(version->string (request-version req)) ; protocol version
|
||||||
(status-code-number status-code)
|
(status-code-number status-code)
|
||||||
|
|
|
@ -86,7 +86,7 @@
|
||||||
(lambda (path req)
|
(lambda (path req)
|
||||||
(if (pair? path) ; need at least one element
|
(if (pair? path) ; need at least one element
|
||||||
(let ((request-method (request-method req))
|
(let ((request-method (request-method req))
|
||||||
(path-string (uri-path-list->path path)))
|
(path-string (uri-path->uri path)))
|
||||||
(if (or (string=? request-method "GET")
|
(if (or (string=? request-method "GET")
|
||||||
(string=? request-method "POST"))
|
(string=? request-method "POST"))
|
||||||
(if (resume-url? path-string)
|
(if (resume-url? path-string)
|
||||||
|
|
|
@ -37,7 +37,7 @@
|
||||||
|
|
||||||
(path-end (or ques sharp slen)))
|
(path-end (or ques sharp slen)))
|
||||||
(values (and colon (substring s 0 colon))
|
(values (and colon (substring s 0 colon))
|
||||||
(split-uri-path s path-start path-end)
|
(split-uri s path-start path-end)
|
||||||
(and ques (substring s (+ ques 1) (or sharp slen)))
|
(and ques (substring s (+ ques 1) (or sharp slen)))
|
||||||
(and sharp (substring s (+ sharp 1) slen)))))
|
(and sharp (substring s (+ sharp 1) slen)))))
|
||||||
|
|
||||||
|
@ -154,7 +154,7 @@
|
||||||
|
|
||||||
;;; Cribbed from scsh's fname.scm
|
;;; Cribbed from scsh's fname.scm
|
||||||
|
|
||||||
(define (split-uri-path uri start end) ; Split at /'s (infix grammar).
|
(define (split-uri uri start end) ; Split at /'s (infix grammar).
|
||||||
(let split ((i start)) ; "" -> ("")
|
(let split ((i start)) ; "" -> ("")
|
||||||
(cond
|
(cond
|
||||||
((>= i end) '(""))
|
((>= i end) '(""))
|
||||||
|
@ -167,25 +167,11 @@
|
||||||
|
|
||||||
;;; The elements of PLIST must be escaped in case they contain slashes.
|
;;; The elements of PLIST must be escaped in case they contain slashes.
|
||||||
;;; This procedure doesn't escape them for you; you must do that yourself:
|
;;; This procedure doesn't escape them for you; you must do that yourself:
|
||||||
;;; (uri-path-list->path (map escape-uri pathlist))
|
;;; (uri-path->uri (map escape-uri pathlist))
|
||||||
|
|
||||||
(define (uri-path-list->path plist)
|
(define (uri-path->uri plist)
|
||||||
(string-join plist "/")) ; Insert slashes between elts of PLIST.
|
(string-join plist "/")) ; Insert slashes between elts of PLIST.
|
||||||
|
|
||||||
|
|
||||||
;;; Remove . and <segment>/.. elements from path. The result is a
|
|
||||||
;;; (maybe empty) list representing a path that does not contain "."
|
|
||||||
;;; and ".." elements neither at the beginning nor somewhere else. I
|
|
||||||
;;; tried to follow RFC2396 here. The procedure returns #f if the path
|
|
||||||
;;; tries to back up past root (like "//.." or "/foo/../.."). "//" may
|
|
||||||
;;; occur somewhere in the path but not being backed up. Usually,
|
|
||||||
;;; relative paths are intended to be used with a base
|
|
||||||
;;; url. Accordingly to RFC2396 (as I hope) relative paths are
|
|
||||||
;;; considered not to start with "/". They are appended to a base
|
|
||||||
;;; URL-path and then simplified. So before you start to simplify a
|
|
||||||
;;; URL try to find out if it is a relative path (i.e. it does not
|
|
||||||
;;; start with a "/").
|
|
||||||
|
|
||||||
(define (simplify-uri-path p)
|
(define (simplify-uri-path p)
|
||||||
(if (null? p) #f ; P must be non-null
|
(if (null? p) #f ; P must be non-null
|
||||||
(let lp ((path-list (cdr p))
|
(let lp ((path-list (cdr p))
|
||||||
|
|
|
@ -104,7 +104,7 @@
|
||||||
;;; The PATH slot of this record is the URL's path split at slashes,
|
;;; The PATH slot of this record is the URL's path split at slashes,
|
||||||
;;; e.g., "foo/bar//baz/" => ("foo" "bar" "" "baz" "")
|
;;; e.g., "foo/bar//baz/" => ("foo" "bar" "" "baz" "")
|
||||||
;;; These elements are in raw, unescaped format. To convert back to
|
;;; These elements are in raw, unescaped format. To convert back to
|
||||||
;;; a string, use (uri-path-list->path (map escape-uri pathlist)).
|
;;; a string, use (uri-path->uri (map escape-uri pathlist)).
|
||||||
|
|
||||||
(define-record-type http-url :http-url
|
(define-record-type http-url :http-url
|
||||||
(make-http-url userhost path search frag-id)
|
(make-http-url userhost path search frag-id)
|
||||||
|
@ -146,7 +146,7 @@
|
||||||
(string-append "http://"
|
(string-append "http://"
|
||||||
(userhost->string (http-url-userhost url))
|
(userhost->string (http-url-userhost url))
|
||||||
"/"
|
"/"
|
||||||
(uri-path-list->path (map escape-uri (http-url-path url)))
|
(uri-path->uri (map escape-uri (http-url-path url)))
|
||||||
(cond ((http-url-search url) =>
|
(cond ((http-url-search url) =>
|
||||||
(lambda (s) (string-append "?" s)))
|
(lambda (s) (string-append "?" s)))
|
||||||
(else ""))
|
(else ""))
|
||||||
|
|
|
@ -55,8 +55,8 @@
|
||||||
uri-escaped-chars
|
uri-escaped-chars
|
||||||
unescape-uri
|
unescape-uri
|
||||||
escape-uri
|
escape-uri
|
||||||
split-uri-path
|
split-uri
|
||||||
uri-path-list->path
|
uri-path->uri
|
||||||
simplify-uri-path))
|
simplify-uri-path))
|
||||||
|
|
||||||
(define-interface url-interface
|
(define-interface url-interface
|
||||||
|
@ -592,7 +592,7 @@
|
||||||
i/o ; make-null-output-port
|
i/o ; make-null-output-port
|
||||||
locks
|
locks
|
||||||
receiving
|
receiving
|
||||||
uri ; uri-path-list->path
|
uri ; uri-path->uri
|
||||||
url ; http-url-path
|
url ; http-url-path
|
||||||
httpd-requests ; request record
|
httpd-requests ; request record
|
||||||
httpd-responses
|
httpd-responses
|
||||||
|
|
Loading…
Reference in New Issue