From 45617df54062eca501af15fa4cb813e0f8c3a0fd Mon Sep 17 00:00:00 2001
From: ~wicrum-wicrun <99811688+wicrum-wicrun@users.noreply.github.com>
Date: Tue, 4 Apr 2023 21:37:43 +0200
Subject: [PATCH] gall: add permissions to scry paths

---
 pkg/arvo/sys/lull.hoon      |  7 ++--
 pkg/arvo/sys/vane/gall.hoon | 65 ++++++++++++++++++++++++-------------
 2 files changed, 48 insertions(+), 24 deletions(-)

diff --git a/pkg/arvo/sys/lull.hoon b/pkg/arvo/sys/lull.hoon
index 37dcf220d..06923397c 100644
--- a/pkg/arvo/sys/lull.hoon
+++ b/pkg/arvo/sys/lull.hoon
@@ -3291,8 +3291,10 @@
             sup=bitt                                    ::  incoming subs
             $=  sky                                     ::  scry bindings
             %+  map  path                               ::
-            ((mop @ud (pair @da (each page @uvI))) lte) ::
-        ==                                              ::
+            $:  lyc=gang                                ::  permissions
+                $=  fan                                 ::  data
+                ((mop @ud (pair @da (each page @uvI))) lte)
+        ==  ==                                          ::
         $:  act=@ud                                     ::  change number
             eny=@uvJ                                    ::  entropy
             now=@da                                     ::  current time
@@ -3335,6 +3337,7 @@
           [%grow =spur =page]
           [%tomb =case =spur]
           [%cull =case =spur]
+          [%perm =spur diff=$-(gang gang)]
       ==
     +$  task
       $%  [%watch =path]
diff --git a/pkg/arvo/sys/vane/gall.hoon b/pkg/arvo/sys/vane/gall.hoon
index 3f826db2b..3be96b37e 100644
--- a/pkg/arvo/sys/vane/gall.hoon
+++ b/pkg/arvo/sys/vane/gall.hoon
@@ -102,6 +102,7 @@
 ::
 +$  path-state
   $:  bob=(unit @ud)
+      lyc=gang
       fan=((mop @ud (pair @da (each page @uvI))) lte)
   ==
 ::
@@ -321,7 +322,7 @@
           run-nonce     (scot %uw (end 5 (shas %yoke-nonce eny)))
           sky
         ?~  yak  ~
-        (~(run by sky.u.yak) (corl (late ~) (lead ~)))
+        (~(run by sky.u.yak) (cork (lead ~) (late [~ ~])))
       ==
     ::
     =/  old  mo-core
@@ -1032,7 +1033,20 @@
         %+  trace  odd.veb.bug.state
         [leaf+"gall: {<agent-name>}: cull {<[case spur]>} no-op"]~
       %+  ~(put by sky.yoke)  spur  ::  delete all older paths
-      [`yon (lot:on-path fan.u.old `+(yon) ~)]
+      u.old(bob `yon, fan (lot:on-path fan.u.old `+(yon) ~))
+    ::  +ap-perm: change permissions on a scry path
+    ::
+    ::    If the agent so requests, we store permissions even for
+    ::    empty paths, to avoid timing issues when %grow comes
+    ::    before %perm.
+    ::
+    ++  ap-perm
+      |=  [=spur diff=$-(gang gang)]
+      ^+  ap-core
+      =-  ap-core(sky.yoke -)
+      %+  ~(put by sky.yoke)  spur
+      =/  old  (~(gut by sky.yoke) spur *path-state)
+      old(lyc (diff lyc.old))
     ::  +ap-from-internal: internal move to move.
     ::
     ::    We convert from cards to duct-indexed moves when resolving
@@ -1043,7 +1057,7 @@
     ::
     +$  carp  $+  carp  (wind neet gift:agent)
     +$  neet  $+  neet
-      $<  ?(%grow %tomb %cull)
+      $<  ?(%grow %tomb %cull %perm)
       $%  note:agent
           [%agent [=ship name=term] task=[%raw-poke =mark =noun]]
           [%huck [=ship name=term] =note-arvo]
