ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-18 12:22:10 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #6478 from silnem2/vats-again

Browse Source 
gen: extend +vats and |suspend to take lists of desks
This commit is contained in:
Ted Blackman 2023-04-24 11:26:10 -04:00 committed by GitHub
commit f55c6fb4cd
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 193 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkg/arvo/gen/hood/suspend.hoon
View File

@ -1,5 +1,3 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
[%kiln-suspend desk]
|= [[now=@da eny=@uvJ bec=beak] desks=(list desk) ~]
[%kiln-suspend-many desks]

14
pkg/arvo/gen/vat.hoon
View File

@ -1,11 +1,7 @@
/- *hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[syd=desk ~]
verb=?
==
=+ ~(abed report-vats p.bec now)
=+ %+ report-vat
verb
%- vat-info syd
[%tang -]
|= [[now=@da eny=@uvJ bec=beak] [syd=desk ~] verb=_&]
:~ %tang
leaf+"Notice: +vat is deprecated as +vats now takes lists of one or more desks"
(report-vat (report-prep p.bec now) p.bec now syd verb)
==

37
pkg/arvo/gen/vats.hoon
View File

@ -1,20 +1,21 @@
:: Print diagnostic information about desks.
::
:: Accepts an optional argument of a list of one or more desks, returns info
:: on all desks if no desks are specified.
::
:: Keyword arguments include =filt and =verb. =filt takes one of %running,
:: %suspended, %exists, %exists-not, or %blocking; =verb takes either & or |
::
:: If both a list of desks and a filter are provided, the output will include
:: the desks from the list that match the filter, with the exception of the
:: %blocking filter which always returns all desks that match.
::
/- *hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
$@(~ [?(%suspended %running %blocking %nonexistent) ~])
$: verb=?
show-suspended=?
show-running=?
show-blocking=?
show-nonexistent=?
==
==
=+ :- verb
?~ +<+< +<+>+
?- -.+<+<
%suspended [& | | |]
%running [| & | |]
%blocking [| | & |]
%nonexistent [| | | &]
==
tang+((report-vats p.bec now) -)
|= [[now=@da * bec=beak] deks=$@(~ (list desk)) filt=@tas verb=_|]
?: &(=(~ deks) =(%$ filt))
:- %tang
%+ turn
~(tap in .^((set desk) %cd /(scot %p p.bec)/base/(scot %da now)))
|=(syd=desk (report-vat (report-prep p.bec now) p.bec now syd verb))
[%tang (report-vats p.bec now deks filt verb)]

15
pkg/arvo/lib/hood/kiln.hoon
View File

@ -551,6 +551,7 @@
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
%kiln-suspend =;(f (f !<(_+<.f vase)) poke-suspend)
%kiln-suspend-many =;(f (f !<(_+<.f vase)) poke-suspend-many)
%kiln-sync =;(f (f !<(_+<.f vase)) poke-sync)
%kiln-syncs =;(f (f !<(_+<.f vase)) poke-syncs)
%kiln-uninstall =;(f (f !<(_+<.f vase)) poke-uninstall)
@ -785,7 +786,19 @@
::
++ poke-suspend
|= =desk
abet:(emit %pass /kiln/suspend %arvo %c %zest desk %dead)
(poke-suspend-many ~[desk])
::
++ poke-suspend-many
|= desks=(list desk)
=< abet
%- emil
%+ turn
%+ skim desks
|= dek=desk
?: (~(has in .^((set desk) %cd /(scot %p our)/base/(scot %da now))) dek)
&
~> %slog.(fmt "desk does not yet exist: {<dek>}") |
|=(=desk [%pass /kiln/suspend %arvo %c %zest desk %dead])
::
++ poke-sync
|= hos=kiln-sync

216
pkg/base-dev/sur/hood.hoon
View File

