The Big Spawn/Actor Swap
This commit is contained in:
parent
eaa1806728
commit
ac4f15325f
|
@ -21,23 +21,23 @@
|
|||
|
||||
#:once-each
|
||||
["--baseurl" baseurl "Specify the canonical base URL for this hub"
|
||||
(actor #:name (list 'command-line-canonical-baseurl baseurl)
|
||||
(spawn #:name (list 'command-line-canonical-baseurl baseurl)
|
||||
(assert (config 'command-line (list 'canonical-baseurl baseurl))))]
|
||||
|
||||
#:multi
|
||||
[("-l" "--listen") host port "Specify one HTTP listener"
|
||||
(actor #:name (list 'command-line-http-listener host port)
|
||||
(spawn #:name (list 'command-line-http-listener host port)
|
||||
(assert (config 'command-line
|
||||
(list 'http-listener host (string->number port)))))]
|
||||
[("-o" "--option") key vals "Specify a single configuration option"
|
||||
(actor #:name (list 'config-option key vals)
|
||||
(spawn #:name (list 'config-option key vals)
|
||||
(assert (config 'command-line
|
||||
(cons (string->symbol key)
|
||||
(port->list read (open-input-string vals))))))]
|
||||
[("-f" "--config-file") filename "Specify a configuration file to load"
|
||||
(spawn-configuration filename filename)])
|
||||
|
||||
(actor #:name 'main
|
||||
(spawn #:name 'main
|
||||
|
||||
(during (config _ (list 'canonical-baseurl $u))
|
||||
(assert (canonical-baseurl u)))
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
(require "../private/util.rkt")
|
||||
(require "../protocol.rkt")
|
||||
|
||||
(actor #:name 'local-topic-manager
|
||||
(spawn #:name 'local-topic-manager
|
||||
|
||||
(field [topics (set)])
|
||||
|
||||
|
@ -27,7 +27,7 @@
|
|||
(retract! (local-topic-config topic ? ?)))
|
||||
(web-respond/bytes! id #"")))
|
||||
|
||||
(during/actor (local-topic-demand $topic)
|
||||
(during/spawn (local-topic-demand $topic)
|
||||
#:name (list 'local-topic topic)
|
||||
(local-topic-main topic)))
|
||||
|
||||
|
|
|
@ -40,13 +40,13 @@
|
|||
upstream-topic ;; Topic -- upstream topic (from discovery)
|
||||
) #:prefab) ;; ASSERTION
|
||||
|
||||
(actor #:name 'remote-topic-manager
|
||||
(during/actor (remote-topic-demand $requested-topic)
|
||||
(spawn #:name 'remote-topic-manager
|
||||
(during/spawn (remote-topic-demand $requested-topic)
|
||||
#:name (list 'remote-topic requested-topic)
|
||||
(remote-topic-main requested-topic)))
|
||||
|
||||
(actor #:name 'upstream-link-manager
|
||||
(during/actor (upstream-link $requested-topic $upstream-hub $upstream-topic)
|
||||
(spawn #:name 'upstream-link-manager
|
||||
(during/spawn (upstream-link $requested-topic $upstream-hub $upstream-topic)
|
||||
#:name (list 'upstream-link requested-topic upstream-hub upstream-topic)
|
||||
(upstream-link-main requested-topic upstream-hub upstream-topic)))
|
||||
|
||||
|
|
|
@ -14,7 +14,7 @@
|
|||
(define-runtime-path htdocs-path "../htdocs")
|
||||
(define path->mime-type (make-path->mime-type "/etc/mime.types")))
|
||||
|
||||
(actor #:name 'static-content-server
|
||||
(spawn #:name 'static-content-server
|
||||
(define url->path (make-url->path htdocs-path))
|
||||
(during (http-listener $host-name $port)
|
||||
(on (web-request-get (id req) (vh host-name port) ,_)
|
||||
|
|
|
@ -12,7 +12,7 @@
|
|||
(require "../private/util.rkt")
|
||||
(require "../protocol.rkt")
|
||||
|
||||
(actor #:name 'hub
|
||||
(spawn #:name 'hub
|
||||
(during (http-listener $host-name $port)
|
||||
(during (canonical-baseurl $baseurl)
|
||||
(on (web-request-incoming (id req) (vh host-name port) 'post ("hub" ()) $body)
|
||||
|
@ -23,13 +23,13 @@
|
|||
(retract! (subscription topic callback ?))
|
||||
(when settings (assert! (subscription topic callback settings))))
|
||||
|
||||
(during/actor (subscription $topic $callback _)
|
||||
(during/spawn (subscription $topic $callback _)
|
||||
#:name (list 'subscription topic callback)
|
||||
#:on-crash (retract! (subscription topic callback ?))
|
||||
(subscription-main topic callback)))
|
||||
|
||||
(define (asynchronous-verification-of-intent id req body baseurl)
|
||||
(actor* #:name 'verification-of-intent
|
||||
(spawn* #:name 'verification-of-intent
|
||||
(define params (make-immutable-hash (form-urlencoded->alist (bytes->string/utf-8 body))))
|
||||
(define callback (hash-ref params 'hub.callback))
|
||||
(define mode (match (hash-ref params 'hub.mode)
|
||||
|
|
|
@ -10,8 +10,8 @@
|
|||
(require "../private/util.rkt")
|
||||
(require "../protocol.rkt")
|
||||
|
||||
(actor #:name 'topic-demand-analyzer
|
||||
(during/actor (topic-demand $full-topic _)
|
||||
(spawn #:name 'topic-demand-analyzer
|
||||
(during/spawn (topic-demand $full-topic _)
|
||||
#:name (list 'topic-demand full-topic)
|
||||
|
||||
(define/query-value topic-baseurl #f (canonical-baseurl $b)
|
||||
|
|
|
@ -12,7 +12,7 @@
|
|||
(require "../private/util.rkt")
|
||||
(require "../protocol.rkt")
|
||||
|
||||
(actor #:name 'websocket-hub
|
||||
(spawn #:name 'websocket-hub
|
||||
(during (http-listener $host-name $port)
|
||||
(during (canonical-baseurl $baseurl)
|
||||
(on (web-request-get (id req) (vh host-name port) ("hub" ()))
|
||||
|
@ -20,7 +20,7 @@
|
|||
(websocket-subscription id req baseurl))))))
|
||||
|
||||
(define (websocket-subscription id req baseurl)
|
||||
(actor* #:name (list 'websocket-subscription id)
|
||||
(spawn* #:name (list 'websocket-subscription id)
|
||||
(define params (web-request-header-query req))
|
||||
(define requested-topic (dict-ref params 'hub.topic))
|
||||
(define topic ;; TODO: abstract this expression out (see also subscription.rkt)
|
||||
|
|
|
@ -31,7 +31,7 @@
|
|||
(define (print-prompt)
|
||||
(printf "> ")
|
||||
(flush-output))
|
||||
(actor (on-start (print-prompt))
|
||||
(spawn (on-start (print-prompt))
|
||||
(stop-when (message (inbound (external-event e (list (? eof-object? _))))))
|
||||
(assert 'shell-running)
|
||||
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
||||
|
@ -58,19 +58,19 @@
|
|||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(actor #:name 'main
|
||||
(spawn #:name 'main
|
||||
(stop-when (retracted 'shell-running))
|
||||
|
||||
(assert vh)
|
||||
|
||||
(on (web-request-get (id req) vh ("" ()))
|
||||
(actor*
|
||||
(spawn*
|
||||
(web-respond/xexpr! id
|
||||
`(html
|
||||
(body
|
||||
(h1 "Poke running")))))))
|
||||
|
||||
(actor #:name 'sink
|
||||
(spawn #:name 'sink
|
||||
(on (web-request-incoming (id req) vh 'post ("sink" (,$sub-id ())) $body)
|
||||
(printf "SINK POST ~a: ~v >>> ~v\n" sub-id req body)
|
||||
(if (equal? body #"fail")
|
||||
|
@ -81,7 +81,7 @@
|
|||
(define challenge (dict-ref (web-request-header-query req) 'hub.challenge ""))
|
||||
(web-respond/bytes! id (string->bytes/utf-8 challenge))))
|
||||
|
||||
(actor #:name 'incoming-tracer
|
||||
(spawn #:name 'incoming-tracer
|
||||
(assert (observe (web-response-complete _ _ _))) ;; :-( See journal for 30 Oct 2016
|
||||
(on (web-request-incoming (id req) vh $verb ,$path $body)
|
||||
(printf "~a ==> ~a ~v ~v\n" id verb path body)
|
||||
|
@ -91,7 +91,7 @@
|
|||
(printf "~a <== timeout\n" id)))))
|
||||
|
||||
(define (spawn-subscriber topic [sub-id (gensym 'sub)])
|
||||
(actor #:name (list 'subscriber sub-id)
|
||||
(spawn #:name (list 'subscriber sub-id)
|
||||
|
||||
(on-start
|
||||
(request! 'post `("hub" ())
|
||||
|
|
Loading…
Reference in New Issue