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

pr8188

Browse Source 
svn: r4098
This commit is contained in:
Jay McCarthy 2006-08-20 01:06:57 +00:00
parent c8755092cf
commit 350bc2167c
3 changed files with 34 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/web-server/configuration-table
View File

@ -6,13 +6,20 @@
(default-indices "index.html" "index.htm") (default-indices "index.html" "index.htm")
(log-format parenthesized-default) (log-format parenthesized-default)
(messages (messages
(servlet-message "servlet-error.html") (servlet-message
(authentication-message "forbidden.html") "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/servlet-error.html")
(servlets-refreshed "servlet-refresh.html") (authentication-message
(passwords-refreshed "passwords-refresh.html") "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/forbidden.html")
(file-not-found-message "not-found.html") (servlets-refreshed
(protocol-message "protocol-error.html") "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/servlet-refresh.html")
(collect-garbage "collect-garbage.html")) (passwords-refreshed
"/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/passwords-refresh.html")
(file-not-found-message
"/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/not-found.html")
(protocol-message
"/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/protocol-error.html")
(collect-garbage
"/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/conf/collect-garbage.html"))
(timeouts (timeouts
(default-servlet-timeout 30) (default-servlet-timeout 30)
(password-connection-timeout 300) (password-connection-timeout 300)
@ -21,10 +28,16 @@
(file-base-connection-timeout 30)) (file-base-connection-timeout 30))
(paths (paths
(configuration-root "conf") (configuration-root "conf")
(host-root "default-web-root") (host-root
(log-file-path "log") "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root")
(file-root "htdocs") (log-file-path
(servlet-root ".") "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/log")
(mime-types "mime.types") (file-root
(password-authentication "passwords")))) "/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/htdocs")
(servlet-root
"/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/.")
(mime-types
"/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/mime.types")
(password-authentication
"/Users/jay/Development/plt/src/plt/trunk/collects/web-server/default-web-root/passwords"))))
(virtual-host-table)) (virtual-host-table))

4
collects/web-server/configuration-util.ss
View File

@ -58,6 +58,6 @@
'truncate)) 'truncate))
(provide/contract (provide/contract
[write-configuration-table (configuration-table? string? . -> . void)] [write-configuration-table (configuration-table? (or/c path? string?) . -> . void)]
[format-host (host-table? . -> . list?)] [format-host (host-table? . -> . list?)]
[write-to-file (string? list? . -> . void)])) [write-to-file ((or/c path? string?) list? . -> . void)]))

8
collects/web-server/configure.ss
View File

@ -395,6 +395,7 @@
(paths-log paths) (paths-log paths)
(paths-htdocs paths) (paths-htdocs paths)
(paths-servlet paths) (paths-servlet paths)
(paths-mime-types paths)
(paths-passwords paths))) (paths-passwords paths)))
; string->num : str -> nat ; string->num : str -> nat
@ -428,6 +429,8 @@
'path-htdocs (build-path-unless-absolute host-root (paths-htdocs paths))) 'path-htdocs (build-path-unless-absolute host-root (paths-htdocs paths)))
,(make-tr-str "Servlet root" ,(make-tr-str "Servlet root"
'path-servlet (build-path-unless-absolute host-root (paths-servlet paths))) 'path-servlet (build-path-unless-absolute host-root (paths-servlet paths)))
,(make-tr-str "MIME Types"
'path-mime-types (build-path-unless-absolute host-root (paths-mime-types paths)))
,(make-tr-str "Password File" ,(make-tr-str "Password File"
'path-password (build-path-unless-absolute host-root (paths-passwords paths))) 'path-password (build-path-unless-absolute host-root (paths-passwords paths)))
(tr (td ([colspan "2"]) (tr (td ([colspan "2"])
@ -481,8 +484,9 @@
(let ([old-paths (host-table-paths old)]) (let ([old-paths (host-table-paths old)])
(apply make-paths (apply make-paths
(paths-conf old-paths) (paths-conf old-paths)
((un-build-path web-base) (build-path (paths-host-base old-paths))) ((un-build-path web-base)
(map eb-host-root '(path-log path-htdocs path-servlet path-password))))))) (build-path (paths-host-base old-paths)))
(map eb-host-root '(path-log path-htdocs path-servlet path-mime-types path-password)))))))
; un-build-path : path -> path -> string ; un-build-path : path -> path -> string
; (GregP) Theory: this should return a string not a path so that the result can be ; (GregP) Theory: this should return a string not a path so that the result can be