Ship out only session-id/continuation-id
and not the session/continuation itself
This commit is contained in:
parent
91c0997dd7
commit
5b2e2ddd6a
|
@ -88,7 +88,8 @@
|
|||
|
||||
(define-interface surflets/continuations-interface
|
||||
(export get-continuations
|
||||
delete-continuation!))
|
||||
delete-continuation!
|
||||
continuation-id))
|
||||
|
||||
;; Access to session-id and continuation-id
|
||||
(define-interface surflets/ids-interface
|
||||
|
@ -118,6 +119,7 @@
|
|||
adjust-timeout!
|
||||
session-alive?
|
||||
session-surflet-name
|
||||
session-session-id
|
||||
options-surflet-path
|
||||
options-session-lifetime
|
||||
options-cache-surflets?
|
||||
|
@ -135,6 +137,7 @@
|
|||
session-adjust-timeout!
|
||||
session-alive?
|
||||
session-surflet-name
|
||||
session-session-id ;faked
|
||||
;; FIXME: This is too much and should be restricted:
|
||||
session-continuation-table
|
||||
session-continuation-table-lock
|
||||
|
@ -364,7 +367,8 @@
|
|||
|
||||
(define-interface surflets/callbacks-interface
|
||||
(export make-callback
|
||||
make-annotated-callback))
|
||||
make-annotated-callback
|
||||
callback-functor))
|
||||
|
||||
;; Returned-via (dispatcher for input-fields and intelligent
|
||||
;; addresses)
|
||||
|
@ -721,3 +725,7 @@
|
|||
locks)
|
||||
(files with-locks))
|
||||
|
||||
;;; EOF
|
||||
;;; Local Variables:
|
||||
;;; buffer-tag-table: "../../TAGS"
|
||||
;;; End::
|
||||
|
|
|
@ -302,8 +302,8 @@
|
|||
(define (delete-session! session-id)
|
||||
(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)
|
||||
;; surveillance of killing new session that has the same number by
|
||||
;; accident)
|
||||
(let ((session (table-ref *session-table* session-id)))
|
||||
(if session
|
||||
(begin
|
||||
|
@ -341,16 +341,17 @@
|
|||
(session-lifetime session-id)))))
|
||||
|
||||
(define (session-lifetime session-id)
|
||||
(let ((maybe-session (session-lookup session-id)))
|
||||
(and maybe-session
|
||||
(really-session-lifetime maybe-session))))
|
||||
(cond ((session-lookup session-id)
|
||||
=> (lambda (session)
|
||||
(really-session-lifetime session)))
|
||||
(else #f)))
|
||||
|
||||
(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)))))
|
||||
(cond ((session-lookup session-id)
|
||||
=> (lambda (session)
|
||||
(really-set-session-lifetime! session new-lifetime)
|
||||
(session-adjust-timeout! session-id new-lifetime)))
|
||||
(else #f)))
|
||||
|
||||
|
||||
;;; RESET-SESSION-TABLE!
|
||||
|
@ -370,18 +371,21 @@
|
|||
|
||||
;;; GET-SESSIONS
|
||||
;; Returns a list of all active sessions in *SESSION-TABLE*
|
||||
;; (locking). The list elements are pairs of session-id and session
|
||||
;; record.
|
||||
;; (locking). The user only gets the session-id, so nothing will
|
||||
;; happen, if he saves this number. (Otherwise, if he saves the
|
||||
;; sessions, they will never be GC'ed). From the user's point of view,
|
||||
;; the number behaves like a record of type session.
|
||||
(define (get-sessions)
|
||||
(with-lock *session-table-lock*
|
||||
(let ((sessions '()))
|
||||
(table-walk
|
||||
(lambda (session-id session-entry)
|
||||
(set! sessions (cons (cons session-id session-entry) sessions)))
|
||||
(set! sessions (cons session-id sessions)))
|
||||
*session-table*)
|
||||
sessions)))
|
||||
|
||||
(define get-session session-lookup)
|
||||
(define (get-session session-id)
|
||||
session-id)
|
||||
|
||||
;; SESSION-ALIVE? returns #t if there is a session with this id, #f
|
||||
;; otherwise.
|
||||
|
@ -390,8 +394,11 @@
|
|||
|
||||
;;; GET-CONTINUATIONS
|
||||
;; Returns a list of all continuations of the session indicated by the
|
||||
;; SESSION-ID number (locking). The list elements are pairs of
|
||||
;; continuation id and continuation.
|
||||
;; SESSION-ID number (locking). The user only gets the pair
|
||||
;; (session-id . continuation-id), so nothing will happen, if he saves
|
||||
;; this number. (Otherwise, if he saves the continuations, they will
|
||||
;; never be GC'ed). From the user's point of view, the number behaves
|
||||
;; like a record of type continuation.
|
||||
(define (get-continuations session-id)
|
||||
(let ((session (session-lookup session-id)))
|
||||
(if session
|
||||
|
@ -401,7 +408,7 @@
|
|||
(with-lock continuation-table-lock
|
||||
(table-walk
|
||||
(lambda (continuation-id continuation-entry)
|
||||
(set! continuations (cons (cons continuation-id continuation-entry)
|
||||
(set! continuations (cons (cons session-id continuation-id)
|
||||
continuations)))
|
||||
continuation-table)
|
||||
continuations))
|
||||
|
@ -409,8 +416,10 @@
|
|||
|
||||
;;; DELETE-CONTINUATION
|
||||
;; Deletes continuation SESSION-ID, CONTINUATION-ID (locking).
|
||||
(define (delete-continuation! session-id continuation-id)
|
||||
(let ((session (session-lookup session-id)))
|
||||
(define (delete-continuation! session-continuation-id)
|
||||
(let* ((session-id (car session-continuation-id))
|
||||
(continuation-id (cdr session-continuation-id))
|
||||
(session (session-lookup session-id)))
|
||||
(if session
|
||||
(let ((continuation-table-lock (session-continuation-table-lock session)))
|
||||
(with-lock continuation-table-lock
|
||||
|
@ -419,6 +428,9 @@
|
|||
(if (table-ref continuation-table continuation-id)
|
||||
(table-set! continuation-table continuation-id #f))))))))
|
||||
|
||||
(define (continuation-id session-continuation-id)
|
||||
(cdr session-continuation-id))
|
||||
|
||||
;;; SET-SESSION-DATA!, GET-SESSION-DATA
|
||||
;; Access to arbitrary data stored along with current session (no
|
||||
;; locking!).
|
||||
|
@ -590,13 +602,24 @@
|
|||
session-data
|
||||
lifetime)
|
||||
session?
|
||||
(surflet-name session-surflet-name)
|
||||
(surflet-name real-session-surflet-name)
|
||||
(continuation-table session-continuation-table)
|
||||
(continuation-table-lock session-continuation-table-lock)
|
||||
(continuation-counter session-continuation-counter)
|
||||
(session-data session-session-data set-session-session-data!)
|
||||
(lifetime really-session-lifetime really-set-session-lifetime!))
|
||||
|
||||
(define (session-surflet-name session-or-session-id)
|
||||
(if (session? session-or-session-id)
|
||||
(real-session-surflet-name session-or-session-id)
|
||||
(let ((session (session-lookup session-or-session-id)))
|
||||
(if session
|
||||
(real-session-surflet-name session)
|
||||
(error "No such session / Session no longer alive."
|
||||
session-or-session-id)))))
|
||||
|
||||
(define (session-session-id session-id) session-id)
|
||||
|
||||
;;; INSTANCE: Every request corresponds to an instance.
|
||||
(define-record-type instance :instance
|
||||
(make-instance session-id)
|
||||
|
@ -752,3 +775,9 @@
|
|||
(if *debug*
|
||||
(format #t "DEBUG: ~?~%" fmt args)
|
||||
(force-output)))
|
||||
|
||||
|
||||
;;; EOF
|
||||
;;; Local Variables:
|
||||
;;; buffer-tag-table: "../../TAGS"
|
||||
;;; End::
|
||||
|
|
Loading…
Reference in New Issue