answer 505 (Version not supported) for requests with major version >

implemented version:
*new proc CHECK-MAJOR-HTTP-VERSION
*new case in MAKE-ERROR-RESPONSE

scheme/httpd/core.scm

@@ -2,10 +2,6 @@
 
 ;;; This file is part of the Scheme Untergrund Networking package.
 
-;;; Copyright (c) 1994 by Brian D. Carlstrom and Olin Shivers.
-;;; Copyright (c) 1996-2002 by Mike Sperber.
-;;; Copyright (c) 2000-2002 by Martin Gasbichler.
-;;; Copyright (c) 2002 by Andreas Bernauer.
 ;;; For copyright information, see the file COPYING which comes with
 ;;; the distribution.
 
@@ -17,11 +13,17 @@
 ;;; a complete server, you need to define request handlers (see below) --
 ;;; they determine how requests are to be handled.
 ;;;
-;;; The RFC detailing the HTTP 1.0 protocol, RFC 1945, can be found at
-;;; http://www.w3.org/Protocols/rfc1945/rfc1945
+;;; See RFC 2616 for the specification of the HTTP/1.1 protocol.  
+;;;
+;;; The server is compatible with previous versions of HTTP in the way
+;;; described in RFC 2616 19.6. See RFC 1945 for the specification of
+;;; HTTP/1.0 and 0.9.
 
-
-(define server/protocol "HTTP/1.0")
+(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))
@@ -168,7 +170,8 @@
 	     (decline))))
 	 (lambda ()
 	   (let ((initial-req (parse-http-request sock options)))
-	     (let redirect-loop ((req initial-req))
+	     (check-major-http-version initial-req)
+	     (let redirect-loop ((req initial-req)) 
 	       (let response-loop ((response ((httpd-options-request-handler options)
 					      (http-url-path (request-url req))
 					      req)))
@@ -216,18 +219,7 @@
 		  '()			; no rfc822 headers
 		  (request-socket req))))
 
-;;;; HTTP request parsing
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; This code provides procedures to read requests from an input
-;;;; port.
-
 ;;; Read and parse an http request from INPORT.
-;;; 
-;;; Note: this parser parses the URI into an http URL record. If the URI
-;;; isn't an http URL, the parser fails. This may not be right. There's
-;;; nothing in the http protocol to prevent you from passing a non-http
-;;; URI -- what this would mean, however, is not clear. Like so much of
-;;; the Web, the protocols are redundant, underconstrained, and ill-specified.
 
 (define (parse-http-request sock options)
   (let ((line (read-crlf-line (socket:inport sock))))
@@ -270,6 +262,14 @@
 	    (lose vstring))))))
 				      
 
+;;; check whether the request's major HTTP version is greater than the
+;;; server's major HTTP version; if so, send 505 (Version not supported).
+
+(define (check-major-http-version req)
+  (if (> (car (request-version req)) (car http-version))
+      (http-error (status-code version-not-supp) req)))
+
+
 ;;; Split string into a list of whitespace-separated strings.
 ;;; This could have been trivially defined in scsh as (field-splitter " \t\n")
 ;;; but I hand-coded it because it's short, and I didn't want invoke the
@@ -289,7 +289,7 @@
        (else '()))))
 
 (define (send-http-headers response port)
-  (display server/protocol port)
+  (display http-version-string port)
   (write-char #\space port)
   (display (status-code-number (response-code response)) port)
   (write-char #\space port)

scheme/httpd/response.scm

@@ -1,10 +1,10 @@
 ;;; This file is part of the Scheme Untergrund Networking package.
 
-;;; Copyright (c) 1994 by Brian D. Carlstrom and Olin Shivers.
-;;; Copyright (c) 2002 by Mike Sperber.
 ;;; For copyright information, see the file COPYING which comes with
 ;;; the distribution.
 
+(define http-version '(1 . 1));server's HTTP-version is only hardcoded here!
+
 (define-record-type http-response :http-response
   (make-response code message seconds mime extras body)
   response?
@@ -312,6 +312,18 @@
        (lambda (port options)
 	 (generic-title port)
 	 (format port "This server received an invalid response from the upstream server it accessed in attempting to fulfill the request.~%")
+	 (close-html port extras))))
+
+     ((eq? code (status-code version-not-supp))
+      (create-writer-body-response
+       '()
+       (lambda (port options)
+	 (generic-title port)
+	 (format port "This server does not support the requested HTTP major version ~D.~%The highest HTTP major version supported is 1.~%"
+		 (car (request-version req)))
+;	 (format port "This server does not support the requested HTTP major version ~D.~%The highest HTTP major version supported is ~D.~%"
+;		 (car (request-version req))
+;		 (car http-version))
 	 (close-html port extras)))))))
 
   

scheme/packages.scm

@@ -3,10 +3,6 @@
 
 ;;; This file is part of the Scheme Untergrund Networking package.
 
-;;; Copyright (c) 1994 by Brian D. Carlstrom and Olin Shivers.
-;;; Copyright (c) 1996-2002 by Mike Sperber.
-;;; Copyright (c) 2000-2002 by Martin Gasbichler.
-;;; Copyright (c) 1998-2001 by Eric Marsden.
 ;;; For copyright information, see the file COPYING which comes with
 ;;; the distribution.
 
@@ -330,7 +326,8 @@
 	  version->string))
 
 (define-interface httpd-responses-interface
-  (export make-response response?
+  (export http-version 
+	  make-response response?
 	  response-code
 	  response-message
 	  response-seconds