Rename "userhost" to "server" according to RFC 2396.
This commit is contained in:
parent
e090e1bd44
commit
608bb395f2
|
@ -268,14 +268,14 @@
|
|||
(parse-http-url path search #f)
|
||||
(fatal-syntax-error "Non-HTTP URL" uri-string))
|
||||
|
||||
;; Interpolate the userhost struct from our net connection.
|
||||
;; Interpolate the server struct from our net connection.
|
||||
(if (and (pair? path) (string=? (car path) ""))
|
||||
(let* ((addr (socket-local-address socket))
|
||||
(local-name (or (httpd-options-fqdn options)
|
||||
(socket-address->fqdn addr #t)))
|
||||
(portnum (or (httpd-options-reported-port options)
|
||||
(my-reported-port addr))))
|
||||
(make-http-url (make-userhost #f #f
|
||||
(make-http-url (make-server #f #f
|
||||
local-name
|
||||
(number->string portnum))
|
||||
(map unescape-uri (cdr path)) ; Skip initial /.
|
||||
|
|
|
@ -16,7 +16,7 @@
|
|||
|
||||
|
||||
;;; Unresolved issues:
|
||||
;;; - The userhost parser shouldn't substitute default values --
|
||||
;;; - The server parser shouldn't substitute default values --
|
||||
;;; that should happen in a separate step.
|
||||
|
||||
;;; The steps in hacking a URL are:
|
||||
|
@ -24,35 +24,35 @@
|
|||
;;; - Consult the UID's <scheme>. Pick the appropriate URL parser and parse.
|
||||
|
||||
|
||||
;;; Userhost strings: //<user>:<password>@<host>:<port>/
|
||||
;;; Server strings: //<user>:<password>@<host>:<port>/
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; A USERHOST record describes path-prefixes of the form
|
||||
;;; A SERVER record describes path-prefixes of the form
|
||||
;;; //<user>:<password>@<host>:<port>/
|
||||
;;; These are frequently used as the initial prefix of URL's describing
|
||||
;;; Internet resources.
|
||||
|
||||
(define-record-type userhost :userhost ; Each slot is a decoded string or #f.
|
||||
(make-userhost user password host port)
|
||||
userhost?
|
||||
(user userhost-user)
|
||||
(password userhost-password)
|
||||
(host userhost-host)
|
||||
(port userhost-port))
|
||||
(define-record-type server :server ; Each slot is a decoded string or #f.
|
||||
(make-server user password host port)
|
||||
server?
|
||||
(user server-user)
|
||||
(password server-password)
|
||||
(host server-host)
|
||||
(port server-port))
|
||||
|
||||
;;; Parse a URI path (a list representing a path, not a string!) into
|
||||
;;; a userhost record. Default values are taken from the userhost
|
||||
;;; record DEFAULT except for the host. Returns a userhost record if
|
||||
;;; it wins. CADDR drops the userhost portion of the path. In fact,
|
||||
;;; a server record. Default values are taken from the server
|
||||
;;; record DEFAULT except for the host. Returns a server record if
|
||||
;;; it wins. CADDR drops the server portion of the path. In fact,
|
||||
;;; fatal-syntax-error is called, if the path doesn't start with '//'.
|
||||
|
||||
;
|
||||
(define (parse-userhost path default)
|
||||
(define (parse-server path default)
|
||||
(if (and (pair? path) ; The thing better begin
|
||||
(string=? (car path) "") ; with // (i.e., have two
|
||||
(pair? (cdr path)) ; initial "" elements).
|
||||
(string=? (cadr path) ""))
|
||||
|
||||
(let* ((uhs (caddr path)) ; Userhost string.
|
||||
(let* ((uhs (caddr path)) ; Server string.
|
||||
(uhs-len (string-length uhs))
|
||||
(at (string-index uhs #\@)) ; Usr:passwd at-sign, if any.
|
||||
|
||||
|
@ -60,34 +60,34 @@
|
|||
(colon1 (and colon1 (< colon1 at) colon1)) ; if any.
|
||||
|
||||
(colon2 (string-index uhs #\: (or at 0)))) ; Host:port colon, if any.
|
||||
(make-userhost (if at
|
||||
(make-server (if at
|
||||
(unescape-uri uhs 0 (or colon1 at))
|
||||
(userhost-user default))
|
||||
(server-user default))
|
||||
(if colon1
|
||||
(unescape-uri uhs (+ colon1 1) at)
|
||||
(userhost-password default))
|
||||
(server-password default))
|
||||
(unescape-uri uhs (if at (+ at 1) 0)
|
||||
(or colon2 uhs-len))
|
||||
(if colon2
|
||||
(unescape-uri uhs (+ colon2 1) uhs-len)
|
||||
(userhost-port default))))
|
||||
(server-port default))))
|
||||
|
||||
(fatal-syntax-error "URL must begin with //..." path)))
|
||||
|
||||
;;; Unparser
|
||||
|
||||
(define userhost-escaped-chars
|
||||
(define server-escaped-chars
|
||||
(char-set-union uri-escaped-chars ; @ and : are also special
|
||||
(string->char-set "@:"))) ; in UH strings.
|
||||
|
||||
(define (userhost->string uh)
|
||||
(let* ((us (userhost-user uh))
|
||||
(pw (userhost-password uh))
|
||||
(ho (userhost-host uh))
|
||||
(po (userhost-port uh))
|
||||
(define (server->string uh)
|
||||
(let* ((us (server-user uh))
|
||||
(pw (server-password uh))
|
||||
(ho (server-host uh))
|
||||
(po (server-port uh))
|
||||
|
||||
;; Encode before assembly in case pieces contain colons or at-signs.
|
||||
(e (lambda (s) (escape-uri s userhost-escaped-chars)))
|
||||
(e (lambda (s) (escape-uri s server-escaped-chars)))
|
||||
|
||||
(user/passwd (if us
|
||||
`(,(e us) . ,(if pw `(":" ,(e pw) "@") '("@")))
|
||||
|
@ -108,9 +108,9 @@
|
|||
;;; a string, use (uri-path->uri (map escape-uri pathlist)).
|
||||
|
||||
(define-record-type http-url :http-url
|
||||
(make-http-url userhost path search frag-id)
|
||||
(make-http-url server path search frag-id)
|
||||
http-url?
|
||||
(userhost http-url-userhost) ; Initial //anonymous@clark.lcs.mit.edu:80/
|
||||
(server http-url-server) ; Initial //anonymous@clark.lcs.mit.edu:80/
|
||||
(path http-url-path) ; Rest of path, split at slashes & decoded.
|
||||
(search http-url-search)
|
||||
(frag-id http-url-frag-id))
|
||||
|
@ -129,8 +129,8 @@
|
|||
;;; FATAL-SYNTAX-ERROR is called.
|
||||
|
||||
(define (parse-http-url path search frag-id)
|
||||
(let ((uh (parse-userhost path default-http-userhost)))
|
||||
(if (or (userhost-user uh) (userhost-password uh))
|
||||
(let ((uh (parse-server path default-http-server)))
|
||||
(if (or (server-user uh) (server-password uh))
|
||||
(fatal-syntax-error
|
||||
"HTTP URL's may not specify a user or password field" path))
|
||||
|
||||
|
@ -145,14 +145,14 @@
|
|||
(fatal-syntax-error "not an HTTP URL" path)))))
|
||||
|
||||
;;; Default http port is 80.
|
||||
(define default-http-userhost (make-userhost #f #f #f "80"))
|
||||
(define default-http-server (make-server #f #f #f "80"))
|
||||
|
||||
|
||||
;;; Unparse.
|
||||
|
||||
(define (http-url->string url)
|
||||
(string-append "http://"
|
||||
(userhost->string (http-url-userhost url))
|
||||
(server->string (http-url-server url))
|
||||
"/"
|
||||
(uri-path->uri (map escape-uri (http-url-path url)))
|
||||
(cond ((http-url-search url) =>
|
||||
|
|
|
@ -60,21 +60,21 @@
|
|||
simplify-uri-path))
|
||||
|
||||
(define-interface url-interface
|
||||
(export userhost?
|
||||
make-userhost
|
||||
(export server?
|
||||
make-server
|
||||
|
||||
userhost-user
|
||||
userhost-password
|
||||
userhost-host
|
||||
userhost-port
|
||||
server-user
|
||||
server-password
|
||||
server-host
|
||||
server-port
|
||||
|
||||
parse-userhost
|
||||
userhost->string
|
||||
parse-server
|
||||
server->string
|
||||
|
||||
http-url?
|
||||
make-http-url
|
||||
|
||||
http-url-userhost
|
||||
http-url-server
|
||||
http-url-path
|
||||
http-url-search
|
||||
http-url-frag-id
|
||||
|
|
Loading…
Reference in New Issue