#lang syndicate/actor (require racket/cmdline) (require racket/port) (require racket/set) (require "private/util.rkt") (require "protocol.rkt") (require/activate syndicate/drivers/timestate) (require/activate syndicate/drivers/web) (require/activate "config.rkt") (require/activate "hub/static-content.rkt") (require/activate "hub/topic-demand.rkt") (require/activate "hub/local-topic.rkt") (require/activate "hub/remote-topic.rkt") (require/activate "hub/subscription.rkt") (require/activate "hub/websocket.rkt") (command-line #:program "racketmq" #:once-each ["--baseurl" baseurl "Specify the canonical base URL for this hub" (actor #:name (list 'command-line-canonical-baseurl baseurl) (assert (config (list 'canonical-baseurl baseurl))))] #:multi [("-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)))))] [("-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" (spawn-configuration filename)]) (actor #:name 'main (during (config (list 'canonical-baseurl $u)) (assert (canonical-baseurl u))) (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.")) (on-start (sleep 0.1) (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. ;; TODO: And/or, make the whole application quit when it gets into a bad state. (during (config (list 'http-listener $h $p)) (assert (http-listener h p))) (during (http-listener $host-name $port) (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"))) #"Moved"))))