Added options for surflet-handler.

scheme/httpd/surflets/packages.scm

@@ -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?!))
 

scheme/httpd/surflets/surflet-handler.scm

@@ -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)
+(define (surflet-handler surflet-path . maybe-options)
-  (set-thread-fluid! *options* (make-default-options surflet-path))
+  (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
+(define-record-type surflet-options :suflet-options
-  (make-options surflet-path cache-surflets? session-lifetime)
+  (make-surflet-options cache-surflets? session-lifetime)
-  options?
+  surflet-options?
-  (surflet-path options:surflet-path set-options:surflet-path!)
+  (cache-surflets? surflet-options-cache-surflets? set-surflet-options-cache-surflets?!)
-  (cache-surflets? options:cache-surflets? set-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)
+(define (make-default-surflet-options)
-  (make-options surflet-path #t 600))
+  (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? 
-(define options-cache-surflets? (make-fluid-selector options:cache-surflets?))
+  (make-fluid-selector surflet-options-cache-surflets?))
-(define options-session-lifetime (make-fluid-selector options:session-lifetime))
+(define options-session-lifetime 
-(define set-options-cache-surflets?! (make-fluid-setter set-options:cache-surflets?!))
+  (make-fluid-selector surflet-options-session-lifetime))
-(define set-options-session-lifetime! (make-fluid-setter set-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.