ws-echo.rkt and ws-echo-client.rkt

This commit is contained in:
Tony Garnock-Jones 2016-05-12 10:48:34 -04:00
parent a8821913a1
commit de44b51e49
2 changed files with 60 additions and 0 deletions

View File

@ -0,0 +1,32 @@
#lang syndicate
;; Websocket echo client
;; racket ws-echo-client.rkt ws://localhost:8081/
;; racket ws-echo-client.rkt wss://localhost:8084/
(require syndicate/drivers/websocket)
(require syndicate/actor)
(require racket/port)
(match-define (vector url) (current-command-line-arguments))
(spawn-websocket-driver)
(define c (websocket-local-client (gensym 'c)))
(define s (websocket-remote-server url))
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
(define reader-count 0)
(define (generate-reader-id)
(begin0 reader-count
(set! reader-count (+ reader-count 1))))
(actor (state [(assert (advertise (websocket-message c s _)))
(on (asserted (websocket-peer-details c s $la _ $ra _))
(log-info "~a: local ~v :: remote ~v" c la ra))
(on (message (external-event e (list (? bytes? $bs))) #:meta-level 1)
(send! (websocket-message c s bs)))
(on (message (websocket-message s c $bs))
(printf "(From server: ~v)\n" bs))]
[(message (external-event e (list (? eof-object? _))) #:meta-level 1)
(printf "Local EOF. Terminating.\n")]
[(retracted (advertise (websocket-message s c _)))
(printf "Server disconnected.\n")])))

View File

@ -0,0 +1,28 @@
#lang syndicate
;; Websocket server that echoes all it receives
(require syndicate/drivers/websocket)
(require syndicate/actor)
(spawn-websocket-driver)
(define any-client (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")))
(actor (forever (assert (advertise (observe (websocket-message any-client tcp-server-id _))))
(on (asserted (advertise (websocket-message ($ c any-client) tcp-server-id _)))
(handle-connection tcp-server-id c))))
(actor (forever (assert (advertise (observe (websocket-message any-client ssl-server-id _))))
(on (asserted (advertise (websocket-message ($ c any-client) ssl-server-id _)))
(handle-connection ssl-server-id c))))
(define (handle-connection s c)
(actor (until (retracted (advertise (websocket-message c s _)))
(on (asserted (websocket-peer-details s c $la _ $ra _))
(log-info "~a: local ~v :: remote ~v" c la ra))
(on (message (websocket-message c s $body))
(log-info "~a: ~v" c body)
(send! (websocket-message s c body))))
(log-info "~a: disconnected" c)))