diff --git a/collects/web-server/docs/reference/private.scrbl b/collects/web-server/docs/reference/private.scrbl index dba09ca324..62b2c3c4f2 100644 --- a/collects/web-server/docs/reference/private.scrbl +++ b/collects/web-server/docs/reference/private.scrbl @@ -10,51 +10,356 @@ Some of these are documented here. @local-table-of-contents[] + @; ------------------------------------------------------------ -@section[#:tag "cache-table.ss"]{Cache Table} +@section[#:tag "timer.ss"]{Timers} -XXX +@file{private/timer.ss} provides a functionality for running +procedures after a given amount of time, that may be extended. +@defstruct[timer ([evt evt?] + [expire-seconds number?] + [action (-> void)])]{ + @scheme[evt] is an @scheme[alarm-evt] that is ready at @scheme[expire-seconds]. + @scheme[action] should be called when this @scheme[evt] is ready. +} + +@defproc[(start-timer-manager [cust custodian?]) + void]{ + Handles the execution and management of timers. Resources are charged to + @scheme[cust]. +} + +@defproc[(start-timer [s number?] + [action (-> void)]) + timer?]{ + Registers a timer that runs @scheme[action] after @scheme[s] seconds. +} + +@defproc[(reset-timer! [t timer?] + [s number?]) + void]{ + Changes @scheme[t] so that it will fire at @scheme[s]. +} + +@defproc[(increment-timer! [t timer?] + [s number?]) + void]{ + Changes @scheme[t] so that it will fire after @scheme[s] seconds. +} + +@defproc[(cancel-timer! [t timer?]) + void]{ + Cancels the firing of @scheme[t] ever and frees resources used by @scheme[t]. +} + + +@; XXX Generalize @; ------------------------------------------------------------ @section[#:tag "connection-manager.ss"]{Connection Manager} -XXX +@file{private/connection-manager.ss} provides functionality for managing pairs of +input and output ports. We have plans to allow a number of different strategies +for doing this. -@; XXX And define-closure.ss -@; ------------------------------------------------------------ -@section[#:tag "closure.ss"]{Serializable Closure} +@defstruct[connection + ([timer timer?] + [i-port input-port?] [o-port output-port?] [custodian custodian?] + [close? boolean?] [mutex semaphore?])]{ + A connection is a pair of ports (@scheme[i-port] and @scheme[o-port]) that is + ready to close after the current job if @scheme[close?] is @scheme[#t]. Resources + associated with the connection should be allocated under @scheme[custodian] and + locked by @scheme[mutex]---including access to the ports. The connection will last + until @scheme[timer] triggers. +} + +@; XXX Don't pass in parent-cust +@defproc[(start-connection-manager [parent-cust custodian?]) + void]{ + Runs the connection manager (now just the timer manager) will @scheme[parent-cust] + as the custodian. +} + +@defproc[(new-connection [timeout number?] + [i-port input-port?] + [o-port output-port?] + [cust custodian?] + [close? boolean?]) + connection?]{ + Constructs a connection with a timer with a trigger of @scheme[timeout] that calls + @scheme[kill-connection!]. +} + +@defproc[(kill-connection! [c connection?]) + void]{ + Closes the ports associated with @scheme[c], kills the timer, and shuts down + the custodian. +} + +@defproc[(adjust-connection-timeout! [c connection?] + [t number?]) + void]{ + Calls @scheme[reset-timer!] with the timer behind @scheme[c] with @scheme[t]. +} -XXX - -@; XXX And dispatch-server-sig.ss @; ------------------------------------------------------------ @section[#:tag "dispatch-server-unit.ss"]{Dispatching Server} -XXX +The @file{web-server} is just a configuration of a dispatching server. +This dispatching server component is useful on its own. +@file{private/dispatch-server-sig.ss} defines the following signatures: + +@defthing[dispatch-server^ signature?]{ + The following identifiers: + @defproc[(serve) + (-> void)]{ + Runs and returns a shutdown procedure. + } + @defproc[(serve-ports [i input-port?] + [o output-port?]) + void]{ + Serves a single connection with @scheme[i] and @scheme[o]. + } +} + +@defthing[dispatch-server-config^ signature?]{ + The following identifiers: + @defthing[port port?]{Specifies the port to serve on.} + @defthing[listen-ip string?]{Passed to @scheme[tcp-accept].} + @defthing[max-waiting integer?]{Passed to @scheme[tcp-accept].} + @defthing[initial-connection-timeout integer?]{Specifies the initial timeout given to a connection.} + @defproc[(read-request [c connection?] + [p port?] + [port-addresses port-addresses?]) + any/c]{ + Defines the way the server reads requests off connections to be passed + to @scheme[dispatch]. + } + @defthing[dispatch dispatcher?]{How to handle requests.} +} + +@file{private/dispatch-server-unit.ss} provides the unit +which actually implements a dispatching server. + +@defthing[dispatch-server\@ (unit/c (tcp^ dispatch-server-config^) (dispatch-server^))]{ + Runs the dispatching server config in a very basic way, except that it uses + @secref["connection-manager.ss"] to manage connections. +} + +@; ------------------------------------------------------------ +@section[#:tag "closure.ss"]{Serializable Closures} + +The defunctionalization process of the Web Language (see @secref["lang"]) +requires an explicit representation of closures that is serializable. +@file{private/closure.ss} is this representation. It provides: + +@defproc[(make-closure-definition-syntax [tag syntax?] + [fvars (listof identifier?)] + [proc syntax?]) + syntax?]{ + Outputs a syntax object that defines a serializable structure, + with @scheme[tag] as the tag, that represents a closure over + @scheme[fvars], that acts a procedure and when invoked calls + @scheme[proc], which is assumed to be syntax of @scheme[lambda] + or @scheme[case-lambda]. +} + +@defproc[(closure->deserialize-name [c closure?]) + symbol?]{ + Extracts the unique tag of a closure @scheme[c] +} + +These are difficult to use directly, so @file{private/define-closure.ss} +defines a helper form: + +@defform[(define-closure tag formals (free-vars ...) body)]{ + Defines a closure, constructed with @scheme[make-tag] that accepts + @scheme[freevars ...], that when invoked with @scheme[formals] + executes @scheme[body]. +} + +@; XXX Example + +@; ------------------------------------------------------------ +@section[#:tag "cache-table.ss"]{Cache Table} + +@file{private/cache-table.ss} provides a set of caching hash table +functions. + +@defproc[(make-cache-table) + cache-table?]{ + Constructs a cache-table. +} + +@defproc[(cache-table-lookup! [ct cache-table?] + [id symbol?] + [mk (-> any/c)]) + any/c]{ + Looks up @scheme[id] in @scheme[ct]. If it is not present, then @scheme[mk] is + called to construct the value and add it to @scheme[ct]. +} + +@defproc[(cache-table-clear! [ct cache-table?]) + void?]{ + Clears all entries in @scheme[ct]. +} + +@defproc[(cache-table? [v any/c]) + boolean?]{ + Determines if @scheme[v] is a cache table. +} + @; ------------------------------------------------------------ @section[#:tag "mime-types.ss"]{MIME Types} -XXX +@file{private/mime-types.ss} provides function for dealing with @file{mime.types} +files. + +@defproc[(read-mime-types [p path?]) + (hash-table/c symbol? bytes?)]{ + Reads the @file{mime.types} file from @scheme[p] and constructs a + hash table mapping extensions to MIME types. +} + +@defproc[(make-get-mime-type [p path?]) + (path? . -> . bytes?)]{ + Uses a @scheme[read-mime-types] with @scheme[p] and constructs a + function from paths to their MIME type. +} @; XXX Rename mod-map.ss @; ------------------------------------------------------------ @section[#:tag "mod-map.ss"]{Serialization Utilities} -XXX - -@; ------------------------------------------------------------ -@section[#:tag "timer.ss"]{Timers} - -XXX +@scheme[(lib "serialize.ss")] provides the functionality of serializing +values. @file{private/mod-map.ss} compresses the serialized representation. +@defproc[(compress-serial [sv serialized-value?]) + compressed-serialized-value?]{ + Collapses multiple occurrences of the same module in the module + map of the serialized representation, @scheme[sv]. +} + +@defproc[(decompress-serial [csv compressed-serialized-value?]) + serialized-value?]{ + Expands multiple occurrences of the same module in the module + map of the compressed serialized representation, @scheme[csv]. +} + @; ------------------------------------------------------------ @section[#:tag "url-param.ss"]{URL Param} -XXX - +The @file{web-server} needs to encode information in URLs. If this data +is stored in the query string, than it will be overridden by browsers that +make GET requests to those URLs with more query data. So, it must be encoded +in URL params. @file{private/url-param.ss} provides functions for helping +with this process. +@defproc[(insert-param [u url?] + [k string?] + [v string?]) + url?]{ + Associates @scheme[k] with @scheme[v] in the final URL param of @scheme[u], + overwritting any current binding for @scheme[k]. +} + +@defproc[(extract-param [u url?] + [k string?]) + (or/c string? false/c)]{ + Extracts the string associated with @scheme[k] in the final URL param of + @scheme[u], if there is one, returning @scheme[#f] otherwise. +} + @; ------------------------------------------------------------ @section[#:tag "util.ss"]{Miscellaneous Utilities} -XXX +There are a number of other miscellaneous utilities the @file{web-server} +needs. They are provided by @file{private/util.ss}. + +@subsection{Lists} +@defproc[(list-prefix [l list?] + [r list?]) + (or/c list? false/c)]{ + If @scheme[l] is a prefix of @scheme[r], then returns the prefix. Otherwise @scheme[#f]. +} + +@subsection{URLs} + +@defproc[(url-replace-path [proc (list? . -> . list?)] + [u url?]) + url?]{ + Replaces the URL path of @scheme[u] with @scheme[proc] of the former path. +} + +@; XXX Remove use or take url? +@defproc[(url-path->string [url-path (listof (or/c string? path/param?))]) + string?]{ + Formats @scheme[url-path] as a string with @scheme["/"] as a delimiter + and no params. +} + +@subsection{Paths} +@; XXX path-element? +@defproc[(explode-path* [p path?]) + (listof (or/c symbol? path?))]{ + Like @scheme[normalize-path], but does not resolve symlinks. +} + +@; XXX path-element? or no list? +@defproc[(path-without-base [base path?] + [p path?]) + list?]{ + Returns, as a list, the portion of @scheme[p] after @scheme[base], + assuming @scheme[base] is a prefix of @scheme[p]. +} + +@defproc[(directory-part [p path?]) + path?]{ + Returns the directory part of @scheme[p], returning @scheme[(current-directory)] + if it is relative. +} + +@defproc[(build-path-unless-absolute [base path-string?] + [p path-string?]) + path?]{ + Prepends @scheme[base] to @scheme[p], unless @scheme[p] is absolute. +} + +@; XXX path-element? +@defproc[(strip-prefix-ups [p list?]) + list?]{ + Removes all the prefix @scheme[".."]s from @scheme[p]. +} + +@subsection{Exceptions} + +@; XXX Remove +@defproc[(network-error [s symbol?] + [fmt string?] + [v any/c] ...) + void]{ + Like @scheme[error], but throws a @scheme[exn:fail:network]. +} + +@defproc[(exn->string [exn (or/c exn? any/c)]) + string?]{ + Formats @scheme[exn] with @scheme[(error-display-handler)] as a string. +} + +@subsection{Strings} + +@defproc[(lowercase-symbol! [sb (or/c string? bytes?)]) + symbol?]{ + Returns @scheme[sb] as a lowercase symbol. +} + +@defproc[(read/string [s string?]) + serializable?]{ + @scheme[read]s a value from @scheme[s] and returns it. +} + +@defproc[(write/string [v serializable?]) + string?]{ + @scheme[write]s @scheme[v] to a string and returns it. +} diff --git a/collects/web-server/docs/reference/reference.scrbl b/collects/web-server/docs/reference/reference.scrbl index 32bc6c39fe..e039071ecf 100644 --- a/collects/web-server/docs/reference/reference.scrbl +++ b/collects/web-server/docs/reference/reference.scrbl @@ -2,6 +2,7 @@ @require["../web-server.ss"] @title[#:tag "web-server-ref"]{Web Server Reference Manual} +@author{Jay McCarthy (jay\@plt-scheme.org)} The @file{web-server} collection provides libraries that can be used to develop Web applications in Scheme. @@ -9,17 +10,29 @@ develop Web applications in Scheme. @table-of-contents[] @include-section["running.scrbl"] + +@include-section["servlet.scrbl"] +@include-section["servlet-env.scrbl"] + +@include-section["lang.scrbl"] + @include-section["configuration.scrbl"] @include-section["dispatchers.scrbl"] @include-section["web-config-unit.scrbl"] @include-section["web-server-unit.scrbl"] @include-section["managers.scrbl"] -@include-section["servlet-env.scrbl"] - -@include-section["servlet.scrbl"] - -@include-section["lang.scrbl"] @include-section["private.scrbl"] +@; ------------------------------------------------------------ +@section[#:tag "ack"]{Acknowledgements} + +We thank Matthew Flatt for his superlative work on MzScheme. +We thank the previous maintainers of the PLT Web Server: Paul T. Graunke, Mike Burns, and Greg Pettyjohn +Numerous people have +provided invaluable feedback on the server, including Eli Barzilay, Ryan Culpepper, Robby +Findler, Dan Licata, Matt Jadud, Jacob Matthews, Matthias Radestock, Andrey Skylar, +Michael Sperber, Dave Tucker, Anton van Straaten, and Noel Welsh. We also thank the +many other PLT Scheme users who have exercised the server and offered critiques. + @index-section["web-server-ref-index"] \ No newline at end of file diff --git a/collects/web-server/docs/web-server.ss b/collects/web-server/docs/web-server.ss index d511392a91..1a7e53a7e4 100644 --- a/collects/web-server/docs/web-server.ss +++ b/collects/web-server/docs/web-server.ss @@ -1,6 +1,21 @@ (module web-server mzscheme (require (lib "manual.ss" "scribble") (lib "eval.ss" "scribble")) + ; XXX Need signature and unit forms and class + ; XXX @module form that checks if all exports are documented + ; XXX formatlambda, caselambda, defproc-case + ; XXX Copyright + ; XXX email and href links + ; XXX last updated + ; XXX multiple tags + ; XXX @require + ; XXX editting mode drscheme or emacs + + ; XXX Make look good + (define (author x) + (elem (hspace 4) + (bold x))) (provide (all-from (lib "manual.ss" "scribble")) - (all-from (lib "eval.ss" "scribble")))) \ No newline at end of file + (all-from (lib "eval.ss" "scribble")) + author)) \ No newline at end of file diff --git a/collects/web-server/private/closure.ss b/collects/web-server/private/closure.ss index 63a72f6deb..41b01484fb 100644 --- a/collects/web-server/private/closure.ss +++ b/collects/web-server/private/closure.ss @@ -7,8 +7,6 @@ (provide make-closure-definition-syntax closure->deserialize-name) - (define myprint printf) - (define (closure->deserialize-name proc) (cdr (first (second (serialize proc))))) diff --git a/collects/web-server/private/dispatch-server-unit.ss b/collects/web-server/private/dispatch-server-unit.ss index 0ff0e9e1dc..692cfb56b6 100644 --- a/collects/web-server/private/dispatch-server-unit.ss +++ b/collects/web-server/private/dispatch-server-unit.ss @@ -6,70 +6,70 @@ (require "web-server-structs.ss" "connection-manager.ss" "dispatch-server-sig.ss") - + ;; **************************************** (import tcp^ (prefix config: dispatch-server-config^)) (export dispatch-server^) - ;; serve: -> -> void - ;; start the server and return a thunk to shut it down - (define (serve) - (define the-server-custodian (make-custodian)) - (start-connection-manager the-server-custodian) - (parameterize ([current-custodian the-server-custodian] - [current-server-custodian the-server-custodian] - [current-thread-initial-stack-size 3]) - (thread - (lambda () - (run-server config:port - handle-connection - #f - (lambda (exn) - #f) - (lambda (p mw re) - (tcp-listen p config:max-waiting #t config:listen-ip)) - tcp-close - tcp-accept - tcp-accept/enable-break)))) - (lambda () - (custodian-shutdown-all the-server-custodian))) - - ;; serve-ports : input-port output-port -> void - ;; returns immediately, spawning a thread to handle - ;; the connection - ;; NOTE: (GregP) should allow the user to pass in a connection-custodian - (define (serve-ports ip op) - (define server-cust (make-custodian)) - (start-connection-manager server-cust) - (parameterize ([current-custodian server-cust] - [current-server-custodian server-cust]) - (define connection-cust (make-custodian)) - (parameterize ([current-custodian connection-cust]) - (thread - (lambda () - (handle-connection ip op - (lambda (ip) - (values "127.0.0.1" - "127.0.0.1")))))))) - - ;; handle-connection : input-port output-port (input-port -> string string) -> void - ;; returns immediately, spawning a thread to handle - (define/kw (handle-connection ip op - #:optional - [port-addresses tcp-addresses]) - (define conn - (new-connection config:initial-connection-timeout - ip op (current-custodian) #f)) - (with-handlers ([exn:fail:network? - (lambda (e) - (kill-connection! conn) - (raise e))]) - (let connection-loop () - (define-values (req close?) (config:read-request conn config:port port-addresses)) - (adjust-connection-timeout! conn config:initial-connection-timeout) - (config:dispatch conn req) - (unless (connection-close? conn) - (set-connection-close?! conn close?)) - (cond - [(connection-close? conn) (kill-connection! conn)] - [else (connection-loop)]))))) \ No newline at end of file + ;; serve: -> -> void + ;; start the server and return a thunk to shut it down + (define (serve) + (define the-server-custodian (make-custodian)) + (start-connection-manager the-server-custodian) + (parameterize ([current-custodian the-server-custodian] + [current-server-custodian the-server-custodian] + [current-thread-initial-stack-size 3]) + (thread + (lambda () + (run-server config:port + handle-connection + #f + (lambda (exn) + #f) + (lambda (p mw re) + (tcp-listen p config:max-waiting #t config:listen-ip)) + tcp-close + tcp-accept + tcp-accept/enable-break)))) + (lambda () + (custodian-shutdown-all the-server-custodian))) + + ;; serve-ports : input-port output-port -> void + ;; returns immediately, spawning a thread to handle + ;; the connection + ;; NOTE: (GregP) should allow the user to pass in a connection-custodian + (define (serve-ports ip op) + (define server-cust (make-custodian)) + (start-connection-manager server-cust) + (parameterize ([current-custodian server-cust] + [current-server-custodian server-cust]) + (define connection-cust (make-custodian)) + (parameterize ([current-custodian connection-cust]) + (thread + (lambda () + (handle-connection ip op + (lambda (ip) + (values "127.0.0.1" + "127.0.0.1")))))))) + + ;; handle-connection : input-port output-port (input-port -> string string) -> void + ;; returns immediately, spawning a thread to handle + (define/kw (handle-connection ip op + #:optional + [port-addresses tcp-addresses]) + (define conn + (new-connection config:initial-connection-timeout + ip op (current-custodian) #f)) + (with-handlers ([exn:fail:network? + (lambda (e) + (kill-connection! conn) + (raise e))]) + (let connection-loop () + (define-values (req close?) (config:read-request conn config:port port-addresses)) + (adjust-connection-timeout! conn config:initial-connection-timeout) + (config:dispatch conn req) + (unless (connection-close? conn) + (set-connection-close?! conn close?)) + (cond + [(connection-close? conn) (kill-connection! conn)] + [else (connection-loop)]))))) \ No newline at end of file diff --git a/collects/web-server/private/url-param.ss b/collects/web-server/private/url-param.ss index 195cfab2bc..37d4bc4242 100644 --- a/collects/web-server/private/url-param.ss +++ b/collects/web-server/private/url-param.ss @@ -4,7 +4,7 @@ (lib "plt-match.ss") (lib "list.ss") "util.ss") - + ; XXX Use instead of embed-ids (provide/contract [extract-param (url? string? . -> . (or/c string? false/c))] [insert-param (url? string? string? . -> . url?)]) diff --git a/collects/web-server/private/util.ss b/collects/web-server/private/util.ss index 3970937a3f..bec8ea787a 100644 --- a/collects/web-server/private/util.ss +++ b/collects/web-server/private/util.ss @@ -5,9 +5,8 @@ (lib "string.ss") (lib "serialize.ss") (lib "url.ss" "net")) - (provide - url-replace-path) (provide/contract + [url-replace-path ((list? . -> . list?) url? . -> . url?)] [explode-path* (path? . -> . (listof (or/c symbol? path?)))] [path-without-base (path? path? . -> . list?)] [list-prefix (list? list? . -> . (or/c list? false/c))] @@ -15,6 +14,7 @@ [url-path->string ((listof (or/c string? path/param?)) . -> . string?)] [network-error ((symbol? string?) (listof any/c) . ->* . (void))] [directory-part (path? . -> . path?)] + ; XXX Eliminate use of this [lowercase-symbol! ((or/c string? bytes?) . -> . symbol?)] [exn->string ((or/c exn? any/c) . -> . string?)] [build-path-unless-absolute (path-string? path-string? . -> . path?)] @@ -52,6 +52,7 @@ ; list-prefix : list? list? -> (or/c list? false/c) ; Is l a prefix or r?, and what is that prefix? + ; XXX Do we need to return the prefix? isn't it ls? (define (list-prefix ls rs) (match ls [(list) @@ -67,7 +68,6 @@ #f)])])) ; path-without-base : path? path? -> (listof path-element?) - ; Expects paths in normal form (define (path-without-base base path) (define b (explode-path* base)) (define p (explode-path* path)) @@ -133,7 +133,7 @@ (define (lowercase-symbol! s) (let ([s (if (bytes? s) (bytes->string/utf-8 s) - s)]) + (string-copy s))]) (string-lowercase! s) (string->symbol s)))