use with-lock instead of obtain-lock/release-lock
This commit is contained in:
interp
parent
956fd7bbf1
commit
4b08eac262
|
|
@ -72,19 +72,19 @@
|
|||
(surflet-request-request s-req) path-string))
|
||||
|
||||
((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*))
|
||||
(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
|
||||
lifetime))
|
||||
(release-lock *session-table-lock*)
|
||||
(receive (session-id lifetime)
|
||||
(with-lock *session-table-lock*
|
||||
(let ((session-id (generate-new-table-id *session-table*))
|
||||
(lifetime (options-session-lifetime)))
|
||||
(table-set! *session-table* session-id
|
||||
(make-session path-string ; used for redirections
|
||||
(make-integer-table) ; continuation table
|
||||
(make-lock) ; continuation table lock
|
||||
(make-thread-safe-counter) ; continuation counter
|
||||
#f ; session-data
|
||||
lifetime))
|
||||
(values session-id lifetime)))
|
||||
;; no access to session table until new session-id is saved
|
||||
(register-instance! session-id)
|
||||
|
||||
(with-fatal-error-handler
|
||||
|
|
@ -93,7 +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) lifetime))
|
||||
(timeout-queue-register-session! session-id (+ (time) lifetime))
|
||||
|
||||
(reset
|
||||
(with-fatal-error-handler
|
||||
|
|
@ -163,10 +163,8 @@
|
|||
(lookup-continuation-table
|
||||
(lambda (session continuation-table continuation-id)
|
||||
(let ((continuation-table-lock (session-continuation-table-lock session)))
|
||||
(obtain-lock continuation-table-lock)
|
||||
(let ((result (table-ref continuation-table continuation-id)))
|
||||
(release-lock continuation-table-lock)
|
||||
result)))))
|
||||
(with-lock continuation-table-lock
|
||||
(table-ref continuation-table continuation-id))))))
|
||||
|
||||
(lambda (path-string surflet-path s-req)
|
||||
(receive (session-id continuation-id)
|
||||
|
|
@ -208,10 +206,11 @@
|
|||
(let ((continuations-table (session-continuation-table session))
|
||||
(continuation-table-lock (session-continuation-table-lock session))
|
||||
(continuation-counter (session-next-continuation-counter session)))
|
||||
(obtain-lock continuation-table-lock)
|
||||
(let ((continuation-id (generate-new-table-id continuations-table)))
|
||||
(table-set! continuations-table continuation-id return)
|
||||
(release-lock continuation-table-lock)
|
||||
(let ((continuation-id
|
||||
(with-lock continuation-table-lock
|
||||
(let ((c-id (generate-new-table-id continuations-table)))
|
||||
(table-set! continuations-table c-id return)
|
||||
c-id))))
|
||||
(let ((new-url (make-resume-url (session-surflet-name session)
|
||||
session-id
|
||||
continuation-counter
|
||||
|
|
@ -284,10 +283,8 @@
|
|||
;; Looks up SESSION-ID in the *SESSION-TABLE* (locking) and returns
|
||||
;; the SESSION record, if anby (#f otherwise).
|
||||
(define (session-lookup session-id)
|
||||
(obtain-lock *session-table-lock*)
|
||||
(let ((result (table-ref *session-table* session-id)))
|
||||
(release-lock *session-table-lock*)
|
||||
result))
|
||||
(with-lock *session-table-lock*
|
||||
(table-ref *session-table* session-id)))
|
||||
|
||||
;;; SESSION-NEXT-CONTINUATION-COUNTER
|
||||
;; Increases the SESSION-CONTINUATION-COUNTER in the SESSION record by
|
||||
|
|
@ -300,17 +297,19 @@
|
|||
;; Deletes the session indicated by its number SESSION-ID from the
|
||||
;; *SESSION-TABLE* (locking).
|
||||
(define (delete-session! session-id)
|
||||
(obtain-lock *session-table-lock*)
|
||||
;; notify surveillance of session being alread killed (prevents
|
||||
(with-lock *session-table-lock*
|
||||
;; notify surveillance of session being alread killed (prevents
|
||||
;; surveillance of killing new session that has the same number by
|
||||
;; accident)
|
||||
(let ((session (table-ref *session-table* session-id)))
|
||||
(if session
|
||||
(begin
|
||||
(timeout-queue-remove-session! session-id)
|
||||
(table-set! *session-table* session-id #f))))
|
||||
(table-set! *session-table* session-id #f))
|
||||
;; else: somebody was faster than we
|
||||
(release-lock *session-table-lock*))
|
||||
))))
|
||||
|
||||
|
||||
|
||||
;;; SESSION-ADJUST-TIMEOUT!
|
||||
;; Resets time-to-die of session indicated by its SESSION-ID number.
|
||||
|
|
@ -358,28 +357,26 @@
|
|||
(lambda (condtion decline)
|
||||
(release-lock *session-table-lock*)
|
||||
(decline))
|
||||
(obtain-lock *session-table-lock*)
|
||||
;; notify session killing
|
||||
(table-walk
|
||||
(lambda (session-id session)
|
||||
(timeout-queue-remove-session! session-id))
|
||||
*session-table*)
|
||||
(set! *session-table* (make-integer-table))
|
||||
(release-lock *session-table*)))
|
||||
(with-lock *session-table-lock*
|
||||
;; notify session killing
|
||||
(table-walk
|
||||
(lambda (session-id session)
|
||||
(timeout-queue-remove-session! session-id))
|
||||
*session-table*)
|
||||
(set! *session-table* (make-integer-table)))))
|
||||
|
||||
;;; GET-SESSIONS
|
||||
;; Returns a list of all active sessions in *SESSION-TABLE*
|
||||
;; (locking). The list elements are pairs of session-id and session
|
||||
;; record.
|
||||
(define (get-sessions)
|
||||
(obtain-lock *session-table-lock*)
|
||||
(let ((sessions '()))
|
||||
(table-walk
|
||||
(lambda (session-id session-entry)
|
||||
(set! sessions (cons (cons session-id session-entry) sessions)))
|
||||
*session-table*)
|
||||
(release-lock *session-table-lock*)
|
||||
sessions))
|
||||
(with-lock *session-table-lock*
|
||||
(let ((sessions '()))
|
||||
(table-walk
|
||||
(lambda (session-id session-entry)
|
||||
(set! sessions (cons (cons session-id session-entry) sessions)))
|
||||
*session-table*)
|
||||
sessions)))
|
||||
|
||||
(define get-session session-lookup)
|
||||
|
||||
|
|
@ -398,14 +395,13 @@
|
|||
(let ((continuation-table-lock (session-continuation-table-lock session))
|
||||
(continuation-table (session-continuation-table session))
|
||||
(continuations '()))
|
||||
(obtain-lock continuation-table-lock)
|
||||
(table-walk
|
||||
(lambda (continuation-id continuation-entry)
|
||||
(set! continuations (cons (cons continuation-id continuation-entry)
|
||||
continuations)))
|
||||
continuation-table)
|
||||
(release-lock continuation-table-lock)
|
||||
continuations)
|
||||
(with-lock continuation-table-lock
|
||||
(table-walk
|
||||
(lambda (continuation-id continuation-entry)
|
||||
(set! continuations (cons (cons continuation-id continuation-entry)
|
||||
continuations)))
|
||||
continuation-table)
|
||||
continuations))
|
||||
'())))
|
||||
|
||||
;;; DELETE-CONTINUATION
|
||||
|
|
@ -414,12 +410,11 @@
|
|||
(let ((session (session-lookup session-id)))
|
||||
(if session
|
||||
(let ((continuation-table-lock (session-continuation-table-lock session)))
|
||||
(obtain-lock continuation-table-lock)
|
||||
(let ((continuation-table (session-continuation-table session))
|
||||
(continuations '()))
|
||||
(if (table-ref continuation-table continuation-id)
|
||||
(table-set! continuation-table continuation-id #f)))
|
||||
(release-lock continuation-table-lock)))))
|
||||
(with-lock continuation-table-lock
|
||||
(let ((continuation-table (session-continuation-table session))
|
||||
(continuations '()))
|
||||
(if (table-ref continuation-table continuation-id)
|
||||
(table-set! continuation-table continuation-id #f))))))))
|
||||
|
||||
;;; SET-SESSION-DATA!, GET-SESSION-DATA
|
||||
;; Access to arbitrary data stored along with current session (no
|
||||
|
|
@ -462,46 +457,29 @@
|
|||
(define get-surflet-rt-structure
|
||||
(let ((load-surflet
|
||||
(lambda (full-surflet-name cached?)
|
||||
;; Want to get warnings also.
|
||||
(with-fatal-handler*
|
||||
(lambda (condition decline)
|
||||
(if cached? (release-lock *surflet-table-lock*))
|
||||
;; Let the others do the job.
|
||||
(error condition))
|
||||
(lambda ()
|
||||
;; load-config-file does not care about cwd(?)
|
||||
;; --> absolute file name needed
|
||||
(load-config-file full-surflet-name)
|
||||
;; surflet-structure to load must be named "surflet"
|
||||
(let ((surflet-structure (reify-structure 'surflet)))
|
||||
(load-structure surflet-structure)
|
||||
(if cached?
|
||||
(begin
|
||||
(table-set! *surflet-table* full-surflet-name
|
||||
(cons surflet-structure
|
||||
(file-last-mod full-surflet-name)))
|
||||
;; only now the lock may be released
|
||||
(release-lock *surflet-table-lock*)))
|
||||
surflet-structure))))))
|
||||
;; load-config-file does not care about cwd(?)
|
||||
;; --> absolute file name needed
|
||||
(load-config-file full-surflet-name)
|
||||
;; surflet-structure to load must be named "surflet"
|
||||
(let ((surflet-structure (reify-structure 'surflet)))
|
||||
(load-structure surflet-structure)
|
||||
(if cached?
|
||||
(table-set! *surflet-table* full-surflet-name
|
||||
(cons surflet-structure
|
||||
(file-last-mod full-surflet-name))))
|
||||
surflet-structure))))
|
||||
|
||||
(lambda (surflet-name directory)
|
||||
(let ((full-surflet-name (absolute-file-name surflet-name directory)))
|
||||
(if (options-cache-surflets?)
|
||||
(begin
|
||||
;; The lock is only obtained and released, if surflets
|
||||
;; are cached. LOAD-SURFLET gets the CACHED? parameter,
|
||||
;; so nothing will happen, if in the meanwhile caching
|
||||
;; is turned off.
|
||||
(obtain-lock *surflet-table-lock*)
|
||||
(with-lock *surflet-table-lock*
|
||||
(cond
|
||||
((table-ref *surflet-table* full-surflet-name) =>
|
||||
(lambda (surflet)
|
||||
(if (equal? (file-last-mod full-surflet-name)
|
||||
(cdr surflet))
|
||||
(begin
|
||||
(release-lock *surflet-table-lock*)
|
||||
(car surflet))
|
||||
(load-surflet full-surflet-name #t))))
|
||||
(if (equal? (file-last-mod full-surflet-name)
|
||||
(cdr surflet))
|
||||
(car surflet)
|
||||
(load-surflet full-surflet-name #t))))
|
||||
(else
|
||||
(load-surflet full-surflet-name #t))))
|
||||
(load-surflet full-surflet-name #f))))))
|
||||
|
|
@ -509,33 +487,26 @@
|
|||
;;; GET-LOADED-SURFLETS
|
||||
;; Returns list of all loaded surflets (real path strings).
|
||||
(define (get-loaded-surflets)
|
||||
(obtain-lock *surflet-table-lock*)
|
||||
(let ((loaded-surflets '()))
|
||||
(table-walk
|
||||
(lambda (surflet-path rt-structure)
|
||||
(set! loaded-surflets (cons surflet-path loaded-surflets)))
|
||||
*surflet-table*)
|
||||
(release-lock *surflet-table-lock*)
|
||||
loaded-surflets))
|
||||
(with-lock *surflet-table-lock*
|
||||
(let ((loaded-surflets '()))
|
||||
(table-walk
|
||||
(lambda (surflet-path rt-structure)
|
||||
(set! loaded-surflets (cons surflet-path loaded-surflets)))
|
||||
*surflet-table*)
|
||||
loaded-surflets)))
|
||||
|
||||
;;; UNLOAD-SURFLET
|
||||
;; Removes SURFLET-NAME from the *SURFLET-TABLE* cache (locking).
|
||||
(define (unload-surflet surflet-name)
|
||||
(obtain-lock *surflet-table-lock*)
|
||||
(if (table-ref *surflet-table* surflet-name)
|
||||
(table-set! *surflet-table* surflet-name #f))
|
||||
(release-lock *surflet-table-lock*))
|
||||
(with-lock *surflet-table-lock*
|
||||
(if (table-ref *surflet-table* surflet-name)
|
||||
(table-set! *surflet-table* surflet-name #f))))
|
||||
|
||||
;;; RESET-SURFLET-CACHE!
|
||||
;; Clears *SURFLET-TABLE* (locking).
|
||||
(define (reset-surflet-cache!)
|
||||
; (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*))
|
||||
(with-lock *surflet-table-lock*
|
||||
(set! *surflet-table* (make-string-table))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; INSTANCE
|
||||
|
|
|
|||
Loading…
Reference in New Issue