syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Correctly distinguish when multiple listeners exist

This commit is contained in:
Tony Garnock-Jones 2014-06-14 20:50:03 -04:00
parent eca3e9ded0
commit 4370cb72a4
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
minimart/drivers/websocket.rkt
View File

@ -28,7 +28,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Ground-level communication messages ;; Ground-level communication messages
(struct websocket-accepted (id connection control-ch) #:prefab) (struct websocket-accepted (id server-addr connection control-ch) #:prefab)
(struct websocket-incoming-message (id message) #:prefab) (struct websocket-incoming-message (id message) #:prefab)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -54,16 +54,16 @@
(begin (when shutdown-procedure (shutdown-procedure)) (begin (when shutdown-procedure (shutdown-procedure))
(transition (struct-copy listener-state state [shutdown-procedure #f]) (quit))) (transition (struct-copy listener-state state [shutdown-procedure #f]) (quit)))
#f)] #f)]
[(message (websocket-accepted id c control-ch) 1 #f) [(message (websocket-accepted id _ c control-ch) 1 #f)
(transition state (transition state
(spawn-connection (listener-state-server-addr state) id c control-ch))] (spawn-connection (listener-state-server-addr state) id c control-ch))]
[_ #f])) [_ #f]))
(define (connection-handler c dummy-state) (define ((connection-handler server-addr) c dummy-state)
(define control-ch (make-channel)) (define control-ch (make-channel))
(define c-input-port (ws-conn-base-ip c)) (define c-input-port (ws-conn-base-ip c))
(define id (gensym 'ws)) (define id (gensym 'ws))
(send-ground-message (websocket-accepted id c control-ch)) (send-ground-message (websocket-accepted id server-addr c control-ch))
(let loop ((blocked? #t)) (let loop ((blocked? #t))
(sync (handle-evt control-ch (sync (handle-evt control-ch
(match-lambda (match-lambda
@ -92,11 +92,11 @@
#:tcp@ (if ssl-options #:tcp@ (if ssl-options
(ssl-options->ssl-tcp@ ssl-options) (ssl-options->ssl-tcp@ ssl-options)
tcp@) tcp@)
connection-handler)) (connection-handler server-addr)))
(spawn websocket-listener (spawn websocket-listener
(listener-state shutdown-procedure server-addr) (listener-state shutdown-procedure server-addr)
(gestalt-union (pub (websocket-message ? server-addr ?) #:level 2) (gestalt-union (pub (websocket-message ? server-addr ?) #:level 2)
(sub (websocket-accepted ? ? ?) #:meta-level 1)))) (sub (websocket-accepted ? server-addr ? ?) #:meta-level 1))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Connection ;; Connection