156 lines
6.1 KiB
Scheme
156 lines
6.1 KiB
Scheme
;;; http server in the Scheme Shell -*- Scheme -*-
|
|
;;; Mike Sperber <sperber@informatik.uni-tuebingen.de>
|
|
|
|
;;; 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
|
|
icon-name
|
|
fqdn
|
|
reported-port
|
|
path-handler
|
|
server-admin
|
|
simultaneous-requests
|
|
logfile
|
|
syslog?
|
|
resolve-ips?)
|
|
httpd-options?
|
|
(port httpd-options-port
|
|
set-httpd-options-port!)
|
|
(root-directory httpd-options-root-directory
|
|
set-httpd-options-root-directory!)
|
|
;; ICON-NAME specifies how to generate the links to
|
|
;; various decorative icons for the listings. It can either be a
|
|
;; procedure which gets passed one of the icon tags in TAG->ICON and
|
|
;; is expected to return a link pointing to the icon. If it is a
|
|
;; string, that is taken as prefix to which the names from TAG->ICON
|
|
;; are appended.
|
|
(icon-name httpd-options-icon-name
|
|
set-httpd-options-icon-name!)
|
|
(fqdn httpd-options-fqdn
|
|
set-httpd-options-fqdn!)
|
|
(reported-port httpd-options-reported-port
|
|
set-httpd-options-reported-port!)
|
|
(path-handler httpd-options-path-handler
|
|
set-httpd-options-path-handler!)
|
|
(server-admin httpd-options-server-admin
|
|
set-httpd-options-server-admin!)
|
|
(simultaneous-requests httpd-options-simultaneous-requests
|
|
set-httpd-options-simultaneous-requests!)
|
|
(logfile httpd-options-logfile set-httpd-options-logfile!)
|
|
(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-httpd-options)
|
|
(really-make-httpd-options 80 ; port
|
|
"/" ; root-directory
|
|
#f ; icon-name
|
|
#f ; fqdn
|
|
#f ; reported-port
|
|
#f ; path-handler
|
|
#f ; server-admin
|
|
#f ; simultaneous-requests
|
|
#f
|
|
; string: filename of logfile (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 logfiles?
|
|
|
|
; creates a copy of a given httpd-option
|
|
|
|
(define (copy-httpd-options options)
|
|
(let ((new-options (make-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-icon-name! new-options
|
|
(httpd-options-icon-name 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-path-handler! new-options
|
|
(httpd-options-path-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-logfile! new-options (httpd-options-logfile 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-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-icon-name
|
|
(make-httpd-options-transformer set-httpd-options-icon-name!))
|
|
(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-path-handler
|
|
(make-httpd-options-transformer set-httpd-options-path-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-logfile
|
|
(make-httpd-options-transformer set-httpd-options-logfile!))
|
|
(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 (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)))))))
|
|
|