scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Introduced field lifetime to session

This commit is contained in:
mainzelm 2003-03-31 10:56:28 +00:00
parent 1c6bfbc4ea
commit 61c3a4c216
2 changed files with 32 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/httpd/surflets/packages.scm
View File

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

38
scheme/httpd/surflets/surflet-handler.scm
View File

@ -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))
@ -350,7 +348,7 @@
(define (session-adjust-timeout! session-id . maybe-time-to-live)
(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)
(let ((session-id (instance-session-id)))
(really-session-adjust-timeout!
(instance-session-id)
session-id
(:optional maybe-time-to-live
(options-session-lifetime))))
(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)
@ -633,13 +645,15 @@
(make-session surflet-name
continuation-table continuation-table-lock
continuation-counter
session-data)
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