diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss index 6099ad5021..632e16f282 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add-param.ss @@ -3,6 +3,7 @@ (provide start interface-version) (define msg (make-parameter "unknown")) +(define printf void) (define (gn) (printf "gn ~a~n" (msg)) diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss index 8bcc653a5d..f416ee5866 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add-simple.ss @@ -3,6 +3,7 @@ (provide start interface-version) (define msg (make-web-parameter "unknown")) +(define printf void) (define (gn) (printf "gn ~a~n" (msg)) diff --git a/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss index eae0530e17..b6b1352909 100644 --- a/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss +++ b/collects/web-server/default-web-root/htdocs/lang-servlets/add.ss @@ -2,6 +2,8 @@ (define interface-version 'stateless) (provide start interface-version) +(define printf void) + ;; get-number-from-user: string -> number ;; ask the user for a number (define (get-number msg) diff --git a/collects/web-server/http/request.ss b/collects/web-server/http/request.ss index 8917ec1757..6a89746f4e 100644 --- a/collects/web-server/http/request.ss +++ b/collects/web-server/http/request.ss @@ -1,6 +1,5 @@ #lang scheme -(require mzlib/contract - mzlib/plt-match +(require mzlib/plt-match net/url mzlib/list net/uri-codec @@ -10,7 +9,11 @@ (provide/contract [rename ext:read-request read-request - ((connection? number? ((input-port?) . ->* . (string? string?))) . ->* . (request? boolean?))]) + (connection? + port-number? + (input-port? . -> . (values string? string?)) + . -> . + (values request? boolean?))]) (define (ext:read-request conn host-port port-addresses) (with-handlers ([exn? (lambda (exn) diff --git a/collects/web-server/lang.ss b/collects/web-server/lang.ss index 6fd66ca732..1ba70de28f 100644 --- a/collects/web-server/lang.ss +++ b/collects/web-server/lang.ss @@ -13,15 +13,15 @@ (provide (rename-out [lang-module-begin #%module-begin]) (all-from-out "lang/lang-api.ss")) +(define-for-syntax anormalize (make-anormal-term elim-letrec-term)) + (define-syntax lang-module-begin (make-lang-module-begin make-labeling (make-module-case/new-defs (make-define-case/new-defs - (compose #;(lambda (stx) (values stx empty)) - defun - elim-callcc - (make-anormal-term elim-letrec-term) - #;(make-anormal-term (lambda (x) x)) - #;elim-letrec-term - ))))) + (lambda (stx) + (define anf-stx (anormalize stx)) + (define no-callcc-stx (elim-callcc anf-stx)) + (define-values (defun-stx new-defs) (defun no-callcc-stx)) + (values defun-stx new-defs)))))) diff --git a/collects/web-server/lang/util.ss b/collects/web-server/lang/util.ss index 1894034ce7..af3afa7803 100644 --- a/collects/web-server/lang/util.ss +++ b/collects/web-server/lang/util.ss @@ -1,9 +1,21 @@ #lang scheme/base (require (for-template scheme/base) - syntax/kerncase - mzlib/pretty - mzlib/list) -(provide (all-defined-out)) + scheme/pretty + scheme/list + scheme/contract + syntax/kerncase) +(provide/contract + [transformer? (parameter/c boolean?)] + [recertify (syntax? syntax? . -> . syntax?)] + [recertify* (syntax? (listof syntax?) . -> . (listof syntax?))] + [recertify/new-defs (syntax? (-> (values syntax? (listof syntax?))) . -> . (values syntax? (listof syntax?)))] + [current-code-labeling (parameter/c (syntax? . -> . syntax?))] + [generate-formal ((symbol?) ((or/c false/c syntax?)) . ->* . (values syntax? syntax?))] + [formals-list (syntax? . -> . (listof syntax?))] + [make-define-case/new-defs ((syntax? . -> . (values syntax? (listof syntax?))) . -> . (syntax? . -> . (listof syntax?)))] + [make-module-case/new-defs ((syntax? . -> . (listof syntax?)) . -> . (syntax? . -> . (listof syntax?)))] + [make-lang-module-begin ((bytes? . -> . (-> symbol?)) (syntax? . -> . (listof syntax?)) . -> . (syntax? . -> . syntax?))] + [bound-identifier-member? (syntax? (listof syntax?) . -> . boolean?)]) (define transformer? (make-parameter #f)) diff --git a/collects/web-server/private/dispatch-server-sig.ss b/collects/web-server/private/dispatch-server-sig.ss index d2487f49bd..67346d6e3f 100644 --- a/collects/web-server/private/dispatch-server-sig.ss +++ b/collects/web-server/private/dispatch-server-sig.ss @@ -1,13 +1,26 @@ -#lang scheme/base -(require mzlib/unit) +#lang scheme +(require web-server/private/util + web-server/private/connection-manager) (define-signature dispatch-server^ - (serve - serve-ports)) + ((contracted + [serve (-> (-> void))] + [serve-ports (input-port? output-port? . -> . (-> void))]))) (define-signature dispatch-server-config^ - (port listen-ip max-waiting initial-connection-timeout - read-request dispatch)) + ((contracted + [port port-number?] + [listen-ip (or/c string? false/c)] + [max-waiting integer?] + [initial-connection-timeout integer?] + [read-request + (connection? + port-number? + (input-port? . -> . (values string? string?)) + . -> . + (values any/c boolean?))] + [dispatch + (-> connection? any/c void)]))) (provide dispatch-server^ dispatch-server-config^) diff --git a/collects/web-server/scribblings/private.scrbl b/collects/web-server/scribblings/private.scrbl index 44f3ec298a..6df3c4b026 100644 --- a/collects/web-server/scribblings/private.scrbl +++ b/collects/web-server/scribblings/private.scrbl @@ -147,21 +147,19 @@ The @scheme[dispatch-server^] signature is an alias for @defsignature[dispatch-server-config^ ()]{ - @defthing[port port?]{Specifies the port to serve on.} - @defthing[listen-ip string?]{Passed to @scheme[tcp-accept].} + @defthing[port port-number?]{Specifies the port to serve on.} + @defthing[listen-ip (or/c string? false/c)]{Passed to @scheme[tcp-listen].} @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? boolean? - (or/c (values string? string?) - (values string? (integer-in 1 65535) - string? (integer-in 1 65535))))]) - any/c]{ + [p port-number?] + [port-addresses + (input-port? . -> . (values string? string?))]) + (values any/c boolean?)]{ Defines the way the server reads requests off connections to be passed to @scheme[dispatch]. } - @defthing[dispatch dispatcher/c]{How to handle requests.} + @defthing[dispatch (-> connection? any/c void)]{How to handle requests.} } } @@ -173,8 +171,8 @@ The @scheme[dispatch-server^] signature is an alias for The @schememodname[web-server/private/dispatch-server-unit] module provides the unit that actually implements a dispatching server. -@defthing[dispatch-server@ (unit/c (tcp^ dispatch-server-config^) - (dispatch-server^))]{ +@defthing[dispatch-server@ (unit/c (import tcp^ dispatch-server-config^) + (export dispatch-server^))]{ Runs the dispatching server config in a very basic way, except that it uses @secref["connection-manager.ss"] to manage connections. } diff --git a/collects/web-server/scribblings/running.scrbl b/collects/web-server/scribblings/running.scrbl index b749364283..a1de7b68e0 100644 --- a/collects/web-server/scribblings/running.scrbl +++ b/collects/web-server/scribblings/running.scrbl @@ -99,7 +99,7 @@ of the @web-server in other applications, or loading a custom dispatcher. @defproc[(serve [#:dispatch dispatch dispatcher/c] - [#:tcp@ tcp@ tcp-unit^ raw:tcp@] + [#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@] [#:port port integer? 80] [#:listen-ip listen-ip (or/c string? false/c) #f] [#:max-waiting max-waiting integer? 40] @@ -127,7 +127,7 @@ from a given path: ] @defproc[(serve/ports [#:dispatch dispatch dispatcher/c] - [#:tcp@ tcp@ tcp-unit^ raw:tcp@] + [#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@] [#:ports ports (listof integer?) (list 80)] [#:listen-ip listen-ip (or/c string? false/c) #f] [#:max-waiting max-waiting integer? 40] @@ -138,7 +138,7 @@ from a given path: } @defproc[(serve/ips+ports [#:dispatch dispatch dispatcher/c] - [#:tcp@ tcp@ tcp-unit^ raw:tcp@] + [#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@] [#:ips+ports ips+ports (listof (cons/c (or/c string? false/c) (listof integer?))) (list (cons #f (list 80)))] [#:max-waiting max-waiting integer? 40] [#:initial-connection-timeout initial-connection-timeout integer? 60]) @@ -147,8 +147,8 @@ from a given path: a function that shuts down all of the server instances. } -@defproc[(serve/web-config@ [config@ web-config^] - [#:tcp@ tcp@ tcp-unit^ raw:tcp@]) +@defproc[(serve/web-config@ [config@ (unit/c (import) (export web-config^))] + [#:tcp@ tcp@ (unit/c (import) (export tcp^)) raw:tcp@]) (-> void)]{ Starts the @web-server with the settings defined by the given @scheme[web-config^] unit. diff --git a/collects/web-server/scribblings/web-config-unit.scrbl b/collects/web-server/scribblings/web-config-unit.scrbl index 76d050c98d..ea6ac8d626 100644 --- a/collects/web-server/scribblings/web-config-unit.scrbl +++ b/collects/web-server/scribblings/web-config-unit.scrbl @@ -31,7 +31,7 @@ Provides contains the following identifiers. Passed to @scheme[tcp-accept]. } -@defthing[virtual-hosts (listof (cons/c string? host-table?))]{ +@defthing[virtual-hosts (string? . -> . host?)]{ Contains the configuration of individual virtual hosts. } @@ -43,8 +43,8 @@ Provides contains the following identifiers. Specifies the port to serve HTTP on. } -@defthing[listen-ip string?]{ - Passed to @scheme[tcp-accept]. +@defthing[listen-ip (or/c false/c string?)]{ + Passed to @scheme[tcp-listen]. } @defthing[make-servlet-namespace make-servlet-namespace/c]{ @@ -62,7 +62,7 @@ Provides contains the following identifiers. [#:port port (or/c false/c port-number?) #f] [#:listen-ip listen-ip (or/c false/c string?) #f] [#:make-servlet-namespace make-servlet-namespace make-servlet-namespace/c (make-make-servlet-namespace)]) - (unit? web-config^)]{ + (unit/c (import) (export web-config^))]{ Reads the S-expression at @scheme[path] and calls @scheme[configuration-table-sexpr->web-config@] appropriately. } @@ -74,7 +74,7 @@ Provides contains the following identifiers. [#:listen-ip listen-ip (or/c false/c string?) #f] [#:make-servlet-namespace make-servlet-namespace make-servlet-namespace/c (make-make-servlet-namespace)]) - (unit? web-config^)]{ + (unit/c (import) (export web-config^))]{ Parses @scheme[sexpr] as a configuration-table and constructs a @scheme[web-config^] unit. } diff --git a/collects/web-server/web-config-sig.ss b/collects/web-server/web-config-sig.ss index 6ba8ea286f..497cd1e3a3 100644 --- a/collects/web-server/web-config-sig.ss +++ b/collects/web-server/web-config-sig.ss @@ -1,8 +1,17 @@ -#lang scheme/signature +#lang scheme +(require web-server/private/util + web-server/configuration/namespace + web-server/configuration/configuration-table-structs) -max-waiting -virtual-hosts -initial-connection-timeout -port -listen-ip -make-servlet-namespace +(provide + web-config^) + +(define-signature + web-config^ + ((contracted + [max-waiting integer?] + [virtual-hosts (string? . -> . host?)] + [initial-connection-timeout integer?] + [port port-number?] + [listen-ip (or/c false/c string?)] + [make-servlet-namespace make-servlet-namespace/c]))) \ No newline at end of file diff --git a/collects/web-server/web-config-unit.ss b/collects/web-server/web-config-unit.ss index f8c11d31cf..2b068fdd24 100644 --- a/collects/web-server/web-config-unit.ss +++ b/collects/web-server/web-config-unit.ss @@ -14,14 +14,14 @@ (#:port (or/c false/c number?) #:listen-ip (or/c false/c string?) #:make-servlet-namespace make-servlet-namespace/c) - unit?)] + (unit/c (import) (export web-config^)))] [configuration-table-sexpr->web-config@ (->* (configuration-table-sexpr?) (#:web-server-root path-string? #:port (or/c false/c number?) #:listen-ip (or/c false/c string?) #:make-servlet-namespace make-servlet-namespace/c) - unit?)]) + (unit/c (import) (export web-config^)))]) ; configuration-table->web-config@ : path -> configuration (define (configuration-table->web-config@ diff --git a/collects/web-server/web-server.ss b/collects/web-server/web-server.ss index 1491095d57..a12a43af6d 100644 --- a/collects/web-server/web-server.ss +++ b/collects/web-server/web-server.ss @@ -14,7 +14,7 @@ (provide/contract [serve (->* (#:dispatch dispatcher/c) - (#:tcp@ unit? + (#:tcp@ (unit/c (import) (export tcp^)) #:port number? #:listen-ip (or/c false/c string?) #:max-waiting number? @@ -22,7 +22,7 @@ (-> void))] [serve/ports (->* (#:dispatch dispatcher/c) - (#:tcp@ unit? + (#:tcp@ (unit/c (import) (export tcp^)) #:ports (listof number?) #:listen-ip (or/c false/c string?) #:max-waiting number? @@ -30,13 +30,13 @@ (-> void))] [serve/ips+ports (->* (#:dispatch dispatcher/c) - (#:tcp@ unit? + (#:tcp@ (unit/c (import) (export tcp^)) #:ips+ports (listof (cons/c (or/c false/c string?) (listof number?))) #:max-waiting number? #:initial-connection-timeout number?) (-> void))] [do-not-return (-> void)] - [serve/web-config@ ((unit?) (#:tcp@ unit?) . ->* . (-> void?))]) + [serve/web-config@ (((unit/c (import) (export web-config^))) (#:tcp@ (unit/c (import) (export tcp^))) . ->* . (-> void?))]) (define (do-not-return) (semaphore-wait (make-semaphore 0)))