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

Adding test case and fixing un-terminated requests

Browse Source
This commit is contained in:
Jay McCarthy 2010-11-27 21:50:28 -05:00
parent a28cf7df10
commit 16f8b3a2a6
3 changed files with 18 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/meta/props
View File

@ -1951,6 +1951,7 @@ path/s is either such a string or a list of them.
"collects/tests/unstable/srcloc.rktl" responsible (cce) drdr:command-line (racket "-f" *)
"collects/tests/utils/gui.rkt" drdr:command-line (gracket-text "-t" *)
"collects/tests/web-server" responsible (jay)
"collects/tests/web-server/pr/length.rkt" drdr:command-line #f
"collects/tests/web-server/run-all-tests.rkt" drdr:timeout 300
"collects/tests/web-server/servlet-env/env.rkt" drdr:command-line (mzc *)
"collects/tests/web-server/servlet-env/insta.rkt" drdr:command-line (mzc "-k" *)

6
collects/tests/web-server/pr/length.rkt Normal file
View File

@ -0,0 +1,6 @@
#lang web-server/insta
(define (start req)
(response 200 #"Okay" (current-seconds)
#"text/html" empty
(λ (op) (write-bytes #"PONG" op))))

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

@ -18,48 +18,12 @@
[rename ext:output-response/method output-response/method (connection? response? bytes? . -> . void)]
[rename ext:output-file output-file (connection? path-string? bytes? bytes? (or/c pair? false/c) . -> . void)])
;; Table 1. head responses:
; ------------------------------------------------------------------------------
; |method | close? | x-fer coding || response actions
; |-----------------------------------------------------------------------------
; |-----------------------------------------------------------------------------
; |head | #t | chunked || 1. Output the headers only.
; |-------------------------------|| 2. Add the special connection-close header.
; |head | #t | not-chunked ||
; |-----------------------------------------------------------------------------
; |head | #f | chunked || 1. Output the headers only.
; |-------------------------------|| 2. Don't add the connection-close header.
; |head | #f | not-chunked ||
; |-----------------------------------------------------------------------------
;; Table 2. get responses:
; ------------------------------------------------------------------------------
; |method | x-fer-coding | close? || response actions
; |-----------------------------------------------------------------------------
; |-----------------------------------------------------------------------------
; | get | chunked | #t || 1. Output headers as above.
; | | | || 2. Generate trivial chunked response.
; |-----------------------------------------------------------------------------
; | get | chunked | #f || 1. Output headers as above.
; | | | || 2. Generate chunks as per RFC 2616 sec. 3.6
; |-----------------------------------------------------------------------------
; | get | not chunked | #t || 1. Output headers as above.
; |-------------------------------|| 2. Generate usual non-chunked response.
; | get | not chunked | #f ||
; |-----------------------------------------------------------------------------
;; Notes:
;; 1. close? is a boolean which corresponds roughly to the protocol version.
;; #t |-> 1.0 and #f |-> 1.1. See function close-connection?
;;
;; 2. In the case of a chunked response when close? = #f, then the response
;; must be compliant with http 1.0. In this case the chunked response is
;; simply turned into a non-chunked one.
(define (output-response conn resp)
(output-response/method conn resp #"GET"))
(define (output-response/method conn resp meth)
(unless (terminated-response? resp)
(set-connection-close?! conn #t))
(output-response-head conn resp)
(unless (bytes-ci=? meth #"HEAD")
(output-response-body conn resp)))
@ -95,6 +59,15 @@
headers)
(fprintf out "\r\n"))
; RFC 2616 Section 4.4
(define (terminated-response? r)
(define hs (response-headers r))
(or (headers-assq* #"Content-Length" hs)
(cond
[(headers-assq* #"Transfer-Encoding" hs)
=> (λ (h) (not (bytes=? (header-value h) #"identity")))]
[else #f])))
(define (output-response-body conn bresp)
(define o-port (connection-o-port conn))
((response-output bresp) o-port)