From 4e859bc92a74bf7fa29ce80ddd29d9764e2f86f3 Mon Sep 17 00:00:00 2001 From: sperber Date: Fri, 29 Nov 2002 14:56:58 +0000 Subject: [PATCH] - renamed USERHOST:xxx to USERHOST-xxx - renamed HTTP-URL:xxx to HTTP-URL-xxx --- scheme/httpd/cgi-server.scm | 6 +-- scheme/httpd/core.scm | 2 +- scheme/httpd/file-dir-handler.scm | 2 +- scheme/httpd/info-gateway.scm | 4 +- scheme/httpd/logging.scm | 2 +- scheme/httpd/rman-gateway.scm | 4 +- scheme/httpd/surflets/surflets.scm | 2 +- .../surflets/web-server/root/surflets/add.scm | 2 +- .../web-server/root/surflets/add2.scm | 2 +- .../web-server/root/surflets/byte-input.scm | 2 +- scheme/lib/url.scm | 48 ++++++++++--------- scheme/packages.scm | 30 ++++-------- 12 files changed, 50 insertions(+), 56 deletions(-) diff --git a/scheme/httpd/cgi-server.scm b/scheme/httpd/cgi-server.scm index 0c2366c..33c2f05 100644 --- a/scheme/httpd/cgi-server.scm +++ b/scheme/httpd/cgi-server.scm @@ -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 '())) diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm index a2183ca..b2eb7ee 100644 --- a/scheme/httpd/core.scm +++ b/scheme/httpd/core.scm @@ -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) diff --git a/scheme/httpd/file-dir-handler.scm b/scheme/httpd/file-dir-handler.scm index a64b4f9..0f81dc7 100644 --- a/scheme/httpd/file-dir-handler.scm +++ b/scheme/httpd/file-dir-handler.scm @@ -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) => diff --git a/scheme/httpd/info-gateway.scm b/scheme/httpd/info-gateway.scm index cfa3a3e..f28c9ab 100644 --- a/scheme/httpd/info-gateway.scm +++ b/scheme/httpd/info-gateway.scm @@ -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) diff --git a/scheme/httpd/logging.scm b/scheme/httpd/logging.scm index 9b4295c..45e7b65 100644 --- a/scheme/httpd/logging.scm +++ b/scheme/httpd/logging.scm @@ -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) diff --git a/scheme/httpd/rman-gateway.scm b/scheme/httpd/rman-gateway.scm index df0ccd0..6151b50 100644 --- a/scheme/httpd/rman-gateway.scm +++ b/scheme/httpd/rman-gateway.scm @@ -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 diff --git a/scheme/httpd/surflets/surflets.scm b/scheme/httpd/surflets/surflets.scm index a4c35a2..43c3517 100644 --- a/scheme/httpd/surflets/surflets.scm +++ b/scheme/httpd/surflets/surflets.scm @@ -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))) diff --git a/scheme/httpd/surflets/web-server/root/surflets/add.scm b/scheme/httpd/surflets/web-server/root/surflets/add.scm index 3f352dd..9397af9 100644 --- a/scheme/httpd/surflets/web-server/root/surflets/add.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/add.scm @@ -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 diff --git a/scheme/httpd/surflets/web-server/root/surflets/add2.scm b/scheme/httpd/surflets/web-server/root/surflets/add2.scm index 3a6935e..c19da03 100644 --- a/scheme/httpd/surflets/web-server/root/surflets/add2.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/add2.scm @@ -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.")))) diff --git a/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm b/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm index 452a517..818da67 100644 --- a/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm +++ b/scheme/httpd/surflets/web-server/root/surflets/byte-input.scm @@ -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) diff --git a/scheme/lib/url.scm b/scheme/lib/url.scm index 0ea886c..7cad273 100644 --- a/scheme/lib/url.scm +++ b/scheme/lib/url.scm @@ -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: ;;; : ? # , , 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 "")))) diff --git a/scheme/packages.scm b/scheme/packages.scm index e25f08a..7971e63 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -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