suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

defsignature and associated web-server doc changes

Browse Source 
svn: r7927
This commit is contained in:
Matthew Flatt 2007-12-08 16:16:46 +00:00
parent 70ecb11464
commit ebf4c453ea
13 changed files with 340 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/games/cards/doc.scrbl
View File

@ -5,7 +5,11 @@
@title{Virtual Playing Cards Library}
@defmodule[games/cards]
@defmodule[games/cards]{The @scheme[games/cards] module provides a
toolbox for creating cards games.}
@; ----------------------------------------------------------------------
@section{Creating Tables and Cards}
@defproc[(make-table [title string? "Cards"]
[w nonnegative-exact-integer? 7]
@ -45,6 +49,9 @@ card off one of the halves, randomly selecting one half or the
other. According to some mathematical theorem, 7 is a large enough
@scheme[n] to get a perfect shuffle.}
@; ----------------------------------------------------------------------
@section{Regions and Buttons}
@defstruct[region ([x real?]
[y real?]
[w (and/c real? (not/c negative?))]
@ -128,7 +135,8 @@ Returns a region like one made by @scheme[make-region], but the is
Gets the current callback that is installed via
@scheme[set-region-interaction-callback!].}
@; ----------------------------------------
@; ----------------------------------------------------------------------
@section{Table Methods}
@definterface[table<%> (frame%)]{
@ -357,7 +365,8 @@ Removes @scheme[card] from the table.}
@scheme[(lib "show-help.ss" "games")].}
}
@; ----------------------------------------
@; ----------------------------------------------------------------------
@section{Card Methods}
@definterface[card<%> ()]{

2
collects/scribble/decode.ss
View File

@ -175,7 +175,7 @@
[(part-collect-decl? (car l))
(loop (cdr l) next? keys (cons (part-collect-decl-element (car l)) colls) accum title tag-prefix tags style)]
[(part-tag-decl? (car l))
(loop (cdr l) next? keys colls accum title tag-prefix (cons (part-tag-decl-tag (car l)) tags) style)]
(loop (cdr l) next? keys colls accum title tag-prefix (append tags (list (part-tag-decl-tag (car l)))) style)]
[(and (pair? (cdr l))
(splice? (cadr l)))
(loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys colls accum title tag-prefix tags style)]

211
collects/scribble/manual.ss
View File

