answer 400 (Bad Request) for 1.1-Requests which don't include a Host
header: *new proc CHECK-HOST-HEADER
This commit is contained in:
parent
453a7cdde6
commit
f605367c1a
|
@ -19,11 +19,6 @@
|
|||
;;; described in RFC 2616 19.6. See RFC 1945 for the specification of
|
||||
;;; HTTP/1.0 and 0.9.
|
||||
|
||||
(define http-version-string
|
||||
(string-append "HTTP/"
|
||||
(number->string (car http-version))
|
||||
"."
|
||||
(number->string (cdr http-version))))
|
||||
|
||||
(define (httpd options)
|
||||
(let ((port (httpd-options-port options))
|
||||
|
@ -171,6 +166,7 @@
|
|||
(lambda ()
|
||||
(let ((initial-req (parse-http-request sock options)))
|
||||
(check-major-http-version initial-req)
|
||||
(check-host-header initial-req)
|
||||
(let redirect-loop ((req initial-req))
|
||||
(let response-loop ((response ((httpd-options-request-handler options)
|
||||
(http-url-path (request-url req))
|
||||
|
@ -269,6 +265,11 @@
|
|||
(if (> (car (request-version req)) (car http-version))
|
||||
(http-error (status-code version-not-supp) req)))
|
||||
|
||||
(define (check-host-header req)
|
||||
(if (not (version< (request-version req) '(1 . 1)))
|
||||
(or (get-header (request-headers req) 'host)
|
||||
(http-error (status-code bad-request) req "Missing Host header"))))
|
||||
|
||||
|
||||
;;; Split string into a list of whitespace-separated strings.
|
||||
;;; This could have been trivially defined in scsh as (field-splitter " \t\n")
|
||||
|
@ -289,7 +290,7 @@
|
|||
(else '()))))
|
||||
|
||||
(define (send-http-headers response port)
|
||||
(display http-version-string port)
|
||||
(display (version->string http-version) port)
|
||||
(write-char #\space port)
|
||||
(display (status-code-number (response-code response)) port)
|
||||
(write-char #\space port)
|
||||
|
|
Loading…
Reference in New Issue