gall: add permissions to scry paths

This commit is contained in:
~wicrum-wicrun 2023-04-04 21:37:43 +02:00
parent 8cd29cb8e7
commit 45617df540
2 changed files with 48 additions and 24 deletions

View File

@ -3291,8 +3291,10 @@
sup=bitt :: incoming subs sup=bitt :: incoming subs
$= sky :: scry bindings $= sky :: scry bindings
%+ map path :: %+ 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 $: act=@ud :: change number
eny=@uvJ :: entropy eny=@uvJ :: entropy
now=@da :: current time now=@da :: current time
@ -3335,6 +3337,7 @@
[%grow =spur =page] [%grow =spur =page]
[%tomb =case =spur] [%tomb =case =spur]
[%cull =case =spur] [%cull =case =spur]
[%perm =spur diff=$-(gang gang)]
== ==
+$ task +$ task
$% [%watch =path] $% [%watch =path]

View File

@ -102,6 +102,7 @@
:: ::
+$ path-state +$ path-state
$: bob=(unit @ud) $: bob=(unit @ud)
lyc=gang
fan=((mop @ud (pair @da (each page @uvI))) lte) fan=((mop @ud (pair @da (each page @uvI))) lte)
== ==
:: ::
@ -321,7 +322,7 @@
run-nonce (scot %uw (end 5 (shas %yoke-nonce eny))) run-nonce (scot %uw (end 5 (shas %yoke-nonce eny)))
sky sky
?~ yak ~ ?~ yak ~
(~(run by sky.u.yak) (corl (late ~) (lead ~))) (~(run by sky.u.yak) (cork (lead ~) (late [~ ~])))
== ==
:: ::
=/ old mo-core =/ old mo-core
@ -1032,7 +1033,20 @@
%+ trace odd.veb.bug.state %+ trace odd.veb.bug.state
[leaf+"gall: {<agent-name>}: cull {<[case spur]>} no-op"]~ [leaf+"gall: {<agent-name>}: cull {<[case spur]>} no-op"]~
%+ ~(put by sky.yoke) spur :: delete all older paths %+ ~(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. :: +ap-from-internal: internal move to move.
:: ::
:: We convert from cards to duct-indexed moves when resolving :: We convert from cards to duct-indexed moves when resolving
@ -1043,7 +1057,7 @@
:: ::
+$ carp $+ carp (wind neet gift:agent) +$ carp $+ carp (wind neet gift:agent)
+$ neet $+ neet +$ neet $+ neet
$< ?(%grow %tomb %cull) $< ?(%grow %tomb %cull %perm)
$% note:agent $% note:agent
[%agent [=ship name=term] task=[%raw-poke =mark =noun]] [%agent [=ship name=term] task=[%raw-poke =mark =noun]]
[%huck [=ship name=term] =note-arvo] [%huck [=ship name=term] =note-arvo]
@ -1728,6 +1742,7 @@
[%pass * %grow *] $(caz t.caz, ap-core (ap-grow +.q.i.caz)) [%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 * %tomb *] $(caz t.caz, ap-core (ap-tomb +.q.i.caz))
[%pass * %cull *] $(caz t.caz, ap-core (ap-cull +.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]) [%pass * ?(%agent %arvo %pyre) *] $(caz t.caz, fex [i.caz fex])
[%give *] $(caz t.caz, fex [i.caz fex]) [%give *] $(caz t.caz, fex [i.caz fex])
[%slip *] !! [%slip *] !!
@ -2047,7 +2062,7 @@
^- roon ^- roon
|= [lyc=gang care=term bem=beam] |= [lyc=gang care=term bem=beam]
^- (unit (unit cage)) ^- (unit (unit cage))
=/ =shop &/p.bem =* ship p.bem
=* dap q.bem =* dap q.bem
=/ =coin $/r.bem =/ =coin $/r.bem
=* path s.bem =* path s.bem
@ -2058,11 +2073,13 @@
~ ~
:: ::
?: ?=(%a care) ?: ?=(%a care)
?. =(p.bem our) ~ ?. =(p.bem our) ~
?~ yok=(~(get by yokes.state) q.bem) ~ ?~ yok=(~(get by yokes.state) q.bem) ~
?: ?=(%nuke -.u.yok) ~ ?: ?=(%nuke -.u.yok) ~
=/ ski (~(get by sky.u.yok) s.bem) ?~ ski=(~(get by sky.u.yok) s.bem) ~
?~ ski ~ ?: ?& ?=(^ lyc.u.ski)
!(~(has in u.lyc.u.ski) ship)
== ~
=/ res=(unit (each page @uvI)) =/ res=(unit (each page @uvI))
?+ -.r.bem ~ ?+ -.r.bem ~
%ud (bind (get:on-path fan.u.ski p.r.bem) tail) %ud (bind (get:on-path fan.u.ski p.r.bem) tail)
@ -2079,28 +2096,30 @@
?. ?=([~ %& *] res) ~ ?. ?=([~ %& *] res) ~
``p.u.res(q !>(q.p.u.res)) ``p.u.res(q !>(q.p.u.res))
:: ::
?. ?=(%.y -.shop)
~
=/ =ship p.shop
?: ?& =(%t care) ?: ?& =(%t care)
=([%$ %da now] coin) =([%$ %da now] coin)
=(our ship)
== ==
=/ yok (~(get by yokes.state) q.bem) =/ yok (~(get by yokes.state) q.bem)
?. ?=([~ %live *] yok) ~ ?. ?=([~ %live *] yok) [~ ~]
:^ ~ ~ %file-list !> ^- (list ^path) :^ ~ ~ %file-list !> ^- (list ^path)
%+ skim ~(tap in ~(key by sky.u.yok)) %- ~(rep by sky.u.yok)
|= =spur |= [[=spur path-state] acc=(list spur)]
?& =(s.bem (scag (lent s.bem) spur)) ?: ?& =(s.bem (scag (lent s.bem) spur))
!=(s.bem spur) !=(s.bem spur)
== !=(~ fan)
?| ?=(~ lyc)
(~(has in u.lyc) ship)
== ==
[spur acc]
acc
:: ::
?: ?& =(%z care) ?: =(%z care)
=(our ship)
==
=/ yok (~(get by yokes.state) q.bem) =/ yok (~(get by yokes.state) q.bem)
?. ?=([~ %live *] yok) ~ ?. ?=([~ %live *] yok) ~
?~ ski=(~(get by sky.u.yok) s.bem) ~ ?~ 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))) =/ res=(unit (pair @da (each noun @uvI)))
?+ -.r.bem ~ ?+ -.r.bem ~
%ud (get:on-path fan.u.ski p.r.bem) %ud (get:on-path fan.u.ski p.r.bem)
@ -2198,11 +2217,13 @@
:: ::
?: ?& =(%w care) ?: ?& =(%w care)
=([%$ %da now] coin) =([%$ %da now] coin)
=(our ship)
== ==
=/ yok (~(get by yokes.state) q.bem) =/ yok (~(get by yokes.state) q.bem)
?. ?=([~ %live *] yok) [~ ~] ?. ?=([~ %live *] yok) [~ ~]
?~ ski=(~(get by sky.u.yok) s.bem) [~ ~] ?~ 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) [~ ~] ?~ las=(ram:on-path fan.u.ski) [~ ~]
``case/!>(ud/key.u.las) ``case/!>(ud/key.u.las)
:: ::