130 lines
5.2 KiB
Racket
130 lines
5.2 KiB
Racket
#lang racket/base
|
|
(require racket/match
|
|
racket/contract)
|
|
(require "manager.rkt")
|
|
(require web-server/private/timer
|
|
web-server/servlet/servlet-structs)
|
|
(provide/contract
|
|
[create-timeout-manager (expiration-handler/c number? number? . -> . manager?)])
|
|
|
|
;; Utility
|
|
(define (make-counter)
|
|
(let ([i 0])
|
|
(lambda ()
|
|
(set! i (add1 i))
|
|
i)))
|
|
|
|
(define-struct (timeout-manager manager) (instance-expiration-handler
|
|
instance-timer-length
|
|
continuation-timer-length
|
|
; Private
|
|
instances
|
|
next-instance-id))
|
|
(define (create-timeout-manager
|
|
instance-expiration-handler
|
|
instance-timer-length
|
|
continuation-timer-length)
|
|
;; Instances
|
|
(define instances (make-hasheq))
|
|
(define next-instance-id (make-counter))
|
|
|
|
(define-struct instance (k-table timer))
|
|
(define (create-instance expire-fn)
|
|
(define instance-id (next-instance-id))
|
|
(hash-set! instances
|
|
instance-id
|
|
(make-instance (create-k-table)
|
|
(start-timer instance-timer-length
|
|
(lambda ()
|
|
(expire-fn)
|
|
(hash-remove! instances instance-id)))))
|
|
instance-id)
|
|
(define (adjust-timeout! instance-id secs)
|
|
(reset-timer! (instance-timer (instance-lookup instance-id #f))
|
|
secs))
|
|
|
|
(define (instance-lookup instance-id peek?)
|
|
(define instance
|
|
(hash-ref instances instance-id
|
|
(lambda ()
|
|
(raise (make-exn:fail:servlet-manager:no-instance
|
|
(format "No instance for id: ~a" instance-id)
|
|
(current-continuation-marks)
|
|
instance-expiration-handler)))))
|
|
(unless peek?
|
|
(increment-timer! (instance-timer instance)
|
|
instance-timer-length))
|
|
instance)
|
|
|
|
;; Continuation table
|
|
(define-struct k-table (next-id-fn htable))
|
|
(define (create-k-table)
|
|
(make-k-table (make-counter) (make-hasheq)))
|
|
|
|
;; Interface
|
|
(define (clear-continuations! instance-id)
|
|
(match (instance-lookup instance-id #f)
|
|
[(struct instance ((and k-table (struct k-table (next-id-fn htable))) instance-timer))
|
|
(hash-for-each
|
|
htable
|
|
(match-lambda*
|
|
[(list k-id (list salt k expiration-handler k-timer))
|
|
(hash-set! htable k-id
|
|
(list salt #f expiration-handler k-timer))]))]))
|
|
|
|
(define (continuation-store! instance-id k expiration-handler)
|
|
(match (instance-lookup instance-id #t)
|
|
[(struct instance ((struct k-table (next-id-fn htable)) instance-timer))
|
|
(define k-id (next-id-fn))
|
|
(define salt (random 100000000))
|
|
(hash-set! htable
|
|
k-id
|
|
(list salt k expiration-handler
|
|
(start-timer continuation-timer-length
|
|
(lambda ()
|
|
(hash-set! htable k-id
|
|
(list salt #f expiration-handler
|
|
(start-timer 0 void)))))))
|
|
(list k-id salt)]))
|
|
(define (continuation-lookup* instance-id a-k-id a-salt peek?)
|
|
(match (instance-lookup instance-id peek?)
|
|
[(struct instance ((struct k-table (next-id-fn htable)) instance-timer))
|
|
(match
|
|
(hash-ref htable a-k-id
|
|
(lambda ()
|
|
(raise (make-exn:fail:servlet-manager:no-continuation
|
|
(format "No continuation for id: ~a" a-k-id)
|
|
(current-continuation-marks)
|
|
instance-expiration-handler))))
|
|
[(list salt k expiration-handler k-timer)
|
|
(unless peek?
|
|
(increment-timer! k-timer
|
|
continuation-timer-length))
|
|
(if (or (not (eq? salt a-salt))
|
|
(not k))
|
|
(raise (make-exn:fail:servlet-manager:no-continuation
|
|
(format "No continuation for id: ~a" a-k-id)
|
|
(current-continuation-marks)
|
|
(if expiration-handler
|
|
expiration-handler
|
|
instance-expiration-handler)))
|
|
k)])]))
|
|
(define (continuation-lookup instance-id a-k-id a-salt)
|
|
(continuation-lookup* instance-id a-k-id a-salt #f))
|
|
(define (continuation-peek instance-id a-k-id a-salt)
|
|
(continuation-lookup* instance-id a-k-id a-salt #t))
|
|
|
|
(make-timeout-manager create-instance
|
|
adjust-timeout!
|
|
clear-continuations!
|
|
continuation-store!
|
|
continuation-lookup
|
|
continuation-peek
|
|
; Specific
|
|
instance-expiration-handler
|
|
instance-timer-length
|
|
continuation-timer-length
|
|
; Private
|
|
instances
|
|
next-instance-id))
|