From afd3a90607f61954cb3f4d7bb6538a39503587c4 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 19 Oct 2010 11:27:50 -0700 Subject: [PATCH] Adding preamble to make-xexpr-response --- collects/tests/web-server/http/xexpr.rkt | 56 +++++++++++++++++++ collects/web-server/http/response-structs.rkt | 7 ++- collects/web-server/scribblings/http.scrbl | 5 +- 3 files changed, 63 insertions(+), 5 deletions(-) create mode 100644 collects/tests/web-server/http/xexpr.rkt diff --git a/collects/tests/web-server/http/xexpr.rkt b/collects/tests/web-server/http/xexpr.rkt new file mode 100644 index 0000000000..31b132202e --- /dev/null +++ b/collects/tests/web-server/http/xexpr.rkt @@ -0,0 +1,56 @@ +#lang racket +(require tests/eli-tester + web-server/private/timer + web-server/private/connection-manager + web-server/http/response + web-server/http + "../util.rkt") + +(define (write-response r [redact? #t]) + (define-values (i-port o-port) (make-pipe)) + (define conn + (connection 0 (start-timer +inf.0 void) + i-port o-port (current-custodian) #t)) + (output-response conn r) + (close-output-port o-port) + (define bs (port->bytes i-port)) + (if redact? (redact bs) bs)) + +(test + (write-response (make-xexpr-response '(a ([href "#"]) "link"))) + => + #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\n\r\nlink" + + (write-response (make-xexpr-response '(a ([href "#"]) "link") + #:code 404)) + => + #"HTTP/1.1 404 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\n\r\nlink" + + (write-response (make-xexpr-response '(a ([href "#"]) "link") + #:message #"Bad request")) + => + #"HTTP/1.1 200 Bad request\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\n\r\nlink" + + (regexp-replace + #"Date: [a-zA-Z0-9:, ]+ GMT\r\n" + (write-response (make-xexpr-response '(a ([href "#"]) "link") + #:seconds 0) + #f) + #"Date: REDACTED GMT\r\n") + => + #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: Thu, 01 Jan 1970 00:00:00 GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\n\r\nlink" + + (write-response (make-xexpr-response '(a ([href "#"]) "link") + #:mime-type #"application/xml")) + => + #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: application/xml\r\nConnection: close\r\nContent-Length: 20\r\n\r\nlink" + + (write-response (make-xexpr-response '(a ([href "#"]) "link") + #:headers (list (header #"head" #"value")))) + => + #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 20\r\nhead: value\r\n\r\nlink" + + (write-response (make-xexpr-response '(a ([href "#"]) "link") + #:preamble #"<>")) + => + #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\nContent-Length: 39\r\n\r\n<>link") \ No newline at end of file diff --git a/collects/web-server/http/response-structs.rkt b/collects/web-server/http/response-structs.rkt index c6fb464fc4..3f9da98183 100644 --- a/collects/web-server/http/response-structs.rkt +++ b/collects/web-server/http/response-structs.rkt @@ -77,10 +77,11 @@ #:message [message #"Okay"] #:seconds [seconds (current-seconds)] #:mime-type [mime-type TEXT/HTML-MIME-TYPE] - #:headers [hdrs empty]) + #:headers [hdrs empty] + #:preamble [preamble #""]) (make-response/full code message seconds mime-type hdrs - (list (string->bytes/utf-8 (xexpr->string xexpr))))) + (list preamble (string->bytes/utf-8 (xexpr->string xexpr))))) (provide/contract [struct response/basic @@ -106,7 +107,7 @@ [response/c contract?] [make-xexpr-response ((pretty-xexpr/c) - (#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?)) + (#:code number? #:message bytes? #:seconds number? #:mime-type bytes? #:headers (listof header?) #:preamble bytes?) . ->* . response/full?)] [normalize-response ((response/c) (boolean?) . ->* . (or/c response/full? response/incremental?))] [TEXT/HTML-MIME-TYPE bytes?]) diff --git a/collects/web-server/scribblings/http.scrbl b/collects/web-server/scribblings/http.scrbl index 2de2af8a3a..45cf2fbc1b 100644 --- a/collects/web-server/scribblings/http.scrbl +++ b/collects/web-server/scribblings/http.scrbl @@ -237,13 +237,14 @@ Here is an example typical of what you will find in many applications: [#:message message bytes? #"Okay"] [#:seconds seconds number? (current-seconds)] [#:mime-type mime-type bytes? TEXT/HTML-MIME-TYPE] - [#:headers headers (listof header?) empty]) + [#:headers headers (listof header?) empty] + [#:preamble preamble bytes? #""]) response/full?]{ Equivalent to @racketblock[ (make-response/full code message seconds mime-type headers - (list (string->bytes/utf-8 (xexpr->string xexpr)))) + (list preamble (string->bytes/utf-8 (xexpr->string xexpr)))) ]} @defproc[(normalize-response [response response/c] [close? boolean? #f])