@ -303,6 +303,63 @@
;; ----------------------------------------
(define-struct sig (tagstr))
(define (definition-site name stx-id form?)
(let ([sig (current-signature)])
(if sig
(make-link-element (if form?
"schemesyntaxlink"
"schemevaluelink")
(list (schemefont (symbol->string name)))
`(,(if form? 'sig-form 'sig-val)
,(format "~a::~a" (sig-tagstr sig) name)))
(annote-exporting-library
(to-element (make-just-context name stx-id))))))
(define (id-to-tag id)
(add-signature-tag id #f))
(define (id-to-form-tag id)
(add-signature-tag id #t))
(define (add-signature-tag id form?)
(let ([sig (current-signature)])
(if sig
`(,(if form? 'sig-form 'sig-val)
,(format "~a::~a" (sig-tagstr sig) (syntax-e id)))
(if form?
(register-scheme-form-definition id)
(register-scheme-definition id #t)))))
(define current-signature (make-parameter #f))
(define-syntax-rule (sigelem sig elem)
(*sig-elem (quote-syntax sig) 'elem))
(define (*sig-elem sig elem)
(let ([s (to-element elem)]
[tag (format "~a::~a"
(register-scheme-form-definition sig #t)
elem)])
(make-delayed-element
(lambda (renderer sec ri)
(let* ([vtag `(sig-val ,tag)]
[stag `(sig-form ,tag)]
[sd (resolve-get/tentative sec ri stag)])
(list
(cond
[sd
(make-link-element "schemesyntaxlink" (list s) stag)]
[else
(make-link-element "schemevaluelink" (list s) vtag)]))))
(lambda () s)
(lambda () s))))
(provide sigelem)
;; ----------------------------------------
(provide method xmethod (rename-out [method ::]))
(define-syntax method
@ -316,7 +373,7 @@
(elem (method a b) " in " (scheme a))]))
(define (*method sym id)
(**method sym (register-scheme-definition id #t)))
(**method sym (id-to-tag id)))
(define (**method sym tag)
(make-element
@ -596,7 +653,7 @@
(define-syntax defthing
(syntax-rules ()
[(_ id result desc ...)
(*defthing (quote-syntax/loc id) 'id (quote-syntax result) (lambda () (list desc ...)))]))
(*defthing (quote-syntax/loc id) 'id #f (schemeblock0 result) (lambda () (list desc ...)))]))
(define-syntax defparam
(syntax-rules ()
[(_ id arg contract desc ...)
@ -782,7 +839,7 @@
(hspace 1)
(if first?
(let* ([mname (car prototype)]
[ctag (register-scheme-definition within-id #t)]
[ctag (id-to-tag within-id)]
[tag (method-tag ctag mname)]
[content (list (*method mname within-id))])
(if tag
@ -799,18 +856,14 @@
(syntax-e within-id)
libs
mname
(register-scheme-definition
within-id #t))))))
ctag)))))
tag)
(car content)))
(*method (car prototype) within-id))))]
[else
(if first?
(let ([tag (register-scheme-definition stx-id #t)]
[content (list
(annote-exporting-library
(to-element (make-just-context (car prototype)
stx-id))))])
(let ([tag (id-to-tag stx-id)]
[content (list (definition-site (car prototype) stx-id #f))])
(if tag
(make-toc-target-element
#f
@ -1015,11 +1068,10 @@
(apply string-append
(map symbol->string (cdar wrappers)))]
[tag
(register-scheme-definition
(id-to-tag
(datum->syntax stx-id
(string->symbol
name))
#t)])
name)))])
(if tag
(inner-make-target-element
#f
@ -1212,34 +1264,42 @@
fields field-contracts)))
(content-thunk))))
(define (*defthing stx-id name result-contract content-thunk)
(define (*defthing stx-id name form? result-contract content-thunk)
(define spacer (hspace 1))
(make-splice
(cons
(make-table
'boxed
(list
(list (make-flow
(list
(make-paragraph
(list (let ([tag (register-scheme-definition stx-id #t)]
[content (list (annote-exporting-library
(to-element (make-just-context name stx-id))))])
(if tag
(make-toc-target-element
#f
(list (make-index-element #f
content
tag
(list (symbol->string name))
content
(with-exporting-libraries
(lambda (libs)
(make-thing-index-desc name libs)))))
tag)
(car content)))
spacer ":" spacer
(to-element result-contract))))))))
(list
(make-flow
(make-table-if-necessary
"argcontract"
(list
(list (make-flow
(list
(make-paragraph
(list (let ([tag ((if form? id-to-form-tag id-to-tag) stx-id)]
[content (list (definition-site name stx-id form?))])
(if tag
(make-toc-target-element
#f
(list (make-index-element #f
content
tag
(list (symbol->string name))
content
(with-exporting-libraries
(lambda (libs)
(make-thing-index-desc name libs)))))
tag)
(car content)))
spacer ":" spacer))))
(make-flow
(list
(if (flow-element? result-contract)
result-contract
(make-paragraph (list result-contract))))))))))))
(content-thunk))))
(define (meta-symbol? s) (memq s '(... ...+ ?)))
@ -1282,13 +1342,13 @@
`(,x . ,(cdr form)))))))
(and kw-id
(eq? form (car forms))
(let ([tag (register-scheme-definition kw-id #t)]
[stag (register-scheme-form-definition kw-id)]
[content (list (annote-exporting-library
(to-element (make-just-context (if (pair? form)
(car form)
form)
kw-id))))])
(let ([tag (id-to-tag kw-id)]
[stag (id-to-form-tag kw-id)]
[content (list (definition-site (if (pair? form)
(car form)
form)
kw-id
#t))])
(if tag
(make-target-element
#f
@ -1660,7 +1720,7 @@
(list (make-flow
(list
(make-paragraph
(list (let ([tag (register-scheme-definition stx-id)]
(list (let ([tag (id-to-tag stx-id)]
[content (list (annote-exporting-library (to-element stx-id)))])
(if tag
((if whole-page?
@ -1871,10 +1931,11 @@
(if v
(cons (cls/intf-super v)
(cls/intf-intfs v))
null)))])
null)))]
[ctag (id-to-tag cname)])
(make-delayed-element
(lambda (r d ri)
(let loop ([search (get d ri (register-scheme-definition cname))])
(let loop ([search (get d ri ctag)])
(cond
[(null? search)
(make-element #f "<method not found>")]
@ -1903,4 +1964,64 @@
null))))
;; ----------------------------------------
(provide defsignature
defsignature/splice
signature-desc)
(define-syntax defsignature
(syntax-rules ()
[(_ name (super ...) body ...)
(*defsignature
(quote-syntax name)
(list (quote-syntax super) ...)
(lambda ()
(list body ...))
#t)]))
(define-syntax defsignature/splice
(syntax-rules ()
[(_ name (super ...) body ...)
(*defsignature
(quote-syntax name)
(list (quote-syntax super) ...)
(lambda ()
(list body ...))
#f)]))
(define-struct sig-desc (in))
(define (signature-desc . l)
(make-sig-desc l))
(define (*defsignature stx-id supers body-thunk indent?)
(*defthing stx-id (syntax-e stx-id) #t (make-element #f '("signature"))
(lambda ()
(let ([in (parameterize ([current-signature (make-sig
(id-to-form-tag stx-id))])
(body-thunk))])
(if indent?
(let-values ([(pre-body post-body)
(let loop ([in in][pre-accum null])
(cond
[(null? in) (values (reverse pre-accum) null)]
[(whitespace? (car in))
(loop (cdr in) (cons (car in)
pre-accum))]
[(sig-desc? (car in))
(loop (cdr in) (append (reverse (sig-desc-in (car in)))
pre-accum))]
[else
(values (reverse pre-accum) in)]))])
(append
pre-body
(list
(make-blockquote
"leftindent"
(flow-paragraphs
(decode-flow
post-body))))))
in)))))
;; ----------------------------------------
)

19
collects/setup/scribble.ss
View File

@ -234,7 +234,21 @@
[src-zo (let-values ([(base name dir?) (split-path (doc-src-file doc))])
(build-path base "compiled" (path-add-suffix name ".zo")))]
[renderer (make-renderer latex-dest doc)]
[can-run? ((can-build? only-dirs) doc)])
[can-run? ((can-build? only-dirs) doc)]
[aux-time (max
(file-or-directory-modify-seconds (build-path
(collection-path "scribble")
"compiled"
(path-add-suffix
(if latex-dest
"latex-render.ss"
"html-render.ss")
".zo"))
#f (lambda () -inf.0))
(file-or-directory-modify-seconds (build-path
(collection-path "scribble")
"scribble.css")
#f (lambda () +inf.0)))])
(let ([my-time (file-or-directory-modify-seconds out-file #f (lambda () -inf.0))]
[info-out-time (file-or-directory-modify-seconds info-out-file #f (lambda () #f))]
[info-in-time (file-or-directory-modify-seconds info-in-file #f (lambda () #f))]
@ -245,7 +259,8 @@
(or (not can-run?)
(my-time
. >= .
(file-or-directory-modify-seconds src-zo #f (lambda () +inf.0)))))])
(max aux-time
(file-or-directory-modify-seconds src-zo #f (lambda () +inf.0))))))])
(printf " [~a ~a]\n"
(if up-to-date? "Using" "Running")
(doc-src-file doc))

131
collects/web-server/docs/reference/dispatchers.scrbl
View File

@ -1,5 +1,22 @@
#lang scribble/doc
@require["../web-server.ss"]
@(require "../web-server.ss"
(for-syntax scheme/base))
@(define-syntax (a-dispatcher stx)
(syntax-case stx ()
[(_ lib-name lib-desc . rest)
;; This macro plays a standard trick for limiting the scope of
;; `require'd bindings: it puts the require and the scope of the
;; require into a macro, which introduces both together
#'(begin
(define-syntax-rule (intro)
((... ...)
(begin
(require (for-label lib-name))
(defmodule lib-name
"The " (schememodname lib-name) " module " lib-desc)
. rest)))
(intro))]))
@title[#:tag "dispatchers"
#:style 'toc]{Dispatchers}
@ -87,67 +104,62 @@ URLs to paths on the filesystem.
@; ------------------------------------------------------------
@section[#:tag "dispatch-sequencer.ss"]{Sequencing}
@require[(prefix-in seq: (for-label web-server/dispatchers/dispatch-sequencer))]
@filepath{dispatchers/dispatch-sequencer.ss} defines a dispatcher constructor
that invokes a sequence of dispatchers until one applies.
@a-dispatcher[web-server/dispatchers/dispatch-sequencer
@elem{defines a dispatcher constructor
that invokes a sequence of dispatchers until one applies.}]{
@defproc[(make (dispatcher dispatcher?) ...)
dispatcher?]{
Invokes each @scheme[dispatcher], invoking the next if the first
calls @scheme[next-dispatcher]. If no @scheme[dispatcher] applies,
then it calls @scheme[next-dispatcher] itself.
}
}}
@; XXX Kind of timeout that is proportional to bindings
@; ------------------------------------------------------------
@section[#:tag "dispatch-timeout.ss"]{Timeouts}
@require[(prefix-in timeout: (for-label web-server/dispatchers/dispatch-timeout))]
@filepath{dispatchers/dispatch-timeout.ss} defines a dispatcher constructor
that changes the timeout on the connection and calls the next
dispatcher.
@a-dispatcher[web-server/dispatchers/dispatch-timeout
@elem{defines a dispatcher constructor
that changes the timeout on the connection and calls the next
dispatcher.}]{
@defproc[(make [new-timeout integer?])
dispatcher?]{
Changes the timeout on the connection with @scheme[adjust-connection-timeout!]
called with @scheme[new-timeout].
}
}}
@; ------------------------------------------------------------
@section[#:tag "dispatch-lift.ss"]{Lifting Procedures}
@require[(prefix-in lift: (for-label web-server/dispatchers/dispatch-lift))]
@filepath{dispatchers/dispatch-lift.ss} defines:
@a-dispatcher[web-server/dispatchers/dispatch-lift
@elem{defines a dispatcher constructor.}]{
@defproc[(make (proc (request? . -> . response?)))
dispatcher?]{
Constructs a dispatcher that calls @scheme[proc] on the request
object, and outputs the response to the connection.
}
}}
@; XXX Change filtering to take predicate, rather than regexp
@; ------------------------------------------------------------
@section[#:tag "dispatch-filter.ss"]{Filtering Requests}
@require[(prefix-in filter: (for-label web-server/dispatchers/dispatch-filter))]
@filepath{dispatchers/dispatch-filter.ss} defines a dispatcher constructor
that calls an underlying dispatcher
with all requests that pass a predicate.
@a-dispatcher[web-server/dispatchers/dispatch-filter
@elem{defines a dispatcher constructor
that calls an underlying dispatcher
with all requests that pass a predicate.}]{
@defproc[(make (regex regexp?) (inner dispatcher?))
dispatcher?]{
Calls @scheme[inner] if the URL path of the request, converted to
a string, matches @scheme[regex]. Otherwise, calls @scheme[next-dispatcher].
}
}}
@; ------------------------------------------------------------
@section[#:tag "dispatch-pathprocedure.ss"]{Procedure Invocation upon Request}
@require[(prefix-in pathproc: (for-label web-server/dispatchers/dispatch-pathprocedure))]
@filepath{dispatchers/dispatch-pathprocedure.ss} defines a dispatcher constructor
for invoking a particular procedure when a request is given to a particular
URL path.
@a-dispatcher[web-server/dispatchers/dispatch-pathprocedure
@elem{defines a dispatcher constructor
for invoking a particular procedure when a request is given to a particular
URL path.}]{
@defproc[(make (path string?) (proc (request? . -> . response?)))
dispatcher?]{
@ -156,14 +168,13 @@ URL path.
}
This is used in the standard @web-server pipeline to provide
a URL that refreshes the password file, servlet cache, etc.
a URL that refreshes the password file, servlet cache, etc.}
@; ------------------------------------------------------------
@section[#:tag "dispatch-log.ss"]{Logging}
@require[(prefix-in log: (for-label web-server/dispatchers/dispatch-log))]
@filepath{dispatchers/dispatch-log.ss} defines a dispatcher constructor
for transparent logging of requests.
@a-dispatcher[web-server/dispatchers/dispatch-log
@elem{defines a dispatcher constructor
for transparent logging of requests.}]{
@defthing[format-req/c contract?]{
Equivalent to @scheme[(request? . -> . string?)].
@ -209,14 +220,13 @@ for transparent logging of requests.
dispatcher?]{
Logs requests to @scheme[log-path] by using @scheme[format] to format the requests.
Then invokes @scheme[next-dispatcher].
}
}}
@; ------------------------------------------------------------
@section[#:tag "dispatch-passwords.ss"]{Password Protection}
@require[(prefix-in passwords: (for-label web-server/dispatchers/dispatch-passwords))]
@filepath{dispatchers/dispatch-passwords.ss} defines a dispatcher constructor
that performs HTTP Basic authentication filtering.
@a-dispatcher[web-server/dispatchers/dispatch-passwords
@elem{defines a dispatcher constructor
that performs HTTP Basic authentication filtering.}]{
@defproc[(make [#:password-file password-file path-string? "passwords"]
[#:authentication-responder
@ -245,14 +255,13 @@ that performs HTTP Basic authentication filtering.
...)]
For example:
@schemeblock['(("secret stuff" "/secret(/.*)?" (bubba "bbq") (|Billy| "BoB")))]
}
}}
@; ------------------------------------------------------------
@section[#:tag "dispatch-host.ss"]{Virtual Hosts}
@require[(prefix-in host: (for-label web-server/dispatchers/dispatch-host))]
@filepath{dispatchers/dispatch-host.ss} defines a dispatcher constructor
that calls a different dispatcher based upon the host requested.
@a-dispatcher[web-server/dispatchers/dispatch-host
@elem{defines a dispatcher constructor
that calls a different dispatcher based upon the host requested.}]{
@defproc[(make (lookup-dispatcher (symbol? . -> . dispatcher?)))
dispatcher?]{
@ -260,14 +269,13 @@ that calls a different dispatcher based upon the host requested.
calls @scheme[lookup-dispatcher] with the host, and invokes the
returned dispatcher. If no host can be extracted, then @scheme['none]
is used.
}
}}
@; ------------------------------------------------------------
@section[#:tag "dispatch-files.ss"]{Serving Files}
@require[(prefix-in files: (for-label web-server/dispatchers/dispatch-files))]
@filepath{dispatchers/dispatch-files.ss} allows files to be served.
It defines a dispatcher construction procedure:
@a-dispatcher[web-server/dispatchers/dispatch-files
@elem{allows files to be served.
It defines a dispatcher construction procedure.}]{
@defproc[(make [#:url->path url->path url->path?]
[#:path->mime-type path->mime-type (path? . -> . bytes?) (lambda (path) TEXT/HTML-MIME-TYPE)]
@ -281,14 +289,13 @@ It defines a dispatcher construction procedure:
Type of the path. The file is then
streamed out the connection object.
This dispatcher supports HTTP Range GET requests and HEAD requests.}
This dispatcher supports HTTP Range GET requests and HEAD requests.}}
@; ------------------------------------------------------------
@section[#:tag "dispatch-servlets.ss"]{Serving Scheme Servlets}
@require[(prefix-in servlets: (for-label web-server/dispatchers/dispatch-servlets))]
@filepath{dispatchers/dispatch-servlets.ss} defines a dispatcher constructor
that runs servlets written in Scheme.
@a-dispatcher[web-server/dispatchers/dispatch-servlets
@elem{defines a dispatcher constructor
that runs servlets written in Scheme.}]{
@; XXX Remove config:scripts
@defproc[(make [config:scripts (box/c cache-table?)]
@ -324,14 +331,13 @@ that runs servlets written in Scheme.
used to format a response with the exception.
Servlets that do not specify timeouts are given timeouts according to @scheme[timeouts-default-servlet].
}
}}
@; ------------------------------------------------------------
@section[#:tag "dispatch-lang.ss"]{Serving Web Language Servlets}
@require[(prefix-in lang: (for-label web-server/dispatchers/dispatch-lang))]
@filepath{dispatchers/dispatch-lang.ss} defines a dispatcher constructor
that runs servlets written in the Web Language.
@a-dispatcher[web-server/dispatchers/dispatch-lang
@elem{defines a dispatcher constructor
that runs servlets written in the Web Language.}]{
@defproc[(make [#:url->path url->path url->path?]
[#:make-servlet-namespace make-servlet-namespace
@ -347,14 +353,13 @@ that runs servlets written in the Web Language.
with the exception. If it succeeds, then @scheme[start] export of the module is invoked.
If there is an error when a servlet is invoked, then @scheme[responders-servlet] is
used to format a response with the exception.
}
}}
@; ------------------------------------------------------------
@section[#:tag "dispatch-stat.ss"]{Statistics}
@require[(prefix-in stat: (for-label web-server/dispatchers/dispatch-stat))]
@filepath{dispatchers/dispatch-stat.ss} provides services related to performance
statistics.
@a-dispatcher[web-server/dispatchers/dispatch-stat
@elem{provides services related to performance
statistics.}]{
@defproc[(make-gc-thread [time integer?])
thread?]{
@ -364,4 +369,4 @@ statistics.
@defproc[(make)
dispatcher?]{
Returns a dispatcher that prints memory usage on every request.
}
}}

6
collects/web-server/docs/reference/dummy-language-servlet.ss Normal file
View File

@ -0,0 +1,6 @@
#lang scheme/base
(define start #f)
(provide (all-defined-out))

9
collects/web-server/docs/reference/dummy-servlet.ss Normal file
View File

@ -0,0 +1,9 @@
#lang scheme/base
(define interface-version #f)
(define timeout #f)
(define start #f)
(define manager #f)
(provide (all-defined-out))

1
collects/web-server/docs/reference/lang.scrbl
View File

@ -12,6 +12,7 @@ is different and what API is provided.
@; ------------------------------------------------------------
@section[#:tag "lang-servlets"]{Definition}
@require[(for-label "dummy-language-servlet.ss")] ; to give a binding context
A @defterm{Web language servlet} is a module written in the
@scheme[(lib "lang.ss" "web-server")] module language. It should provide

8
collects/web-server/docs/reference/managers.scrbl
View File

@ -46,17 +46,13 @@ the users and implementers of managers.
}
@defstruct[(exn:fail:servlet-manager:no-instance exn:fail)
([message string?]
[continuation-marks continuation-mark-set?]
[expiration-handler expiration-handler?])]{
([expiration-handler expiration-handler?])]{
This exception should be thrown by a manager when an instance is looked
up that does not exist.
}
@defstruct[(exn:fail:servlet-manager:no-continuation exn:fail)
([message string?]
[continuation-marks continuation-mark-set?]
[expiration-handler expiration-handler?])]{
([expiration-handler expiration-handler?])]{
This exception should be thrown by a manager when a continuation is
looked up that does not exist.
}

26
collects/web-server/docs/reference/private.scrbl
View File

@ -112,10 +112,14 @@ for doing this.
The @web-server is just a configuration of a dispatching server.
This dispatching server component is useful on its own.
@filepath{private/dispatch-server-sig.ss} defines the following signatures:
@subsection{Dispatching Server Signatures}
@defthing[dispatch-server^ signature?]{
The following identifiers:
@defmodule[web-server/private/dispatch-server-sig]
The @schememodname[web-server/private/dispatch-server-sig] module
provides two signatures.
@defsignature[dispatch-server^ ()]{
@defproc[(serve)
(-> void)]{
Runs and returns a shutdown procedure.
@ -127,8 +131,8 @@ This dispatching server component is useful on its own.
}
}
@defthing[dispatch-server-config^ signature?]{
The following identifiers:
@defsignature[dispatch-server-config^ ()]{
@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].}
@ -143,12 +147,18 @@ This dispatching server component is useful on its own.
@defthing[dispatch dispatcher?]{How to handle requests.}
}
@filepath{private/dispatch-server-unit.ss} provides the unit
which actually implements a dispatching server.
@subsection{Dispatching Server Unit}
@defmodule[web-server/private/dispatch-server-unit]
The @schememodname[web-server/private/dispatch-server-unit] module
provides the unit that actually implements a dispatching server.
@; XXX Talk about how threads and custodians are used.
@defthing[dispatch-server\@ (unit/c (tcp^ dispatch-server-config^) (dispatch-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.
}

23
collects/web-server/docs/reference/servlet.scrbl
View File

@ -12,6 +12,7 @@ of these servlets. This API is provided by @filepath{servlet.ss}.
@; ------------------------------------------------------------
@section[#:tag "module-servlets"]{Definition}
@require[(for-label "dummy-servlet.ss")] ; to give a binding context
A @defterm{servlet} is a module that provides the following:
@ -92,19 +93,17 @@ related to HTTP request data structures.
@defstruct[binding ([id bytes?])]{Represents a binding of @scheme[id].}
@defstruct[(binding:form binding) ([id bytes?]
[value bytes?])]{
@defstruct[(binding:form binding) ([value bytes?])]{
Represents a form binding of @scheme[id] to @scheme[value].
}
@defstruct[(binding:file binding) ([id bytes?]
[filename bytes?]
@defstruct[(binding:file binding) ([filename bytes?]
[content bytes?])]{
Represents the uploading of the file @scheme[filename] with the id @scheme[id]
and the content @scheme[content].
}
@defproc[(bindings-assq [id bytes?] [binds (listof binding?)])
@defproc[(bindings-assq [binds (listof binding?)])
(or/c false/c binding?)]{
Returns the binding with an id equal to @scheme[id] from @scheme[binds] or @scheme[#f].
}
@ -196,23 +195,13 @@ HTTP responses.
@; XXX Rename string? option
@defstruct[(response/full response/basic)
([code number?]
[message string?]
[seconds number?]
[mime bytes?]
[headers (listof header?)]
[body (listof (or/c string? bytes?))])]{
([body (listof (or/c string? bytes?))])]{
As with @scheme[response/basic], except with @scheme[body] as the response
body.
}
@defstruct[(response/incremental response/basic)
([code number?]
[message string?]
[seconds number?]
[mime bytes?]
[headers (listof header?)]
[generator ((() (listof (or/c bytes? string?)) . ->* . any) . -> . any)])]{
([generator ((() (listof (or/c bytes? string?)) . ->* . any) . -> . any)])]{
As with @scheme[response/basic], except with @scheme[generator] as a function that is
called to generate the response body, by being given an @scheme[output-response] function
that outputs the content it is called with.

20
collects/web-server/docs/reference/web-config-unit.scrbl
View File

@ -1,16 +1,21 @@
#lang scribble/doc
@require["../web-server.ss"]
@title[#:tag "web-config-unit.ss"
#:style 'toc]{Web Config Unit}
@title[#:tag "web-config-unit.ss"]{Web Config Unit}
@require[(for-label web-server/web-config-unit)]
@require[(for-label web-server/web-config-sig)]
The @web-server offers a unit-based approach to configuring the server.
@filepath{web-config-sig.ss} provides the signature
@defthing[web-config^ signature?] signature, which contains the following
identifiers:
@section{Configuration Signature}
@defmodule[web-server/web-config-sig]
@defsignature[web-config^ ()]{
@signature-desc{
Provides contains the following identifiers.
}
@defthing[max-waiting integer?]{
Passed to @scheme[tcp-accept].
@ -39,8 +44,11 @@ identifiers:
@defthing[make-servlet-namespace make-servlet-namespace?]{
Passed to @scheme[servlets:make].
}
}
@filepath{web-config-unit.ss} provides the following:
@section{Configuration Units}
@defmodule[web-server/web-config-unit]
@defproc[(configuration-table->web-config\@ [path path?]
[#:port port (or/c false/c port-number?) #f]

29
collects/web-server/docs/reference/web-server-unit.scrbl
View File

@ -1,15 +1,17 @@
#lang scribble/doc
@require["../web-server.ss"]
@title[#:tag "web-server-unit.ss"
#:style 'toc]{Web Server Unit}
@title[#:tag "web-server-unit.ss"]{Web Server Unit}
@require[(for-label web-server/web-server-sig)]
@require[(for-label web-server/web-server-unit)]
The @web-server offers a unit-based approach to running the server.
@filepath{web-server-sig.ss} provides the @defthing[web-server^ signature?] signature
with two elements:
@section{Signature}
@defmodule[web-server/web-server-sig]
@defsignature[web-server^ ()]{
@defproc[(serve) (-> void)]{
Runs the server and returns a procedure that shuts down the server.
@ -21,12 +23,20 @@ with two elements:
Serves a single connection represented by the ports @scheme[ip] and
@scheme[op].
}
}
@section{Unit}
@defmodule[web-server/web-server-unit]
@defthing[web-server\@ (unit/c (web-config^ tcp^)
(web-server^))]{
Uses the @scheme[web-config^] to construct a @scheme[dispatcher?]
function that sets up one virtual host dispatcher, for each virtual
host in the @scheme[web-config^], that sequences the following
operations:
@filepath{web-server-unit.ss} provides the @defthing[web-server\@ unit?] unit. It
imports a @scheme[web-config^] unit and a @scheme[tcp^] unit. It uses the
@scheme[web-config^] to construct a @scheme[dispatcher?] function that
sets up one virtual host dispatcher, for each virtual host in the @scheme[web-config^],
that sequences the following operations:
@itemize[
@item{Logs the incoming request with the given format to the given file}
@item{Performs HTTP Basic Authentication with the given password file}
@ -39,3 +49,4 @@ that sequences the following operations:
Using this @scheme[dispatcher?], it loads a dispatching server that provides @scheme[serve]
and @scheme[serve-ports] functions that operate as expected.
}