diff --git a/collects/tests/web-server/servlet/web-test.ss b/collects/tests/web-server/servlet/web-test.ss index 65f9eac2b2..1dac07efac 100644 --- a/collects/tests/web-server/servlet/web-test.ss +++ b/collects/tests/web-server/servlet/web-test.ss @@ -1,7 +1,11 @@ #lang scheme/base (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) + (planet "util.ss" ("schematics" "schemeunit.plt" 2)) net/url web-server/servlet/web) +(require/expose web-server/servlet/web + (embed-ids)) + (provide web-tests) (define url0 (string->url "http://test.com/servlets/example.ss")) diff --git a/collects/web-server/scribblings/servlet.scrbl b/collects/web-server/scribblings/servlet.scrbl index f51887da51..1991d05ce3 100644 --- a/collects/web-server/scribblings/servlet.scrbl +++ b/collects/web-server/scribblings/servlet.scrbl @@ -502,12 +502,6 @@ functions of interest for the servlet developer.} returns the instance id, continuation id, and nonce. } -@defproc[(embed-ids [ids (list/c number? number? number?)] - [u url?]) - string?]{ - Creates a @scheme[continuation-url?]. -} - @; ------------------------------------------------------------ @section[#:tag "helpers.ss"]{Helpers} @(require (for-label web-server/servlet/helpers)) diff --git a/collects/web-server/servlet/web.ss b/collects/web-server/servlet/web.ss index e586235f63..60adeb8e94 100644 --- a/collects/web-server/servlet/web.ss +++ b/collects/web-server/servlet/web.ss @@ -1,8 +1,5 @@ -#lang scheme/base -(require net/url - mzlib/list - mzlib/plt-match - scheme/contract) +#lang scheme +(require net/url) (require "../managers/manager.ss" "../private/util.ss" "../private/servlet.ss" @@ -14,58 +11,30 @@ (provide servlet-prompt) -;; ************************************************************ -;; HELPERS -(provide/contract - [continuation-url? (url? . -> . (or/c false/c (list/c number? number? number?)))] - [embed-ids ((list/c number? number? number?) url? . -> . string?)]) - ;; ******************************************************************************** ;; Parameter Embedding +(require web-server/private/url-param) ;; embed-ids: (list number number number) url -> string -(define embed-ids - (match-lambda* - [(list (list inst-id k-id salt) in-url) - (insert-param - in-url - (format "~a*~a*~a" inst-id k-id salt))])) +(define (embed-ids v u) + (url->string + (insert-param + u "k" (write/string v)))) ;; continuation-url?: url -> (or/c (list number number number) #f) ;; determine if this url encodes a continuation and extract the instance id and ;; continuation id. (define (continuation-url? a-url) - (define (match-url-params x) (regexp-match #rx"([^\\*]*)\\*([^\\*]*)\\*([^\\*]*)" x)) - (let ([k-params (filter match-url-params - (apply append (map path/param-param (url-path a-url))))]) - (if (empty? k-params) - #f - (match (match-url-params (first k-params)) - [(list s instance k-id salt) - (let ([instance/n (string->number instance)] - [k-id/n (string->number k-id)] - [salt/n (string->number salt)]) - (if (and (number? instance/n) - (number? k-id/n) - (number? salt/n)) - (list instance/n - k-id/n - salt/n) - #f))])))) + (cond + [(extract-param a-url "k") + => read/string] + [else + #f])) -;; insert-param: url string -> string -;; add a path/param to the path in a url -;; (assumes that there is only one path/param) -(define (insert-param in-url new-param-str) - (url->string - (url-replace-path - (lambda (old-path) - (if (empty? old-path) - (list (make-path/param "" (list new-param-str))) - (list* (make-path/param (path/param-path (first old-path)) - (list new-param-str)) - (rest old-path)))) - in-url))) +(provide/contract + [continuation-url? (url? . -> . (or/c false/c (list/c number? number? number?)))]) + +;; ******************************************************************************** (provide/contract [current-url-transform (parameter/c url-transform/c)]