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