syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Allow deferred production of initial-ref

This commit is contained in:
Tony Garnock-Jones 2021-06-08 16:35:07 +02:00
parent 600a52c287
commit 2276d1a81e
2 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
syndicate/distributed/tcp-server.rkt
View File

@ -55,19 +55,20 @@
(accept-bytes tr bs) (accept-bytes tr bs)
(loop)))))) (loop))))))
#:initial-ref #:initial-ref
(ref (during* #:name (cons 'gatekeeper name-base) (action ()
(action (assertion) (ref (during* #:name (cons 'gatekeeper name-base)
(match (parse-Resolve assertion) (action (assertion)
[(? eof-object?) (void)] (match (parse-Resolve assertion)
[(Resolve unvalidated-sturdyref observer) [(? eof-object?) (void)]
(at ds [(Resolve unvalidated-sturdyref observer)
(during (Bind (SturdyRef-oid unvalidated-sturdyref) $key $target) (at ds
(define sturdyref (validate unvalidated-sturdyref key)) (during (Bind (SturdyRef-oid unvalidated-sturdyref) $key $target)
(define attenuation (define sturdyref (validate unvalidated-sturdyref key))
(append-map values (reverse (SturdyRef-caveatChain sturdyref)))) (define attenuation
(define attenuated-target (append-map values (reverse (SturdyRef-caveatChain sturdyref))))
(apply attenuate-entity-ref target attenuation)) (define attenuated-target
(at observer (assert (embedded attenuated-target)))))]))))))) (apply attenuate-entity-ref target attenuation))
(at observer (assert (embedded attenuated-target)))))]))))))))
(spawn (spawn
#:name 'tcp-server #:name 'tcp-server

7
syndicate/relay.rkt
View File

@ -283,7 +283,12 @@
(define tr (make-tunnel-relay this-turn name packet-writer)) (define tr (make-tunnel-relay this-turn name packet-writer))
(setup-inputs this-turn tr) (setup-inputs this-turn tr)
(when initial-ref (when initial-ref
(rewrite-ref-out tr initial-ref #f (lambda (_ws) (void)))) (rewrite-ref-out tr
(if (procedure? initial-ref)
(initial-ref this-turn)
initial-ref)
#f
(lambda (_ws) (void))))
(when then (when then
(turn-assert! this-turn (turn-assert! this-turn
then then