diff --git a/collects/tests/web-server/dispatchers/dispatch-files-test.rkt b/collects/tests/web-server/dispatchers/dispatch-files-test.rkt index 049509207c..59dbacb8f5 100644 --- a/collects/tests/web-server/dispatchers/dispatch-files-test.rkt +++ b/collects/tests/web-server/dispatchers/dispatch-files-test.rkt @@ -40,6 +40,15 @@ (define (req d? meth heads) (make-request meth (if d? dir-url file-url) heads (delay empty) #"" "host" 80 "client")) +(define (bytes-sort bs) + (sort + (with-input-from-bytes bs + (λ () (port->bytes-lines #:line-mode 'return-linefeed))) + bytesA titleHere's some content!") - (test-equal? "file, exists, whole, no Range, head" + (test-equal?* "file, exists, whole, no Range, head" (collect (dispatch #t tmp-file) (req #f #"HEAD" empty)) #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n") - (test-equal? "file, exists, whole, Range, get" + (test-equal?* "file, exists, whole, Range, get" (collect (dispatch #t tmp-file) (req #f #"GET" (list (make-header #"Range" #"bytes=0-80")))) #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\nA titleHere's some content!") - (test-equal? "file, exists, whole, Range, head" + (test-equal?* "file, exists, whole, Range, head" (collect (dispatch #t tmp-file) (req #f #"HEAD" (list (make-header #"Range" #"bytes=0-80")))) #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n") - (test-equal? "file, exists, part, get" + (test-equal?* "file, exists, part, get" (collect (dispatch #t tmp-file) (req #f #"GET" (list (make-header #"Range" #"bytes=5-9")))) #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 5\r\nContent-Range: bytes 5-9/81\r\n\r\n>A titleHere's some content!") - (test-equal? "dir, exists, no Range, head" + (test-equal?* "dir, exists, no Range, head" (collect (dispatch #t a-dir) (req #t #"HEAD" empty)) #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n") - (test-equal? "dir, exists, Range, get" + (test-equal?* "dir, exists, Range, get" (collect (dispatch #t a-dir) (req #t #"GET" (list (make-header #"Range" #"bytes=0-80")))) #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\nA titleHere's some content!") - (test-equal? "dir, exists, Range, head" + (test-equal?* "dir, exists, Range, head" (collect (dispatch #t a-dir) (req #t #"HEAD" (list (make-header #"Range" #"bytes=0-80")))) #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n") - (test-equal? "dir, not dir-url, get" + (test-equal?* "dir, not dir-url, get" (collect (dispatch #t a-dir) (req #f #"GET" empty)) #"HTTP/1.1 302 Moved Temporarily\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nLocation: /foo/\r\n\r\n") (test-exn "dir, not exists, get" diff --git a/collects/web-server/http/response.rkt b/collects/web-server/http/response.rkt index 947f597226..849a79a061 100644 --- a/collects/web-server/http/response.rkt +++ b/collects/web-server/http/response.rkt @@ -32,21 +32,37 @@ ;; Write the headers portion of a response to an output port. ;; NOTE: According to RFC 2145 the server should write HTTP/1.1 ;; header for *all* clients. +(define-syntax-rule (maybe-hash-set! h k v) + (unless (hash-has-key? h k) + (hash-set! h k (header k v)))) +(define-syntax-rule (maybe-hash-set!* h [k v] ...) + (begin (maybe-hash-set! h k v) + ...)) + (define (output-response-head conn bresp) (fprintf (connection-o-port conn) "HTTP/1.1 ~a ~a\r\n" (response-code bresp) (response-message bresp)) + (define hs (make-hash)) + (for ([h (in-list (response-headers bresp))]) + (hash-set! hs (header-field h) h)) + (maybe-hash-set!* + hs + [#"Date" + (string->bytes/utf-8 (seconds->gmt-string (current-seconds)))] + [#"Last-Modified" + (string->bytes/utf-8 (seconds->gmt-string (response-seconds bresp)))] + [#"Server" + #"Racket"] + [#"Content-Type" + (response-mime bresp)]) + (when (connection-close? conn) + (hash-set! hs #"Connection" + (make-header #"Connection" #"close"))) (output-headers conn - (list* (make-header #"Date" (string->bytes/utf-8 (seconds->gmt-string (current-seconds)))) - (make-header #"Last-Modified" (string->bytes/utf-8 (seconds->gmt-string (response-seconds bresp)))) - (make-header #"Server" #"Racket") - (make-header #"Content-Type" (response-mime bresp)) - (append (if (connection-close? conn) - (list (make-header #"Connection" #"close")) - empty) - (response-headers bresp))))) + (hash-values hs))) ;; output-headers : connection (list-of header) -> void (define (output-headers conn headers) diff --git a/collects/web-server/scribblings/http.scrbl b/collects/web-server/scribblings/http.scrbl index 7890804b5d..c3be565788 100644 --- a/collects/web-server/scribblings/http.scrbl +++ b/collects/web-server/scribblings/http.scrbl @@ -168,8 +168,7 @@ Here is an example typical of what you will find in many applications: [output (output-port? . -> . void)])]{ An HTTP response where @racket[output] produces the body. @racket[code] is the response code, @racket[message] the message, @racket[seconds] the generation time, @racket[mime] - the MIME type of the file, and @racket[extras] are the extra headers, in addition - to those produced by the server. + the MIME type of the file, and @racket[headers] are the headers. If @racket[headers] does not include @litchar{Date}, @litchar{Last-Modified}, @litchar{Server}, or @litchar{Content-Type} headers, then the server will automatically add them. The server will always replace your @litchar{Connection} header if it needs to ensure the connection will be closed. (Typically with an HTTP/1.0 client.) Example: @racketblock[