From eee5c6b14aed59aa3ba64adc7c2228947ba0b972 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 26 Nov 2010 17:50:41 -0500 Subject: [PATCH] Adding response/port --- .../dispatchers/dispatch-servlets-test.rkt | 5 ++++ .../htdocs/servlets/examples/port.rkt | 15 ++++++++++++ collects/web-server/http/response-structs.rkt | 12 +++++++++- collects/web-server/http/response.rkt | 2 ++ collects/web-server/scribblings/http.scrbl | 24 ++++++++++++++++++- 5 files changed, 56 insertions(+), 2 deletions(-) create mode 100644 collects/web-server/default-web-root/htdocs/servlets/examples/port.rkt diff --git a/collects/tests/web-server/dispatchers/dispatch-servlets-test.rkt b/collects/tests/web-server/dispatchers/dispatch-servlets-test.rkt index afd0df4a68..b27aaa9092 100644 --- a/collects/tests/web-server/dispatchers/dispatch-servlets-test.rkt +++ b/collects/tests/web-server/dispatchers/dispatch-servlets-test.rkt @@ -54,6 +54,11 @@ [t0 (simple-xpath* '(p) (call d url0 empty))]) t0) "Hello, Web!") + (test-equal? "port.rkt" + (let* ([d (mkd (build-path example-servlets "port.rkt"))] + [t0 (simple-xpath* '(p) (call d url0 empty))]) + t0) + "Hello, Web!") (test-equal? "response.rktd - loading" (parameterize ([xexpr-drop-empty-attributes #t]) (let* ([d (mkd (build-path example-servlets "response.rktd"))]) diff --git a/collects/web-server/default-web-root/htdocs/servlets/examples/port.rkt b/collects/web-server/default-web-root/htdocs/servlets/examples/port.rkt new file mode 100644 index 0000000000..21955dc509 --- /dev/null +++ b/collects/web-server/default-web-root/htdocs/servlets/examples/port.rkt @@ -0,0 +1,15 @@ +#lang racket/base +(require web-server/servlet + racket/list) +(provide (all-defined-out)) +(define interface-version 'v1) +(define timeout +inf.0) + +(define (start initial-request) + (response/port + 200 #"Okay" (current-seconds) #"text/html" empty + (λ (op) + (display #<

Hello, Web!

+END + op)))) \ 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 3f9da98183..84f71e26eb 100644 --- a/collects/web-server/http/response-structs.rkt +++ b/collects/web-server/http/response-structs.rkt @@ -9,6 +9,7 @@ (define-struct response/basic (code message seconds mime headers)) (define-struct (response/full response/basic) (body)) (define-struct (response/incremental response/basic) (generator)) +(define-struct (response/port response/basic) (output)) (define response/c (or/c response/basic? @@ -30,6 +31,8 @@ (list* (make-header #"Content-Length" (string->bytes/utf-8 (number->string (response/full->size resp)))) (response/basic-headers resp)) (response/full-body resp))] + [(response/port? resp) + resp] [(response/incremental? resp) (if close? resp @@ -104,10 +107,17 @@ [mime bytes?] [headers (listof header?)] [generator ((() () #:rest (listof bytes?) . ->* . any) . -> . any)])] + [struct (response/port response/basic) + ([code number?] + [message bytes?] + [seconds number?] + [mime bytes?] + [headers (listof header?)] + [output (output-port? . -> . void)])] [response/c contract?] [make-xexpr-response ((pretty-xexpr/c) (#: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?))] + [normalize-response ((response/c) (boolean?) . ->* . (or/c response/full? response/incremental? response/port?))] [TEXT/HTML-MIME-TYPE bytes?]) diff --git a/collects/web-server/http/response.rkt b/collects/web-server/http/response.rkt index 2a7868cf33..51ee1eea14 100644 --- a/collects/web-server/http/response.rkt +++ b/collects/web-server/http/response.rkt @@ -103,6 +103,8 @@ (for-each (lambda (str) (display str o-port)) (response/full-body bresp))] + [(? response/port?) + ((response/port-output bresp) o-port)] [(? response/incremental?) (if (connection-close? conn) ((response/incremental-generator bresp) diff --git a/collects/web-server/scribblings/http.scrbl b/collects/web-server/scribblings/http.scrbl index 1233240086..00304bbdf4 100644 --- a/collects/web-server/scribblings/http.scrbl +++ b/collects/web-server/scribblings/http.scrbl @@ -199,6 +199,28 @@ Here is an example typical of what you will find in many applications: #"

")) ] } + +@defstruct[(response/port response/basic) + ([output (output-port? . -> . void)])]{ + As with @racket[response/basic], except where @racket[output] generates the response + body. This response type is not as safe and efficient for clients as @racket[response/incremental], + but can be convenient on the server side. + + Example: + @racketblock[ + (make-response/full + 301 #"Moved Permanently" + (current-seconds) TEXT/HTML-MIME-TYPE + (list (make-header #"Location" + #"http://racket-lang.org/downloads")) + (λ (op) + (write-bytes #"

" op) + (write-bytes #"Please go to here instead." op) + (write-bytes #"

" op))) + ] +} @defstruct[(response/incremental response/basic) ([generator ((() () #:rest (listof bytes?) . ->* . any) . -> . any)])]{ @@ -248,7 +270,7 @@ Here is an example typical of what you will find in many applications: ]} @defproc[(normalize-response [response response/c] [close? boolean? #f]) - (or/c response/full? response/incremental?)]{ + (or/c response/full? response/incremental? response/port?)]{ Coerces @racket[response] into a full response, filling in additional details where appropriate. @racket[close?] represents whether the connection will be closed after the response is sent (i.e. if HTTP 1.0 is being used.) The accuracy of this only matters if