63 lines
2.6 KiB
Scheme
63 lines
2.6 KiB
Scheme
(module configuration-util mzscheme
|
|
(require (lib "contract.ss")
|
|
(lib "file.ss")
|
|
(lib "pretty.ss"))
|
|
(require "configuration-table-structs.ss")
|
|
|
|
; write-configuration-table : configuration-table path -> void
|
|
; writes out the new configuration file
|
|
(define (write-configuration-table new configuration-path)
|
|
(write-to-file
|
|
configuration-path
|
|
`((port ,(configuration-table-port new))
|
|
(max-waiting ,(configuration-table-max-waiting new))
|
|
(initial-connection-timeout ,(configuration-table-initial-connection-timeout new))
|
|
(default-host-table
|
|
,(format-host (configuration-table-default-host new)))
|
|
(virtual-host-table
|
|
. ,(map (lambda (h) (list (car h) (format-host (cdr h))))
|
|
(configuration-table-virtual-hosts new))))))
|
|
|
|
; format-host : host-table
|
|
(define (format-host host)
|
|
(let ([t (host-table-timeouts host)]
|
|
[p (host-table-paths host)]
|
|
[m (host-table-messages host)])
|
|
`(host-table
|
|
; more here - configure
|
|
(default-indices "index.html" "index.htm")
|
|
; more here - configure
|
|
(log-format parenthesized-default)
|
|
(messages
|
|
(servlet-message ,(messages-servlet m))
|
|
(authentication-message ,(messages-authentication m))
|
|
(servlets-refreshed ,(messages-servlets-refreshed m))
|
|
(passwords-refreshed ,(messages-passwords-refreshed m))
|
|
(file-not-found-message ,(messages-file-not-found m))
|
|
(protocol-message ,(messages-protocol m))
|
|
(collect-garbage ,(messages-collect-garbage m)))
|
|
(timeouts
|
|
(default-servlet-timeout ,(timeouts-default-servlet t))
|
|
(password-connection-timeout ,(timeouts-password t))
|
|
(servlet-connection-timeout ,(timeouts-servlet-connection t))
|
|
(file-per-byte-connection-timeout ,(timeouts-file-per-byte t))
|
|
(file-base-connection-timeout ,(timeouts-file-base t)))
|
|
(paths
|
|
(configuration-root ,(paths-conf p))
|
|
(host-root ,(paths-host-base p))
|
|
(log-file-path ,(paths-log p))
|
|
(file-root ,(paths-htdocs p))
|
|
(servlet-root ,(paths-servlet p))
|
|
(mime-types ,(paths-mime-types p))
|
|
(password-authentication ,(paths-passwords p))))))
|
|
|
|
; write-to-file : str TST -> void
|
|
(define (write-to-file file-name x)
|
|
(call-with-output-file file-name
|
|
(lambda (out) (pretty-print x out))
|
|
'truncate))
|
|
|
|
(provide/contract
|
|
[write-configuration-table (configuration-table? path-string? . -> . void)]
|
|
[format-host (host-table? . -> . list?)]
|
|
[write-to-file (path-string? list? . -> . void)])) |