Further adaptation to recent Preserves changes
This commit is contained in:
parent
92eab82b1f
commit
ef66c1d358
|
@ -57,6 +57,9 @@
|
||||||
(exit 1))
|
(exit 1))
|
||||||
|
|
||||||
(define (queue-task! e thunk)
|
(define (queue-task! e thunk)
|
||||||
(thread-send (engine-thread e) thunk))
|
(thread-send (engine-thread e)
|
||||||
|
thunk
|
||||||
|
(lambda ()
|
||||||
|
(log-syndicate/engine-warning "Attempt to enqueue task for dead engine ~v" e))))
|
||||||
|
|
||||||
(define *dead-engine* (make-engine 0))
|
(define *dead-engine* (make-engine 0))
|
||||||
|
|
|
@ -122,7 +122,7 @@
|
||||||
(define rewrite-ref-in
|
(define rewrite-ref-in
|
||||||
(action (tr wire-ref save!)
|
(action (tr wire-ref save!)
|
||||||
(match wire-ref
|
(match wire-ref
|
||||||
[(sturdy:WireRef-mine oid)
|
[(sturdy:WireRef-mine (sturdy:Oid oid))
|
||||||
(define ws (grab (tunnel-relay-imported-references tr)
|
(define ws (grab (tunnel-relay-imported-references tr)
|
||||||
membrane-oid-map
|
membrane-oid-map
|
||||||
oid
|
oid
|
||||||
|
@ -131,7 +131,7 @@
|
||||||
(wire-symbol oid (turn-ref this-turn (make-relay-entity tr oid)) 0))))
|
(wire-symbol oid (turn-ref this-turn (make-relay-entity tr oid)) 0))))
|
||||||
(save! ws)
|
(save! ws)
|
||||||
(wire-symbol-ref ws)]
|
(wire-symbol-ref ws)]
|
||||||
[(sturdy:WireRef-yours oid attenuation)
|
[(sturdy:WireRef-yours (sturdy:Oid oid) attenuation)
|
||||||
(define r (lookup-local tr oid))
|
(define r (lookup-local tr oid))
|
||||||
(if (or (null? attenuation) (eq? *inert-ref* r))
|
(if (or (null? attenuation) (eq? *inert-ref* r))
|
||||||
r
|
r
|
||||||
|
@ -143,25 +143,26 @@
|
||||||
(action (tr packet)
|
(action (tr packet)
|
||||||
(match (parse-Turn packet)
|
(match (parse-Turn packet)
|
||||||
[(? eof-object?) (error 'handle-packet "Invalid IO.Turn")]
|
[(? eof-object?) (error 'handle-packet "Invalid IO.Turn")]
|
||||||
[wire-turn
|
[(Turn wire-turn)
|
||||||
(for [(ev (in-list wire-turn))]
|
(for [(ev (in-list wire-turn))]
|
||||||
(match-define (TurnEvent oid event) ev)
|
(log-info "~v" ev)
|
||||||
|
(match-define (TurnEvent (Oid oid) event) ev)
|
||||||
(define r (lookup-local tr oid))
|
(define r (lookup-local tr oid))
|
||||||
(match event
|
(match event
|
||||||
[(Event-Assert (Assert assertion remote-handle))
|
[(Event-Assert (Assert (Assertion assertion) (Handle remote-handle)))
|
||||||
(define-values (a imported) (rewrite-in this-turn tr assertion))
|
(define-values (a imported) (rewrite-in this-turn tr assertion))
|
||||||
(hash-set! (tunnel-relay-inbound-assertions tr)
|
(hash-set! (tunnel-relay-inbound-assertions tr)
|
||||||
remote-handle
|
remote-handle
|
||||||
(inbound (turn-assert! this-turn r a)
|
(inbound (turn-assert! this-turn r a)
|
||||||
imported))]
|
imported))]
|
||||||
[(Event-Retract (Retract remote-handle))
|
[(Event-Retract (Retract (Handle remote-handle)))
|
||||||
(define i (hash-ref (tunnel-relay-inbound-assertions tr) remote-handle #f))
|
(define i (hash-ref (tunnel-relay-inbound-assertions tr) remote-handle #f))
|
||||||
(when (not i) (error 'handle-packet "Peer retracted invalid handle ~a" remote-handle))
|
(when (not i) (error 'handle-packet "Peer retracted invalid handle ~a" remote-handle))
|
||||||
(hash-remove! (tunnel-relay-inbound-assertions tr) remote-handle)
|
(hash-remove! (tunnel-relay-inbound-assertions tr) remote-handle)
|
||||||
(for [(ws (in-list (inbound-imported i)))]
|
(for [(ws (in-list (inbound-imported i)))]
|
||||||
(drop (tunnel-relay-imported-references tr) ws))
|
(drop (tunnel-relay-imported-references tr) ws))
|
||||||
(turn-retract! this-turn (inbound-local-handle i))]
|
(turn-retract! this-turn (inbound-local-handle i))]
|
||||||
[(Event-Message (Message body))
|
[(Event-Message (Message (Assertion body)))
|
||||||
(define-values (a imported) (rewrite-in this-turn tr body))
|
(define-values (a imported) (rewrite-in this-turn tr body))
|
||||||
(when (not (null? imported))
|
(when (not (null? imported))
|
||||||
(error 'handle-packet "Cannot receive transient reference"))
|
(error 'handle-packet "Cannot receive transient reference"))
|
||||||
|
@ -207,14 +208,14 @@
|
||||||
(set-tunnel-relay-next-local-oid! tr (+ oid 1))
|
(set-tunnel-relay-next-local-oid! tr (+ oid 1))
|
||||||
(wire-symbol oid local-ref 0))))
|
(wire-symbol oid local-ref 0))))
|
||||||
(save! ws)
|
(save! ws)
|
||||||
(sturdy:WireRef-mine (wire-symbol-oid ws)))
|
(sturdy:WireRef-mine (sturdy:Oid (wire-symbol-oid ws))))
|
||||||
|
|
||||||
(define (rewrite-ref-out tr local-ref transient? save!)
|
(define (rewrite-ref-out tr local-ref transient? save!)
|
||||||
(define re (entity-data (entity-ref-target local-ref)))
|
(define re (entity-data (entity-ref-target local-ref)))
|
||||||
(cond [(or (not (relay-entity? re)) (not (eq? (relay-entity-relay re) tr)))
|
(cond [(or (not (relay-entity? re)) (not (eq? (relay-entity-relay re) tr)))
|
||||||
(rewrite-ref-out* tr local-ref transient? save!)]
|
(rewrite-ref-out* tr local-ref transient? save!)]
|
||||||
[(null? (entity-ref-attenuation local-ref))
|
[(null? (entity-ref-attenuation local-ref))
|
||||||
(sturdy:WireRef-yours (relay-entity-oid re) '())]
|
(sturdy:WireRef-yours (sturdy:Oid (relay-entity-oid re)) '())]
|
||||||
[else
|
[else
|
||||||
;; we may trust the peer to enforce attenuation on our
|
;; we may trust the peer to enforce attenuation on our
|
||||||
;; behalf, in which case we can return (sturdy:WireRef-yours
|
;; behalf, in which case we can return (sturdy:WireRef-yours
|
||||||
|
@ -238,20 +239,21 @@
|
||||||
(define (make-relay-entity tr oid)
|
(define (make-relay-entity tr oid)
|
||||||
(entity #:name (list (tunnel-relay-name tr) oid)
|
(entity #:name (list (tunnel-relay-name tr) oid)
|
||||||
#:assert (action (assertion handle)
|
#:assert (action (assertion handle)
|
||||||
(send-event tr (Event-Assert (Assert (register tr assertion handle) handle))))
|
(send-event tr (Event-Assert
|
||||||
|
(Assert (Assertion (register tr assertion handle))
|
||||||
|
(Handle handle)))))
|
||||||
#:retract (action (handle)
|
#:retract (action (handle)
|
||||||
(deregister tr handle)
|
(deregister tr handle)
|
||||||
(send-event tr (Event-Retract (Retract handle))))
|
(send-event tr (Event-Retract (Retract (Handle handle)))))
|
||||||
#:message (action (body)
|
#:message (action (body)
|
||||||
(send-event tr (Event-Message (Message (register tr body #f)))))
|
(send-event tr (Event-Message (Message (Assertion (register tr body #f))))))
|
||||||
#:sync (action (peer)
|
#:sync (action (peer)
|
||||||
(define exported #f)
|
(define exported #f)
|
||||||
(define (save! ws) (set! exported ws))
|
(define (save! ws) (set! exported ws))
|
||||||
(define spe (sync-peer-entity tr oid peer (lambda () exported)))
|
(define spe (sync-peer-entity tr oid peer (lambda () exported)))
|
||||||
(send-event tr
|
(send-event tr
|
||||||
(Event-Sync
|
(Event-Sync
|
||||||
(Sync (embedded
|
(Sync (rewrite-ref-out tr (turn-ref this-turn spe) #f save!)))))
|
||||||
(rewrite-ref-out tr (turn-ref this-turn spe) #f save!))))))
|
|
||||||
#:data (relay-entity tr oid)))
|
#:data (relay-entity tr oid)))
|
||||||
|
|
||||||
(define (sync-peer-entity tr oid peer get-export)
|
(define (sync-peer-entity tr oid peer get-export)
|
||||||
|
@ -286,10 +288,12 @@
|
||||||
(turn-assert! this-turn
|
(turn-assert! this-turn
|
||||||
then
|
then
|
||||||
(and initial-oid
|
(and initial-oid
|
||||||
(embedded (rewrite-ref-in this-turn
|
(embedded
|
||||||
tr
|
(rewrite-ref-in this-turn
|
||||||
(sturdy:WireRef-mine initial-oid)
|
tr
|
||||||
(lambda (_ws) (void))))))))))
|
(sturdy:WireRef-mine
|
||||||
|
(sturdy:Oid initial-oid))
|
||||||
|
(lambda (_ws) (void))))))))))
|
||||||
|
|
||||||
(define-syntax-rule (D v0)
|
(define-syntax-rule (D v0)
|
||||||
(let ((v v0))
|
(let ((v v0))
|
||||||
|
|
Loading…
Reference in New Issue