diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm index 9a553b5..78c8cf8 100644 --- a/scheme/httpd/core.scm +++ b/scheme/httpd/core.scm @@ -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)