+ longer instance lifetime

+ GET-INSTANCES returns all instances as an alist
+ let SEND/SUSPEND terminate correctly if instance has died in the meanwhile
  (may happen while administrating servlets)

scheme/httpd/surflets/surflet-handler.scm

@@ -21,6 +21,10 @@
   (value #f)
   (new-memo #f))
 
+;; caller must do locking stuff
+(define (memo-killed! memo)
+  (set-memo:message memo 'killed))
+
 (define-record-type session :session
   (make-session instance-id return-continuation)
   session?
@@ -31,7 +35,7 @@
 
 (define-record options
   (cache-plugins? #t)
-  (instance-lifetime 60))		; in seconds
+  (instance-lifetime 600))		; in seconds
 
 (define *options* (make-options))
 ;(define *options-lock* (make-lock))   ; currently unused
@@ -47,7 +51,8 @@
     (lambda ()
       (random-integer 1073741824))))	; I hope, 1+ billion is enough....
 
-(define (servlet-handler servlet-path)
+;; servlet-prefix gives virtual prefixed path to servlets
+(define (servlet-handler servlet-path servlet-prefix)
   (lambda (path req)
     (if (pair? path)			; need at least one element
 	(let ((request-method (request:method req))
@@ -69,9 +74,16 @@
 	   ((or (string=? request-method "GET")
 ;		(string=? request-method "POST"))        ; do this at later time
 		)
-	     (if (resume-url? path-string)
-		 (resume-url path-string servlet-path req)
-		 (launch-new-instance path-string servlet-path req)))
+	    (let ((response 
+		   (if (resume-url? path-string)
+		       (resume-url path-string servlet-path req)
+		       (launch-new-instance path-string servlet-path req))))
+	      (if (redirect-body? (response-body response))
+		  ;; prefix with servlet-path
+		  (make-redirect-response 
+		   (string-join (file-name-as-directory servlet-prefix)
+				(redirect-body-location (response-body response))))
+		  response)))
 	   (else
 	    (make-http-error-response http-status/method-not-allowed req 
 				      request-method))))
@@ -117,7 +129,7 @@
   (lambda ()
     (let loop ((time-to-die time-to-die)
 	       (memo memo))
-      (debug "instance-surveillance[~s]: going to sleep until ~a~%"
+      (debug "instance-surveillance[~s]: going to sleep until ~a"
 	     instance-id (format-date "~c" (date time-to-die)))
       (let ((seconds-to-sleep (- time-to-die (time))))
 	(if (positive? seconds-to-sleep)
@@ -125,22 +137,22 @@
       ;; check state of the world
       (case (memo:message memo)
 	((killed)			; too late
-	 (debug "instance-surveillance[~s]: instance already killed, dieing~%"
+	 (debug "instance-surveillance[~s]: instance already killed, dieing"
 		 instance-id)
 	 )
 	((adjust-timeout)		; new timeout
-	 (debug "instance-surveillance[~s]: adjusting timeout~%" instance-id)
+	 (debug "instance-surveillance[~s]: adjusting timeout" instance-id)
 	 (loop (memo:value memo) 
 	       (memo:new-memo memo)))
 	((kill)				; kill instance
-	 (debug "instance-surveillance[~s]: killing~%" 
+	 (debug "instance-surveillance[~s]: killing" 
 		 instance-id)
 	 (obtain-lock *instance-table-lock*)
 	 (table-set! *instance-table* instance-id #f)
 	 (release-lock *instance-table-lock*))
 	(else
 	 (format (current-error-port) 
-		 "instance-surveillance[~s]: unknown message ~s; dieing~%"
+		 "instance-surveillance[~s]: unknown message ~s; dieing"
 		 instance-id (memo:message memo)))))))
       
 
@@ -193,19 +205,24 @@
   (shift return
 	 (let* ((instance-id (session-instance-id))
 		(instance (instance-lookup instance-id)))
-	   (instance-adjust-timeout! instance-id)
-	   (let ((continuations-table (instance-continuation-table instance))
-		 (continuation-table-lock (instance-continuation-table-lock instance))
-		 (continuation-counter (instance-next-continuation-counter instance)))
-	     (obtain-lock continuation-table-lock)
-	     (let ((continuation-id (generate-new-table-id continuations-table)))
-	       (table-set! continuations-table continuation-id return)
-	       (release-lock continuation-table-lock)
-	       (let ((new-url (make-resume-url (instance-servlet-name instance)
-					       instance-id 
-					       continuation-counter
-					       continuation-id)))
-		 (response-maker new-url)))))))
+	   ;;  the session might be deleted in the meanwhile
+	   (if instance
+	       (begin
+		 (instance-adjust-timeout! instance-id)
+		 (let ((continuations-table (instance-continuation-table instance))
+		       (continuation-table-lock (instance-continuation-table-lock instance))
+		       (continuation-counter (instance-next-continuation-counter instance)))
+		   (obtain-lock continuation-table-lock)
+		   (let ((continuation-id (generate-new-table-id continuations-table)))
+		     (table-set! continuations-table continuation-id return)
+		     (release-lock continuation-table-lock)
+		     (let ((new-url (make-resume-url (instance-servlet-name instance)
+						     instance-id 
+						     continuation-counter
+						     continuation-id)))
+		       (response-maker new-url)))))
+	       (make-http-error-response http-status/not-found #f
+					 "The URL refers to a servlet, whose instance is no longer alive.")))))
 
 (define (send/finish response)
   (instance-delete! (session-instance-id))
@@ -267,10 +284,16 @@
      (set! *instance-table* (make-integer-table))
      (release-lock *instance-table*))))
 
-;; caller must do locking stuff
-(define (memo-killed! memo)
-  (set-memo:message memo 'killed))
-
+(define (get-instances)
+  (obtain-lock *instance-table-lock*)
+  (let ((instances '()))
+    (table-walk
+     (lambda (instance-id instance-entry)
+       (set! instances (cons (cons instance-id instance-entry) instances)))
+     *instance-table*)
+    (release-lock *instance-table-lock*)
+    instances))
+	
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ID generation  
@@ -311,7 +334,6 @@
 		       ;; only now the lock may be released
 		       (release-lock *plugin-table-lock*)))
 		 plugin-structure))))))
-
     (if (options:cache-plugins? *options*)
 	(begin
 	  ;; The lock is only obtained and released, if plugins are