+ longer standard instance lifetime

+ instance lifetime adjusted when new continuation is launched
+ GET-LOADED-PLUGINS and UNLOAD-PLUGIN
+ small bug fixes

scheme/httpd/surflets/surflet-handler.scm

@@ -2,7 +2,7 @@
 ;; Copyright Andreas Bernauer, 2002
 
 
-(define *debug* #f)
+(define *debug* #t)
 
 ;;; instance-table: entry for every new request on a servlet page
 (define-record-type instance :instance
@@ -31,7 +31,7 @@
 
 (define-record options
   (cache-plugins? #t)
-  (instance-lifetime 10))		; in seconds
+  (instance-lifetime 60))		; in seconds
 
 (define *options* (make-options))
 ;(define *options-lock* (make-lock))   ; currently unused
@@ -53,19 +53,19 @@
 	(let ((request-method (request:method req))
 	      (path-string (uri-path-list->path path)))
 	  (cond
-	   ((string=? path-string "profile") ; triggers profiling
-	    (http-syslog (syslog-level debug)
-			 "profiling: triggered in servlet-handler [~a]"
-			 (profile-space)) ; PROFILE
-	    (make-http-error-response http-status/accepted req "profiled"))
-	   ((string=? path-string "reset")	; triggers cache clearing
-	    (http-syslog (syslog-level debug)
-			 "servlet-handler: clearing plugin cache")
-	    (reset-plugin-cache!)
-	    (http-syslog (syslog-level debug)
-			 "servlet-handler: clearing instance table")
-	    (reset-instance-table!)
-	    (make-http-error-response http-status/accepted req "plugin cache cleared"))
+;	   ((string=? path-string "profile") ; triggers profiling
+;	    (http-syslog (syslog-level debug)
+;			 "profiling: triggered in servlet-handler [~a]"
+;			 (profile-space)) ; PROFILE
+;	    (make-http-error-response http-status/accepted req "profiled"))
+;	   ((string=? path-string "reset")	; triggers cache clearing
+;	    (http-syslog (syslog-level debug)
+;			 "servlet-handler: clearing plugin cache")
+;	    (reset-plugin-cache!)
+;	    (http-syslog (syslog-level debug)
+;			 "servlet-handler: clearing instance table")
+;	    (reset-instance-table!)
+;	    (make-http-error-response http-status/accepted req "plugin cache cleared"))
 	   ((or (string=? request-method "GET")
 ;		(string=? request-method "POST"))        ; do this at later time
 		)
@@ -117,7 +117,7 @@
   (lambda ()
     (let loop ((time-to-die time-to-die)
 	       (memo memo))
-      (format #t "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)
@@ -150,8 +150,16 @@
 	 (lambda (path-string req)
 	   (make-http-error-response
 	    http-status/bad-request req
-	    (format #f "The servlet does not accept any requests any more or your URL is illformed.<BR>
-You can try starting at the <A HREF=~a>beginning</a>."
+	    (format #f 
+		    "<br>
+<p>There may be several reasons, why your request was denied:
+<ul>
+<li>The servlet does not accept any requests any more.</li>
+<li>The servlet URL has timed out.</li>
+<li>You URL is illformed.</li>
+</ul>
+</p>
+<p>In any case, you may try to restart the servlet from the <a href=\"~a\">beginning</a></p>"
 		    (resume-url-servlet-name path-string)))))
 	(lookup-continuation-table
 	  (lambda (instance continuation-table continuation-id)
@@ -184,8 +192,9 @@ You can try starting at the <A HREF=~a>beginning</a>."
 (define (send/suspend response-maker)
   (shift return
 	 (let* ((instance-id (session-instance-id))
-		(instance (instance-lookup instance-id))
-		(continuations-table (instance-continuation-table instance))
+		(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)
@@ -196,8 +205,7 @@ You can try starting at the <A HREF=~a>beginning</a>."
 					       instance-id 
 					       continuation-counter
 					       continuation-id)))
-	       (response-maker new-url))))))
-	       
+		 (response-maker new-url)))))))
 
 (define (send/finish response)
   (instance-delete! (session-instance-id))
@@ -239,8 +247,7 @@ You can try starting at the <A HREF=~a>beginning</a>."
 		    (+ (time) 
 		       (options:instance-lifetime *options*)))
     (set-memo:new-memo memo new-memo)
-    ;; FIXME: We change instance entry's value. Do we need locking
-    ;; here?
+    ;; I don't think we need locking here. Do you agree?
     (set-instance-memo! instance new-memo)
     (set-memo:message memo 'adjust-timeout))
   (release-lock *instance-table-lock*))
@@ -252,6 +259,7 @@ You can try starting at the <A HREF=~a>beginning</a>."
      (decline))
    (lambda ()
      (obtain-lock *instance-table-lock*)
+     ;; notify instance killing
      (table-walk 
       (lambda (instance-id instance)
 	(memo-killed! (instance-memo instance)))
@@ -322,6 +330,22 @@ You can try starting at the <A HREF=~a>beginning</a>."
 		(load-plugin #t))))
 	(load-plugin #f))))
 
+(define (get-loaded-plugins)
+  (obtain-lock *plugin-table-lock*)
+  (let ((loaded-plugins '()))
+    (table-walk
+     (lambda (plugin-path rt-structure)
+       (set! loaded-plugins (cons plugin-path loaded-plugins)))
+     *plugin-table*)
+    (release-lock *plugin-table-lock*)
+    loaded-plugins))
+
+(define (unload-plugin plugin-name)
+  (obtain-lock *plugin-table-lock*)
+  (if (table-ref *plugin-table* plugin-name)
+      (table-set! *plugin-table* plugin-name #f))
+  (release-lock *plugin-table-lock*))
+
 (define (reset-plugin-cache!)
   (with-fatal-error-handler*
    (lambda (condition decline)
@@ -393,7 +417,10 @@ You can try starting at the <A HREF=~a>beginning</a>."
 ;; access to options
 
 (define (set-instance-lifetime! new-lifetime)
-  (set-options:instance-lifetime new-lifetime))
+  (set-options:instance-lifetime *options* new-lifetime))
+
+(define (get-instance-lifetime)
+  (options:instance-lifetime *options*))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; thread-safe counter