@@ -1728,6 +1742,7 @@
         [%pass * %grow *]  $(caz t.caz, ap-core (ap-grow +.q.i.caz))
         [%pass * %tomb *]  $(caz t.caz, ap-core (ap-tomb +.q.i.caz))
         [%pass * %cull *]  $(caz t.caz, ap-core (ap-cull +.q.i.caz))
+        [%pass * %perm *]  $(caz t.caz, ap-core (ap-perm +.q.i.caz))
         [%pass * ?(%agent %arvo %pyre) *]  $(caz t.caz, fex [i.caz fex])
         [%give *]  $(caz t.caz, fex [i.caz fex])
         [%slip *]  !!
@@ -2047,7 +2062,7 @@
   ^-  roon
   |=  [lyc=gang care=term bem=beam]
   ^-  (unit (unit cage))
-  =/  =shop  &/p.bem
+  =*  ship  p.bem
   =*  dap  q.bem
   =/  =coin  $/r.bem
   =*  path  s.bem
@@ -2058,11 +2073,13 @@
     ~
   ::
   ?:  ?=(%a care)
-    ?.  =(p.bem our)  ~
+    ?.  =(p.bem our)                       ~
     ?~  yok=(~(get by yokes.state) q.bem)  ~
-    ?:  ?=(%nuke -.u.yok)  ~
-    =/  ski  (~(get by sky.u.yok) s.bem)
-    ?~  ski  ~
+    ?:  ?=(%nuke -.u.yok)                  ~
+    ?~  ski=(~(get by sky.u.yok) s.bem)    ~
+    ?:  ?&  ?=(^ lyc.u.ski)
+            !(~(has in u.lyc.u.ski) ship)
+        ==                                 ~
     =/  res=(unit (each page @uvI))
       ?+    -.r.bem  ~
           %ud  (bind (get:on-path fan.u.ski p.r.bem) tail)
@@ -2079,28 +2096,30 @@
     ?.  ?=([~ %& *] res)  ~
     ``p.u.res(q !>(q.p.u.res))
   ::
-  ?.  ?=(%.y -.shop)
-    ~
-  =/  =ship  p.shop
   ?:  ?&  =(%t care)
           =([%$ %da now] coin)
-          =(our ship)
       ==
     =/  yok  (~(get by yokes.state) q.bem)
-    ?.  ?=([~ %live *] yok)  ~
+    ?.  ?=([~ %live *] yok)  [~ ~]
     :^  ~  ~  %file-list  !>  ^-  (list ^path)
-    %+  skim  ~(tap in ~(key by sky.u.yok))
-    |=  =spur
-    ?&  =(s.bem (scag (lent s.bem) spur))
-        !=(s.bem spur)
-    ==
+    %-  ~(rep by sky.u.yok)
+    |=  [[=spur path-state] acc=(list spur)]
+    ?:  ?&  =(s.bem (scag (lent s.bem) spur))
+            !=(s.bem spur)
+            !=(~ fan)
+            ?|  ?=(~ lyc)
+                (~(has in u.lyc) ship)
+        ==  ==
+      [spur acc]
+    acc
   ::
-  ?:  ?&  =(%z care)
-          =(our ship)
-      ==
+  ?:  =(%z care)
     =/  yok  (~(get by yokes.state) q.bem)
     ?.  ?=([~ %live *] yok)              ~
     ?~  ski=(~(get by sky.u.yok) s.bem)  ~
+    ?:  ?&  ?=(^ lyc.u.ski)
+            !(~(has in u.lyc.u.ski) ship)
+        ==                               ~
     =/  res=(unit (pair @da (each noun @uvI)))
       ?+  -.r.bem  ~
         %ud  (get:on-path fan.u.ski p.r.bem)
@@ -2198,11 +2217,13 @@
   ::
   ?:  ?&  =(%w care)
           =([%$ %da now] coin)
-          =(our ship)
       ==
     =/  yok  (~(get by yokes.state) q.bem)
     ?.  ?=([~ %live *] yok)              [~ ~]
     ?~  ski=(~(get by sky.u.yok) s.bem)  [~ ~]
+    ?:  ?&  ?=(^ lyc.u.ski)
+            !(~(has in u.lyc.u.ski) ship)
+        ==                               ~
     ?~  las=(ram:on-path fan.u.ski)      [~ ~]
     ``case/!>(ud/key.u.las)
   ::