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

Ship out only session-id/continuation-id 

and not the session/continuation itself
This commit is contained in:
interp 2003-04-16 16:02:37 +00:00
parent 91c0997dd7
commit 5b2e2ddd6a
2 changed files with 59 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
scheme/httpd/surflets/packages.scm
View File

@ -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::

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

@ -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::