diff --git a/collects/web-server/prototype-web-server/dispatch-lang.ss b/collects/web-server/prototype-web-server/dispatch-lang.ss index d7bd09f07f..4562005561 100644 --- a/collects/web-server/prototype-web-server/dispatch-lang.ss +++ b/collects/web-server/prototype-web-server/dispatch-lang.ss @@ -1,5 +1,6 @@ (module dispatch-lang mzscheme (require (lib "kw.ss") + (lib "list.ss") (lib "contract.ss") (lib "url.ss" "net") (lib "session.ss" "web-server" "prototype-web-server" "private") @@ -12,8 +13,7 @@ "../private/util.ss" "../private/response.ss" "../configuration/namespace.ss" - "../configuration/responders.ss" - "private/utils.ss") + "../configuration/responders.ss") (provide/contract [interface-version dispatcher-interface-version?]) @@ -21,6 +21,32 @@ (define top-cust (current-custodian)) + ; same-servlet? : url? url? -> boolean? + (define (same-servlet? req ses) + (define (abstract-url u) + (map path/param-path + (url-path u))) + (define ans (list-prefix (abstract-url ses) (abstract-url req))) + #;(printf "~S => ~S~n" `(same-servlet? ,(url->string req) ,(url->string ses)) ans) + (and ans #t)) + + ;; make-session-url: url (listof string) -> url + ;; produce a new url for this session: + ;; Minimal path to the servlet. + ;; No query. + ;; No fragment. + (define (make-session-url uri new-path) + (make-url + (url-scheme uri) + (url-user uri) + (url-host uri) + (url-port uri) + #t + (map (lambda (p) (make-path/param p empty)) + new-path) + empty + #f)) + (define interface-version 'v1) (define/kw (make #:key url->path @@ -74,16 +100,7 @@ 'start)) (set-session-servlet! ses (initialize-servlet start))) (resume-session (session-id ses) - conn req))))) - - ; same-servlet? : url? url? -> boolean? - (define (same-servlet? req ses) - (define (abstract-url u) - (map path/param-path - (url-path u))) - (define ans (list-prefix (abstract-url ses) (abstract-url req))) - #;(printf "~S => ~S~n" `(same-servlet? ,(url->string req) ,(url->string ses)) ans) - (and ans #t)) + conn req))))) ;; resume-session: number connection request (define (resume-session ses-id conn req) diff --git a/collects/web-server/prototype-web-server/lang/stuff-url.ss b/collects/web-server/prototype-web-server/lang/stuff-url.ss index f7212334d5..83bd664b37 100644 --- a/collects/web-server/prototype-web-server/lang/stuff-url.ss +++ b/collects/web-server/prototype-web-server/lang/stuff-url.ss @@ -2,7 +2,7 @@ (require (lib "contract.ss") (lib "url.ss" "net") (lib "serialize.ss") - "../private/utils.ss" + "../../private/util.ss" "../private/url-param.ss" "../private/mod-map.ss") diff --git a/collects/web-server/prototype-web-server/private/url-param.ss b/collects/web-server/prototype-web-server/private/url-param.ss index 99c341b4a9..bfcd06a571 100644 --- a/collects/web-server/prototype-web-server/private/url-param.ss +++ b/collects/web-server/prototype-web-server/private/url-param.ss @@ -3,7 +3,6 @@ (lib "url.ss" "net") (lib "plt-match.ss") (lib "list.ss") - "utils.ss" "../../private/util.ss") (provide/contract diff --git a/collects/web-server/prototype-web-server/private/utils.ss b/collects/web-server/prototype-web-server/private/utils.ss deleted file mode 100644 index 1df80e0684..0000000000 --- a/collects/web-server/prototype-web-server/private/utils.ss +++ /dev/null @@ -1,35 +0,0 @@ -(module utils mzscheme - (require (lib "contract.ss") - (lib "url.ss" "net") - (lib "list.ss") - (lib "serialize.ss")) - - (provide/contract - [read/string (string? . -> . serializable?)] - [write/string (serializable? . -> . string?)] - [make-session-url (url? (listof string?) . -> . url?)]) - - (define (read/string str) - (read (open-input-string str))) - (define (write/string v) - (define str (open-output-string)) - (write v str) - (get-output-string str)) - - ;; make-session-url: url (listof string) -> url - ;; produce a new url for this session: - ;; Minimal path to the servlet. - ;; No query. - ;; No fragment. - (define (make-session-url uri new-path) - (make-url - (url-scheme uri) - (url-user uri) - (url-host uri) - (url-port uri) - #t - (map (lambda (p) (make-path/param p empty)) - new-path) - '() - #f - ))) \ No newline at end of file