From 96216b243d9c1fa209edf16160ce2253f9e1a3ae Mon Sep 17 00:00:00 2001 From: vibr Date: Mon, 17 May 2004 16:39:17 +0000 Subject: [PATCH] answer HTTP/1.0 for requests with unknown HTTP-version --- scheme/httpd/core.scm | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm index d32a502..c792d26 100644 --- a/scheme/httpd/core.scm +++ b/scheme/httpd/core.scm @@ -20,6 +20,7 @@ ;;; The RFC detailing the HTTP 1.0 protocol, RFC 1945, can be found at ;;; http://www.w3.org/Protocols/rfc1945/rfc1945 + (define server/protocol "HTTP/1.0") (define (httpd options) @@ -242,20 +243,19 @@ (if (eof-object? line) (fatal-syntax-error "EOF while parsing request.") - + (let* ((elts (string->words line)) ; Split at white-space. (version (case (length elts) ((2) '(0 . 9)) ((3) (parse-http-version (caddr elts))) - (else (fatal-syntax-error "Bad HTTP version."))))) - - (let* ((meth (car elts)) - (uri-string (cadr elts)) - (url (parse-http-servers-url-fragment uri-string sock options)) - (headers (if (equal? version '(0 . 9)) - '() - (read-rfc822-headers (socket:inport sock))))) - (make-request meth uri-string url version headers sock)))))) + (else (fatal-syntax-error "Bad Request Line.")))) + (meth (car elts)) + (uri-string (cadr elts)) + (url (parse-http-servers-url-fragment uri-string sock options)) + (headers (if (equal? version '(0 . 9)) + '() + (read-rfc822-headers (socket:inport sock))))) + (make-request meth uri-string url version headers sock))))) ;;; Parse the URL, but if it begins without the "http://host:port" ;;; prefix, interpolate one from SOCKET. It would be sleazier but @@ -340,23 +340,26 @@ (write-crlf port)) + (define (send-http-response request response input-port output-port options) (cond + ;;if request-record could not be built (i.e. either + ;;fatal-syntax-error was called because of an erroneous request + ;;line, or an server-internal error (not an os-error) occurred) + ;;and therefore HTTP-version of request is not known, answer + ;;with HTTP/1.0 ((not request) - ;; We have a bad request error. Try to report this headerless. - (display-http-body (response-body response) input-port output-port options) - ;; no CLF-logging - ) + (send-http-headers response output-port) + (display-http-body (response-body response) input-port output-port options)) + ;;no CLF-logging) ((nph-response? response) (display-http-body (nph-response-body response) input-port output-port options) (http-log request (status-code ok))); guess the status code - (else + (else (if (not (v0.9-request? request)) (send-http-headers response output-port)) - (if (not (string=? (request-method request) "HEAD")) (display-http-body (response-body response) input-port output-port options)) - (http-log request (response-code response))))) (define (send-http-header-fields headers port)