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 get-sessions
delete-session! delete-session!
instance-session-id instance-session-id
session-adjust-timeout! set-session-lifetime!
adjust-timeout! adjust-timeout!
session-alive? session-alive?
session-surflet-name session-surflet-name

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

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