.
original commit: 4682e54f83e879ee536d410ce1a147083d15d233
This commit is contained in:
parent
3ada00788f
commit
ffa48b2215
|
@ -327,7 +327,7 @@
|
|||
(format "the size of the name list (~a) does not match the size of the value list (~a): "
|
||||
(length names) (length vals))
|
||||
vals))
|
||||
(let ([lock-file (build-path (find-system-path 'pref-dir) "PREFLOCK")])
|
||||
(let ([lock-file (build-path (find-system-path 'pref-dir) ".plt-PREFLOCK")])
|
||||
(with-handlers ([(lambda (x)
|
||||
(and (exn:i/o:filesystem? x)
|
||||
(eq? (exn:i/o:filesystem-detail x) 'already-exists)))
|
||||
|
|
|
@ -135,38 +135,38 @@
|
|||
(copy a)
|
||||
(copy b)
|
||||
rd))]))
|
||||
|
||||
|
||||
(define (run-server port-number handler connection-timeout)
|
||||
(let ([l (tcp-listen port-number)]
|
||||
[can-break? (break-enabled)])
|
||||
(dynamic-wind
|
||||
void
|
||||
(lambda ()
|
||||
;; loop to handle connections
|
||||
(let loop ()
|
||||
(with-handlers ([not-break-exn? void])
|
||||
;; Make a custodian for the next session:
|
||||
(let ([c (make-custodian)])
|
||||
(parameterize ([current-custodian c])
|
||||
;; disable breaks during session set-up...
|
||||
(parameterize ([break-enabled #f])
|
||||
;; ... but enabled breaks while blocked on an accept:
|
||||
(let-values ([(r w) ((if can-break?
|
||||
tcp-accept/enable-break
|
||||
tcp-accept)
|
||||
l)])
|
||||
;; Handler thread:
|
||||
(let ([t (thread (lambda ()
|
||||
(when can-break?
|
||||
(break-enabled #t))
|
||||
(handler r w)))])
|
||||
;; Clean-up and timeout thread:
|
||||
(thread (lambda ()
|
||||
(object-wait-multiple connection-timeout t)
|
||||
(when (thread-running? t)
|
||||
;; Only happens if connection-timeout is not #f
|
||||
(break-thread t))
|
||||
(object-wait-multiple connection-timeout t)
|
||||
(custodian-shutdown-all c)))))))))
|
||||
(loop)))
|
||||
(lambda () (tcp-close l))))))
|
||||
void
|
||||
(lambda ()
|
||||
;; loop to handle connections
|
||||
(let loop ()
|
||||
(with-handlers ([not-break-exn? void])
|
||||
;; Make a custodian for the next session:
|
||||
(let ([c (make-custodian)])
|
||||
(parameterize ([current-custodian c])
|
||||
;; disable breaks during session set-up...
|
||||
(parameterize ([break-enabled #f])
|
||||
;; ... but enable breaks while blocked on an accept:
|
||||
(let-values ([(r w) ((if can-break?
|
||||
tcp-accept/enable-break
|
||||
tcp-accept)
|
||||
l)])
|
||||
;; Handler thread:
|
||||
(let ([t (thread (lambda ()
|
||||
(when can-break?
|
||||
(break-enabled #t))
|
||||
(handler r w)))])
|
||||
;; Clean-up and timeout thread:
|
||||
(thread (lambda ()
|
||||
(object-wait-multiple connection-timeout t)
|
||||
(when (thread-running? t)
|
||||
;; Only happens if connection-timeout is not #f
|
||||
(break-thread t))
|
||||
(object-wait-multiple connection-timeout t)
|
||||
(custodian-shutdown-all c)))))))))
|
||||
(loop)))
|
||||
(lambda () (tcp-close l))))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user