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

View File

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

View File

@ -283,7 +283,12 @@
(define tr (make-tunnel-relay this-turn name packet-writer))
(setup-inputs this-turn tr)
(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
(turn-assert! this-turn
then