97 lines
4.4 KiB
Racket
97 lines
4.4 KiB
Racket
; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
; Copyright (C) 2010-2021 Tony Garnock-Jones <tonygarnockjones@gmail.com>
|
|
|
|
#lang syndicate
|
|
|
|
(provide (all-from-out "protocol.rkt")
|
|
(all-from-out "client.rkt")
|
|
(all-from-out "client/tcp.rkt")
|
|
(all-from-out "client/loopback.rkt")
|
|
(all-from-out "server.rkt")
|
|
(all-from-out "server/tcp.rkt")
|
|
(all-from-out "server/websocket.rkt"))
|
|
|
|
(require "internal-protocol.rkt")
|
|
(require "protocol.rkt")
|
|
|
|
(require/activate "client.rkt")
|
|
(require/activate "client/tcp.rkt")
|
|
(require/activate "client/loopback.rkt")
|
|
|
|
(require/activate "server.rkt")
|
|
(require/activate "server/tcp.rkt")
|
|
(require/activate "server/websocket.rkt")
|
|
|
|
(require/activate "federation.rkt")
|
|
|
|
(module+ main
|
|
(require racket/cmdline)
|
|
(define tcp-port default-tcp-server-port)
|
|
(define http-port default-http-server-port)
|
|
(define default-management-scope "local")
|
|
(define uplinks '())
|
|
(define management-scope default-management-scope)
|
|
(command-line #:once-any
|
|
["--tcp" port
|
|
((format "Listen on plain TCP port (default ~a)" default-tcp-server-port))
|
|
(set! tcp-port (string->number port))]
|
|
["--no-tcp" "Do not listen on any plain TCP port"
|
|
(set! tcp-port #f)]
|
|
#:once-any
|
|
["--http" port
|
|
((format "Listen on websocket HTTP port (default ~a)" default-http-server-port))
|
|
(set! http-port (string->number port))]
|
|
["--no-http" "Do not listen on any websocket HTTP port"
|
|
(set! http-port #f)]
|
|
#:multi
|
|
[("--management-scope" "-m") scope
|
|
("Set the management scope for future `--uplink`s and, "
|
|
"ultimately, for local federation management use. "
|
|
(format "(default ~v)" default-management-scope))
|
|
(set! management-scope scope)]
|
|
["--uplink" local-scope host port remote-scope
|
|
("Connect the named local-scope to the named remote-scope"
|
|
"via the management scope in the server at host:port")
|
|
(define port-number (string->number port))
|
|
(when (not port-number)
|
|
(eprintf "Invalid --uplink port number: ~v" port)
|
|
(exit 1))
|
|
(set! uplinks (cons (federated-uplink local-scope
|
|
(server-tcp-connection host
|
|
port-number
|
|
management-scope)
|
|
remote-scope)
|
|
uplinks))])
|
|
(extend-ground-boot! (lambda ()
|
|
(spawn (assert (federation-management-scope management-scope)))
|
|
;; ^ for inbound as well as outbound links
|
|
(when tcp-port (spawn-tcp-server! tcp-port))
|
|
(when http-port (spawn-websocket-server! http-port))
|
|
(when (pair? uplinks)
|
|
(spawn (define a (server-loopback-connection management-scope))
|
|
(assert (server-connection a))
|
|
(for [(u uplinks)]
|
|
(assert (to-server a u))))))))
|
|
|
|
(define-logger syndicate/distributed)
|
|
|
|
(when (log-level? syndicate/distributed-logger 'debug)
|
|
(spawn #:name 'client-debug
|
|
(on (asserted (server-connection $addr))
|
|
(log-syndicate/distributed-debug "C + ~v" addr))
|
|
(on (retracted (server-connection $addr))
|
|
(log-syndicate/distributed-debug "C - ~v" addr))
|
|
(on (message (server-packet $addr $p))
|
|
(log-syndicate/distributed-debug "C IN ~v ~v" addr p))
|
|
;; C OUT is covered in client.rkt
|
|
)
|
|
(spawn #:name 'server-debug
|
|
(on (asserted (server-poa $id))
|
|
(log-syndicate/distributed-debug "S + ~v" id))
|
|
(on (retracted (server-poa $id))
|
|
(log-syndicate/distributed-debug "S - ~v" id))
|
|
(on (message (message-poa->server $id $p))
|
|
(log-syndicate/distributed-debug "S IN ~v ~v" id p))
|
|
(on (message (message-server->poa $id $p))
|
|
(log-syndicate/distributed-debug "S OUT ~v ~v" id p))))
|