Renamed REQUEST:xxx to REQUEST-xxx.

This commit is contained in:
sperber 2002-11-29 14:49:22 +00:00
parent b45c23df44
commit 641b8129ba
17 changed files with 69 additions and 75 deletions

View File

@ -34,7 +34,7 @@
(define (access-controlled-handler control ph) (define (access-controlled-handler control ph)
(lambda (path req) (lambda (path req)
(if (eq? (if (eq?
(control (host-info (socket-remote-address (request:socket req)))) (control (host-info (socket-remote-address (request-socket req))))
'deny) 'deny)
(http-error http-status/forbidden req) (http-error http-status/forbidden req)
(ph path req)))) (ph path req))))

View File

@ -103,7 +103,7 @@
(nph? (string-prefix? "nph-" prog)) ; PROG starts with "nph-" ? (nph? (string-prefix? "nph-" prog)) ; PROG starts with "nph-" ?
; why did we had (string-suffix? "-nph" prog) here? ; 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. (argv (if (and search (not (string-index search #\=))) ; argv list.
(split-and-decode-search-spec search) (split-and-decode-search-spec search)
'())) '()))
@ -117,7 +117,7 @@
(apply exec/env filename env argv)))) (apply exec/env filename env argv))))
(http-syslog (syslog-level debug) "[cgi-server] search: ~s, argv: ~s~%" search argv) (http-syslog (syslog-level debug) "[cgi-server] search: ~s, argv: ~s~%" search argv)
(let ((request-method (request:method req))) (let ((request-method (request-method req)))
(cond (cond
((or (string=? request-method "GET") ((or (string=? request-method "GET")
(string=? request-method "POST")) ; Could do others also. (string=? request-method "POST")) ; Could do others also.
@ -171,17 +171,17 @@
;;; if the URL's path elements contain encoded /'s (%2F). CGI loses. ;;; if the URL's path elements contain encoded /'s (%2F). CGI loses.
(define (cgi-env req bin-dir path-suffix request-invariant-cgi-env) (define (cgi-env req bin-dir path-suffix request-invariant-cgi-env)
(let* ((sock (request:socket req)) (let* ((sock (request-socket req))
(raddr (socket-remote-address sock)) (raddr (socket-remote-address sock))
(headers (request:headers req)) (headers (request-headers req))
;; Compute the $PATH_INFO and $PATH_TRANSLATED strings. ;; Compute the $PATH_INFO and $PATH_TRANSLATED strings.
(path-info (uri-path-list->path path-suffix)) ; No encode or .. check. (path-info (uri-path-list->path path-suffix)) ; No encode or .. check.
(path-translated (path-list->file-name path-info bin-dir)) (path-translated (path-list->file-name path-info bin-dir))
;; Compute the $SCRIPT_PATH string. ;; 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)) (script-path (take (- (length url-path) (length path-suffix))
url-path)) url-path))
(script-name (uri-path-list->path script-path))) (script-name (uri-path-list->path script-path)))
@ -191,9 +191,9 @@
(receive (lhost lport) (receive (lhost lport)
(socket-address->internet-address (socket-local-address sock)) (socket-address->internet-address (socket-local-address sock))
`(("SERVER_PROTOCOL" . ,(version->string (request:version req))) `(("SERVER_PROTOCOL" . ,(version->string (request-version req)))
("SERVER_PORT" . ,(number->string lport)) ("SERVER_PORT" . ,(number->string lport))
("REQUEST_METHOD" . ,(request:method req)) ("REQUEST_METHOD" . ,(request-method req))
("PATH_INFO" . ,path-info) ("PATH_INFO" . ,path-info)
("PATH_TRANSLATED" . ,path-translated) ("PATH_TRANSLATED" . ,path-translated)
@ -208,7 +208,7 @@
,@request-invariant-cgi-env ; Stuff that never changes (see cgi-handler). ,@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)))) (lambda (srch) `(("QUERY_STRING" . ,srch))))
(else '())) (else '()))
@ -255,8 +255,8 @@
'status))) 'status)))
(http-syslog (syslog-level debug) "[cgi-server] headers: ~s~%" headers) (http-syslog (syslog-level debug) "[cgi-server] headers: ~s~%" headers)
(http-syslog (syslog-level debug) "[cgi-server] request:method=~a~%" (http-syslog (syslog-level debug) "[cgi-server] request-method=~a~%"
(request:method req)) (request-method req))
(if loc (if loc
(if (uri-has-protocol? (string-trim loc)) (if (uri-has-protocol? (string-trim loc))

View File

@ -169,7 +169,7 @@
(let ((initial-req (parse-http-request sock options))) (let ((initial-req (parse-http-request sock options)))
(let redirect-loop ((req initial-req)) (let redirect-loop ((req initial-req))
(let ((response ((httpd-options-request-handler options) (let ((response ((httpd-options-request-handler options)
(http-url:path (request:url req)) (http-url:path (request-url req))
req))) req)))
(if (eq? (response-code response) (if (eq? (response-code response)
http-status/redirect) http-status/redirect)
@ -201,9 +201,9 @@
(make-request "GET" (make-request "GET"
new-location-uri new-location-uri
url url
(request:version req) ; did not change (request-version req) ; did not change
'() ; no rfc822 headers '() ; no rfc822 headers
(request:socket req)))) (request-socket req))))
;;;; HTTP request parsing ;;;; HTTP request parsing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -337,7 +337,7 @@
(if (not (v0.9-request? request)) (if (not (v0.9-request? request))
(send-http-headers response output-port)) (send-http-headers response output-port))
(if (not (string=? (request:method request) "HEAD")) (if (not (string=? (request-method request) "HEAD"))
(display-http-body (response-body response) input-port output-port options)) (display-http-body (response-body response) input-port output-port options))
(http-log request (response-code response))) (http-log request (response-code response)))

View File

@ -112,7 +112,7 @@
;;; ROOTED-FILE-OR-DIRECTORY-HANDLER for examples on how to feed this. ;;; 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) (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 (make-http-error-response http-status/bad-request req
"Indexed search not provided for this URL.") "Indexed search not provided for this URL.")
(cond ((dotdot-check root file-path) => (cond ((dotdot-check root file-path) =>
@ -142,7 +142,7 @@
(if (file-name-directory? fname) ; Simple index generation. (if (file-name-directory? fname) ; Simple index generation.
(directory-serve-response fname file-path req) (directory-serve-response fname file-path req)
(let ((request-method (request:method req))) (let ((request-method (request-method req)))
(cond (cond
((or (string=? request-method "GET") ((or (string=? request-method "GET")
(string=? request-method "HEAD")) ; Absolutely. (string=? request-method "HEAD")) ; Absolutely.
@ -155,8 +155,8 @@
((directory) ; Send back a redirection "foo" -> "foo/" ((directory) ; Send back a redirection "foo" -> "foo/"
(make-http-error-response (make-http-error-response
http-status/moved-perm req http-status/moved-perm req
(string-append (request:uri req) "/") (string-append (request-uri req) "/")
(string-append (http-url->string (request:url req)) (string-append (http-url->string (request-url req))
"/"))) "/")))
(else (make-http-error-response http-status/forbidden req))))) (else (make-http-error-response http-status/forbidden req)))))
@ -353,7 +353,7 @@
(length files))) (length files)))
(define (directory-serve-response fname file-path req) (define (directory-serve-response fname file-path req)
(let ((request-method (request:method req))) (let ((request-method (request-method req)))
(cond (cond
((or (string=? request-method "GET") ((or (string=? request-method "GET")
(string=? request-method "HEAD")) (string=? request-method "HEAD"))

View File

@ -48,7 +48,7 @@
(make-predicate-handler (make-predicate-handler
(lambda (path req) (lambda (path req)
;; we expect only one host-header-field ;; we expect only one host-header-field
(string=? hostname (string-trim (get-header (request:headers req) 'host)))) (string=? hostname (string-trim (get-header (request-headers req) 'host))))
handler default-handler)) handler default-handler))
;; selects handler according to path-prefix ;; selects handler according to path-prefix

View File

@ -134,7 +134,7 @@
(string-append "info?" node-name)))))) (string-append "info?" node-name))))))
(lambda (path req) (lambda (path req)
(let ((request-method (request:method req))) (let ((request-method (request-method req)))
(cond (cond
((string=? request-method "GET") ((string=? request-method "GET")
(with-fatal-error-handler (with-fatal-error-handler
@ -158,10 +158,10 @@
(make-writer-body (make-writer-body
(lambda (out options) (lambda (out options)
(receive (find-entry node-name) (parse-info-url (request:url req)) (receive (find-entry node-name) (parse-info-url (request-url req))
(display-node node-name (display-node node-name
(file-finder find-entry) (file-finder find-entry)
(referencer make-reference (request:url req) out) (referencer make-reference (request-url req) out)
icon-name icon-name
out)) out))
(with-tag out address () (with-tag out address ()

View File

@ -103,16 +103,16 @@
(display (make-CLF (display (make-CLF
(receive (host-address _) (receive (host-address _)
(socket-address->internet-address (socket-address->internet-address
(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-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 (version->string (request-version req)) ; protocol version
status-code status-code
23 ; filesize (unknown) 23 ; filesize (unknown)
(get-header (request:headers req) 'referer) (get-header (request-headers req) 'referer)
(get-header (request:headers req) 'user-agent)) (get-header (request-headers req) 'user-agent))
(logging-http-log-port)) (logging-http-log-port))
(force-output (logging-http-log-port)) (force-output (logging-http-log-port))
(release-lock http-log-lock))))) (release-lock http-log-lock)))))

View File

@ -7,23 +7,25 @@
;;;; This code defines the http REQUEST data structure ;;;; This code defines the http REQUEST data structure
(define-record request (define-record-type request :request
method ; A string such as "GET", "PUT", etc. (make-request method uri url version headers socket)
uri ; The escaped URI string as read from request line. request?
url ; An http URL record (see url.scm). (method request-method) ; A string such as "GET", "PUT", etc.
version ; A (major . minor) integer pair. (uri request-uri) ; The escaped URI string as read from request line.
headers ; An rfc822 header alist (see rfc822.scm). (url request-url) ; An http URL record (see url.scm).
socket) ; The socket connected to the client. (version request-version) ; A (major . minor) integer pair.
(headers request-headers) ; An rfc822 header alist (see rfc822.scm).
(socket request-socket)) ; The socket connected to the client.
(define-record-discloser type/request (define-record-discloser :request
(lambda (req) (lambda (req)
(list 'request (list 'request
(request:method req) (request-method req)
(request:uri req) (request-uri req)
(request:url req) (request-url req)
(request:version req) (request-version req)
(request:headers req) (request-headers req)
(request:socket req)))) (request-socket req))))
;;; A http protocol version is an integer pair: (major . minor). ;;; A http protocol version is an integer pair: (major . minor).
(define (version< v1 v2) (define (version< v1 v2)
@ -34,7 +36,7 @@
(define (version<= v1 v2) (not (version< v2 v1))) (define (version<= v1 v2) (not (version< v2 v1)))
(define (v0.9-request? req) (define (v0.9-request? req)
(version<= (request:version req) '(0 . 9))) (version<= (request-version req) '(0 . 9)))
(define (version->string v) (define (version->string v)

View File

@ -160,8 +160,8 @@
(title-html port "Request not allowed.") (title-html port "Request not allowed.")
(format port (format port
"Your client does not have permission to perform a ~A~%" "Your client does not have permission to perform a ~A~%"
(request:method req)) (request-method req))
(format port "operation on url ~a.~%" (request:uri req)) (format port "operation on url ~a.~%" (request-uri req))
(send-message port) (send-message port)
(close-html port)))) (close-html port))))
@ -199,7 +199,7 @@ the error, and time it occured.~%"
(generic-title port) (generic-title port)
(format port "This server does not currently implement (format port "This server does not currently implement
the requested method (~A).~%" the requested method (~A).~%"
(request:method req)) (request-method req))
(send-message port) (send-message port)
(close-html port)))) (close-html port))))

View File

@ -42,7 +42,7 @@
(man (:optional maybe-man man))) (man (:optional maybe-man man)))
(lambda (path req) (lambda (path req)
(let ((request-method (request:method req))) (let ((request-method (request-method req)))
(cond (cond
((string=? request-method "GET") ((string=? request-method "GET")
(with-fatal-error-handler (with-fatal-error-handler
@ -63,7 +63,7 @@
(make-writer-body (make-writer-body
(lambda (out options) (lambda (out options)
(receive (man-path entry and-then) (receive (man-path entry and-then)
(parse-man-url (request:url req)) (parse-man-url (request-url req))
(emit-man-page entry man man-path and-then reference-template out)) (emit-man-page entry man man-path and-then reference-template out))
(with-tag out address () (with-tag out address ()

View File

@ -42,7 +42,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (seval-handler path req) (define (seval-handler path req)
(let ((request-method (request:method req))) (let ((request-method (request-method req)))
(cond (cond
((string=? request-method "POST") ; Could do others also. ((string=? request-method "POST") ; Could do others also.
(seval path req)) (seval path req))
@ -94,7 +94,7 @@
(define (read-request-sexp req iport) (define (read-request-sexp req iport)
(cond (cond
((get-header (request:headers req) 'content-length) => ((get-header (request-headers req) 'content-length) =>
(lambda (cl-str) ; Take the first Content-length: header, (lambda (cl-str) ; Take the first Content-length: header,
(let* ((cl-start (string-skip cl-str char-set:whitespace)) ; skip whitespace, (let* ((cl-start (string-skip cl-str char-set:whitespace)) ; skip whitespace,
(cl (if cl-start ; & convert to (cl (if cl-start ; & convert to

View File

@ -85,7 +85,7 @@
(set-thread-fluid! *options* (make-default-options servlet-path servlet-prefix)) (set-thread-fluid! *options* (make-default-options servlet-path servlet-prefix))
(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-list->path path)))
(if (or (string=? request-method "GET") (if (or (string=? request-method "GET")
(string=? request-method "POST")) (string=? request-method "POST"))

View File

@ -47,14 +47,14 @@
(define *cache-lock* (make-lock)) (define *cache-lock* (make-lock))
(define (get-bindings request) (define (get-bindings request)
(let ((request-method (request:method request))) (let ((request-method (request-method request)))
(cond (cond
((string=? request-method "GET") ((string=? request-method "GET")
(form-query (http-url:search (request:url request)))) (form-query (http-url:search (request-url request))))
((string=? request-method "POST") ((string=? request-method "POST")
(or (cached-bindings request) (or (cached-bindings request)
(let* ((content-length (get-content-length (request:headers request))) (let* ((content-length (get-content-length (request-headers request)))
(input-port (socket:inport (request:socket request))) (input-port (socket:inport (request-socket request)))
(form-data (read-string content-length input-port))) (form-data (read-string content-length input-port)))
(let ((form-bindings (form-query form-data))) (let ((form-bindings (form-query form-data)))
(obtain-lock *cache-lock*) (obtain-lock *cache-lock*)

View File

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

View File

@ -56,7 +56,7 @@
,(make-submit-button)) ,(make-submit-button))
(hr) (hr)
(p (URL "/" "Return to main menu."))))))) (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))) (input-field-value byte-input-fields bindings)))
(define (main req) (define (main req)

View File

@ -458,7 +458,7 @@ spaceships of class " ,class)
(p "Thank you for your ordering.") (p "Thank you for your ordering.")
(p "Your order has been registered. " (p "Your order has been registered. "
"We will contact you (" "We will contact you ("
,(host-name-or-ip (socket-remote-address (request:socket req))) ,(host-name-or-ip (socket-remote-address (request-socket req)))
") as soon as the ship is built.") ") as soon as the ship is built.")
(p "This will take about " ,months " months.")))) (p "This will take about " ,months " months."))))

View File

@ -301,18 +301,12 @@
(define-interface httpd-requests-interface (define-interface httpd-requests-interface
(export make-request ; HTTP request (export make-request ; HTTP request
request? ; record type. request? ; record type.
request:method request-method
request:uri request-uri
request:url request-url
request:version request-version
request:headers request-headers
request:socket request-socket
set-request:method
set-request:uri
set-request:url
set-request:version
set-request:headers
set-request:socket
version< version<= version< version<=
v0.9-request? v0.9-request?
@ -739,9 +733,7 @@
(define-structure httpd-requests httpd-requests-interface (define-structure httpd-requests httpd-requests-interface
(open scheme (open scheme
define-record-types ;; define-record-discloser define-record-types)
defrec-package ;; define-record
)
(files (httpd request))) (files (httpd request)))
(define-structure httpd-responses httpd-responses-interface (define-structure httpd-responses httpd-responses-interface