suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Responding to Norman's request

Browse Source
This commit is contained in:
Jay McCarthy 2011-04-12 13:59:14 -06:00
parent 00ca86ffc6
commit 9c19571ecd
3 changed files with 45 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/tests/web-server/dispatchers/dispatch-files-test.rkt
View File

@ -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)))
bytes<?))
(define-syntax-rule (test-equal?* n lhs rhs)
(test-equal? n (bytes-sort lhs) (bytes-sort rhs)))
(define dispatch-files-tests
(test-suite
"Files"
@ -75,22 +84,22 @@
(files:read-range-header (list (make-header #"Range" #"bytes=1-10,20-,-30")))
(list (cons 1 10) (cons 20 #f) (cons #f 30)))
(test-equal? "file, exists, whole, no Range, get"
(test-equal?* "file, exists, whole, no Range, get"
(collect (dispatch #t tmp-file) (req #f #"GET" 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<html><head><title>A title</title></head><body>Here's some content!</body></html>")
(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\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
(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><hea")
(test-equal? "file, exists, part, head"
(test-equal?* "file, exists, part, head"
(collect (dispatch #t tmp-file) (req #f #"HEAD" (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")
@ -98,19 +107,19 @@
exn:dispatcher?
(lambda () (collect (dispatch #t not-there) (req #f #"GET" empty))))
(test-equal? "dir, exists, no Range, get"
(test-equal?* "dir, exists, no Range, get"
(collect (dispatch #t a-dir) (req #t #"GET" 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<html><head><title>A title</title></head><body>Here's some content!</body></html>")
(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\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
(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"

32
collects/web-server/http/response.rkt
View File

@ -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)

3
collects/web-server/scribblings/http.scrbl
View File

@ -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[