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