+ add option instance-lifetime along with some functions

+ add instance surveillance thread that kills instance after
  a period of time

scheme/httpd/surflets/packages.scm

@@ -93,7 +93,9 @@
 	httpd-logging			;HTTP-SYSLOG
 	shift-reset			;SHIFT and RESET
 	conditions			;exception
-	defrec-package			;define-record
+	defrec-package			;DEFINE-RECORD
+	threads				;SLEEP
+	thread-fluids			;FORK-THREAD
 	scsh				;regexp et al.
 	scheme
 	)

scheme/httpd/surflets/surflet-handler.scm

@@ -2,16 +2,25 @@
 ;; Copyright Andreas Bernauer, 2002
 
 
+(define *debug* #f)
+
 ;;; instance-table: entry for every new request on a servlet page
 (define-record-type instance :instance
-  (make-instance servlet-name continuation-table continuation-table-lock
+  (make-instance servlet-name memo 
+		 continuation-table continuation-table-lock
 		 continuation-counter)
   instance?
   (servlet-name instance-servlet-name)
+  (memo instance-memo set-instance-memo!)
   (continuation-table instance-continuation-table)
   (continuation-table-lock instance-continuation-table-lock)
   (continuation-counter instance-continuation-counter))
 
+(define-record memo
+  (message 'kill)			;kill, killed, adjust-timeout
+  (value #f)
+  (new-memo #f))
+
 (define-record-type session :session
   (make-session instance-id return-continuation)
   session?
@@ -21,7 +30,8 @@
 		       set-session-return-continuation!))
 
 (define-record options
-  (cache-plugins? #t))
+  (cache-plugins? #t)
+  (instance-lifetime 10))		; in seconds
 
 (define *options* (make-options))
 ;(define *options-lock* (make-lock))   ; currently unused
@@ -74,10 +84,12 @@
       (begin
 	(obtain-lock *instance-table-lock*)
 	;; no access to instance table until new instance-id is saved
-	(let ((instance-id (generate-new-table-id *instance-table*)))
+	(let ((instance-id (generate-new-table-id *instance-table*))
+	      (memo (make-memo)))
 	  (table-set! *instance-table* instance-id
 		      (make-instance path-string    ; used to make
 						  ; redirections to origin
+				     memo
 				     (make-integer-table) ; continuation table
 				     (make-lock)          ; continuation table lock
 				     (make-thread-safe-counter))) ; continuation counter
@@ -89,6 +101,10 @@
 			   (decline)) 
 			 (lambda () 
 			   (get-plugin-rt-structure path-string servlet-path)))))
+	    (fork-thread (instance-surveillance instance-id
+						(+ (time)
+						   (options:instance-lifetime *options*))
+						memo))
 	    (reset
 	     (begin
 	       (with-cwd
@@ -97,6 +113,37 @@
 		 plugin plugin-interface 
 		 (main req))))))))))
 
+(define (instance-surveillance instance-id time-to-die memo)
+  (lambda ()
+    (let loop ((time-to-die time-to-die)
+	       (memo memo))
+      (format #t "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)
+	    (sleep (* 1000 seconds-to-sleep))))
+      ;; check state of the world
+      (case (memo:message memo)
+	((killed)			; too late
+	 (debug "instance-surveillance[~s]: instance already killed, dieing~%"
+		 instance-id)
+	 )
+	((adjust-timeout)		; new timeout
+	 (debug "instance-surveillance[~s]: adjusting timeout~%" instance-id)
+	 (loop (memo:value memo) 
+	       (memo:new-memo memo)))
+	((kill)				; kill instance
+	 (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-id (memo:message memo)))))))
+      
+
 ;; try to get continuation-table and then the continuation
 (define resume-url
   (let ((bad-request 
@@ -132,7 +179,7 @@ You can try starting at the <A HREF=~a>beginning</a>."
 		    (bad-request path-string req)))
 	      (bad-request path-string req)))
 	))))
-    
+
 
 (define (send/suspend response-maker)
   (shift return
@@ -173,10 +220,49 @@ You can try starting at the <A HREF=~a>beginning</a>."
 
 (define (instance-delete! instance-id)
   (obtain-lock *instance-table-lock*)
+  ;; notify surveillance of instance being alread killed (prevents
+  ;; surveillance of killing new instance that has the same number by
+  ;; accident)
+  (let ((instance (table-ref *instance-table* instance-id)))
+    (memo-killed! (instance-memo instance)))
   ;; why can't table entries be deleted correctly?
   (table-set! *instance-table* instance-id #f)
   (release-lock *instance-table-lock*))
  
+(define (instance-adjust-timeout! instance-id)
+  (obtain-lock *instance-table-lock*)
+  (let* ((instance (table-ref *instance-table* instance-id))
+	 (memo (instance-memo instance))
+	 (new-memo (make-memo)))
+    ;; Do it this way: new values and then new message
+    (set-memo:value memo 
+		    (+ (time) 
+		       (options:instance-lifetime *options*)))
+    (set-memo:new-memo memo new-memo)
+    ;; FIXME: We change instance entry's value. Do we need locking
+    ;; here?
+    (set-instance-memo! instance new-memo)
+    (set-memo:message memo 'adjust-timeout))
+  (release-lock *instance-table-lock*))
+
+(define (reset-instance-table!)
+  (with-fatal-error-handler
+   (lambda (condtion decline)
+     (release-lock *instance-table-lock*)
+     (decline))
+   (lambda ()
+     (obtain-lock *instance-table-lock*)
+     (table-walk 
+      (lambda (instance-id instance)
+	(memo-killed! (instance-memo instance)))
+      *instance-table*)
+     (set! *instance-table* (make-integer-table))
+     (release-lock *instance-table*))))
+
+;; caller must do locking stuff
+(define (memo-killed! memo)
+  (set-memo:message memo 'killed))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ID generation  
@@ -246,16 +332,6 @@ You can try starting at the <A HREF=~a>beginning</a>."
      (set! *plugin-table* (make-string-table))
      (release-lock *plugin-table-lock*))))
 
-(define (reset-instance-table!)
-  (with-fatal-error-handler
-   (lambda (condtion decline)
-     (release-lock *instance-table-lock*)
-     (decline))
-   (lambda ()
-     (obtain-lock *instance-table-lock*)
-     (set! *instance-table* (make-integer-table))
-     (release-lock *instance-table*))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SESSION
 (define *session* (make-thread-cell #f))
@@ -313,6 +389,11 @@ You can try starting at the <A HREF=~a>beginning</a>."
 (define (resume-url? id-url)
   (regexp-search? *resume-url-regexp* id-url))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; access to options
+
+(define (set-instance-lifetime! new-lifetime)
+  (set-options:instance-lifetime new-lifetime))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; thread-safe counter
@@ -343,9 +424,7 @@ You can try starting at the <A HREF=~a>beginning</a>."
 
 
 
-
+(define (debug fmt . args)
-; instance-table thread safe
+  (if *debug*
-; continuation-table thread safe
+      (format #t "DEBUG: ~?~%" fmt args)
-; generate-new-instance-id only called if thread safe
+      (force-output)))
-; generate-new-continuation-id only called if thread safe
-; respect plugin timestamp