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)
(lambda (path req)
(if (eq?
(control (host-info (socket-remote-address (request:socket req))))
(control (host-info (socket-remote-address (request-socket req))))
'deny)
(http-error http-status/forbidden req)
(ph path req))))

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)
'()))
@ -117,7 +117,7 @@
(apply exec/env filename env 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
((or (string=? request-method "GET")
(string=? request-method "POST")) ; Could do others also.
@ -171,17 +171,17 @@
;;; if the URL's path elements contain encoded /'s (%2F). CGI loses.
(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))
(headers (request:headers req))
(headers (request-headers req))
;; Compute the $PATH_INFO and $PATH_TRANSLATED strings.
(path-info (uri-path-list->path path-suffix)) ; No encode or .. check.
(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)))
@ -191,9 +191,9 @@
(receive (lhost lport)
(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))
("REQUEST_METHOD" . ,(request:method req))
("REQUEST_METHOD" . ,(request-method req))
("PATH_INFO" . ,path-info)
("PATH_TRANSLATED" . ,path-translated)
@ -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 '()))
@ -255,8 +255,8 @@
'status)))
(http-syslog (syslog-level debug) "[cgi-server] headers: ~s~%" headers)
(http-syslog (syslog-level debug) "[cgi-server] request:method=~a~%"
(request:method req))
(http-syslog (syslog-level debug) "[cgi-server] request-method=~a~%"
(request-method req))
(if loc
(if (uri-has-protocol? (string-trim loc))

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)
@ -201,9 +201,9 @@
(make-request "GET"
new-location-uri
url
(request:version req) ; did not change
(request-version req) ; did not change
'() ; no rfc822 headers
(request:socket req))))
(request-socket req))))
;;;; HTTP request parsing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -337,7 +337,7 @@
(if (not (v0.9-request? request))
(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))
(http-log request (response-code response)))

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) =>
@ -142,7 +142,7 @@
(if (file-name-directory? fname) ; Simple index generation.
(directory-serve-response fname file-path req)
(let ((request-method (request:method req)))
(let ((request-method (request-method req)))
(cond
((or (string=? request-method "GET")
(string=? request-method "HEAD")) ; Absolutely.
@ -155,8 +155,8 @@
((directory) ; Send back a redirection "foo" -> "foo/"
(make-http-error-response
http-status/moved-perm req
(string-append (request:uri req) "/")
(string-append (http-url->string (request:url req))
(string-append (request-uri req) "/")
(string-append (http-url->string (request-url req))
"/")))
(else (make-http-error-response http-status/forbidden req)))))
@ -353,7 +353,7 @@
(length files)))
(define (directory-serve-response fname file-path req)
(let ((request-method (request:method req)))
(let ((request-method (request-method req)))
(cond
((or (string=? request-method "GET")
(string=? request-method "HEAD"))

View File

@ -48,7 +48,7 @@
(make-predicate-handler
(lambda (path req)
;; 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))
;; selects handler according to path-prefix

View File

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

View File

@ -103,16 +103,16 @@
(display (make-CLF
(receive (host-address _)
(socket-address->internet-address
(socket-remote-address (request:socket req)))
(socket-remote-address (request-socket req)))
(format-internet-host-address host-address))
(request:method req) ; request method
(request-method req) ; request method
(uri-path-list->path
(http-url:path (request:url req))) ; requested file
(version->string (request:version req)) ; protocol version
(http-url:path (request-url req))) ; requested file
(version->string (request-version req)) ; protocol version
status-code
23 ; filesize (unknown)
(get-header (request:headers req) 'referer)
(get-header (request:headers req) 'user-agent))
(get-header (request-headers req) 'referer)
(get-header (request-headers req) 'user-agent))
(logging-http-log-port))
(force-output (logging-http-log-port))
(release-lock http-log-lock)))))

View File

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

View File

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

View File

@ -42,7 +42,7 @@
(man (:optional maybe-man man)))
(lambda (path req)
(let ((request-method (request:method req)))
(let ((request-method (request-method req)))
(cond
((string=? request-method "GET")
(with-fatal-error-handler
@ -63,7 +63,7 @@
(make-writer-body
(lambda (out options)
(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))
(with-tag out address ()

View File

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

View File

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

View File

@ -47,14 +47,14 @@
(define *cache-lock* (make-lock))
(define (get-bindings request)
(let ((request-method (request:method request)))
(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)))
(input-port (socket:inport (request:socket request)))
(let* ((content-length (get-content-length (request-headers request)))
(input-port (socket:inport (request-socket request)))
(form-data (read-string content-length input-port)))
(let ((form-bindings (form-query form-data)))
(obtain-lock *cache-lock*)

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

@ -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

@ -458,7 +458,7 @@ spaceships of class " ,class)
(p "Thank you for your ordering.")
(p "Your order has been registered. "
"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.")
(p "This will take about " ,months " months."))))

View File

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