Split host and port in websocket-remote-client and broker-scope.
This commit is contained in:
Tony Garnock-Jones
parent
c29ae059ff
commit
81f9a0f0fe
|
|
@ -16,7 +16,7 @@
|
|||
(require json)
|
||||
(require "protocol.rkt")
|
||||
|
||||
(struct broker-scope (host path) #:prefab)
|
||||
(struct broker-scope (host port path) #:prefab)
|
||||
(struct broker-data (scope assertion) #:prefab)
|
||||
|
||||
(define broker-data-parenthesis (struct-type->parenthesis struct:broker-data))
|
||||
|
|
@ -25,7 +25,7 @@
|
|||
;; Depends on timer driver and websocket driver running at the given metalevel.
|
||||
(define (spawn-broker-server port
|
||||
#:ssl-options [ssl-options #f])
|
||||
(define any-client (websocket-remote-client ? ? ?))
|
||||
(define any-client any-websocket-remote-client)
|
||||
(define server-id (websocket-local-server port ssl-options))
|
||||
(spawn-demand-matcher (advertise (websocket-message (?! any-client) server-id ?))
|
||||
(observe (websocket-message (?! any-client) server-id ?))
|
||||
|
|
@ -33,8 +33,9 @@
|
|||
(lambda (c) (spawn-connection-handler c server-id))))
|
||||
|
||||
(define (spawn-connection-handler c server-id)
|
||||
(actor (define scope (broker-scope (websocket-remote-client-host c)
|
||||
(websocket-remote-client-path c)))
|
||||
(actor (define scope (broker-scope (websocket-remote-client-request-host c)
|
||||
(websocket-remote-client-request-port c)
|
||||
(websocket-remote-client-request-path c)))
|
||||
|
||||
(define (arm-ping-timer!)
|
||||
(send! #:meta-level 1 (set-timer c (ping-interval) 'relative)))
|
||||
|
|
@ -86,6 +87,7 @@
|
|||
(trie-step* t (list broker-data-parenthesis
|
||||
broker-scope-parenthesis
|
||||
(broker-scope-host scope)
|
||||
(broker-scope-port scope)
|
||||
(broker-scope-path scope)))))))
|
||||
|
||||
(define (wrap-patch scope p)
|
||||
|
|
|
|||
|
|
@ -1,11 +1,22 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide (struct-out websocket-remote-client)
|
||||
(struct-out websocket-local-server)
|
||||
(struct-out websocket-local-client)
|
||||
(struct-out websocket-remote-server)
|
||||
(struct-out websocket-ssl-options)
|
||||
(struct-out websocket-message)
|
||||
(struct-out websocket-peer-details)
|
||||
spawn-websocket-driver
|
||||
any-websocket-remote-client)
|
||||
|
||||
(require racket/exn)
|
||||
(require racket/match)
|
||||
(require net/rfc6455)
|
||||
(require (only-in net/rfc6455/conn-api
|
||||
ws-conn-base-ip
|
||||
ws-conn-peer-addresses
|
||||
ws-conn-host
|
||||
ws-conn-host+port
|
||||
ws-conn-path))
|
||||
(require "../main.rkt")
|
||||
(require "../demand-matcher.rkt")
|
||||
|
|
@ -17,19 +28,10 @@
|
|||
(require net/ssl-tcp-unit)
|
||||
(require net/url)
|
||||
|
||||
(provide (struct-out websocket-remote-client)
|
||||
(struct-out websocket-local-server)
|
||||
(struct-out websocket-local-client)
|
||||
(struct-out websocket-remote-server)
|
||||
(struct-out websocket-ssl-options)
|
||||
(struct-out websocket-message)
|
||||
(struct-out websocket-peer-details)
|
||||
spawn-websocket-driver)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Protocol messages
|
||||
|
||||
(struct websocket-remote-client (id host path) #:prefab)
|
||||
(struct websocket-remote-client (id request-host request-port request-path) #:prefab)
|
||||
(struct websocket-local-server (port ssl-options) #:prefab)
|
||||
(struct websocket-local-client (id) #:prefab)
|
||||
(struct websocket-remote-server (url) #:prefab)
|
||||
|
|
@ -40,6 +42,8 @@
|
|||
(local-addr remote-addr local-ip local-port remote-ip remote-port)
|
||||
#:prefab)
|
||||
|
||||
(define any-websocket-remote-client (websocket-remote-client ? ? ? ?))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Ground-level communication messages
|
||||
|
||||
|
|
@ -82,11 +86,13 @@
|
|||
(define ((connection-handler server-addr) c dummy-state)
|
||||
(define control-ch (make-channel))
|
||||
(define id (gensym 'ws))
|
||||
(define-values (client-host client-port) (ws-conn-host+port c))
|
||||
(send-ground-message
|
||||
(websocket-connection id
|
||||
server-addr
|
||||
(websocket-remote-client id
|
||||
(ws-conn-host c)
|
||||
client-host
|
||||
client-port
|
||||
(ws-conn-path c))
|
||||
c
|
||||
control-ch))
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
|
||||
(spawn-websocket-driver)
|
||||
|
||||
(define any-client (websocket-remote-client ? ? ?))
|
||||
(define any-client any-websocket-remote-client)
|
||||
(define tcp-server-id (websocket-local-server 8081 #f))
|
||||
(define ssl-server-id (websocket-local-server 8084 (websocket-ssl-options "server-cert.pem"
|
||||
"private-key.pem")))
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
|
||||
(spawn-websocket-driver)
|
||||
|
||||
(define any-client (websocket-remote-client ? ? ?))
|
||||
(define any-client any-websocket-remote-client)
|
||||
(define server-id (websocket-local-server 8081 (websocket-ssl-options "server-cert.pem"
|
||||
"private-key.pem")))
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
|
||||
(spawn-websocket-driver)
|
||||
|
||||
(define any-client (websocket-remote-client ? ? ?))
|
||||
(define any-client any-websocket-remote-client)
|
||||
(define server-id (websocket-local-server 8081 #f))
|
||||
|
||||
(define (spawn-connection-handler c)
|
||||
|
|
|
|||
Loading…
Reference in New Issue