Renamed REQUEST:xxx to REQUEST-xxx.
This commit is contained in:
parent
b45c23df44
commit
641b8129ba
|
@ -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))))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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"))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"))
|
||||
|
|
|
@ -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*)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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."))))
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue