81 lines
2.8 KiB
Scheme
81 lines
2.8 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
|
||
|
|
fqdn
|
||
|
|
reported-port
|
||
|
|
path-handler
|
||
|
|
server-admin
|
||
|
|
simultaneous-requests)
|
||
|
|
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!)
|
||
|
|
(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!))
|
||
|
|
|
||
|
|
(define (make-httpd-options)
|
||
|
|
(really-make-httpd-options 80 ; port
|
||
|
|
"/" ; root-directory
|
||
|
|
#f ; fqdn
|
||
|
|
#f ; reported-port
|
||
|
|
#f ; path-handler
|
||
|
|
"sperber@informatik.uni-tuebingen.de" ; server-admin
|
||
|
|
#f)) ; simultaneous-requests
|
||
|
|
|
||
|
|
(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-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))
|
||
|
|
new-options))
|
||
|
|
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
(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-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!))
|