Introduced field lifetime to session

scheme/httpd/surflets/packages.scm

@@ -127,7 +127,7 @@
 	   get-sessions
 	   delete-session!
 	   instance-session-id
-	   session-adjust-timeout!
+           set-session-lifetime!
 	   adjust-timeout!
 	   session-alive?
 	   session-surflet-name

scheme/httpd/surflets/surflet-handler.scm

@@ -74,14 +74,16 @@
    ((string=? (file-name-extension path-string) ".scm")
     (obtain-lock *session-table-lock*)
     ;; no access to session table until new session-id is saved
-    (let ((session-id (generate-new-table-id *session-table*)))
+    (let ((session-id (generate-new-table-id *session-table*))
+          (lifetime (options-session-lifetime)))
       (table-set! *session-table* session-id
 		  (make-session path-string    ; used to make
 						; redirections to origin
 				 (make-integer-table) ; continuation table
 				 (make-lock)          ; continuation table lock
 				 (make-thread-safe-counter) ; continuation counter
-				 #f))	              ; session-data
+				 #f	              ; session-data
+                                 lifetime))
       (release-lock *session-table-lock*)
       (register-instance! session-id)
       
@@ -91,9 +93,7 @@
 	 (delete-session! session-id)
 	 (bad-gateway-error-response s-req path-string condition))
        (let ((surflet (get-surflet-rt-structure path-string surflet-path)))
-         (timeout-queue-register-session!
-          session-id
-          (+ (time) (options-session-lifetime)))
+         (timeout-queue-register-session! session-id (+ (time) lifetime))
 
 	 (reset
 	  (with-fatal-error-handler
@@ -141,8 +141,6 @@
                 (let ((session-id.time (queue-head *timeout-queue*)))
                   (if (<= (cdr session-id.time) now)
                       (let ((session-id (car session-id.time)))
-                        (debug "session-surveillance[~s]: killing" 
-                               session-id)
                         (table-set! *session-table* session-id #f)
                         (set! *timeout-queue* 
                               (queue-delete *timeout-queue* session-id))
@@ -348,9 +346,9 @@
 ;;; SESSION-ADJUST-TIMEOUT!
 ;; Resets time-to-die of session indicated by its SESSION-ID number.
 (define (session-adjust-timeout! session-id . maybe-time-to-live)
-  (really-session-adjust-timeout! 
+  (really-session-adjust-timeout!
    session-id 
-   (:optional maybe-time-to-live (options-session-lifetime))))
+   (:optional maybe-time-to-live (session-lifetime session-id))))
 
 (define (really-session-adjust-timeout! session-id time-to-live)
   (with-lock *session-table-lock*
@@ -366,10 +364,24 @@
 ;; Resets time-to-die of current session. The argument must be
 ;; optional as PLT does not have it.
 (define (adjust-timeout! . maybe-time-to-live)
-  (really-session-adjust-timeout! 
-   (instance-session-id) 
-   (:optional maybe-time-to-live
-	      (options-session-lifetime))))
+  (let ((session-id (instance-session-id)))
+    (really-session-adjust-timeout! 
+     session-id
+     (:optional maybe-time-to-live
+                (session-lifetime session-id)))))
+
+(define (session-lifetime session-id)
+  (let ((maybe-session (session-lookup session-id)))
+    (and maybe-session
+         (really-session-lifetime maybe-session))))
+
+(define (set-session-lifetime! session-id new-lifetime)
+  (let ((maybe-session (session-lookup session-id)))
+    (and maybe-session
+         (begin
+           (really-set-session-lifetime! maybe-session new-lifetime)
+           (session-adjust-timeout! session-id new-lifetime)))))
+       
 
 ;;; RESET-SESSION-TABLE!
 ;; Clears the *SESSION-TABLE* (locking)
@@ -631,15 +643,17 @@
 ;;; SESSION: session-table entry for every new request on a surflet page
 (define-record-type session :session
   (make-session surflet-name
-		 continuation-table continuation-table-lock
-		 continuation-counter
-		 session-data)
+                continuation-table continuation-table-lock
+                continuation-counter
+                session-data
+                lifetime)
   session?
   (surflet-name session-surflet-name)
   (continuation-table session-continuation-table)
   (continuation-table-lock session-continuation-table-lock)
   (continuation-counter session-continuation-counter)
-  (session-data session-session-data set-session-session-data!))
+  (session-data session-session-data set-session-session-data!)
+  (lifetime really-session-lifetime really-set-session-lifetime!))
 
 ;;; INSTANCE: Every request corresponds to an instance.
 (define-record-type instance :instance