diff --git a/collects/web-server/compat/5.0.99.3/PORTING b/collects/web-server/compat/5.0.99.3/PORTING new file mode 100644 index 0000000000..242490c276 --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/PORTING @@ -0,0 +1,50 @@ +In Racket 5.0.99.4 and before, the Web Server supported implicit conversion of X-expressions and lists with the format (cons/c bytes? (listof (or/c string? bytes?))) into response data +structures for output. + +The compatibility binding for normalize-response is a coercion from the OLD responses to the NEW response structure. + +Other incompatibilities introduced: + +The contract on read-mime-types specifies what kind of hash it returns. +send/formlet requires that the wrapper return an Xexpr +response/basic was removed. +response/full was removed. +response/port was removed [1] +The response/incremental structure was removed. +response/c was removed. +make-xexpr-response was renamed response/xexpr and extended. +normalize-response was removed. +xexpr-response/cookies was removed and folded into response/xexpr. + +The following places are where old responses were accepted and no longer are: + +configuration-table responders +authentication responder on dispatchers/dispatch-passwords +servlet-loading responder on dispatchers/dispatch-servlets +#lang web-server/insta [2] +lang/web --- make-stateless-servlet +private/servlet --- handler field +servlet-env --- serve/servlet's #:file-not-found-responder arg +serlet/servlet-structs --- response-generator/c, expiration-handler/c +servlet/setup --- make*servlet +servlet/web --- with-errors-to-browser + +The following places are where old responses were accepted and no longer are, but compatible bindings are provided: + +dispatch/serve --- serve/dispatch +dispatchers/dispatch-lift --- make +dispatchers/dispatch-pathprocedure --- make +http/response --- output-response and output-response/method +servlet-dispatch --- dispatch/servlet +servlet-env --- serve/servlet +servlet/web --- send/* + +Here are some ideas that could be use to ease backwards compatibility: + +* A new servlet version for module servlets that puts an old contract on the return from start. + +Footnotes: + +1. response/port was present for about a week, so no compatibility is provided. + +2. If anyone can suggest a good way to provide a compatibility layer without duplicating code, I'm interested. The problem is that web-server/insta walks the module source to find the "start" function, and we'd presumably want to overwrite that. Plus, web-server/insta will import other bindings that now have imcompatibilities. diff --git a/collects/web-server/compat/5.0.99.3/dispatch/serve.rkt b/collects/web-server/compat/5.0.99.3/dispatch/serve.rkt new file mode 100644 index 0000000000..477fc2a2ea --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/dispatch/serve.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require (prefix-in new: web-server/dispatch/serve) + "../http/response-structs.rkt") + +(define (serve/dispatch d) + (new:serve/dispatch (λ (req) (normalize-response (d req))))) + +(provide (all-defined-out)) \ No newline at end of file diff --git a/collects/web-server/compat/5.0.99.3/dispatchers/dispatch-lift.rkt b/collects/web-server/compat/5.0.99.3/dispatchers/dispatch-lift.rkt new file mode 100644 index 0000000000..e50c7bbc3a --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/dispatchers/dispatch-lift.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require (prefix-in new: web-server/dispatchers/dispatch-lift) + "../http/response-structs.rkt") + +(define (make d) + (new:make (λ (req) (normalize-response (d req))))) + +(provide (all-defined-out)) \ No newline at end of file diff --git a/collects/web-server/compat/5.0.99.3/dispatchers/dispatch-pathprocedure.rkt b/collects/web-server/compat/5.0.99.3/dispatchers/dispatch-pathprocedure.rkt new file mode 100644 index 0000000000..91f4c07e49 --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/dispatchers/dispatch-pathprocedure.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require (prefix-in new: web-server/dispatchers/dispatch-pathprocedure) + "../http/response-structs.rkt") + +(define (make p d) + (new:make p (λ (req) (normalize-response (d req))))) + +(provide (all-defined-out)) \ No newline at end of file diff --git a/collects/web-server/compat/5.0.99.3/http/cookie.rkt b/collects/web-server/compat/5.0.99.3/http/cookie.rkt new file mode 100644 index 0000000000..834b08baaa --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/http/cookie.rkt @@ -0,0 +1,7 @@ +#lang racket/base +(require web-server/http/xexpr) + +(define (xexpr-response/cookies cs xe) + (response/xexpr xe #:cookies cs)) + +(provide (all-from-out)) \ No newline at end of file diff --git a/collects/web-server/compat/5.0.99.3/http/response-structs.rkt b/collects/web-server/compat/5.0.99.3/http/response-structs.rkt new file mode 100644 index 0000000000..80ce129f6f --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/http/response-structs.rkt @@ -0,0 +1,70 @@ +#lang racket/base +(require racket/contract + web-server/http/response-structs + web-server/http/xexpr + racket/list + xml) + +(define response/basic? response?) +(define (make-response/basic c m s mime hs) + (response/full c m s mime hs #"")) +(define response/basic-code response-code) +(define response/basic-message response-message) +(define response/basic-seconds response-seconds) +(define response/basic-mime response-mime) +(define response/basic-headers response-headers) + +(define BODIES (make-weak-hasheq)) +(define response/full? response?) +(define (make-response/full c m s mime hs bs) + (define r (response/full c m s mime hs bs)) + (hash-set! BODIES r bs) + r) +(define response/full-code response-code) +(define response/full-message response-message) +(define response/full-seconds response-seconds) +(define response/full-mime response-mime) +(define response/full-headers response-headers) +(define (response/full-body r) + (hash-ref BODIES r)) + +(define GENS (make-weak-hasheq)) +(define response/incremental? response?) +(define (make-response/incremental c m s mime hs gen) + (define r + (response c m s mime hs + (λ (out) + (gen (λ bss + (for ([bs (in-list bss)]) + (write-bytes bs out))))))) + (hash-set! GENS r gen) + r) +(define response/incremental-code response-code) +(define response/incremental-message response-message) +(define response/incremental-seconds response-seconds) +(define response/incremental-mime response-mime) +(define response/incremental-headers response-headers) +(define (response/incremental-body r) + (hash-ref GENS r)) + +(define response/c + (or/c response/basic? + (cons/c bytes? (listof (or/c string? bytes?))) + xexpr/c)) + +(define make-xexpr-response response/xexpr) + +(define (normalize-response r [close? #f]) + (cond + [(response? r) r] + [(and (pair? r) (bytes? (car r))) + (response/full 200 #"Okay" (current-seconds) (car r) + empty + (map (λ (x) (if (bytes? x) x (string->bytes/utf-8 x))) + (cdr r)))] + [else + (response/xexpr r)])) + +(provide (except-out (all-defined-out) + BODIES + GENS)) \ No newline at end of file diff --git a/collects/web-server/compat/5.0.99.3/http/response.rkt b/collects/web-server/compat/5.0.99.3/http/response.rkt new file mode 100644 index 0000000000..9cbdb02c3f --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/http/response.rkt @@ -0,0 +1,10 @@ +#lang racket/base +(require (prefix-in new: web-server/http/response) + "../http/response-structs.rkt") + +(define (output-response conn r) + (new:output-response conn (normalize-response r))) +(define (output-response/method conn r meth) + (new:output-response/method conn (normalize-response r) meth)) + +(provide (all-defined-out)) \ No newline at end of file diff --git a/collects/web-server/compat/5.0.99.3/servlet-dispatch.rkt b/collects/web-server/compat/5.0.99.3/servlet-dispatch.rkt new file mode 100644 index 0000000000..4544f6508e --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/servlet-dispatch.rkt @@ -0,0 +1,13 @@ +#lang racket/base +(require (prefix-in new: web-server/servlet-dispatch) + "../http/response-structs.rkt") + +(define dispatch/servlet + (make-keyword-procedure + (lambda (kws kw-args gen) + (keyword-apply new:dispatch/servlet + kws + kw-args + (λ (req) (normalize-response (gen req))))))) + +(provide (all-defined-out)) \ No newline at end of file diff --git a/collects/web-server/compat/5.0.99.3/servlet-env.rkt b/collects/web-server/compat/5.0.99.3/servlet-env.rkt new file mode 100644 index 0000000000..ae01e3eeda --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/servlet-env.rkt @@ -0,0 +1,13 @@ +#lang racket/base +(require (prefix-in new: web-server/servlet-env) + "../http/response-structs.rkt") + +(define serve/servlet + (make-keyword-procedure + (lambda (kws kw-args gen) + (keyword-apply new:serve/servlet + kws + kw-args + (λ (req) (normalize-response (gen req))))))) + +(provide (all-defined-out)) \ No newline at end of file diff --git a/collects/web-server/compat/5.0.99.3/servlet/web.rkt b/collects/web-server/compat/5.0.99.3/servlet/web.rkt new file mode 100644 index 0000000000..e8bd46ba65 --- /dev/null +++ b/collects/web-server/compat/5.0.99.3/servlet/web.rkt @@ -0,0 +1,32 @@ +#lang racket/base +(require (prefix-in new: web-server/servlet/web) + "../http/response-structs.rkt") + +(define-syntax-rule (define-send/back-like new:send/back send/back) + (define (send/back r) + (new:send/back (normalize-response r)))) + +(define-send/back-like new:send/back send/back) +(define-send/back-like new:send/finish send/finish) + +(define-syntax-rule (define-send/forward-like new:send/forward send/forward) + (define (send/forward generator) + (new:send/forward + (λ (k-url) + (normalize-response (generator k-url)))))) + +(define-send/forward-like new:send/forward send/forward) +(define-send/forward-like new:send/suspend send/suspend) +(define-send/forward-like new:send/suspend/url send/suspend/url) + +(define-syntax-rule (define-ssd-like new:send/suspend/dispatch send/suspend/dispatch) + (define (send/suspend/dispatch generator) + (new:send/suspend/dispatch + (λ (embed/url) + (normalize-response + (generator embed/url)))))) + +(define-ssd-like new:send/suspend/dispatch send/suspend/dispatch) +(define-ssd-like new:send/suspend/url/dispatch send/suspend/url/dispatch) + +(provide (all-defined-out)) \ No newline at end of file