diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss index 562176266c..9763bd34a8 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/wc-comp.ss @@ -29,7 +29,7 @@ ; A new frame has been created (define last (web-cell-ref a-counter)) ; It is a child of the parent frame, so we can inspect the value - (web-cell-mask a-counter (add1 last)) + (web-cell-shadow a-counter (add1 last)) ; The new frame has been modified (counter))))]) "+")))) diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss index e8485d69c6..9d1fa3ce55 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/wc.ss @@ -35,7 +35,7 @@ ; A new frame has been created (define last (web-cell-ref a-counter)) ; It is a child of the parent frame, so we can inspect the value - (web-cell-mask a-counter (add1 last)) + (web-cell-shadow a-counter (add1 last)) ; The new frame has been modified (generate))))]) "+"))))) diff --git a/collects/web-server/dispatchers/dispatch-lang.ss b/collects/web-server/dispatchers/dispatch-lang.ss index 67cb0f31d4..64ffd2c8d0 100644 --- a/collects/web-server/dispatchers/dispatch-lang.ss +++ b/collects/web-server/dispatchers/dispatch-lang.ss @@ -71,7 +71,7 @@ (begin-session conn req)])) ;; XXX Currently there are just sessions, should be servlets and sessions - + ;; XXX Control extent of servlet data ;; begin-session: connection request (define (begin-session conn req) (define uri (request-uri req)) diff --git a/collects/web-server/docs/reference/lang.scrbl b/collects/web-server/docs/reference/lang.scrbl index d9a763aead..0e1b818d9e 100644 --- a/collects/web-server/docs/reference/lang.scrbl +++ b/collects/web-server/docs/reference/lang.scrbl @@ -3,11 +3,247 @@ @title[#:style 'toc]{Web Language Servlets} -XXX +The @file{web-server} allows servlets to be written in a special Web +language that is nearly identical to Scheme. Herein we discuss how it +is different and what API is provided. @local-table-of-contents[] @; ------------------------------------------------------------ -@section[#:tag "example"]{Example} +@section[#:tag "lang-servlets"]{Definition} -XXX \ No newline at end of file +A @defterm{Web language servlet} is a module written in the +@scheme[(lib "lang.ss" "web-server")] module language. It should provide +the following identifier: + +@defproc[(start [initial-request request?]) + response?]{ + This function is called when this servlet is invoked. + The argument is the HTTP request that initiated the servlet. +} + +@; XXX Cite paper +@; ------------------------------------------------------------ +@section[#:tag "considerations"]{Usage Considerations} + + +A servlet has the following process performed on it automatically: +@itemize[ + @item{All uses of @scheme[letrec] are removed and replaced with equivalent uses of + @scheme[let] and imperative features. (@file{lang/elim-letrec.ss})} + @item{The program is converted into ANF (Administrative Normal Form), + making all continuations explicit. (@file{lang/anormal.ss})} + @item{All continuations (and other continuations marks) are recorded in the + continuation marks of the expression + they are the continuation of. (@file{lang/elim-callcc.ss})} + @item{All calls to external modules are identified and marked. + (@file{lang/elim-callcc.ss})} + @item{All uses of @scheme[call/cc] are removed and replaced with + equivalent gathering of the continuations through the continuation-marks. + (@file{lang/elim-callcc.ss})} + @item{The program is defunctionalized with a serializable data-structure for each + anonymous lambda. (@file{lang/defun.ss})} +] + +This process also the continuations captured by your servlet to be serialized. +This means they may be stored on the client's browser or the server's disk. +Thus, your servlet has no cost to the server other than execution. This is +very attractive if you've used Scheme servlets and had memory problems. + +This process IS defined on all of PLT Scheme and occurs AFTER macro-expansion, +so you are free to use all interesting features of PLT Scheme. However, there +are some considerations you must make. + +First, this process drastically changes the structure of your program. It +will create an immense number of lambdas and structures your program +did not normally contain. The performance implication of this has not been +studied with PLT Scheme. However, it is theoretically a benefit. The main +implications would be due to optimizations MzScheme attempts to perform +that will no longer apply. Ideally, your program should be optimized first. + +Second, the defunctionalization process is sensitive to the syntactic structure +of your program. Therefore, if you change your program in a trivial way, for example, +changing a constant, then all serialized continuations will be obsolete and will +error when deserialization is attempted. This is a feature, not a bug! + +Third, the values in the lexical scope of your continuations must be serializable +for the continuations itself to be serializable. This means that you must use +@scheme[define-serializable-struct] rather than @scheme[define-struct], and take +care to use modules that do the same. Similarly, you may not use @scheme[parameterize], +because parameterizations are not serializable. + +Fourth, and related, this process only runs on your code, not on the code you +@scheme[require]. Thus, your continuations---to be capturable---must not +be in the context of another module. For example, the following will not work: +@schemeblock[ + (define requests + (map (lambda (rg) (send/suspend/url rg)) + response-generators)) +] +because @scheme[map] is not transformed by the process. However, if you defined +your own @scheme[map] function, there would be no problem. + +Fifth, the store is NOT serialized. If you rely on the store you will +be taking huge risks. You will be assuming that the serialized continuation +is invoked before the server is restarted or the memory is garbage collected. + +@; ------------------------------------------------------------ +@section[#:tag "reprovided"]{Reprovided API} + +The APIs from @scheme[(lib "url.ss" "net")], @secref["request-structs.ss"], +@secref["response-structs.ss"], and @secref["helpers.ss"] are reprovided +by the Web language API. + +@; ------------------------------------------------------------ +@section[#:tag "lang/web.ss"]{Web} + +@file{lang/web.ss} provides the most basic Web functionality. + +@defproc[(send/suspend/url [response-generator (url? . -> . response?)]) + request?]{ + Captures the current continuation. Serializes it and stuffs it into + a URL. Calls @scheme[response-generator] with this URL and delivers + the response to the client. If the URL is invoked + the request is returned to this continuation. +} + +@defproc[(send/suspend/hidden [response-generator (url? xexpr? . -> . response?)]) + request?]{ + Captures the current continuation. Serializes it and generates an INPUT + form that includes the serialization as a hidden form. + Calls @scheme[response-generator] with this URL and form field and delivers + the response to the client. If the URL is invoked with form data containing + the hiddden form, + the request is returned to this continuation. + + Note: The continuation is NOT stuffed. +} + +@defproc[(embed-proc/url [k-url url?] + [proc (request? . -> . any/c)]) + url?]{ + Serializes and stuffs @scheme[proc] into @scheme[k-url]. For use with + @scheme[extract-proc/url]. +} + +@defproc[(extract-proc/url [req request?]) + any/c]{ + Inspects the URL of @scheme[req] and attempts to extract the procedured + embeded with @scheme[embed-proc/url]. If sucessful, it is invoked with + @scheme[req] as an argument. +} + +@; ------------------------------------------------------------ +@section[#:tag "lang/stuff-url.ss"]{Stuff URL} + +@file{lang/stuff-url.ss} provides an interface for "stuffing" +serializable values into URLs. Currently there is a particular +hard-coded behavior, but we hope to make it more flexible in +the future. + +@defproc[(stuff-url [v serializable?] + [u url?]) + url?]{ + Serializes @scheme[v] and computes the MD5 of the serialized + representation. The serialization of @scheme[v] is written to + @file{$HOME/.urls/M} where `M' is the MD5. `M' is then + placed in @scheme[u] as a URL param. +} + +@defproc[(stuffed-url? [u url?]) + boolean?]{ + Checks if @scheme[u] appears to be produced by @scheme[stuff-url]. +} + +@defproc[(unstuff-url [u url?]) + serializable?]{ + Extracts the value previously serialized into @scheme[u] by @scheme[stuff-url]. +} + +In the future, we will offer the facilities to: +@itemize[ + @item{Optionally use the content-addressed storage.} + @item{Use different hashing algorithms for the CAS.} + @item{Encrypt the serialized value.} + @item{Only use the CAS if the URL would be too long. (URLs may only be 1024 characters.)} +] + +@; ------------------------------------------------------------ +@section[#:tag "lang/web-extras.ss"]{Web Extras} + +@file{lang/web-extras.ss} provides @scheme[send/suspend/dispatch] and +@scheme[redirect/get] as @secref["web.ss"], except they use +@scheme[embed-proc/url] + @scheme[extract-proc/url] and +@scheme[send/suspend/url] respectively. + +@; XXX Make warning cool +@; ------------------------------------------------------------ +@section[#:tag "lang/file-box.ss"]{File Boxes} + +As mentioned earlier, it is dangerous to rely on the store in +Web Language servlets, due to the deployment scenarios available +to them. @file{lang/file-box.ss} provides a simple API to replace +boxes in a safe way. + +@defproc[(file-box? [v any/c]) + boolean?]{Checks if @scheme[v] is a file-box.} + +@defproc[(file-box [p path?] + [v serializable?]) + file-box?]{ + Creates a file-box that is stored at @scheme[p], with the default + contents of @scheme[v]. +} + +@defproc[(file-unbox [fb file-box?]) + serializable?]{ + Returns the value inside @scheme[fb] +} + +@defproc[(file-box-set? [fb file-box?]) + boolean?]{ + Returns @scheme[#t] if @scheme[fb] contains a value. +} + +@defproc[(file-box-set! [fb file-box?] + [v serializable?]) + void]{ + Saves @scheme[v] in the file represented by @scheme[fb]. +} + +Warning: If you plan on using a load-balancer, make sure your file-boxes +are on a shared medium. + +@; ------------------------------------------------------------ +@section[#:tag "lang/web-param.ss"]{Web Parameters} + +As mentioned earlier, it is not easy to use @scheme[parameterize] in the +Web Language. @file{lang/web-param.ss} provides (roughly) the same +functionality in a way that is serializable. Like other serializable +things in the Web Language, they are sensitive to source code modification. + +@defform[(make-web-parameter default)]{ + Expands to the definition of a web-parameter with + @scheme[default] as the default value. A web-parameter is + a procedure that, when called with zero arguments, returns @scheme[default] + or the last value @scheme[web-parameterize]d in the dynamic context + of the call. +} + +@defproc[(web-parameter? [v any/c]) + boolean?]{ + Checks if @scheme[v] appears to be a web-parameter. +} + +@defform[(web-parameterize ([web-parameter-expr value-expr] ...) expr ...)]{ + Runs @scheme[(begin expr ...)] such that the web-parameters that + the @scheme[web-parameter-expr]s evaluate to are bound to the @scheme[value-expr]s. + From the perspective of the @scheme[value-expr]s, this is like @scheme[let]. +} + +@; ------------------------------------------------------------ +@section[#:tag "lang/web-cells.ss"]{Web Cells} + +@file{lang/web-cells.ss} provides the same API as @secref["web-cells.ss"], +but in a way compatible with the Web Language. The one difference is that +@scheme[make-web-cell] is syntax, rather than a function. diff --git a/collects/web-server/docs/reference/private.scrbl b/collects/web-server/docs/reference/private.scrbl index 6f634ab14d..31dd88c65a 100644 --- a/collects/web-server/docs/reference/private.scrbl +++ b/collects/web-server/docs/reference/private.scrbl @@ -3,11 +3,57 @@ @title[#:style 'toc]{Internal} -XXX +The @file{web-server} is a complicated piece of software and as a result, +defines a number of interesting and independently useful sub-components. +Some of these are documented here. @local-table-of-contents[] @; ------------------------------------------------------------ -@section[#:tag "example"]{Example} +@section[#:tag "cache-table.ss"]{Cache Table} -XXX \ No newline at end of file +XXX + +@; ------------------------------------------------------------ +@section[#:tag "connection-manager.ss"]{Connection Manager} + +XXX + +@; XXX And define-closure.ss +@; ------------------------------------------------------------ +@section[#:tag "closure.ss"]{Serializable Closure} + +XXX + +@; XXX And dispatch-server-sig.ss +@; ------------------------------------------------------------ +@section[#:tag "dispatch-server-unit.ss"]{Dispatching Server} + +XXX + +@; ------------------------------------------------------------ +@section[#:tag "mime-types.ss"]{MIME Types} + +XXX + +@; XXX Rename mod-map.ss +@; ------------------------------------------------------------ +@section[#:tag "mod-map.ss"]{Serialization Utilities} + +XXX + +@; ------------------------------------------------------------ +@section[#:tag "timer.ss"]{Timers} + +XXX + +@; ------------------------------------------------------------ +@section[#:tag "url-param.ss"]{URL Param} + +XXX + + +@; ------------------------------------------------------------ +@section[#:tag "util.ss"]{Miscellaneous Utilities} + +XXX diff --git a/collects/web-server/docs/reference/servlet.scrbl b/collects/web-server/docs/reference/servlet.scrbl index 89ac9abcb7..41e8346bd1 100644 --- a/collects/web-server/docs/reference/servlet.scrbl +++ b/collects/web-server/docs/reference/servlet.scrbl @@ -76,6 +76,7 @@ for use in servlets. @section[#:tag "request-structs.ss"]{HTTP Requests} @; XXX Create http sub-directory +@; XXX Have this include read-request and write-response @file{private/request-structs.ss} provides a number of structures and functions related to HTTP request data structures. @@ -177,6 +178,7 @@ HTTP responses. } @; XXX Rename string? option +@; XXX Format warning cool. @defstruct[(response/full response/basic) ([code number?] [message string?] @@ -211,7 +213,10 @@ HTTP responses. } @defthing[TEXT/HTML-MIME-TYPE bytes?]{Equivalent to @scheme[#"text/html; charset=utf-8"].} - + +Warning: If you include a Length header in a response that is inaccurate, there WILL be an error in +transmission that the server will not catch. + @; ------------------------------------------------------------ @section[#:tag "web.ss"]{Web} diff --git a/collects/web-server/lang/file-box.ss b/collects/web-server/lang/file-box.ss index dd59f2541f..9f2b3488d5 100644 --- a/collects/web-server/lang/file-box.ss +++ b/collects/web-server/lang/file-box.ss @@ -23,7 +23,7 @@ (provide/contract [file-box? (any/c . -> . boolean?)] - [file-box (path? any/c . -> . file-box?)] - [file-unbox (file-box? . -> . any/c)] + [file-box (path? serializable? . -> . file-box?)] + [file-unbox (file-box? . -> . serializable?)] [file-box-set? (file-box? . -> . boolean?)] - [file-box-set! (file-box? any/c . -> . void)])) + [file-box-set! (file-box? serializable? . -> . void)])) \ No newline at end of file diff --git a/collects/web-server/lang/stuff-url.ss b/collects/web-server/lang/stuff-url.ss index 097678c5f0..d56b0ae535 100644 --- a/collects/web-server/lang/stuff-url.ss +++ b/collects/web-server/lang/stuff-url.ss @@ -34,7 +34,7 @@ ;; encode in the url (define (stuff-url svl uri) (define result-uri - (insert-param uri "c" (md5-store (write/string (compress-serial svl))))) + (insert-param uri "c" (md5-store (write/string (compress-serial (serialize svl)))))) (when (> (string-length (url->string result-uri)) 1024) (error "the url is too big: " (url->string result-uri))) @@ -47,4 +47,4 @@ ;; unstuff-url: url -> serial ;; decode from the url and reconstruct the serial (define (unstuff-url req-url) - (decompress-serial (read/string (md5-lookup (extract-param req-url "c")))))) \ No newline at end of file + (deserialize (decompress-serial (read/string (md5-lookup (extract-param req-url "c"))))))) \ No newline at end of file diff --git a/collects/web-server/lang/web-cells.ss b/collects/web-server/lang/web-cells.ss index 401d26bd10..ed9a14f97b 100644 --- a/collects/web-server/lang/web-cells.ss +++ b/collects/web-server/lang/web-cells.ss @@ -64,14 +64,14 @@ (define id (next-web-cell-id)) (define key (string->symbol (format "~a-~a" label id))) (define wc (make-primitive-wc key)) - (web-cell-mask wc default) + (web-cell-shadow wc default) wc) (define (web-cell-ref pwc) (env-lookup (primitive-wc-id pwc) (frame-env (current-frame)))) - (define (web-cell-mask wc nv) + (define (web-cell-shadow wc nv) (update-frame! (make-frame (env-replace (primitive-wc-id wc) nv @@ -81,4 +81,4 @@ (provide/contract [web-cell? (any/c . -> . boolean?)] [web-cell-ref (web-cell? . -> . any/c)] - [web-cell-mask (web-cell? any/c . -> . void)])) \ No newline at end of file + [web-cell-shadow (web-cell? any/c . -> . void)])) \ No newline at end of file diff --git a/collects/web-server/lang/web-param.ss b/collects/web-server/lang/web-param.ss index 09edf5ef86..444a466df7 100644 --- a/collects/web-server/lang/web-param.ss +++ b/collects/web-server/lang/web-param.ss @@ -1,6 +1,7 @@ (module web-param mzscheme (require "../private/closure.ss" (lib "list.ss")) + ; XXX Add contract (provide make-web-parameter web-parameter? web-parameterize) diff --git a/collects/web-server/lang/web.ss b/collects/web-server/lang/web.ss index cf84ee1e2f..685c899e50 100644 --- a/collects/web-server/lang/web.ss +++ b/collects/web-server/lang/web.ss @@ -35,6 +35,7 @@ ;; send/suspend/hidden: (url input-field -> response) -> request ;; like send/suspend except the continuation is encoded in a hidden field + ;; XXX incorporate stuffing in some way (define (send/suspend/hidden page-maker) (send/suspend (lambda (k) @@ -49,13 +50,14 @@ (send/suspend (lambda (k) (page-maker - (stuff-url (serialize k) + (stuff-url k (session-url (current-session))))))) + ; XXX Don't use stuff-url, but use the other serialize thing (define embed-label "superkont") (define (embed-proc/url k-url proc) (define superkont-url - (stuff-url (serialize proc) + (stuff-url proc (session-url (current-session)))) (define result-uri (insert-param k-url embed-label @@ -68,9 +70,8 @@ (define req-url (request-uri request)) (define maybe-embedding (extract-param req-url embed-label)) (if maybe-embedding - (let ([proc (deserialize - (unstuff-url - (string->url maybe-embedding)))]) + (let ([proc (unstuff-url + (string->url maybe-embedding))]) (proc request)) (error 'send/suspend/dispatch "No ~a: ~S!" embed-label))) @@ -81,9 +82,8 @@ ; Look in url for c= (let ([req-url (request-uri req)]) (and (stuffed-url? req-url) - (deserialize - (unstuff-url - req-url)))) + (unstuff-url + req-url))) ; Look in query for kont= (match (bindings-assq #"kont" (request-bindings/raw req)) [(struct binding:form (id kont)) diff --git a/collects/web-server/private/connection-structs.ss b/collects/web-server/private/connection-structs.ss index c921bed35d..cfde8ae00c 100644 --- a/collects/web-server/private/connection-structs.ss +++ b/collects/web-server/private/connection-structs.ss @@ -1,6 +1,6 @@ (module connection-structs mzscheme (require (lib "contract.ss")) - (require "timer-structs.ss") + (require "timer.ss") (define-struct connection (timer i-port o-port custodian close? mutex) (make-inspector)) diff --git a/collects/web-server/private/timer-structs.ss b/collects/web-server/private/timer-structs.ss deleted file mode 100644 index 061b65de51..0000000000 --- a/collects/web-server/private/timer-structs.ss +++ /dev/null @@ -1,8 +0,0 @@ -(module timer-structs mzscheme - (require (lib "contract.ss")) - - (define-struct timer (evt expire-seconds action)) - (provide/contract - [struct timer ([evt evt?] - [expire-seconds number?] - [action (-> void)])])) \ No newline at end of file diff --git a/collects/web-server/private/timer.ss b/collects/web-server/private/timer.ss index 749680d422..583465790d 100644 --- a/collects/web-server/private/timer.ss +++ b/collects/web-server/private/timer.ss @@ -2,7 +2,8 @@ (require (lib "list.ss") (lib "contract.ss") (lib "async-channel.ss")) - (require "timer-structs.ss") + + (define-struct timer (evt expire-seconds action)) (define timer-ch (make-async-channel)) @@ -85,8 +86,11 @@ (* 1000 secs)) (timer-action timer))) + (provide/contract - [timer? (any/c . -> . boolean?)] + [struct timer ([evt evt?] + [expire-seconds number?] + [action (-> void)])] [start-timer-manager (custodian? . -> . void)] [start-timer (number? (-> void) . -> . timer?)] [reset-timer! (timer? number? . -> . void)] diff --git a/collects/web-server/tests/private/request-test.ss b/collects/web-server/tests/private/request-test.ss index 542f77375f..7325917bbc 100644 --- a/collects/web-server/tests/private/request-test.ss +++ b/collects/web-server/tests/private/request-test.ss @@ -2,7 +2,7 @@ (require (planet "util.ss" ("schematics" "schemeunit.plt" 2)) (planet "test.ss" ("schematics" "schemeunit.plt" 2)) (lib "connection-structs.ss" "web-server" "private") - (lib "timer-structs.ss" "web-server" "private") + (lib "timer.ss" "web-server" "private") (lib "request-structs.ss" "web-server" "private")) (require/expose (lib "request.ss" "web-server" "private")