- renamed USERHOST:xxx to USERHOST-xxx
- renamed HTTP-URL:xxx to HTTP-URL-xxx
This commit is contained in:
parent
68b1f0c386
commit
4e859bc92a
|
@ -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 '()))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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) =>
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."))))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 ""))))
|
||||
|
|
|
@ -66,32 +66,22 @@
|
|||
(export userhost? ; USERHOST
|
||||
make-userhost ; record struct
|
||||
|
||||
userhost:user
|
||||
userhost:password
|
||||
userhost:host
|
||||
userhost:port
|
||||
userhost-user
|
||||
userhost-password
|
||||
userhost-host
|
||||
userhost-port
|
||||
|
||||
set-userhost:user
|
||||
set-userhost:password
|
||||
set-userhost:host
|
||||
set-userhost:port
|
||||
|
||||
parse-userhost ; parse &
|
||||
userhost->string ; unparse.
|
||||
|
||||
http-url? ; HTTP-URL
|
||||
make-http-url ; record struct
|
||||
|
||||
http-url:userhost
|
||||
http-url:path
|
||||
http-url:search
|
||||
http-url:frag-id
|
||||
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
|
||||
|
||||
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
|
||||
|
|
Loading…
Reference in New Issue