1#lang racket/base
2(require racket/match
3         racket/contract)
4(require "manager.rkt")
5(require web-server/private/timer
6         web-server/http
7         web-server/servlet/servlet-structs)
8(provide/contract
9 [create-timeout-manager
10  (->
11   (or/c false/c
12         (request? . -> . can-be-response?))
13   number? number?
14   manager?)])
15
16;; Utility
17(define (make-counter)
18  (let ([i 0])
19    (lambda ()
20      (set! i (add1 i))
21      i)))
22
23(define-struct (timeout-manager manager)
24  (instance-expiration-handler
25   instance-timer-length
26   continuation-timer-length
27                                        ; Private
28   instances
29   next-instance-id))
30(define (create-timeout-manager
31         instance-expiration-handler
32         instance-timer-length
33         continuation-timer-length)
34  (define tm (start-timer-manager))
35
36  ;; Instances
37  (define instances (make-hasheq))
38  (define next-instance-id (make-counter))
39
40  (define-struct instance (k-table timer))
41  (define (create-instance expire-fn)
42    (define instance-id (next-instance-id))
43    (hash-set! instances
44               instance-id
45               (make-instance (create-k-table)
46                              (start-timer tm
47                                           instance-timer-length
48                                           (lambda ()
49                                             (expire-fn)
50                                             (hash-remove! instances instance-id)))))
51    instance-id)
52  (define (adjust-timeout! instance-id secs)
53    (reset-timer! (instance-timer (instance-lookup instance-id #f))
54                  secs))
55
56  (define (instance-lookup instance-id peek?)
57    (define instance
58      (hash-ref instances instance-id
59                (lambda ()
60                  (raise (make-exn:fail:servlet-manager:no-instance
61                          (format "No instance for id: ~a" instance-id)
62                          (current-continuation-marks)
63                          instance-expiration-handler)))))
64    (unless peek?
65      (increment-timer! (instance-timer instance)
66                        instance-timer-length))
67    instance)
68
69  ;; Continuation table
70  (define-struct k-table (next-id-fn htable))
71  (define (create-k-table)
72    (make-k-table (make-counter) (make-hasheq)))
73
74  ;; Interface
75  (define (clear-continuations! instance-id)
76    (match (instance-lookup instance-id #f)
77      [(struct instance ((and k-table (struct k-table (next-id-fn htable))) instance-timer))
78       (hash-for-each
79        htable
80        (match-lambda*
81         [(list k-id (list salt k expiration-handler k-timer))
82          (hash-set! htable k-id
83                     (list salt #f expiration-handler k-timer))]))]))
84
85  (define (continuation-store! instance-id k expiration-handler)
86    (match (instance-lookup instance-id #t)
87      [(struct instance ((struct k-table (next-id-fn htable)) instance-timer))
88       (define k-id (next-id-fn))
89       (define salt (random 100000000))
90       (hash-set! htable
91                  k-id
92                  (list salt k expiration-handler
93                        (start-timer tm continuation-timer-length
94                                     (lambda ()
95                                       (hash-set! htable k-id
96                                                  (list salt #f expiration-handler
97                                                        (start-timer tm 0 void)))))))
98       (list k-id salt)]))
99  (define (continuation-lookup* instance-id a-k-id a-salt peek?)
100    (match (instance-lookup instance-id peek?)
101      [(struct instance ((struct k-table (next-id-fn htable)) instance-timer))
102       (match
103           (hash-ref htable a-k-id
104                     (lambda ()
105                       (raise (make-exn:fail:servlet-manager:no-continuation
106                               (format "No continuation for id: ~a" a-k-id)
107                               (current-continuation-marks)
108                               instance-expiration-handler))))
109         [(list salt k expiration-handler k-timer)
110          (unless peek?
111            (increment-timer! k-timer
112                              continuation-timer-length))
113          (if (or (not (eq? salt a-salt))
114                  (not k)
115                  (and (custodian-box? k)
116                       (not (custodian-box-value k))))
117            (raise (make-exn:fail:servlet-manager:no-continuation
118                    (format "No continuation for id: ~a" a-k-id)
119                    (current-continuation-marks)
120                    (if expiration-handler
121                      expiration-handler
122                      instance-expiration-handler)))
123            k)])]))
124  (define (continuation-lookup instance-id a-k-id a-salt)
125    (continuation-lookup* instance-id a-k-id a-salt #f))
126  (define (continuation-peek instance-id a-k-id a-salt)
127    (continuation-lookup* instance-id a-k-id a-salt #t))
128
129  (make-timeout-manager create-instance
130                        adjust-timeout!
131                        clear-continuations!
132                        continuation-store!
133                        continuation-lookup
134                        continuation-peek
135                                        ; Specific
136                        instance-expiration-handler
137                        instance-timer-length
138                        continuation-timer-length
139                                        ; Private
140                        instances
141                        next-instance-id))
142