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

Re-implement session timeouts using a hash table mapping session ids 

to timeouts and let the surveillance thread walk the table to find
outdated surflets. The previous implementation was nothing but bogus.
This commit is contained in:
mainzelm 2006-08-02 15:23:32 +00:00
parent 8a2351a190
commit 28cd440b4e
1 changed files with 23 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -93,7 +93,7 @@
(delete-session! session-id) (delete-session! session-id)
(bad-surflet-error-response s-req path-string condition)) (bad-surflet-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! session-id (+ (time) lifetime)) (register-session-timeout! session-id (+ (time) lifetime))
(reset (reset
(with-fatal-error-handler (with-fatal-error-handler
@ -117,32 +117,32 @@
;;; SESSION-SURVEILLANCE ;;; SESSION-SURVEILLANCE
(define *timeout-queue*) (define *session-timeouts*)
(define (timeout-queue-register-session! session-id timeout) (define (register-session-timeout! session-id timeout)
(search-tree-set! *timeout-queue* session-id timeout)) (table-set! *session-timeouts* session-id timeout))
(define (timeout-queue-remove-session! session-id) (define (remove-session-timeout! session-id)
(search-tree-set! *timeout-queue* session-id #f)) (table-set! *session-timeouts* session-id #f))
(define (timeout-queue-adjust-session-timeout! session-id new-timeout)
(search-tree-set! *timeout-queue* session-id new-timeout))
(define (adjust-session-timeout! session-id new-timeout)
(table-set! *session-timeouts* session-id new-timeout))
(define (surveillance-thread) (define (surveillance-thread)
(set! *timeout-queue* (make-search-tree = <)) (set! *session-timeouts* (make-integer-table))
(let lp () (let lp ()
(with-lock *session-table-lock* (with-lock *session-table-lock*
(let ((now (time))) (let ((now (time))
(let lp2 () (dead-sessions '()))
(receive (session-id time) (search-tree-min *timeout-queue*) (table-walk (lambda (session-id timeout)
(if session-id (if (<= timeout now)
(if (<= time now) (set! dead-sessions (cons session-id dead-sessions))))
(begin *session-timeouts*)
(timeout-queue-remove-session! session-id) (for-each (lambda (session-id)
(pop-search-tree-min! *timeout-queue*) (remove-session-timeout! session-id)
(lp2)))))))) (table-set! *session-table* session-id #f))
(sleep 1000) dead-sessions)))
(sleep 10000)
(lp))) (lp)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -300,7 +300,7 @@
(let ((session (table-ref *session-table* session-id))) (let ((session (table-ref *session-table* session-id)))
(if session (if session
(begin (begin
(timeout-queue-remove-session! session-id) (remove-session-timeout! session-id)
(table-set! *session-table* session-id #f)) (table-set! *session-table* session-id #f))
;; else: somebody was faster than we ;; else: somebody was faster than we
)))) ))))
@ -318,7 +318,7 @@
(with-lock *session-table-lock* (with-lock *session-table-lock*
(let ((session (table-ref *session-table* session-id))) (let ((session (table-ref *session-table* session-id)))
(if session (if session
(timeout-queue-adjust-session-timeout! (adjust-session-timeout!
session-id session-id
(+ (time) time-to-live)) (+ (time) time-to-live))
(error "There is no session with this ID" session-id))))) (error "There is no session with this ID" session-id)))))
@ -358,7 +358,7 @@
;; notify session killing ;; notify session killing
(table-walk (table-walk
(lambda (session-id session) (lambda (session-id session)
(timeout-queue-remove-session! session-id)) (remove-session-timeout! session-id))
*session-table*) *session-table*)
(set! *session-table* (make-integer-table))))) (set! *session-table* (make-integer-table)))))