- renamed USERHOST:xxx to USERHOST-xxx

- renamed HTTP-URL:xxx to HTTP-URL-xxx
This commit is contained in:
sperber 2002-11-29 14:56:58 +00:00
parent 68b1f0c386
commit 4e859bc92a
12 changed files with 50 additions and 56 deletions

View File

@ -103,7 +103,7 @@
(nph? (string-prefix? "nph-" prog)) ; PROG starts with "nph-" ?
; why did we had (string-suffix? "-nph" prog) here?
(search (http-url:search (request-url req))) ; Compute the
(search (http-url-search (request-url req))) ; Compute the
(argv (if (and search (not (string-index search #\=))) ; argv list.
(split-and-decode-search-spec search)
'()))
@ -181,7 +181,7 @@
(path-translated (path-list->file-name path-info bin-dir))
;; Compute the $SCRIPT_PATH string.
(url-path (http-url:path (request-url req)))
(url-path (http-url-path (request-url req)))
(script-path (take (- (length url-path) (length path-suffix))
url-path))
(script-name (uri-path-list->path script-path)))
@ -208,7 +208,7 @@
,@request-invariant-cgi-env ; Stuff that never changes (see cgi-handler).
,@(cond ((http-url:search (request-url req)) =>
,@(cond ((http-url-search (request-url req)) =>
(lambda (srch) `(("QUERY_STRING" . ,srch))))
(else '()))

View File

@ -169,7 +169,7 @@
(let ((initial-req (parse-http-request sock options)))
(let redirect-loop ((req initial-req))
(let ((response ((httpd-options-request-handler options)
(http-url:path (request-url req))
(http-url-path (request-url req))
req)))
(if (eq? (response-code response)
http-status/redirect)

View File

@ -112,7 +112,7 @@
;;; ROOTED-FILE-OR-DIRECTORY-HANDLER for examples on how to feed this.
(define (make-rooted-file-path-response root file-path file-serve-response req)
(if (http-url:search (request-url req))
(if (http-url-search (request-url req))
(make-http-error-response http-status/bad-request req
"Indexed search not provided for this URL.")
(cond ((dotdot-check root file-path) =>

View File

@ -117,12 +117,12 @@
((list? parse-info) ; it's an info path
(lambda (url)
(values parse-info
(unescape-uri (http-url:search url)))))
(unescape-uri (http-url-search url)))))
(else
(let ((info-path ((infix-splitter ":") (getenv "INFOPATH"))))
(lambda (url)
(values info-path
(unescape-uri (http-url:search url))))))))
(unescape-uri (http-url-search url))))))))
(make-reference
(cond
((procedure? reference) reference)

View File

@ -107,7 +107,7 @@
(format-internet-host-address host-address))
(request-method req) ; request method
(uri-path-list->path
(http-url:path (request-url req))) ; requested file
(http-url-path (request-url req))) ; requested file
(version->string (request-version req)) ; protocol version
status-code
23 ; filesize (unknown)

View File

@ -26,13 +26,13 @@
((list? finder)
(lambda (url)
(values finder
(unescape-uri (http-url:search url))
(unescape-uri (http-url-search url))
'())))
(else
(let ((man-path ((infix-splitter ":") (getenv "MANPATH"))))
(lambda (url)
(values man-path
(unescape-uri (http-url:search url))
(unescape-uri (http-url-search url))
'()))))))
(reference-template
(cond

View File

@ -50,7 +50,7 @@
(let ((request-method (request-method request)))
(cond
((string=? request-method "GET")
(form-query (http-url:search (request-url request))))
(form-query (http-url-search (request-url request))))
((string=? request-method "POST")
(or (cached-bindings request)
(let* ((content-length (get-content-length (request-headers request)))

View File

@ -26,7 +26,7 @@
(p (URL "/" "Return to main menu") (br)
(URL "add.scm" "Start new calculation."))))))))
(let* ((bindings (form-query
(http-url:search (request-url result))))
(http-url-search (request-url result))))
(number (string->number
(extract-single-binding "number" bindings))))
(if number

View File

@ -28,7 +28,7 @@
(URL "add2.scm" "Start new calculation."))))))))
(if result
(or (input-field-value number-input-field
(form-query (http-url:search (request:url result))))
(form-query (http-url-search (request:url result))))
(get-number input-text "Please enter a valid number."))
(get-number input-text "Please enter a number."))))

View File

@ -56,7 +56,7 @@
,(make-submit-button))
(hr)
(p (URL "/" "Return to main menu.")))))))
(bindings (form-query (http-url:search (request-url req)))))
(bindings (form-query (http-url-search (request-url req)))))
(input-field-value byte-input-fields bindings)))
(define (main req)

View File

@ -31,11 +31,13 @@
;;; These are frequently used as the initial prefix of URL's describing
;;; Internet resources.
(define-record userhost ; Each slot is a decoded string or #f.
user
password
host
port)
(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))
;;; Parse a URI path (a list representing a path, not a string!) into
;;; a userhost record. Default values are taken from the userhost
@ -61,15 +63,15 @@
; if any.
(make-userhost (if at
(unescape-uri uhs 0 (or colon1 at))
(userhost:user default))
(userhost-user default))
(if colon1
(unescape-uri uhs (+ colon1 1) at)
(userhost:password default))
(userhost-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))))
(userhost-port default))))
(fatal-syntax-error "URL must begin with //..." path)))
@ -80,10 +82,10 @@
(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))
(let* ((us (userhost-user uh))
(pw (userhost-password uh))
(ho (userhost-host uh))
(po (userhost-port uh))
;; Encode before assembly in case pieces contain colons or at-signs.
(e (lambda (s) (escape-uri s userhost-escaped-chars)))
@ -104,11 +106,13 @@
;;; These elements are in raw, unescaped format. To convert back to
;;; a string, use (uri-path-list->path (map escape-uri pathlist)).
(define-record http-url
userhost ; Initial //anonymous@clark.lcs.mit.edu:80/
path ; Rest of path, split at slashes & decoded.
search
frag-id)
(define-record-type http-url :http-url
(make-http-url userhost path search frag-id)
http-url?
(userhost http-url-userhost) ; 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))
;;; The URI parser (parse-uri in uri.scm) maps a string to four parts:
;;; <scheme> : <path> ? <search> # <frag-id> <scheme>, <search>, and
@ -125,7 +129,7 @@
(define (parse-http-url path search frag-id)
(let ((uh (parse-userhost path default-http-userhost)))
(if (or (userhost:user uh) (userhost:password uh))
(if (or (userhost-user uh) (userhost-password uh))
(fatal-syntax-error
"HTTP URL's may not specify a user or password field" path))
@ -140,12 +144,12 @@
(define (http-url->string url)
(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)))
(cond ((http-url:search url) =>
(uri-path-list->path (map escape-uri (http-url-path url)))
(cond ((http-url-search url) =>
(lambda (s) (string-append "?" s)))
(else ""))
(cond ((http-url:frag-id url) =>
(cond ((http-url-frag-id url) =>
(lambda (fi) (string-append "#" fi)))
(else ""))))

View File

@ -66,15 +66,10 @@
(export userhost? ; USERHOST
make-userhost ; record struct
userhost:user
userhost:password
userhost:host
userhost:port
set-userhost:user
set-userhost:password
set-userhost:host
set-userhost:port
userhost-user
userhost-password
userhost-host
userhost-port
parse-userhost ; parse &
userhost->string ; unparse.
@ -82,15 +77,10 @@
http-url? ; HTTP-URL
make-http-url ; record struct
http-url:userhost
http-url:path
http-url:search
http-url:frag-id
set-http-url:userhost
set-http-url:path
set-http-url:search
set-http-url:frag-id
http-url-userhost
http-url-path
http-url-search
http-url-frag-id
parse-http-url ; parse &
http-url->string))
@ -469,7 +459,7 @@
(define-structure url url-interface
(open scheme-with-scsh
scsh-utilities
defrec-package
define-record-types
receiving
srfi-13
srfi-14
@ -717,7 +707,7 @@
locks ; make-lock obtain-lock release-lock
receiving ; receive
uri ; uri-path-list->path
url ; http-url:path
url ; http-url-path
httpd-requests ; request record
formats ; format
format-net ; format-internet-host-address