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

check existence of sessions in some locking areas

This commit is contained in:
interp 2003-03-10 13:10:29 +00:00
parent 64371c9941
commit 87a4165f94
1 changed files with 25 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -316,9 +316,11 @@
;; surveillance of killing new session that has the same number by
;; accident)
(let ((session (table-ref *session-table* session-id)))
(memo-killed! (session-memo session)))
;; why can't table entries be deleted correctly?
(table-set! *session-table* session-id #f)
(if session
(begin
(memo-killed! (session-memo session))
(table-set! *session-table* session-id #f))))
;; else: somebody was faster than we
(release-lock *session-table-lock*))
;;; SESSION-ADJUST-TIMEOUT!
@ -330,17 +332,21 @@
(define (really-session-adjust-timeout! session-id time-to-live)
(obtain-lock *session-table-lock*)
(let* ((session (table-ref *session-table* session-id))
(memo (session-memo session))
(new-memo (make-default-memo)))
;; Do it this way: new values and then new message
(set-memo:value memo
(+ (time) time-to-live))
(set-memo:new-memo memo new-memo)
;; I don't think we need locking here. Do you agree?
(set-session-memo! session new-memo)
(set-memo:message memo 'adjust-timeout))
(release-lock *session-table-lock*))
(let ((session (table-ref *session-table* session-id))
(new-memo (make-default-memo)))
(if session
(let ((memo (session-memo session)))
;; Do it this way: new values and then new message
(set-memo:value memo
(+ (time) time-to-live))
(set-memo:new-memo memo new-memo)
;; I don't think we need locking here. Do you agree?
(set-session-memo! session new-memo)
(set-memo:message memo 'adjust-timeout)
(release-lock *session-table-lock*))
(begin
(release-lock *session-table-lock*)
(error "There is no session with this ID" session-id)))))
;;; ADJUST-TIMEOUT!
;; Resets time-to-die of current session. The argument must be
@ -522,13 +528,13 @@
;;; RESET-SURFLET-CACHE!
;; Clears *SURFLET-TABLE* (locking).
(define (reset-surflet-cache!)
(with-fatal-handler
(lambda (condition decline)
(release-lock *surflet-table-lock*)
(decline))
; (with-fatal-handler
; (lambda (condition decline)
; (release-lock *surflet-table-lock*)
; (decline))
(obtain-lock *surflet-table-lock*)
(set! *surflet-table* (make-string-table))
(release-lock *surflet-table-lock*)))
(release-lock *surflet-table-lock*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; INSTANCE