Merge branch 'philip/gall-unsub' (#1756)

* philip/gall-unsub:
  gall: unsubscribe after breach

Signed-off-by: Jared Tobin <jared@tlon.io>

bin/solid.pill

@@ -1,3 +1,3 @@
 version https://git-lfs.github.com/spec/v1
-oid sha256:f42ac1a3a138f563e5394c3cf8d86583368cba8fd09fe02f1f11025fb4b57c8a
+oid sha256:7bd794546c921d200d25091cf5d5efd0c0b237b55dcf87a3c7d135445ab46f72
-size 15371855
+size 15471644

pkg/arvo/app/ph.hoon

@@ -309,6 +309,40 @@
         (check-file-touched ~marbud %home file)
       ~&  >  'DONE DONE'
       (pure:m ~)
+    ::
+    ::  Doesn't succeed because success is hard to define, just make
+    ::  sure it doesn't crash in Gall
+    ::
+      :+  %breach-gall
+        ~[~bud ~dev]
+      =.  eth-node  (spawn:eth-node ~dev)
+      ;<  [eth-node=_eth-node ~]  bind:m
+        %+  (wrap-philter ,_eth-node ,~)
+          router:eth-node
+        ;<  ~  bind:m  (raw-real-ship:eth-node ~bud)
+        ~&  >  'BUD DONE'
+        ;<  ~  bind:m  (raw-real-ship:eth-node ~dev)
+        ~&  >  'DEV DONE'
+        ;<  ~  bind:m  (just-events (dojo ~bud "|start %hall"))
+        ;<  ~  bind:m  (just-events (dojo ~bud "|start %talk"))
+        ;<  ~  bind:m  (just-events (dojo ~dev "|start %hall"))
+        ;<  ~  bind:m  (just-events (dojo ~dev "|start %talk"))
+        ;<  ~  bind:m  (just-events (dojo ~bud ";create channel %hi 'desc'"))
+        ;<  ~  bind:m  (just-events (dojo ~dev ";join ~bud/hi"))
+        ;<  ~  bind:m  (just-events (dojo ~bud "heyya"))
+        (wait-for-dojo ~dev "heyya")
+      ~&  >  'CHANNEL DONE'
+      ;<  eth-node=_eth-node  bind:m
+        (breach-and-hear:eth-node our.hid ~dev ~bud)
+      ~&  >  'BREACH DONE'
+      ;<  [eth-node=_eth-node ~]  bind:m
+        %+  (wrap-philter ,_eth-node ,~)
+          router:eth-node
+        ;<  ~  bind:m  (raw-real-ship:eth-node ~dev)
+        ~&  >  'REBOOT DEV DONE'
+        (send-hi ~bud ~dev)
+      ~&  >  'DONE'
+      stall
   ==
 ::
 ++  install-tests

pkg/arvo/lib/ph/util.hoon

@@ -34,6 +34,15 @@
     [//term/1 %belt %ret ~]
   ==
 ::
+::  Control character
+::
+++  ctrl
+  |=  [who=ship what=term]
+  ^-  (list ph-event)
+  %+  send-events-to  who
+  :~  [//term/1 %belt %ctl (,@c what)]
+  ==
+::
 ::  Inject a file into a ship
 ::
 ++  insert-file

pkg/arvo/sys/vane/gall.hoon

@@ -127,7 +127,10 @@
 ::  +foreign: foreign connections
 ::
 ++  foreign
-  $:  :: index
+  $:  :: rift of first contact
+      ::
+      =rift
+      :: index
       ::
       index=@ud
       :: by duct
@@ -469,10 +472,16 @@
     |=  =ship
     ^-  [bone _mo-core]
     ::
-    =/  =foreign
+    =?  mo-core  !(~(has by contacts.agents.state) ship)
-      =/  existing  (~(get by contacts.agents.state) ship)
+      =/  =note-arvo  [%j %public-keys (silt ship ~)]
-      (fall existing [1 ~ ~])
+      =.  moves  [[system-duct.agents.state %pass /sys/jael note-arvo] moves]
+      =/  =rift  (fall (mo-rift-scry ship) *rift)
+      =/  =foreign  [rift 1 ~ ~]
+      =.  contacts.agents.state
+        (~(put by contacts.agents.state) ship foreign)
+      mo-core
     ::
+    =/  =foreign  (~(got by contacts.agents.state) ship)
     =/  existing  (~(get by index-map.foreign) hen)
     ?^  existing
       [u.existing mo-core]
@@ -493,10 +502,49 @@
   ::
   ++  mo-retrieve-duct
     |=  [=ship index=@ud]
-    ^-  duct
+    ^-  (unit duct)
     ::
-    =/  =foreign  (~(got by contacts.agents.state) ship)
+    =/  contact=(unit foreign)  (~(get by contacts.agents.state) ship)
-    (~(got by duct-map.foreign) index)
+    ?~  contact
+      ~
+    `(~(got by duct-map.u.contact) index)
+  ::  +mo-rift-scry: for a +rift
+  ::
+  ++  mo-rift-scry
+    |=  who=ship
+    ^-  (unit rift)
+    =;  rit
+      ?~(rit ~ u.rit)
+    ;;  (unit (unit rift))
+    %-  (sloy-light ska)
+    =/  pur=spur
+      /(scot %p who)
+    [[151 %noun] %j our %rift da+now pur]
+  ::  +mo-cancel-jael: cancel jael subscription
+  ::
+  ++  mo-cancel-jael
+    |=  =ship
+    ^+  mo-core
+    =/  =note-arvo  [%j %nuke (silt ship ~)]
+    =.  moves
+      [[system-duct.agents.state %pass /sys/jael note-arvo] moves]
+    mo-core
+  ::  +mo-breach: ship breached, so forget about them
+  ::
+  ++  mo-breach
+    |=  =ship
+    ^+  mo-core
+    =/  agents=(list [name=term =agent])  ~(tap by running.agents.state)
+    |-  ^+  mo-core
+    ?~  agents
+      mo-core
+    =.  mo-core
+      =/  =routes  [disclosing=~ attributing=ship]
+      =/  app  (ap-abed:ap name.i.agents routes)
+      ap-abet:(ap-breach:app ship)
+    =.  mo-core  (mo-cancel-jael ship)
+    =.  contacts.agents.state  (~(del by contacts.agents.state) ship)
+    $(agents t.agents)
   ::  +mo-handle-sys: handle a +sign incoming over /sys.
   ::
   ::    (Note that /sys implies the +sign should be routed to a vane.)
@@ -507,6 +555,7 @@
     ^+  mo-core
     ::
     ?+  -.path  !!
+      %jael  (mo-handle-sys-jael path sign-arvo)
       %core  (mo-handle-sys-core path sign-arvo)
       %pel   (mo-handle-sys-pel path sign-arvo)
       %red   (mo-handle-sys-red path sign-arvo)
@@ -515,6 +564,43 @@
       %val   (mo-handle-sys-val path sign-arvo)
       %way   (mo-handle-sys-way path sign-arvo)
     ==
+  ::  +mo-handle-sys-jael: receive update about contact
+  ::
+  ++  mo-handle-sys-jael
+    |=  [=path =sign-arvo]
+    ^+  mo-core
+    ?>  ?=([%j %public-keys *] sign-arvo)
+    ?>  ?=([%jael ~] path)
+    ?:  ?=(%full -.public-keys-result.sign-arvo)
+      =/  ships=(list [=ship =point:able:jael])
+        ~(tap by points.public-keys-result.sign-arvo)
+      |-  ^+  mo-core
+      ?~  ships
+        mo-core
+      =.  mo-core
+        =/  contact=(unit foreign)
+          (~(get by contacts.agents.state) ship.i.ships)
+        ?~  contact
+          =/  =tank
+            leaf+"gall: unexpected jael update for {<ship.i.ships>}, cancelling"
+          %-  (slog tank ~)
+          (mo-cancel-jael ship.i.ships)
+        ?:  (lte rift.point.i.ships rift.u.contact)
+          mo-core
+        (mo-breach ship.i.ships)
+      $(ships t.ships)
+    ?.  ?=(%rift -.diff.public-keys-result.sign-arvo)
+      mo-core
+    =/  =ship  who.public-keys-result.sign-arvo
+    =/  contact=(unit foreign)  (~(get by contacts.agents.state) ship)
+    ?~  contact
+      =/  =tank
+        leaf+"gall: unexpected jael update for {<ship>}, cancelling"
+      %-  (slog tank ~)
+      (mo-cancel-jael ship)
+    ?:  (lte to.diff.public-keys-result.sign-arvo rift.u.contact)
+      mo-core
+    (mo-breach ship)
   ::  +mo-handle-sys-core: receive a core from %ford.
   ::
   ++  mo-handle-sys-core
@@ -634,7 +720,10 @@
     ::  XX pump should ack
     =.  mo-core  (mo-give %mack ~)
     =/  duct  (mo-retrieve-duct him num)
-    =.  mo-core  (mo-abed duct)
+    ?~  duct
+      %-  (slog leaf/"gall: sys-rep no index" ~)
+      mo-core
+    =.  mo-core  (mo-abed u.duct)
     =/  =cage  (result-to-cage:ford build-result)
     =/  move  [%unto [%diff cage]]
     (mo-give move)
@@ -955,9 +1044,12 @@
         %x
       ::  XX should crash
       =.  mo-core  (mo-give %mack ~)
-      =/  initialised
       =/  out  (mo-retrieve-duct ship bone)
-        (mo-abed out)
+      ?~  out
+        %-  (slog leaf/"gall: x no index" ~)
+        mo-core
+      =/  initialised
+        (mo-abed u.out)
       (mo-give:initialised %unto %quit ~)
     ==
   ::  +ap: agent engine
@@ -1123,6 +1215,29 @@
           [%pass use-path note-arvo]
         ==
       [duct card]
+    ::  +ap-breach: ship breached, so forget about them
+    ::
+    ++  ap-breach
+      |=  =ship
+      ^+  ap-core
+      =/  in=(list [=bone =^ship =path])
+        ~(tap by incoming.subscribers.current-agent)
+      |-  ^+  ap-core
+      ?^  in
+        =?  ap-core  =(ship ship.i.in)
+          =/  core  ap-load-delete(agent-bone bone.i.in)
+          core(agent-bone agent-bone)
+        $(in t.in)
+      ::
+      =/  out=(list [[=bone =wire] =bean =^ship =path])
+        ~(tap by outgoing.subscribers.current-agent)
+      |-  ^+  ap-core
+      ?~  out
+        ap-core
+      =?  ap-core  =(ship ship.i.out)
+        =/  core  (ap-specific-take(agent-bone bone.i.out) wire.i.out %quit ~)
+        core(agent-bone agent-bone)
+      $(out t.out)
     ::  +ap-call: call into server.
     ::
     ++  ap-call