answer 505 (Version not supported) for requests with major version >
implemented version: *new proc CHECK-MAJOR-HTTP-VERSION *new case in MAKE-ERROR-RESPONSE
This commit is contained in:
parent
fe6b3fffac
commit
40d7c923a2
|
@ -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,6 +170,7 @@
|
|||
(decline))))
|
||||
(lambda ()
|
||||
(let ((initial-req (parse-http-request sock options)))
|
||||
(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))
|
||||
|
@ -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)
|
||||
|
|
|
@ -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)))))))
|
||||
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue