scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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:
vibr 2005-04-13 20:53:53 +00:00
parent 453a7cdde6
commit f605367c1a
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
scheme/httpd/core.scm
View File

@ -19,11 +19,6 @@
;;; described in RFC 2616 19.6. See RFC 1945 for the specification of ;;; described in RFC 2616 19.6. See RFC 1945 for the specification of
;;; HTTP/1.0 and 0.9. ;;; 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) (define (httpd options)
(let ((port (httpd-options-port options)) (let ((port (httpd-options-port options))
@ -171,6 +166,7 @@
(lambda () (lambda ()
(let ((initial-req (parse-http-request sock options))) (let ((initial-req (parse-http-request sock options)))
(check-major-http-version initial-req) (check-major-http-version initial-req)
(check-host-header initial-req)
(let redirect-loop ((req initial-req)) (let redirect-loop ((req initial-req))
(let response-loop ((response ((httpd-options-request-handler options) (let response-loop ((response ((httpd-options-request-handler options)
(http-url-path (request-url req)) (http-url-path (request-url req))
@ -269,6 +265,11 @@
(if (> (car (request-version req)) (car http-version)) (if (> (car (request-version req)) (car http-version))
(http-error (status-code version-not-supp) req))) (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. ;;; Split string into a list of whitespace-separated strings.
;;; This could have been trivially defined in scsh as (field-splitter " \t\n") ;;; This could have been trivially defined in scsh as (field-splitter " \t\n")
@ -289,7 +290,7 @@
(else '())))) (else '()))))
(define (send-http-headers response port) (define (send-http-headers response port)
(display http-version-string port) (display (version->string http-version) port)
(write-char #\space port) (write-char #\space port)
(display (status-code-number (response-code response)) port) (display (status-code-number (response-code response)) port)
(write-char #\space port) (write-char #\space port)