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