Add surflet-path to options (needed by admin-surflets.scm)

scheme/httpd/surflets/packages.scm

@@ -116,6 +116,7 @@
 	   adjust-timeout!
 	   session-alive?
 	   session-surflet-name
+	   options-surflet-path
 	   options-session-lifetime
 	   options-cache-surflets?
            options-make-session-timeout-text)))
@@ -143,12 +144,15 @@
 
 (define-interface surflet-handler/options-interface
   (export make-surflet-options
+	  with-surflet-path
           with-session-lifetime
           with-cache-surflets?
           with-make-session-timeout-text
+	  options-surflet-path
           options-session-lifetime
 	  options-cache-surflets?
           options-make-session-timeout-text
+	  set-options-surflet-path!
 	  set-options-session-lifetime!
 	  set-options-cache-surflets?!
           set-options-make-session-timeout-text))
@@ -395,6 +399,7 @@
 	threads				;SLEEP
 	uri				;URI-PATH-LIST->PATH
 	with-locks			;WITH-LOCK
+;	inspect-exception		;WITH-INSPECTING-HANDLER
 	)
   (files surflet-handler))
 

scheme/httpd/surflets/surflet-handler.scm

@@ -39,25 +39,26 @@
 ;; (HTTP-)RESPONSE. SURFLET-PATH is a string pointing to the real
 ;; directory where the SUrflets are searched.
 (define (surflet-handler surflet-path . maybe-options)
-  (let-optionals maybe-options ((options (make-default-surflet-options)))
+  (let-optionals maybe-options 
+      ((options (with-surflet-path surflet-path (make-default-surflet-options))))
     (set-thread-fluid! *options* options)
     (spawn surveillance-thread)
     (lambda (path req)
       (if (pair? path)			; need at least one element
-          (let ((request-method (request-method req))
+	  (let ((request-method (request-method req))
-                (path-string (uri-path->uri path)))
+		(path-string (uri-path->uri path)))
-            (if (or (string=? request-method "GET")
+	    (if (or (string=? request-method "GET")
-                    (string=? request-method "POST"))
+		    (string=? request-method "POST"))
-                (make-input-response
+		(make-input-response
-                 (lambda (input-port)
+		 (lambda (input-port)
-                   (let ((s-req (make-surflet-request req input-port)))
+		   (let ((s-req (make-surflet-request req input-port)))
-                     (if (resume-url? path-string)
+		     (if (resume-url? path-string)
-                         (resume-url path-string surflet-path s-req)
+			 (resume-url path-string (options-surflet-path) s-req)
-                         (launch-new-session path-string surflet-path s-req)))))
+			 (launch-new-session path-string (options-surflet-path) s-req)))))
-                (make-error-response (status-code method-not-allowed) req 
+		(make-error-response (status-code method-not-allowed) req 
-                                     request-method)))
+				     request-method)))
-          (make-error-response (status-code bad-request) req 
+	  (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
@@ -84,6 +85,7 @@
 				      #f	                  ; session-data
 				      lifetime))
 	    (values session-id lifetime)))
+
       ;; no access to session table until new session-id is saved
       (register-instance! session-id)
       
@@ -117,6 +119,8 @@
 
 
 ;;; SESSION-SURVEILLANCE     
+(define *timeout-queue*)
+
 (define (timeout-queue-register-session! session-id timeout)
   (search-tree-set! *timeout-queue* (cons session-id timeout) 'ignore))
 
@@ -126,7 +130,6 @@
 (define (timeout-queue-adjust-session-timeout! session-id new-timeout)
   (search-tree-set! *timeout-queue* (cons session-id new-timeout) 'ignore))
 
-(define *timeout-queue*)
 
 (define (surveillance-thread)
   (set! *timeout-queue* (make-search-tree (lambda (p q) (eq? (car p) (car q)))
@@ -603,8 +606,10 @@
 
 ;;; OPTIONS: options for the surflet-handler
 (define-record-type surflet-options :suflet-options
-  (really-make-surflet-options cache-surflets? session-lifetime make-session-timeout-text)
+  (really-make-surflet-options surflet-path cache-surflets? 
+			       session-lifetime make-session-timeout-text)
   surflet-options?
+  (surflet-path surflet-options-surflet-path set-surflet-options-surflet-path!)
   (cache-surflets? surflet-options-cache-surflets? set-surflet-options-cache-surflets?!)
   ;; session lifetime is in seconds
   (session-lifetime surflet-options-session-lifetime set-surflet-options-session-lifetime!)
@@ -625,10 +630,13 @@
 
 ;; Constructor with defaults.
 (define (make-default-surflet-options)
-  (really-make-surflet-options #t 600 default-make-session-timeout-text))
+  (really-make-surflet-options #f #t 600 default-make-session-timeout-text))
 
 (define (copy-surflet-options options)
   (let ((new-options (make-default-surflet-options)))
+    (set-surflet-options-surflet-path!
+     new-options
+     (surflet-options-surflet-path options))
     (set-surflet-options-cache-surflets?!
      new-options
      (surflet-options-cache-surflets? options))
@@ -658,6 +666,9 @@
 	  (loop (transformer value options)
 		(cddr stuff))))))
 
+(define with-surflet-path 
+  (make-surflet-options-transformer
+   set-surflet-options-surflet-path!))
 (define with-cache-surflets?
   (make-surflet-options-transformer
    set-surflet-options-cache-surflets?!))
@@ -674,12 +685,16 @@
 (define (make-fluid-setter setter)
   (lambda (value)
     (setter (thread-fluid *options*) value)))
+(define options-surflet-path
+  (make-fluid-selector surflet-options-surflet-path))
 (define options-cache-surflets? 
   (make-fluid-selector surflet-options-cache-surflets?))
 (define options-session-lifetime 
   (make-fluid-selector surflet-options-session-lifetime))
 (define options-make-session-timeout-text
   (make-fluid-selector surflet-options-make-session-timeout-text))
+(define set-options-surflet-path!
+  (make-fluid-setter set-surflet-options-surflet-path!))
 (define set-options-cache-surflets?! 
   (make-fluid-setter set-surflet-options-cache-surflets?!))
 (define set-options-session-lifetime!