Add a MAKE-HTTPD-OPTIONS combinator for a more visually pleasant
layout for HTTPD-OPTIONS constructors.
This commit is contained in:
parent
3b298aadcc
commit
7460d8009f
|
@ -48,9 +48,7 @@
|
|||
(set-gid (->uid "nobody"))
|
||||
(set-uid (->gid "nobody"))
|
||||
(initialise-request-invariant-cgi-env)
|
||||
(httpd (with-path-handler
|
||||
ph
|
||||
(with-port
|
||||
8001
|
||||
(with-root-directory "/usr/local/etc/httpd/htdocs")))))
|
||||
(httpd (make-httpd-options with-path-handler ph
|
||||
with-port 8001
|
||||
with-root-directory "/usr/local/etc/httpd/htdocs")))
|
||||
|
||||
|
|
|
@ -44,7 +44,7 @@
|
|||
(resolve-ips? httpd-options-resolve-ips? set-httpd-options-resolve-ips?!))
|
||||
|
||||
; default httpd-options generation
|
||||
(define (make-httpd-options)
|
||||
(define (make-default-httpd-options)
|
||||
(really-make-httpd-options 80 ; port
|
||||
"/" ; root-directory
|
||||
#f ; icon-name
|
||||
|
@ -63,7 +63,7 @@
|
|||
; creates a copy of a given httpd-option
|
||||
|
||||
(define (copy-httpd-options options)
|
||||
(let ((new-options (make-httpd-options)))
|
||||
(let ((new-options (make-default-httpd-options)))
|
||||
(set-httpd-options-port! new-options
|
||||
(httpd-options-port options))
|
||||
(set-httpd-options-root-directory! new-options
|
||||
|
@ -94,7 +94,7 @@
|
|||
(lambda (new-value . stuff)
|
||||
(let ((new-options (if (not (null? stuff))
|
||||
(copy-httpd-options (car stuff))
|
||||
(make-httpd-options))))
|
||||
(make-default-httpd-options))))
|
||||
(set-option! new-options new-value)
|
||||
new-options)))
|
||||
|
||||
|
@ -122,35 +122,12 @@
|
|||
(define with-resolve-ips?
|
||||
(make-httpd-options-transformer set-httpd-options-resolve-ips?!))
|
||||
|
||||
;(define (with-httpd-options options-alist)
|
||||
; (let ((new-options (make-httpd-options)))
|
||||
; (let loop ((options-alist options-alist))
|
||||
; (if (null? options-alist)
|
||||
; new-options
|
||||
; (begin
|
||||
; (case (caar options-alist)
|
||||
; (('port)
|
||||
; (set-httpd-options-port! new-options (cdar options-alist)))
|
||||
; (('root-directory)
|
||||
; (set-httpd-options-root-directory! new-options (cdar options-alist)))
|
||||
; (('fqdn)
|
||||
; (set-httpd-options-fqdn! new-options (cdar options-alist)))
|
||||
; (('reported-port)
|
||||
; (set-httpd-options-reported-port! new-options (cdar options-alist)))
|
||||
; (('path-handler)
|
||||
; (set-httpd-options-path-handler! new-options (cdar options-alist)))
|
||||
; (('server-admin)
|
||||
; (set-httpd-options-server-admin! new-options (cdar options-alist)))
|
||||
; (('simultaneous-requests)
|
||||
; (set-httpd-options-simultaneous-requests! new-options (cdar options-alist)))
|
||||
; (('logfile)
|
||||
; (set-httpd-options-logfile! new-options (cdar options-alist)))
|
||||
; (('syslog?)
|
||||
; (set-httpd-options-syslog?! new-options (cdar options-alist)))
|
||||
; (else
|
||||
; (begin
|
||||
; (format (current-error-port)
|
||||
; "[httpd] Warning: Ignoring unknown option ~A."
|
||||
; (cdar options-alist)))))
|
||||
; (loop (cdr options-alist)))))))
|
||||
|
||||
(define (make-httpd-options . stuff)
|
||||
(let loop ((options (make-default-httpd-options))
|
||||
(stuff stuff))
|
||||
(if (null? stuff)
|
||||
options
|
||||
(let* ((transformer (car stuff))
|
||||
(value (cadr stuff)))
|
||||
(loop (transformer value options)
|
||||
(cddr stuff))))))
|
||||
|
|
|
@ -253,7 +253,8 @@
|
|||
time->http-date-string))
|
||||
|
||||
(define-interface httpd-make-options-interface
|
||||
(export with-port
|
||||
(export make-httpd-options
|
||||
with-port
|
||||
with-root-directory
|
||||
with-icon-name
|
||||
with-fqdn
|
||||
|
|
Loading…
Reference in New Issue