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

up

Browse Source 
svn: r7827
This commit is contained in:
Jay McCarthy 2007-11-24 00:40:08 +00:00
parent d9a2d52490
commit 63aaa0ad0b
2 changed files with 48 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
collects/web-server/web-config-unit.ss
View File

@ -13,26 +13,36 @@
; configuration-table->web-config@ : path -> configuration
(define (configuration-table->web-config@
table-file-name
. bct-keys)
(apply configuration-table-sexpr->web-config@
(call-with-input-file table-file-name read)
#:web-server-root (directory-part table-file-name)
bct-keys))
#:port [port #f]
#:listen-ip [listen-ip #f]
#:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)])
(configuration-table-sexpr->web-config@
(call-with-input-file table-file-name read)
#:web-server-root (directory-part table-file-name)
#:port port
#:listen-ip listen-ip
#:make-servlet-namespace make-servlet-namespace))
; configuration-table-sexpr->web-config@ : string? sexp -> configuration
(define (configuration-table-sexpr->web-config@
sexpr
#:web-server-root [web-server-root (directory-part default-configuration-table-path)]
. bct-keys)
(apply complete-configuration
web-server-root
(sexpr->configuration-table sexpr)
bct-keys))
#:web-server-root [web-server-root (directory-part default-configuration-table-path)]
#:port [port #f]
#:listen-ip [listen-ip #f]
#:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)])
(complete-configuration
web-server-root
(sexpr->configuration-table sexpr)
#:port port
#:listen-ip listen-ip
#:make-servlet-namespace make-servlet-namespace))
; : str configuration-table -> configuration
(define (complete-configuration
base table
. bct-keys)
base table
#:port [port #f]
#:listen-ip [listen-ip #f]
#:make-servlet-namespace [make-servlet-namespace (make-make-servlet-namespace)])
(define default-host
(apply-default-functions-to-host-table
base (configuration-table-default-host table)))
@ -41,10 +51,12 @@
(list (regexp (string-append (car x) "(:[0-9]*)?"))
(apply-default-functions-to-host-table base (cdr x))))
(configuration-table-virtual-hosts table)))
(apply build-configuration
table
(gen-virtual-hosts expanded-virtual-host-table default-host)
bct-keys))
(build-configuration
table
(gen-virtual-hosts expanded-virtual-host-table default-host)
#:port port
#:listen-ip listen-ip
#:make-servlet-namespace make-servlet-namespace))
; : configuration-table host-table -> configuration
(define (build-configuration

25
collects/web-server/web-server.ss
View File

@ -42,26 +42,39 @@
(serve))
(define (serve/ports
#:dispatch dispatch
#:tcp@ [tcp@ raw:tcp@]
#:ports [ports (list 80)]
. serve-keys)
#:listen-ip [listen-ip #f]
#:max-waiting [max-waiting 40]
#:initial-connection-timeout [initial-connection-timeout 60])
(define shutdowns
(map (lambda (port)
(apply serve
(serve #:dispatch dispatch
#:tcp@ tcp@
#:port port
serve-keys))
#:listen-ip listen-ip
#:max-waiting max-waiting
#:initial-connection-timeout initial-connection-timeout))
ports))
(lambda ()
(for-each apply shutdowns)))
(define (serve/ips+ports
#:dispatch dispatch
#:tcp@ [tcp@ raw:tcp@]
#:ips+ports [ips+ports (list (cons #f (list 80)))]
. serve-keys)
#:max-waiting [max-waiting 40]
#:initial-connection-timeout [initial-connection-timeout 60])
(define shutdowns
(map (match-lambda
[(list-rest listen-ip ports)
(apply serve/ports
(serve #:dispatch dispatch
#:tcp@ tcp@
#:ports ports
serve-keys)])
#:listen-ip listen-ip
#:max-waiting max-waiting
#:initial-connection-timeout initial-connection-timeout)])
ips+ports))
(lambda ()
(for-each apply shutdowns)))