diff --git a/scheme/httpd/http-top.scm b/scheme/httpd/http-top.scm index 7990729..09995a4 100644 --- a/scheme/httpd/http-top.scm +++ b/scheme/httpd/http-top.scm @@ -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"))) diff --git a/scheme/httpd/options.scm b/scheme/httpd/options.scm index 5d3f5ea..bfcc95b 100644 --- a/scheme/httpd/options.scm +++ b/scheme/httpd/options.scm @@ -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))))))) - \ No newline at end of file +(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)))))) diff --git a/scheme/packages.scm b/scheme/packages.scm index 9870fbc..64bc02e 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -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