@ -16,76 +16,118 @@
::
+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
++ report-vats
=| $: =cone
sor=(map desk [ship desk])
zyn=(map [desk ship desk] sync-state)
desks=(set desk)
=pikes
=rock:tire:clay
kel=weft
==
|_ [our=@p now=@da]
+* ego (scot %p our)
wen (scot %da now)
++ $
|= [? ? ? ? ?]
(report-vats:abed +<)
::
++ kel-path
|= =desk
^- path
/[ego]/[desk]/[wen]/sys/kelvin
::
++ desk-exists
|= =desk
?& !=(ud.cass 0):.^(=cass %cw /[ego]/[desk]/[wen])
.^(? %cu (kel-path desk))
==
::
++ abed
%= ..abed
cone .^(^cone %cx /[ego]//[wen]/domes)
sor .^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
zyn .^ (map [desk ship desk] sync-state) %gx
:: +report-prep: get data required for reports
::
++ report-prep
|= [our=@p now=@da]
=/ ego (scot %p our)
=/ wen (scot %da now)
:* .^(rock:tire %cx /[ego]//[wen]/tire)
.^(=cone %cx /[ego]//[wen]/domes)
.^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
.^ (map [desk ship desk] sync-state) %gx
/[ego]/hood/[wen]/kiln/syncs/noun
==
desks .^((set desk) %cd /[ego]/base/[wen])
pikes .^(^pikes %gx /[ego]/hood/[wen]/kiln/pikes/kiln-pikes)
rock .^(rock:tire:clay %cx /[ego]//[wen]/tire)
kel (weft .^(* cx/(en-beam [our %base da+now] /sys/kelvin)))
==
++ vat-info
|= desk=_`desk`%base
=/ pike (~(got by pikes) desk)
=/ zest -:(~(got by rock) desk)
=/ kel-path (kel-path desk)
=/ sink=sink
?~ s=(~(get by sor) desk)
:: +report-vats: report on all desk installations
::
++ report-vats
|= [our=@p now=@da desks=(list desk) filt=@tas verb=?]
=/ ego (scot %p our)
=/ wen (scot %da now)
=/ prep (report-prep our now)
?~ filt
%+ turn (flop desks)
|=(syd=@tas (report-vat prep our now syd verb))
=/ deks
?~ desks ~(tap in -.prep)
%+ skip ~(tap in -.prep)
|=([syd=@tas *] =(~ (find ~[syd] desks)))
?: =(filt %blocking)
=/ base-wic
%+ sort ~(tap by wic:(~(got by -.prep) %base))
|=([[* a=@ud] [* b=@ud]] (gth a b))
?~ base-wic ~[leaf+"%base already up-to-date"]
=/ blockers=(list desk)
%+ turn
%+ skip ~(tap in -.prep)
|= [* [zest=@tas wic=(set weft)]]
?. =(zest %live) &
(~(has in wic) i.base-wic)
|=([syd=desk *] syd)
?~ blockers ~[leaf+"No desks blocking upgrade, run |bump to apply"]
:- [%rose [" %" "To unblock upgrade run |suspend %" ""] blockers]
%+ turn (flop blockers)
|=(syd=desk (report-vat prep our now syd verb))
%+ turn
?+ filt !!
::
%exists
%+ skip deks
|=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
::
%running
%+ skim deks
|=([* [zest=@tas *]] =(zest %live))
::
%suspended
%+ skip deks
|= [syd=@tas [zest=@tas *]]
?| =(syd %kids)
=(zest %live)
=(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0)
==
::
%exists-not
%+ skim deks
|=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
==
|=([syd=desk *] (report-vat prep our now syd verb))
:: +report-vat: report on a single desk installation
::
++ report-vat
|= $: $: tyr=rock:tire =cone sor=(map desk [ship desk])
zyn=(map [desk ship desk] sync-state)
==
our=ship now=@da syd=desk verb=?
==
^- tank
=/ ego (scot %p our)
=/ wen (scot %da now)
=+ .^(=cass %cw /[ego]/[syd]/[wen])
?: =(ud.cass 0)
leaf+"desk does not yet exist: {<syd>}"
?: =(%kids syd)
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
leaf+"%kids %cz hash: {<hash>}"
=/ kel-path
/[ego]/[syd]/[wen]/sys/kelvin
?. .^(? %cu kel-path)
leaf+"bad desk: {<syd>}"
=+ .^(=waft %cx kel-path)
:+ %rose ["" "{<syd>}" "::"]
^- tang
=/ hash .^(@uv %cz /[ego]/[syd]/[wen])
=/ =sink
?~ s=(~(get by sor) syd)
~
?~ z=(~(get by zyn) desk u.s)
?~ z=(~(get by zyn) syd u.s)
~
`[-.u.s +.u.s +.u.z]
=/ hash .^(@uv %cz /[ego]/[desk]/[wen])
=/ dek (~(got by rock) desk)
=/ =dome (~(got by cone) our desk)
=+ .^(=waft %cx kel-path)
:* &1 &2 &3 &4 &5 &6 &7 &8
desk=desk
^= running =(%live zest)
^= suspended =(%dead zest)
^= meb :: =(list @uv)
=/ meb=(list @uv)
?~ sink [hash]~
(mergebase-hashes our desk now her.u.sink sud.u.sink)
^- [on=(list [@tas ?]) of=(list [@tas ?])]
(mergebase-hashes our syd now her.u.sink sud.u.sink)
=/ dek (~(got by tyr) syd)
=/ =dome (~(got by cone) our syd)
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
(skid ~(tap by ren.dome) |=([* ?] +<+))
^= sat
=/ sat
?- zest.dek
%live "running"
%dead "suspended"
%held "suspended until next update"
==
^- kul=tape
=/ kul=tape
%+ roll
%+ sort
~(tap in (waft-to-wefts:clay waft))
@ -95,51 +137,12 @@
(lte lal.a lal.b)
|= [=weft =tape]
(welp " {<[lal num]:weft>}" tape)
^= blocking
?& !=(%base desk)
!=(%live zest.pike)
!(~(has in wic.pike) kel)
== ==
::
++ report-vats
|= $: verb=?
show-suspended=?
show-running=?
show-blocking=?
show-nonexistent=?
==
=/ [real=(list desk) fake=(list desk)]
(skid ~(tap in desks) desk-exists)
=; reals=tang
?. show-nonexistent
reals
%+ weld reals
`tang`(turn fake |=(=desk leaf+"nonexistent desk: {<desk>}"))
%+ turn
%+ skim (turn real vat-info)
|= vat-info
?| &(suspended show-suspended)
&(running show-running)
&(blocking show-blocking)
==
|= =vat-info
^- tank
:+ %rose [" " " " "::"]
:- leaf+"{<desk.vat-info>}"
%- flop
%- report-vat
[verb vat-info]
::
++ report-vat
|= [verb=? vat-info]
^- tang
?: =(%kids desk)
~[leaf+"%kids %cz hash: {<hash>}"]
%- flop
?. verb
=/ base-hash ?.(=(1 (lent meb)) <meb> <(head meb)>)
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash ends in: {(slag (sub (lent base-hash) 5) base-hash)}"
leaf/"%cz hash ends in: {(slag (sub (lent <hash>) 5) <hash>)}"
leaf/"app status: {sat}"
leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
:~ leaf/"/sys/kelvin: {kul}"
@ -150,7 +153,7 @@
leaf/"force on: {?:(=(~ on) "~" <on>)}"
leaf/"force off: {?:(=(~ of) "~" <of>)}"
::
leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}"
leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}"
leaf/"updates: {?~(sink "local" "remote")}"
leaf/"source ship: {?~(sink <~> <her.u.sink>)}"
leaf/"source desk: {?~(sink <~> <sud.u.sink>)}"
@ -158,13 +161,18 @@
leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> <u.kid.u.sink>))}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
++ report-kids
:: +report-kids: non-vat cz hash report for kids desk
::
++ report-kids
|= [our=ship now=@da]
^- tank
?. (~(has in .^((set desk) %cd /[ego]//[wen])) %kids)
=/ syd %kids
=/ ego (scot %p our)
=/ wen (scot %da now)
?. (~(has in .^((set desk) %cd /[ego]//[wen])) syd)
leaf/"no %kids desk"
=+ .^(hash=@uv %cz /[ego]/kids/[wen])
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
leaf/"%kids %cz hash: {<hash>}"
--
:: +read-bill-foreign: read /desk/bill from a foreign desk
::
++ read-bill-foreign