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

Standardizing names

Browse Source 
svn: r6418
This commit is contained in:
Jay McCarthy 2007-05-30 22:01:17 +00:00
parent 6ac2665af9
commit bec7331eae
9 changed files with 64 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/handin-server/web-status-server.ss
View File

@ -8,7 +8,7 @@
(lib "web-server-unit.ss" "web-server")
(lib "web-server-sig.ss" "web-server")
(lib "web-config-sig.ss" "web-server")
(lib "configuration.ss" "web-server")
(lib "web-config-unit.ss" "web-server")
(lib "namespace.ss" "web-server" "configuration")
"private/config.ss")
@ -58,7 +58,7 @@
(virtual-host-table)))
(define configuration
(load-configuration-sexpr
(configuration-table-sexpr->web-config@
config
#:web-server-root web-dir
#:make-servlet-namespace

4
collects/help/private/config.ss
View File

@ -1,6 +1,6 @@
(module config mzscheme
(require (lib "file.ss")
(lib "configuration.ss" "web-server")
(lib "web-config-unit.ss" "web-server")
(lib "dirs.ss" "setup")
(lib "config.ss" "planet")
"internal-hp.ss")
@ -42,7 +42,7 @@
(servlet-root ,servlet-root)
(mime-types "../../web-server/default-web-root/mime.types")
(password-authentication "passwords"))))])
(load-configuration-sexpr
(configuration-table-sexpr->web-config@
`((port ,internal-port)
(max-waiting 40)
(initial-connection-timeout 30)

39
collects/web-server/configuration.ss
View File

@ -1,39 +0,0 @@
(module configuration mzscheme
(require (lib "kw.ss")
(lib "contract.ss"))
(require "private/configuration.ss"
"private/configuration-table-structs.ss"
"private/util.ss"
"private/parse-table.ss"
"web-config-sig.ss")
(define default-configuration-table-path
(build-path (collection-path "web-server") "configuration-table"))
; get-configuration : path -> configuration-table
(define (get-configuration table-file-name)
(parse-configuration-table (call-with-input-file table-file-name read)))
; load-configuration : path -> configuration
(define/kw (load-configuration table-file-name
#:other-keys bct-keys)
(apply load-configuration-sexpr
(call-with-input-file table-file-name read)
#:web-server-root (directory-part table-file-name)
bct-keys))
; load-configuration-sexpr : string? sexp -> configuration
(define/kw (load-configuration-sexpr sexpr
#:key
[web-server-root (directory-part default-configuration-table-path)]
#:other-keys bct-keys)
(apply complete-configuration
web-server-root
(parse-configuration-table sexpr)
bct-keys))
(provide load-configuration
load-configuration-sexpr)
(provide/contract
[get-configuration (path-string? . -> . configuration-table?)]
[default-configuration-table-path path?]))

2
collects/web-server/private/configure.ss
View File

@ -5,7 +5,7 @@
(lib "list.ss")
(lib "pretty.ss")
(lib "file.ss")
(only (lib "configuration.ss" "web-server")
(only (lib "web-config-unit.ss" "web-server")
default-configuration-table-path)
(lib "configuration-table-structs.ss" "web-server" "private")
(lib "parse-table.ss" "web-server" "private")

22
collects/web-server/private/launch.ss
View File

@ -4,11 +4,11 @@
(lib "unit.ss")
(lib "tcp-sig.ss" "net"))
(require "util.ss"
"../web-config-unit.ss"
"../web-config-sig.ss"
"../web-server-unit.ss"
"../web-server-sig.ss"
"../configuration.ss")
"../web-server-sig.ss")
(define configuration@
(parse-command-line
"web-server"
@ -17,11 +17,11 @@
[("-f" "--configuration-table")
,(lambda (flag file-name)
(cond
[(not (file-exists? file-name))
(error 'web-server "configuration file ~s not found" file-name)]
[(not (memq 'read (file-or-directory-permissions file-name)))
(error 'web-server "configuration file ~s is not readable" file-name)]
[else (cons 'config (string->path file-name))]))
[(not (file-exists? file-name))
(error 'web-server "configuration file ~s not found" file-name)]
[(not (memq 'read (file-or-directory-permissions file-name)))
(error 'web-server "configuration file ~s is not readable" file-name)]
[else (cons 'config (string->path file-name))]))
("Use an alternate configuration table" "file-name")]
[("-p" "--port")
,(lambda (flag port)
@ -43,12 +43,12 @@
(error 'web-server "ip-address expects a numeric ip-address (i.e. 127.0.0.1); given ~s" ip-address))))
("Restrict access to come from ip-address" "ip-address")]))
(lambda (flags)
(load-configuration
(configuration-table->web-config@
(extract-flag 'config flags default-configuration-table-path)
#:port (extract-flag 'port flags #f)
#:listen-ip (extract-flag 'ip-address flags #f)))
'()))
(define-compound-unit launch@
(import (T : tcp^))
(export S)
@ -60,5 +60,5 @@
launch@
(import tcp^)
(export web-server^))
(provide serve))

4
collects/web-server/private/setup-launch.ss
View File

@ -2,7 +2,7 @@
(require (lib "cmdline.ss")
(lib "file.ss")
(lib "struct.ss"))
(require "../configuration.ss"
(require "../web-config-unit.ss"
"configuration-table-structs.ss"
"util.ss"
"configuration-util.ss")
@ -35,7 +35,7 @@
;; Write configuration-table into dest/configuration-table
(write-configuration-table
(copy-struct configuration-table
(get-configuration default-configuration-table-path)
(read-configuration-table default-configuration-table-path)
[configuration-table-port port])
(build-path dest "configuration-table"))))
'()))

6
collects/web-server/tools/servlet-env.ss
View File

@ -1,8 +1,8 @@
(module servlet-env mzscheme
(require (lib "sendurl.ss" "net")
(lib "unit.ss"))
(require "../configuration.ss"
"../web-server.ss"
(require "../web-server.ss"
"../web-config-unit.ss"
"../web-config-sig.ss"
"../private/util.ss"
"../response-structs.ss"
@ -54,7 +54,7 @@
final-value))
(define (build-standalone-servlet-configuration the-port the-path the-servlet)
(let ([basic-configuration@ (load-configuration default-configuration-table-path)]
(let ([basic-configuration@ (configuration-table->web-config@ default-configuration-table-path)]
[the-scripts (make-cache-table)])
(define-values/invoke-unit basic-configuration@
(import)

56
collects/web-server/private/configuration.ss → collects/web-server/web-config-unit.ss
View File

@ -1,12 +1,44 @@
(module configuration mzscheme
(module web-config-unit mzscheme
(require (lib "unit.ss")
(lib "kw.ss"))
(require "configuration-table-structs.ss"
"util.ss"
"cache-table.ss"
"../configuration/namespace.ss"
"../configuration/responders.ss"
"../web-config-sig.ss")
(lib "kw.ss")
(lib "contract.ss"))
(require "private/configuration-table-structs.ss"
"private/util.ss"
"private/cache-table.ss"
"private/parse-table.ss"
"configuration/namespace.ss"
"configuration/responders.ss"
"web-config-sig.ss")
(provide configuration-table->web-config@
configuration-table-sexpr->web-config@)
(provide/contract
[read-configuration-table (path-string? . -> . configuration-table?)]
[default-configuration-table-path path?])
(define default-configuration-table-path
(build-path (collection-path "web-server") "configuration-table"))
; read-configuration-table : path -> configuration-table
(define (read-configuration-table table-file-name)
(parse-configuration-table (call-with-input-file table-file-name read)))
; configuration-table->web-config@ : path -> configuration
(define/kw (configuration-table->web-config@ table-file-name
#:other-keys 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))
; configuration-table-sexpr->web-config@ : string? sexp -> configuration
(define/kw (configuration-table-sexpr->web-config@ sexpr
#:key
[web-server-root (directory-part default-configuration-table-path)]
#:other-keys bct-keys)
(apply complete-configuration
web-server-root
(parse-configuration-table sexpr)
bct-keys))
; : str configuration-table -> configuration
(define/kw (complete-configuration base table
@ -25,7 +57,7 @@
bct-keys))
(define default-make-servlet-namespace (make-make-servlet-namespace))
; : configuration-table host-table -> configuration
(define/kw (build-configuration table the-virtual-hosts
#:key
@ -47,7 +79,7 @@
(define instances (make-hash-table))
(define scripts (box (make-cache-table)))
(define make-servlet-namespace the-make-servlet-namespace)))
; apply-default-functions-to-host-table : str host-table -> host
;; Greg P: web-server-root is the directory-part of the path to the configuration-table (I don't think I like this.)
(define (apply-default-functions-to-host-table web-server-root host-table)
@ -94,6 +126,4 @@
(and (regexp-match (car x) host-name-possibly-followed-by-a-collon-and-a-port-number)
(cadr x)))
expanded-virtual-host-table)
default-host)))
(provide complete-configuration))
default-host))))

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

@ -10,7 +10,6 @@
"web-config-sig.ss"
"web-server-sig.ss"
"web-server-unit.ss"
"configuration.ss"
(prefix http: "private/request.ss"))
(provide
serve