2016-11-20 21:13:40 +00:00
|
|
|
#lang syndicate/actor
|
|
|
|
|
2016-11-20 21:54:54 +00:00
|
|
|
(require racket/cmdline)
|
2016-11-21 04:04:44 +00:00
|
|
|
(require racket/port)
|
2016-11-20 21:54:54 +00:00
|
|
|
(require racket/set)
|
|
|
|
|
2016-11-20 21:13:40 +00:00
|
|
|
(require "private/util.rkt")
|
|
|
|
(require "protocol.rkt")
|
|
|
|
|
2016-11-20 22:51:38 +00:00
|
|
|
(require/activate syndicate/drivers/timestate)
|
2016-11-22 03:44:00 +00:00
|
|
|
(require/activate syndicate/drivers/web)
|
2016-11-20 21:13:40 +00:00
|
|
|
(require/activate "config.rkt")
|
|
|
|
(require/activate "hub/static-content.rkt")
|
|
|
|
(require/activate "hub/topic-demand.rkt")
|
|
|
|
(require/activate "hub/local-topic.rkt")
|
2016-11-21 22:35:39 +00:00
|
|
|
(require/activate "hub/remote-topic.rkt")
|
2016-11-20 21:13:40 +00:00
|
|
|
(require/activate "hub/subscription.rkt")
|
2016-11-21 04:05:33 +00:00
|
|
|
(require/activate "hub/websocket.rkt")
|
2016-11-20 21:13:40 +00:00
|
|
|
|
2016-11-20 21:54:54 +00:00
|
|
|
(command-line #:program "racketmq"
|
|
|
|
|
|
|
|
#:once-each
|
2016-11-21 22:35:39 +00:00
|
|
|
["--baseurl" baseurl "Specify the canonical base URL for this hub"
|
|
|
|
(actor #:name (list 'command-line-canonical-baseurl baseurl)
|
|
|
|
(assert (config (list 'canonical-baseurl baseurl))))]
|
2016-11-20 21:54:54 +00:00
|
|
|
|
|
|
|
#:multi
|
2016-11-21 22:35:39 +00:00
|
|
|
[("-l" "--listen") host port "Specify one HTTP listener"
|
|
|
|
(actor #:name (list 'command-line-http-listener host port)
|
|
|
|
(assert (config (list 'http-listener host (string->number port)))))]
|
2016-11-21 04:04:44 +00:00
|
|
|
[("-o" "--option") key vals "Specify a single configuration option"
|
|
|
|
(actor #:name (list 'config-option key vals)
|
|
|
|
(assert (config (cons (string->symbol key)
|
|
|
|
(port->list read (open-input-string vals))))))]
|
|
|
|
[("-f" "--config-file") filename "Specify a configuration file to load"
|
2016-11-20 21:54:54 +00:00
|
|
|
(spawn-configuration filename)])
|
2016-11-20 21:13:40 +00:00
|
|
|
|
|
|
|
(actor #:name 'main
|
2016-11-20 21:55:06 +00:00
|
|
|
|
2016-11-21 22:35:39 +00:00
|
|
|
(during (config (list 'canonical-baseurl $u))
|
|
|
|
(assert (canonical-baseurl u)))
|
2016-11-20 21:55:06 +00:00
|
|
|
|
2016-11-21 22:35:39 +00:00
|
|
|
(define/query-set canonical-baseurls ($ c (canonical-baseurl _)) c)
|
|
|
|
(stop-when (rising-edge (> (set-count (canonical-baseurls)) 1))
|
|
|
|
(log-error "Too many canonical-baseurl records in configuration."))
|
2016-11-20 22:51:38 +00:00
|
|
|
(on-start (sleep 0.1)
|
2016-11-21 22:35:39 +00:00
|
|
|
(when (set-empty? (canonical-baseurls))
|
|
|
|
(log-error "No canonical-baseurl records specified; try the --baseurl command line argument")))
|
|
|
|
;; TODO: Make the too-many-canonical-baseurl-records situation recoverable.
|
2016-11-20 21:55:06 +00:00
|
|
|
;; TODO: And/or, make the whole application quit when it gets into a bad state.
|
|
|
|
|
2016-11-21 22:35:39 +00:00
|
|
|
(during (config (list 'http-listener $h $p))
|
|
|
|
(assert (http-listener h p)))
|
2016-11-20 21:55:06 +00:00
|
|
|
|
2016-11-21 22:35:39 +00:00
|
|
|
(during (http-listener $host-name $port)
|
2016-11-22 03:44:00 +00:00
|
|
|
(assert (vh host-name port))
|
|
|
|
(on (web-request-get (id req) (vh host-name port) ("" ()))
|
|
|
|
(web-respond/bytes! id
|
|
|
|
#:header (web-response-header
|
|
|
|
#:code 303
|
|
|
|
#:message #"Moved"
|
|
|
|
#:headers (list (cons 'location "/index.html")
|
|
|
|
(cons 'content-type "text/html")))
|
|
|
|
#"<a href=\"/index.html\">Moved</a>"))))
|