sunet/scheme/httpd/options.scm

125 lines
4.6 KiB
Scheme
Raw Normal View History

;;; http server in the Scheme Shell -*- Scheme -*-
2002-08-27 05:03:22 -04:00
;;; This file is part of the Scheme Untergrund Networking package.
;;; Copyright (c) 2002 by Mike Sperber.
;;; For copyright information, see the file COPYING which comes with
;;; the distribution.
;;; This package manages options to the http server as an abstract
;;; data type.
(define-record-type httpd-options :httpd-options
(really-make-httpd-options port
root-directory
fqdn
reported-port
request-handler
server-admin
simultaneous-requests
log-file
syslog?
resolve-ips?)
httpd-options?
(port httpd-options-port
set-httpd-options-port!)
(root-directory httpd-options-root-directory
set-httpd-options-root-directory!)
(fqdn httpd-options-fqdn
set-httpd-options-fqdn!)
(reported-port httpd-options-reported-port
set-httpd-options-reported-port!)
(request-handler httpd-options-request-handler
set-httpd-options-request-handler!)
(server-admin httpd-options-server-admin
set-httpd-options-server-admin!)
(simultaneous-requests httpd-options-simultaneous-requests
set-httpd-options-simultaneous-requests!)
(log-file httpd-options-log-file set-httpd-options-log-file!)
(syslog? httpd-options-syslog? set-httpd-options-syslog?!)
(resolve-ips? httpd-options-resolve-ips? set-httpd-options-resolve-ips?!))
; default httpd-options generation
(define (make-default-httpd-options)
(really-make-httpd-options 80 ; port
"/" ; root-directory
#f ; fqdn
#f ; reported-port
#f ; request-handler
#f ; server-admin
#f ; simultaneous-requests
#f
; string: filename of log-file (directory must exist)
; output-port: log to this port (e.g. (current-error-port))
; #f: no logging
#t ; Do syslogging?
#t)) ; Write host names instead of IPs in log-files?
; creates a copy of a given httpd-option
(define (copy-httpd-options 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
(httpd-options-root-directory options))
(set-httpd-options-fqdn! new-options
(httpd-options-fqdn options))
(set-httpd-options-reported-port! new-options
(httpd-options-reported-port options))
(set-httpd-options-request-handler! new-options
(httpd-options-request-handler options))
(set-httpd-options-server-admin! new-options
(httpd-options-server-admin options))
(set-httpd-options-simultaneous-requests!
new-options
(httpd-options-simultaneous-requests options))
(set-httpd-options-log-file! new-options (httpd-options-log-file options))
(set-httpd-options-syslog?! new-options (httpd-options-syslog? options))
(set-httpd-options-resolve-ips?! new-options (httpd-options-resolve-ips? options))
new-options))
; (make-httpd-options-transformer set-option!) -> lambda (new-value [httpd-option])
; creates a transformer for httpd-options
; the returned procedure is called with the new value for the option
; and optionally with the httpd-option to change
(define (make-httpd-options-transformer set-option!)
(lambda (new-value . stuff)
(let ((new-options (if (not (null? stuff))
(copy-httpd-options (car stuff))
(make-default-httpd-options))))
(set-option! new-options new-value)
new-options)))
; several transformers for port, root-directory, etc.
(define with-port
(make-httpd-options-transformer set-httpd-options-port!))
(define with-root-directory
(make-httpd-options-transformer set-httpd-options-root-directory!))
(define with-fqdn
(make-httpd-options-transformer set-httpd-options-fqdn!))
(define with-reported-port
(make-httpd-options-transformer set-httpd-options-reported-port!))
(define with-request-handler
(make-httpd-options-transformer set-httpd-options-request-handler!))
(define with-server-admin
(make-httpd-options-transformer set-httpd-options-server-admin!))
(define with-simultaneous-requests
(make-httpd-options-transformer set-httpd-options-simultaneous-requests!))
(define with-log-file
(make-httpd-options-transformer set-httpd-options-log-file!))
(define with-syslog?
(make-httpd-options-transformer set-httpd-options-syslog?!))
(define with-resolve-ips?
(make-httpd-options-transformer set-httpd-options-resolve-ips?!))
(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))))))