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

Rearranging API

Browse Source 
svn: r6459
This commit is contained in:
Jay McCarthy 2007-06-02 02:30:22 +00:00
parent f4dd13bc5a
commit 3b71e57e3b
3 changed files with 16 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/web-server/configuration/configuration-table.ss
View File

@ -5,8 +5,10 @@
(require "configuration-table-structs.ss" (require "configuration-table-structs.ss"
"../servlet/bindings.ss") "../servlet/bindings.ss")
(provide/contract (provide/contract
[read-configuration-table (path-string? . -> . configuration-table?)]
[write-configuration-table (configuration-table? path-string? . -> . void)] [write-configuration-table (configuration-table? path-string? . -> . void)]
[parse-configuration-table (list? . -> . configuration-table?)]) [configuration-table->sexpr (configuration-table? . -> . list?)]
[sexpr->configuration-table (list? . -> . configuration-table?)])
(define (get-binding key bindings default) (define (get-binding key bindings default)
(first (get-binding* key bindings (list default)))) (first (get-binding* key bindings (list default))))
@ -15,8 +17,11 @@
(with-handlers ([exn? (lambda _ default)]) (with-handlers ([exn? (lambda _ default)])
(extract-binding/single key bindings))) (extract-binding/single key bindings)))
(define (read-configuration-table table-file-name)
(sexpr->configuration-table (call-with-input-file table-file-name read)))
; parse-configuration-table : tst -> configuration-table ; parse-configuration-table : tst -> configuration-table
(define (parse-configuration-table t) (define (sexpr->configuration-table t)
(define port (get-binding 'port t 80)) (define port (get-binding 'port t 80))
(define max-waiting (get-binding 'max-waiting t 40)) (define max-waiting (get-binding 'max-waiting t 40))
(define initial-connection-timeout (get-binding 'initial-connection-timeout t 30)) (define initial-connection-timeout (get-binding 'initial-connection-timeout t 30))
@ -78,10 +83,7 @@
mime-types mime-types
password-authentication))) password-authentication)))
; write-configuration-table : configuration-table path -> void (define (configuration-table->sexpr new)
; writes out the new configuration file
(define (write-configuration-table new configuration-path)
(define sexpr
`((port ,(configuration-table-port new)) `((port ,(configuration-table-port new))
(max-waiting ,(configuration-table-max-waiting new)) (max-waiting ,(configuration-table-max-waiting new))
(initial-connection-timeout ,(configuration-table-initial-connection-timeout new)) (initial-connection-timeout ,(configuration-table-initial-connection-timeout new))
@ -90,6 +92,11 @@
(virtual-host-table (virtual-host-table
. ,(map (lambda (h) (list (car h) (host-table->sexpr (cdr h)))) . ,(map (lambda (h) (list (car h) (host-table->sexpr (cdr h))))
(configuration-table-virtual-hosts new))))) (configuration-table-virtual-hosts new)))))
; write-configuration-table : configuration-table path -> void
; writes out the new configuration file
(define (write-configuration-table new configuration-path)
(define sexpr (configuration-table->sexpr new))
(call-with-output-file configuration-path (call-with-output-file configuration-path
(lambda (out) (pretty-print sexpr out)) (lambda (out) (pretty-print sexpr out))
'truncate)) 'truncate))

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

@ -694,7 +694,7 @@
; read-configuration : path -> configuration-table ; read-configuration : path -> configuration-table
(define (read-configuration configuration-path) (define (read-configuration configuration-path)
(parse-configuration-table (call-with-input-file configuration-path read))) (sexpr->configuration-table (call-with-input-file configuration-path read)))
; write-configuration : configuration-table path -> void ; write-configuration : configuration-table path -> void
; writes out the new configuration file and ; writes out the new configuration file and

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

@ -12,16 +12,11 @@
(provide configuration-table->web-config@ (provide configuration-table->web-config@
configuration-table-sexpr->web-config@) configuration-table-sexpr->web-config@)
(provide/contract (provide/contract
[read-configuration-table (path-string? . -> . configuration-table?)]
[default-configuration-table-path path?]) [default-configuration-table-path path?])
(define default-configuration-table-path (define default-configuration-table-path
(build-path (collection-path "web-server") "default-web-root" "configuration-table.ss")) (build-path (collection-path "web-server") "default-web-root" "configuration-table.ss"))
; 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 ; configuration-table->web-config@ : path -> configuration
(define/kw (configuration-table->web-config@ table-file-name (define/kw (configuration-table->web-config@ table-file-name
#:other-keys bct-keys) #:other-keys bct-keys)
@ -37,7 +32,7 @@
#:other-keys bct-keys) #:other-keys bct-keys)
(apply complete-configuration (apply complete-configuration
web-server-root web-server-root
(parse-configuration-table sexpr) (sexpr->configuration-table sexpr)
bct-keys)) bct-keys))
; : str configuration-table -> configuration ; : str configuration-table -> configuration