Added options for surflet-handler.

This commit is contained in:
mainzelm 2003-03-17 10:17:55 +00:00
parent 573e980f33
commit 3de0a9c480
2 changed files with 58 additions and 32 deletions

View File

@ -143,7 +143,6 @@
(define-interface surflet-handler/options-interface
(export options-session-lifetime
options-cache-surflets?
options-surflet-path
set-options-session-lifetime!
set-options-cache-surflets?!))

View File

@ -38,8 +38,9 @@
;; Loads a new or resumes a suspended SUrflet; returns a
;; (HTTP-)RESPONSE. SURFLET-PATH is a string pointing to the real
;; directory where the SUrflets are searched.
(define (surflet-handler surflet-path)
(set-thread-fluid! *options* (make-default-options surflet-path))
(define (surflet-handler surflet-path . maybe-options)
(let-optionals maybe-options ((options (make-default-surflet-options)))
(set-thread-fluid! *options* options)
(lambda (path req)
(if (pair? path) ; need at least one element
(let ((request-method (request-method req))
@ -55,7 +56,7 @@
(make-error-response (status-code method-not-allowed) req
request-method)))
(make-error-response (status-code bad-request) req
(format #f "Bad path: ~s" path)))))
(format #f "Bad path: ~s" path))))))
;;; LAUNCH-NEW-SESSION
;; Loads and runs a new session of a SUrflet installing the RESET
@ -653,17 +654,40 @@
;;; OPTIONS: options for the surflet-handler
(define-record-type options :options
(make-options surflet-path cache-surflets? session-lifetime)
options?
(surflet-path options:surflet-path set-options:surflet-path!)
(cache-surflets? options:cache-surflets? set-options:cache-surflets?!)
(define-record-type surflet-options :suflet-options
(make-surflet-options cache-surflets? session-lifetime)
surflet-options?
(cache-surflets? surflet-options-cache-surflets? set-surflet-options-cache-surflets?!)
;; session lifetime is in seconds
(session-lifetime options:session-lifetime set-options:session-lifetime!))
(session-lifetime surflet-options-session-lifetime set-surflet-options-session-lifetime!))
;; Constructor with defaults.
(define (make-default-options surflet-path)
(make-options surflet-path #t 600))
(define (make-default-surflet-options)
(make-surflet-options #t 600))
(define (copy-surflet-options options)
(let ((new-options (make-default-surflet-options)))
(set-surflet-options-cache-surflets?!
new-options
(surflet-options-cache-surflets? options))
(set-surflet-options-session-lifetime!
new-options
(surflet-options-session-lifetime options))))
(define (make-surflet-options-transformer set-option!)
(lambda (new-value . stuff)
(let ((new-options (if (not (null? stuff))
(copy-surflet-options (car stuff))
(make-default-surflet-options))))
(set-option! new-options new-value)
new-options)))
(define with-cache-surflets?
(make-surflet-options-transformer
set-surflet-options-cache-surflets?!))
(define with-session-lifetime
(make-surflet-options-transformer
set-surflet-options-session-lifetime!))
;; Selectors for *options* (preserved-thread-fluid)
(define (make-fluid-selector selector)
@ -671,11 +695,14 @@
(define (make-fluid-setter setter)
(lambda (value)
(setter (thread-fluid *options*) value)))
(define options-surflet-path (make-fluid-selector options:surflet-path))
(define options-cache-surflets? (make-fluid-selector options:cache-surflets?))
(define options-session-lifetime (make-fluid-selector options:session-lifetime))
(define set-options-cache-surflets?! (make-fluid-setter set-options:cache-surflets?!))
(define set-options-session-lifetime! (make-fluid-setter set-options:session-lifetime!))
(define options-cache-surflets?
(make-fluid-selector surflet-options-cache-surflets?))
(define options-session-lifetime
(make-fluid-selector surflet-options-session-lifetime))
(define set-options-cache-surflets?!
(make-fluid-setter set-surflet-options-cache-surflets?!))
(define set-options-session-lifetime!
(make-fluid-setter set-surflet-options-session-lifetime!))
;;; SURFLET-RESPONSE: Surflets are expected to return this object type.