shrub/pkg/arvo/lib/hood/kiln.hoon

1710 lines
51 KiB
Plaintext
Raw Normal View History

/- *hood
2021-07-23 14:07:58 +03:00
/* base-bill %bill /desk/bill
=, clay
2016-12-02 02:59:17 +03:00
=, space:userlib
=, format
=* dude dude:gall
|%
+$ state state-7
+$ state-7 [%7 pith-7]
+$ state-6 [%6 pith-6]
2021-09-06 17:27:17 +03:00
+$ state-5 [%5 pith-5]
2021-08-20 01:57:31 +03:00
+$ state-4 [%4 pith-4]
+$ state-3 [%3 pith-3]
+$ state-2 [%2 pith-2]
+$ state-1 [%1 pith-1]
+$ state-0 [%0 pith-0]
+$ any-state
2021-08-11 19:23:36 +03:00
$~ *state
$% state-7
state-6
state-5
2021-09-06 17:27:17 +03:00
state-4
2021-08-20 01:57:31 +03:00
state-3
state-2
state-1
state-0
==
::
+$ pith-7
$: wef=(unit weft)
rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ark=(map desk arak) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
fus=(map desk per-fuse)
:: used for fuses - every time we get a fuse we
:: bump this. used when calculating hashes to
:: ensure they're unique even when the same
:: request is made multiple times.
hxs=(map desk @ud)
== ::
::
+$ pith-6
$: wef=(unit weft)
rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ark=(map desk arak-6) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
fus=(map desk per-fuse)
:: used for fuses - every time we get a fuse we
:: bump this. used when calculating hashes to
:: ensure they're unique even when the same
:: request is made multiple times.
hxs=(map desk @ud)
== ::
::
+$ arak-6 [rail=rail-6 next=(list rung) =rein]
+$ rail-6 [paused=? =ship =desk =aeon]
::
2021-09-06 17:27:17 +03:00
+$ pith-5
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ark=(map desk arak-6) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
2021-05-24 01:43:41 +03:00
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
fus=(map desk per-fuse)
:: used for fuses - every time we get a fuse we
:: bump this. used when calculating hashes to
:: ensure they're unique even when the same
:: request is made multiple times.
hxs=(map desk @ud)
== ::
2021-09-06 17:27:17 +03:00
::
+$ pith-4 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ark=(map desk arak-4) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
fus=(map desk per-fuse)
:: used for fuses - every time we get a fuse we
:: bump this. used when calculating hashes to
:: ensure they're unique even when the same
:: request is made multiple times.
hxs=(map desk @ud)
== ::
+$ arak-4
$: =ship
=desk
=aeon
next=(list rung)
=rein
==
2021-08-20 01:57:31 +03:00
+$ pith-3 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ark=(map desk arak-3) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
fus=(map desk per-fuse)
:: used for fuses - every time we get a fuse we
:: bump this. used when calculating hashes to
:: ensure they're unique even when the same
:: request is made multiple times.
hxs=(map desk @ud)
==
+$ arak-3
$: =ship
=desk
=aeon
2021-09-06 17:27:17 +03:00
next=(list rung)
2021-08-20 01:57:31 +03:00
rein=rein-3
==
+$ rein-3
$: add=(set dude)
sub=(set dude)
==
::
+$ pith-2 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
2021-08-11 19:23:36 +03:00
fus=(map desk per-fuse)
hxs=(map desk @ud)
== ::
+$ pith-1 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
== ::
+$ pith-0 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
autoload-on=? ::
cur-hoon=@uvI ::
cur-arvo=@uvI ::
cur-zuse=@uvI ::
cur-vanes=(map @tas @uvI) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
==
+$ per-desk :: per-desk state
$: auto=? :: escalate on failure
gem=?(%this %that germ) :: strategy
her=@p :: from ship
sud=@tas :: from desk
cas=case :: at case
==
2021-05-24 01:43:41 +03:00
+$ per-fuse :: per fuse state
:: map [ship desk] to latest version number we
:: have for them. used for things we're %trak-ing
:: our invariant here is to store the latest version
:: number we've heard of.
$: mox=(map [ship desk] let=@ud)
:: relevant parts of originating request
kf=kiln-fuse-data
==
+$ kiln-commit term ::
+$ kiln-mount ::
$: pax=path ::
pot=term ::
==
+$ kiln-unmount $@(term [knot path]) ::
+$ kiln-sync ::
$: syd=desk :: local desk
her=ship :: foreign ship
sud=desk :: foreign desk
==
+$ kiln-unsync ::
$: syd=desk :: local desk
her=ship :: foreign ship
sud=desk :: foreign desk
==
+$ kiln-merge ::
$@ ~
$: syd=desk ::
ali=ship ::
sud=desk ::
cas=case ::
gim=?(%auto germ) ::
==
2021-05-24 01:43:41 +03:00
+$ fuse-source [who=ship des=desk ver=$@(%trak case)]
:: actual poke
2021-04-20 06:46:46 +03:00
+$ kiln-fuse
2021-05-02 06:04:19 +03:00
$@ ~
2021-04-20 06:46:46 +03:00
$: syd=desk
2021-05-24 01:43:41 +03:00
$@ ~ :: signifies clearing the fuse
$: overwrite=flag :: force overwrite previous fuse
bas=fuse-source
con=(list [fuse-source germ])
==
2021-04-20 06:46:46 +03:00
==
2021-05-24 01:43:41 +03:00
:: state tracked by kiln
+$ kiln-fuse-data
$: syd=desk
bas=fuse-source
con=(list [fuse-source germ])
==
:: Request to list current fuses. ~ means "list all"
::
+$ kiln-fuse-list (unit desk)
--
2021-08-18 01:16:48 +03:00
|= [bowl:gall state]
2015-09-02 01:20:17 +03:00
?> =(src our)
=| moz=(list card:agent:gall)
|%
++ kiln .
2015-12-09 04:54:26 +03:00
++ abet :: resolve
[(flop moz) `state`+<+.$]
2015-09-02 01:20:17 +03:00
::
2019-11-14 21:39:50 +03:00
++ emit
2019-11-19 07:36:21 +03:00
|= card:agent:gall
2019-11-14 21:39:50 +03:00
%_(+> moz [+< moz])
::
++ emil :: return cards
2019-11-19 07:36:21 +03:00
|= (list card:agent:gall)
2015-09-02 01:20:17 +03:00
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ render
|= [mez=tape sud=desk who=ship syd=desk]
:^ %palm [" " ~ ~ ~] leaf+(weld "kiln: " mez)
2015-12-21 00:16:39 +03:00
~[leaf+"from {<sud>}" leaf+"on {<who>}" leaf+"to {<syd>}"]
2015-09-02 01:20:17 +03:00
::
++ on-init
=< abet
~> %slog.0^leaf/"kiln: boot"
=/ desks=(set desk)
.^((set desk) %cd /(scot %p our)//(scot %da now))
=. desks (~(del in desks) %base)
=. desks (~(del in desks) %kids)
:: set up base desk
::
=. ..on-init
=/ =rein [liv=& add=(sy %hood %dojo ~) sub=~] :: TODO questionable
=/ daz (get-apps-want base-bill rein)
%- emil
%- zing ^- (list (list card:agent:gall))
(turn daz start-dude:~(pass vats [%base *arak]))
:: install other desks
::
=/ dez=(list desk) ~(tap in desks)
=/ sop=ship
(sein:title our now our)
|-
?~ dez ..on-init
=. ..on-init
abet:(install-local:vats i.dez)
=? ..on-init !=(sop our)
abet:(install:vats i.dez sop i.dez)
$(dez t.dez)
::
2020-06-10 02:21:30 +03:00
++ on-load
2021-08-11 19:23:36 +03:00
=> |%
+$ ota [syd=desk her=ship sud=desk]
--
=| old-ota=(unit ota)
2020-07-18 02:58:28 +03:00
|= [hood-version=@ud old=any-state]
2021-08-11 19:23:36 +03:00
=? old-ota ?=(%0 -.old)
=/ syncs=(list [ota =aeon]) ~(tap by syn.old)
|- ^- (unit ota)
?~ syncs
~
?: &(=([%base %kids] [syd sud]:i.syncs) !=(our her.i.syncs))
`[syd her sud]:i.syncs
$(syncs t.syncs)
::
=? old ?=(%0 -.old)
=? syn.old ?=(^ old-ota) (~(del by syn.old) u.old-ota)
[%3 [rem syn ark=~ commit-timer fus=~ hxs=~]:old]
2020-06-10 02:21:30 +03:00
::
=? old ?=(%1 -.old)
:* %2
rem.old
syn.old
ota.old
commit-timer.old
2021-08-11 19:23:36 +03:00
fus=~
hxs=~
==
2021-08-11 19:23:36 +03:00
::
=? old-ota ?=(%2 -.old)
?~ ota.old ~
`[%base ship desk]:u.ota.old
2020-06-10 02:21:30 +03:00
::
=? old ?=(%2 -.old)
:* %3
rem.old
syn.old
ark=~
commit-timer.old
2021-08-11 19:23:36 +03:00
fus.old
hxs.old
==
::
2021-09-06 17:27:17 +03:00
=? old ?=(%3 -.old)
:- %4
+.old(ark (~(run by ark.old) |=(a=arak-3 a(rein [liv=& rein.a]))))
::
=? old ?=(%4 -.old)
:- %5
=- +.old(ark -)
%- ~(run by ark.old)
|= a=arak-4
^- arak-6
2021-09-06 17:27:17 +03:00
[[paused=| ship desk aeon] next rein]:a
::
=? old ?=(%5 -.old)
[%6 ~ +.old]
2021-09-06 17:27:17 +03:00
::
=? old ?=(%6 -.old)
:- %7
=- +.old(ark -)
%- ~(run by ark.old)
|= a=arak-6
^- arak
:_ rein.a
^- (unit rail)
`[paused.rail ship.rail desk.rail aeon.rail next]:a
::
?> ?=(%7 -.old)
=. +<+.$.abet old
2021-08-11 19:23:36 +03:00
=< abet
=? kiln ?=(^ old-ota)
abet:(install:vats %base [her sud]:u.old-ota)
=? kiln ?=(^ wef)
=/ except=(set desk) (sy %base %kids ~)
(bump:vats u.wef (all-desks-but:vats except) %.n)
=. wef ~
kiln
2020-06-10 02:21:30 +03:00
::
++ on-peek
|= =path
^- (unit (unit cage))
2020-12-04 11:37:28 +03:00
?+ path [~ ~]
2021-08-24 07:09:12 +03:00
[%x %kiln %lag ~] ``loob+!>(.^(? //(scot %p our)//(scot %da now)/zen/lag))
::
2021-08-23 04:44:24 +03:00
[%x %kiln %vat @ ~]
=* loc i.t.t.t.path
=/ ego (scot %p our)
=/ wen (scot %da now)
=/ rak=(unit arak) (~(get by ark) loc)
?~ rak [~ ~]
=/ hog .^(@uv cz+~[ego loc wen])
=/ cas .^(cass cw+~[ego loc wen])
:^ ~ ~ %noun
2021-08-23 04:44:24 +03:00
!> ^- vat
[loc hog cas u.rak]
2021-08-24 07:09:12 +03:00
::
2021-08-23 04:44:24 +03:00
[%x %kiln %vats ~]
:^ ~ ~ %kiln-vats
!> ^- (list vat)
=/ ego (scot %p our)
=/ wen (scot %da now)
%+ turn ~(tap by ark)
|= [loc=desk rak=arak]
=/ hog .^(@uv cz+~[ego loc wen])
=/ cas .^(cass cw+~[ego loc wen])
[loc hog cas rak]
::
[%x %kiln %ark ~] ``noun+!>(ark)
2020-12-04 11:37:28 +03:00
[%x %kiln %our ~] ``noun+!>(our)
[%x %kiln %base-hash ~]
2021-07-23 14:07:58 +03:00
=/ ver (mergebase-hashes our %base now (~(got by ark) %base))
2020-12-04 11:37:28 +03:00
``noun+!>(?~(ver 0v0 i.ver))
2020-12-02 09:27:52 +03:00
==
::
++ vats
|_ [loc=desk rak=arak]
++ ral (need rail.rak)
++ vats .
++ abet kiln(ark (~(put by ark) loc rak))
++ abed
|= lac=desk
~_ leaf/"kiln: {<lac>} not installed"
vats(loc lac, rak (~(got by ark) lac))
::
++ here "{<loc>} from {<[ship desk]:ral>}"
++ make-wire |=(step=@tas /kiln/vats/[loc]/[step])
++ from-wire
|= =wire
~| wire
?> ?=([@ @ *] wire)
(abed i.wire)
2021-07-07 21:11:40 +03:00
::
++ emit |=(card:agent:gall vats(kiln (^emit +<)))
++ emil |=((list card:agent:gall) vats(kiln (^emil +<)))
++ give
|%
++ snap [%give %fact ~[/kiln/vats] %kiln-vats-snap !>(ark)]
++ diff |=(d=^diff [%give %fact ~[/kiln/vats] %kiln-vats-diff !>(d)])
--
2021-07-07 21:11:40 +03:00
++ pass
|%
++ pyre |=(=tang [%pass /kiln/vats %pyre tang])
2021-07-07 21:11:40 +03:00
++ find (warp %find [%sing %y ud+1 /])
++ sync-da (warp %sync [%sing %w da+now /])
++ sync-ud (warp %sync [%sing %w ud+aeon:ral /])
++ download (warp %download [%sing %v ud+aeon:ral /])
2021-09-06 17:27:17 +03:00
++ warp
|= [s=term r=rave]
(clay-card s %warp ship:ral desk:ral `r)
2021-07-09 18:56:52 +03:00
++ merge-main
2021-07-07 21:11:40 +03:00
=/ germ (get-germ loc)
=/ =aeon (dec aeon:ral)
2021-09-06 17:27:17 +03:00
%+ clay-card %merge-main
[%merg loc ship:ral desk:ral ud+aeon germ]
2021-07-09 18:56:52 +03:00
++ merge-kids
=/ germ (get-germ %kids)
=/ =aeon (dec aeon:ral)
2021-09-06 17:27:17 +03:00
%+ clay-card %merge-kids
[%merg %kids ship:ral desk:ral ud+aeon germ]
2021-09-15 22:57:08 +03:00
++ listen
(clay-card %listen %warp our loc `[%next %z da+now /])
2021-07-07 21:11:40 +03:00
++ clay-card
|= [step=@tas =task:clay]
^- card:agent:gall
[%pass (make-wire step) %arvo %c task]
++ start-dude
|= =dude
^- (list card:agent:gall)
:- [%pass /kiln/vats/[loc]/jolt/[dude] %arvo %g %jolt loc dude]
2021-07-23 14:07:58 +03:00
?. (is-fish dude (read-bill our loc now))
~> %slog.0^leaf/"kiln: jolt {<dude>}"
~
2021-07-23 14:07:58 +03:00
~> %slog.0^leaf/"kiln: jolt {<dude>}, binding console"
=/ =cage [%drum-link !>([our dude])]
[%pass /kiln/link/[dude] %agent [our %hood] %poke cage]~
++ stop-dude
|= =dude
^- (list card:agent:gall)
:- [%pass /kiln/vats/[loc]/uninstall %arvo %g %idle dude]
2021-07-23 14:07:58 +03:00
?. (is-fish dude (read-bill our loc now))
~> %slog.0^leaf/"kiln: idle {<dude>}"
~
2021-07-23 14:07:58 +03:00
~> %slog.0^leaf/"kiln: idle {<dude>}, unbinding console"
=/ =cage [%drum-unlink !>([our dude])]
[%pass /kiln/link/[dude] %agent [our %hood] %poke cage]~
2021-07-07 21:11:40 +03:00
--
:: +uninstall: stop tracking apps on desk, and suspend apps
::
++ uninstall
|= lac=desk
^+ kiln
?: =(%base lac)
2021-08-27 17:38:30 +03:00
=- (^emit (pyre:pass leaf/- ~))
"kiln: |uninstall: %base cannot be uninstalled"
?. (~(has by ark) lac)
~> %slog.0^leaf/"kiln: |uninstall: {<lac>} not installed, ignoring"
kiln
=. vats (abed lac)
~> %slog.0^leaf/"kiln: uninstalling {here}"
2021-08-20 01:57:31 +03:00
=. vats stop-agents
kiln(ark (~(del by ark) lac))
:: +install: set up desk sync to .lac to install all apps from [her rem]
::
++ install
|= [lac=desk her=ship rem=desk]
^+ vats
?: =([her rem] [our lac])
(install-local lac)
2021-07-02 02:10:03 +03:00
=/ got (~(get by ark) lac)
?: =(`[her rem] got)
~> %slog.0^leaf/"kiln: already tracking {here:(abed lac)}, ignoring"
vats
=: loc lac
rak [`[paused=| her rem *aeon next=~] rein:(fall got *arak)]
==
~> %slog.0^leaf/"kiln: beginning install into {here}"
(emil find:pass listen:pass ~)
:: +install-local: install from a local desk, with no remote
::
++ install-local
|= lac=desk
^+ vats
?: (~(has by ark) loc)
~> %slog.0^leaf/"kiln: already tracking {here:(abed lac)}, ignoring"
vats
=: loc lac
rak [~ *rein]
==
~> %slog.0^leaf/"kiln: local install {here}"
=. vats (update-running-apps (get-apps-diff our loc now rein.rak))
=. vats (emit listen:pass)
vats
:: +reset: resync after failure
::
:: TODO: instead of jumping all the way back to find:pass,
:: which will end up skipping all the way until the latest
:: remote commit, increment the aeon so we skip only the problematic
:: commit and try the commit immediately after it.
::
++ reset
^+ vats
2021-07-09 08:08:33 +03:00
~> %slog.0^leaf/"kiln: resetting tracking for {here}"
2021-09-13 11:24:03 +03:00
=/ cad (diff:give %reset loc rak)
=/ rel ral
=. rail.rak `rel(aeon 0, next ~)
2021-09-13 11:24:03 +03:00
(emil find:pass cad ~)
2021-09-06 17:27:17 +03:00
:: +pause: stop syncing from upstream
::
++ pause
|= lac=desk
^+ vats
?. is-tracking
~> %slog.0^leaf/"kiln: {<lac>} already paused, ignoring"
vats
2021-09-06 17:27:17 +03:00
=. vats (abed lac)
~> %slog.0^leaf/"kiln: {<lac>} pausing updates"
=/ rel ral
=. rail.rak `rel(paused &, aeon 0)
vats
:: +remove-upstream: stop listening to an upstream for changes
::
++ remove-upstream
|= lac=desk
^+ vats
=. vats (abed lac)
=. rail.rak ~
2021-09-06 17:27:17 +03:00
vats
:: +resume: restart tracking from upstream
::
2021-09-09 21:31:44 +03:00
:: TODO: check whether kelvin is legit
::
2021-09-06 17:27:17 +03:00
++ resume
|= lac=desk
^+ vats
=. vats (abed lac)
~> %slog. :+ %0 %leaf
?. paused:ral
2021-09-06 17:27:17 +03:00
"kiln: {<lac>} already tracking, ignoring"
"kiln: {<lac>} resuming updates"
2021-09-21 05:49:04 +03:00
=/ rel ral
=. rail.rak `rel(paused |)
2021-09-06 17:27:17 +03:00
reset
2021-08-20 01:57:31 +03:00
:: +suspend: shut down all agents, keep syncing
::
++ suspend
|= lac=desk
^+ vats
=/ got (~(get by ark) lac)
?: =(%base lac)
2021-08-27 17:38:30 +03:00
=- (emit (pyre:pass leaf/- ~))
"kiln: suspend: %base cannot be suspended"
2021-08-20 01:57:31 +03:00
?. (~(has by ark) lac)
~> %slog.0^leaf/"kiln: suspend: {<lac>} not installed, ignoring"
vats
=. vats (abed lac)
=. liv.rein.rak |
=. vats stop-agents
(emit (diff:give %suspend loc rak))
:: +revive: restart agents on a suspended desk
::
++ revive
|= lac=desk
^+ vats
=. vats (abed lac)
=. liv.rein.rak &
=. vats (update-running-apps (get-apps-diff our loc now rein.rak))
(emit (diff:give %revive loc rak))
:: +set-rein: adjust which agents are forced on or off
::
++ set-rein
|= [lac=desk new=rein]
^+ vats
=. vats (abed lac)
=^ old rein.rak [rein.rak new]
?+ [liv.old liv.new] !!
[%| %|] vats
[%| %&] (revive lac)
[%& %|] (suspend lac)
[%& %&] (update-running-apps (get-apps-diff our loc now rein.rak))
==
2021-09-01 03:00:40 +03:00
:: +bump: try to apply kernel kelvin upgrade
::
2021-09-01 02:43:25 +03:00
:: Apply merges to revive faded agents on all desks.
:: If .force, suspends stale agents. Else, any stale desk
:: will cause a crash.
::
++ bump
2021-09-01 03:00:40 +03:00
|= [kel=weft except=(set desk) force=?]
^+ kiln
2021-09-01 03:00:40 +03:00
=/ ded (find-blocked kel except)
2021-09-01 02:43:25 +03:00
?: force
=. kiln (suspend-many ded)
(bump-many kel (all-desks-but (~(uni in except) ded)))
2021-08-27 17:38:30 +03:00
?: =(~ ded)
2021-09-01 03:00:40 +03:00
(bump-many kel (all-desks-but except))
2021-08-27 17:38:30 +03:00
=- (^emit (pyre:pass leaf/- ~))
"kiln: desks blocked upgrade to {<zuse/zuse>}: {<ded>}"
2021-09-01 02:43:25 +03:00
::
++ all-desks-but |=(not=(set desk) (~(dif in ~(key by ark)) not))
::
++ find-blocked
2021-09-01 03:00:40 +03:00
|= [kel=weft except=(set desk)]
2021-09-01 02:43:25 +03:00
^- (set desk)
2021-09-01 03:00:40 +03:00
(~(dif in (get-blockers kel)) (~(put in except) %base))
2021-09-01 02:43:25 +03:00
::
++ suspend-many
|= dead=(set desk)
^+ kiln
=/ ded ~(tap in dead)
|- ^+ kiln
?~ ded kiln
$(ded t.ded, kiln abet:(suspend i.ded))
::
++ bump-many
|= [kel=weft live=(set desk)]
^+ kiln
2021-09-09 21:31:44 +03:00
:: ensure %base is always reloaded first
2021-09-09 21:32:29 +03:00
::
2021-09-09 21:31:44 +03:00
=/ liv
%+ sort ~(tap in live)
|= [a=desk b=desk]
^- ?
?: =(%base a) &
?: =(%base b) |
(lte `@`a `@`b)
::
2021-09-01 02:43:25 +03:00
|- ^+ kiln
?~ liv kiln
$(liv t.liv, kiln (bump-one kel i.liv))
::
++ bump-one
|= [kel=weft =desk]
^+ kiln
~> %slog.0^leaf/"kiln: bump {<desk>} to {<[- +]:kel>}"
=< abet ^+ vats
=. vats (abed desk)
?: =([~ kel] (read-kelvin-local our desk now))
~> %slog.0^leaf/"kiln: {here} already at {<[- +]:kel>}, ignoring"
vats
=^ tem rail.rak (crank-next %| kel)
2021-09-01 02:43:25 +03:00
?^ tem
2021-08-27 17:38:30 +03:00
(emit merge-main:pass)
2021-09-01 02:43:25 +03:00
=- (emit (pyre:pass leaf/- ~))
"kiln: {here} killed upgrade to {<[- +]:kel>}"
2021-08-20 01:57:31 +03:00
:: +stop-agents: internal helper to suspend agents on .loc
::
:: Will not shut down %hood or %dojo.
::
++ stop-agents
^+ vats
=/ ded (get-apps-live our loc now)
=. ded (skip ded |=(d=dude ?=(?(%hood %dojo) d)))
(stop-dudes ded)
::
++ take
|= [=wire syn=sign-arvo]
^+ kiln
?> ?=([@ @ *] wire)
?: ?=(%jolt i.t.wire)
(take-onto wire syn)
=< abet
=. vats (from-wire wire)
?+ i.t.wire
~> %slog.0^leaf/"kiln: vats-bad-take {<wire>}"
vats
2021-07-09 18:56:52 +03:00
%find (take-find syn)
%sync (take-sync syn)
%download (take-download syn)
2021-09-15 22:57:08 +03:00
%listen (take-listen syn)
2021-07-09 18:56:52 +03:00
%merge-main (take-merge-main syn)
%merge-kids (take-merge-kids syn)
==
::
++ take-find
|= syn=sign-arvo
^+ vats
?> ?=(%writ +<.syn)
?. is-tracking
2021-09-06 17:27:17 +03:00
vats
2021-07-13 17:35:15 +03:00
?~ p.syn
~> %slog.0^leaf/"kiln: cancelled (1) install into {here}, aborting"
vats(ark (~(del by ark) loc))
~> %slog.0^leaf/"kiln: activated install into {here}"
(emit sync-da:pass)
::
++ take-sync
|= syn=sign-arvo
^+ vats
?> ?=(%writ +<.syn)
=* rit u.p.syn
?. is-tracking
2021-09-06 17:27:17 +03:00
vats
?~ p.syn
~> %slog.0^leaf/"kiln: cancelled (1) install into {here}, retrying"
reset
=? rail.rak ?=(%w p.p.rit) `%*(. ral aeon ud:;;(cass:clay q.q.r.rit))
~> %slog.0^leaf/"kiln: downloading update for {here}"
(emit download:pass)
::
++ take-download
|= syn=sign-arvo
^+ vats
?> ?=(%writ +<.syn)
?. is-tracking
2021-09-06 17:27:17 +03:00
vats
?~ p.syn
~> %slog.0^leaf/"kiln: cancelled (2) install into {here}, retrying"
reset
~> %slog.0^leaf/"kiln: finished downloading update for {here}"
2021-07-10 15:56:08 +03:00
=/ old-weft `weft`[%zuse zuse]
=/ new-weft (read-kelvin-foreign [ship desk aeon]:ral)
=? vats liv.rein.rak
=/ bill (read-bill-foreign [ship desk aeon]:ral)
=/ wan (sy (get-apps-want bill rein.rak))
=/ hav (sy (get-apps-live our loc now))
=/ ded ~(tap in (~(dif in hav) wan))
(stop-dudes ded)
=. rail.rak `%*(. ral aeon +(aeon:ral))
2021-09-07 21:57:55 +03:00
|^ ^+ vats
?: =(%base loc)
do-base
?: (gth num.new-weft num.old-weft)
kelvin-retreat
?: =(num.new-weft num.old-weft)
kelvin-same
kelvin-advance
2021-07-09 08:08:33 +03:00
::
2021-09-07 21:57:55 +03:00
++ kelvin-retreat
^+ vats
~> %slog.0^leaf/"kiln: cannot install {here}, old kelvin {<new-weft>}"
~> %slog.0^leaf/"kiln: will retry at foreign kelvin {<old-weft>}"
=/ =diff [%block loc rak new-weft blockers=(sy %base ~)]
(emil sync-ud:pass (diff:give diff) ~)
::
++ kelvin-advance
^+ vats
~> %slog.0^leaf/"kiln: future version {<new-weft>}, enqueueing"
:: retry upgrade if not blocked anymore
=. rail.rak `%*(. ral next (snoc next:ral [(dec aeon:ral) new-weft]))
2021-09-07 21:57:55 +03:00
=. ark (~(put by ark) loc rak)
=/ =diff [%block loc rak new-weft blockers=(sy %base ~)]
=. vats (emil sync-ud:pass (diff:give diff) ~)
=/ base=arak (~(got by ark) %base)
?~ rail.base
vats
=/ rel u.rail.base
?. &(?=(^ next.rel) =(~ (get-blockers weft.i.next.rel)))
vats
2021-09-07 21:57:55 +03:00
~> %slog.0^leaf/"kiln: unblocked system update, updating"
=. kiln (bump-one weft.i.next.rel %base)
2021-09-07 21:57:55 +03:00
vats
::
++ kelvin-same
^+ vats
2021-07-09 08:08:33 +03:00
~> %slog.0^leaf/"kiln: merging into {here}"
=. rail.rak +:(crank-next %& (dec aeon:ral))
(emil ~[merge-main sync-ud]:pass)
2021-07-09 08:08:33 +03:00
::
2021-09-07 21:57:55 +03:00
++ do-base
^+ vats
=/ blockers
?: =(new-weft old-weft)
~
(get-blockers new-weft)
::
?. =(~ blockers)
~> %slog.0^leaf/"kiln: OTA blocked on {<blockers>}"
=. rail.rak `%*(. ral next (snoc next:ral [(dec aeon:ral) new-weft]))
2021-09-07 21:57:55 +03:00
=/ =diff [%block loc rak new-weft blockers]
(emil sync-ud:pass (diff:give diff) ~)
~> %slog.0^leaf/"kiln: applying OTA to {here}, kelvin: {<new-weft>}"
=. rail.rak +:(crank-next %& (dec aeon:ral))
2021-09-07 21:57:55 +03:00
=. wef
?: =(old-weft new-weft) ~
`new-weft
(emil ~[merge-main sync-ud]:pass)
--
::
2021-09-15 22:57:08 +03:00
++ take-listen
|= syn=sign-arvo
^+ vats
?> ?=([@ %writ ~ *] syn)
=. vats (emit listen:pass)
take-commit
::
++ take-commit
^+ vats
~> %slog.0^leaf/"kiln: commit detected at {here}"
=. vats (emit (diff:give %commit loc rak))
=? vats liv.rein.rak
(update-running-apps (get-apps-diff our loc now rein.rak))
?. =(%base loc)
vats
=/ kel [- +]:weft:(head next:ral)
~> %slog.0^leaf/"kiln: merging %base into %kids at {<kel>}"
2021-09-15 22:57:08 +03:00
(emit merge-kids:pass)
::
2021-07-09 18:56:52 +03:00
++ take-merge-main
|= syn=sign-arvo
^+ vats
?> ?=(%mere +<.syn)
?: ?=([%| %ali-unavailable *] p.syn)
2021-07-07 21:11:40 +03:00
=+ "kiln: merge into {here} failed, maybe because sunk; restarting"
%- (slog leaf/- p.p.syn)
=. vats (emit (diff:give %merge-sunk loc rak p.p.syn))
reset
?: ?=(%| -.p.syn)
2021-07-07 21:11:40 +03:00
=+ "kiln: merge into {here} failed, waiting for next revision"
%- (slog leaf/- p.p.syn)
=. vats (emit (diff:give %merge-fail loc rak p.p.syn))
vats
2021-09-15 22:57:08 +03:00
take-commit
2021-07-09 18:56:52 +03:00
::
++ take-merge-kids
|= syn=sign-arvo
^+ vats
2021-07-09 18:56:52 +03:00
?> ?=(%mere +<.syn)
?: ?=([%| %ali-unavailable *] p.syn)
~> %slog.0^leaf/"kiln: OTA to %kids failed, maybe peer sunk; restarting"
=. vats (emit (diff:give %merge-sunk %kids rak p.p.syn))
2021-07-09 18:56:52 +03:00
reset
?- -.p.syn
%& ~> %slog.0^leaf/"kiln: OTA to %kids succeeded"
(emit (diff:give %commit %kids rak))
%| ~> %slog.0^leaf/"kiln: OTA to %kids failed {<p.p.syn>}"
(emit (diff:give %merge-fail %kids rak p.p.syn))
==
::
++ take-onto
|= [=wire syn=sign-arvo]
^+ kiln
=/ onto ?>(?=([%gall %onto *] syn) p.syn)
?- -.onto
%& kiln
%| (mean >p.onto< p.onto)
==
::
++ update-running-apps
|= [liv=(list dude) ded=(list dude)]
2021-07-23 14:07:58 +03:00
=. vats (start-dudes liv)
=. vats (stop-dudes ded)
vats
::
++ start-dudes
|= daz=(list dude)
~> %slog.0^leaf/"kiln: starting {<daz>}"
2021-07-23 14:07:58 +03:00
(emil `(list card:agent:gall)`(zing (turn daz start-dude:pass)))
::
++ stop-dudes
|= daz=(list dude)
~> %slog.0^leaf/"kiln: stopping {<daz>}"
(emil `(list card:agent:gall)`(zing (turn daz stop-dude:pass)))
:: +crank-next: pop stale items from .next until one matches
::
++ crank-next
2021-09-01 02:43:25 +03:00
|= new=(each aeon weft)
^+ [match=*(unit rung) rail.rak]
?~ rail.rak !!
=/ rog next.u.rail.rak
=- [match `u.rail.rak(next next)]
|- ^- [match=(unit rung) next=(list rung)]
?~ rog [~ next.u.rail.rak]
2021-09-01 02:43:25 +03:00
?: ?- -.new
%& =(p.new aeon.i.rog)
%| =(p.new weft.i.rog)
==
[`i.rog t.rog]
$(rog t.rog)
::
++ is-tracking
^- ?
?~ rail.rak |
!paused.u.rail.rak
--
:: +get-blockers: find desks that would block a kernel update
::
++ get-blockers
|= kel=weft
^- (set desk)
%- ~(gas in *(set desk))
%+ murn ~(tap by ark)
|= [=desk =arak]
?: =(%base desk)
~
2021-08-20 01:57:31 +03:00
?. liv.rein.arak
~
?~ rail.arak
`desk
?: (lien next.u.rail.arak |=([* k=weft] =(k kel)))
~
`desk
:: +get-germ: select merge strategy into local desk
::
:: If destination desk doesn't exist, need a %init merge. If this is
:: its first revision, it probably doesn't have a mergebase yet, so
:: use %take-that.
::
++ get-germ
|= =desk
=+ .^(=cass:clay %cw /(scot %p our)/[desk]/(scot %da now))
?- ud.cass
%0 %init
* %take-that
::%1 %take-that
::* %mate
==
2021-07-10 15:56:08 +03:00
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-autocommit =;(f (f !<(_+<.f vase)) poke-autocommit)
%kiln-bump =;(f (f !<(_+<.f vase)) poke-bump)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-fuse =;(f (f !<(_+<.f vase)) poke-fuse)
2021-08-11 19:23:36 +03:00
%kiln-fuse-list =;(f (f !<(_+<.f vase)) poke-fuse-list)
%kiln-gall-sear =;(f (f !<(_+<.f vase)) poke-gall-sear)
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-install =;(f (f !<(_+<.f vase)) poke-install)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
2021-07-21 12:00:11 +03:00
%kiln-nuke =;(f (f !<(_+<.f vase)) poke-nuke)
2021-09-06 17:27:17 +03:00
%kiln-pause =;(f (f !<(_+<.f vase)) poke-pause)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
2021-09-06 17:27:17 +03:00
%kiln-resume =;(f (f !<(_+<.f vase)) poke-resume)
2021-08-20 01:57:31 +03:00
%kiln-revive =;(f (f !<(_+<.f vase)) poke-revive)
%kiln-rein =;(f (f !<(_+<.f vase)) poke-rein)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
2021-09-06 17:27:17 +03:00
%kiln-suspend =;(f (f !<(_+<.f vase)) poke-suspend)
%kiln-sync =;(f (f !<(_+<.f vase)) poke-sync)
%kiln-syncs =;(f (f !<(_+<.f vase)) poke-syncs)
%kiln-track =;(f (f !<(_+<.f vase)) poke-track)
%kiln-uninstall =;(f (f !<(_+<.f vase)) poke-uninstall)
%kiln-unmount =;(f (f !<(_+<.f vase)) poke-unmount)
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
==
2016-02-26 02:19:44 +03:00
::
++ poke-autocommit
|= [mon=kiln-commit auto=?]
=< abet
=. +>.$ (emit %pass /commit %arvo %c [%dirk mon])
?. auto
+>.$
=/ recur ~s1
=. commit-timer
[/kiln/autocommit (add now recur) recur mon]
(emit %pass way.commit-timer %arvo %b [%wait nex.commit-timer])
::
++ poke-bump
2021-09-01 02:43:25 +03:00
|= [except=(set desk) force=?]
=/ =arak
(~(got by ark) %base)
=/ kel=weft
?~ rail.arak zuse+zuse
?~ next.u.rail.arak zuse+zuse
weft.i.next.u.rail.arak
2021-09-01 03:00:40 +03:00
abet:(bump:vats kel except force)
::
++ poke-cancel
|= a=@tas
abet:(emit %pass /cancel %arvo %c [%drop a])
::
++ poke-cancel-autocommit
2018-03-19 07:18:20 +03:00
|= ~
abet:(emit %pass way.commit-timer %arvo %b [%rest nex.commit-timer])
2015-09-02 01:20:17 +03:00
::
++ poke-commit
|= [mon=kiln-commit auto=?]
=< abet
=. +>.$ (emit %pass /commit %arvo %c [%dirk mon])
?. auto
+>.$
=/ recur ~s1
=. commit-timer
[/kiln/autocommit (add now recur) recur mon]
(emit %pass way.commit-timer %arvo %b [%wait nex.commit-timer])
2015-09-02 01:20:17 +03:00
::
++ poke-fuse-list
=>
|%
++ format-fuse
2021-06-08 03:23:00 +03:00
|= [into=desk pf=per-fuse]
^- tank
=/ sources=tape
%+ reel
con.kf.pf
|= [[fs=fuse-source g=germ] acc=tape]
^- tape
2021-08-11 19:23:36 +03:00
:(weld " [" (format-fuse-source fs) " " <g> "]" acc)
2021-06-08 03:23:00 +03:00
:- %leaf
;: weld
"|fuse {<into>} "
(format-fuse-source bas.kf.pf)
sources
==
:: +format-fuse-source: fuse source -> beak -> path
::
++ format-fuse-source
|= fs=fuse-source
^- tape
=/ bec=beak [who.fs des.fs ?:(?=([%trak] ver.fs) [%tas %track] ver.fs)]
<(en-beam [bec /])>
--
|= k=kiln-fuse-list
^+ abet
%. abet
?~ k
?~ fus
(slog [leaf+"no ongoing fuses" ~])
%- slog
%+ roll
~(tap by `(map desk per-fuse)`fus)
|= [[syd=desk pf=per-fuse] acc=tang]
^- tang
2021-06-08 03:23:00 +03:00
[(format-fuse syd pf) acc]
=/ pfu=(unit per-fuse) (~(get by fus) u.k)
?~ pfu
(slog [leaf+"no ongoing fuse for {<u.k>}" ~])
2021-06-08 03:23:00 +03:00
(slog [(format-fuse u.k u.pfu) ~])
::
2021-04-20 06:46:46 +03:00
++ poke-fuse
|= k=kiln-fuse
2021-05-02 06:04:19 +03:00
?~ k abet
2021-05-24 01:43:41 +03:00
=/ payload +.k
?~ payload
:: cancelling an ongoing fuse
%- (slog [leaf+"cancelling fuse into {<syd.k>}" ~])
=/ f (fuzz syd.k now)
?~ f
abet
abet:abet:delete:u.f
2021-05-24 01:43:41 +03:00
?: &(!overwrite.payload (~(has by fus) syd.k))
((slog [leaf+"existing fuse into {<syd.k>} - need =overwrite &" ~]) abet)
=. fus (~(put by fus) syd.k [~ [syd.k bas.payload con.payload]])
=/ old-cnt=@ud (~(gut by hxs) syd.k 0)
=. hxs (~(put by hxs) syd.k +(old-cnt))
=/ f (fuzz syd.k now)
?~ f
abet
abet:abet:fuse:u.f
2021-04-20 06:46:46 +03:00
::
++ poke-gall-sear
|= =ship
abet:(emit %pass /kiln %arvo %g %sear ship)
::
2016-05-07 02:21:29 +03:00
++ poke-info
|= [mez=tape tor=(unit toro)]
?~ tor
abet:(spam leaf+mez ~)
2019-11-14 21:39:50 +03:00
abet:(emit:(spam leaf+mez ~) %pass /kiln %arvo %c [%info u.tor])
2015-09-02 01:20:17 +03:00
::
++ poke-install
|= [loc=desk her=ship rem=desk]
abet:abet:(install:vats +<)
::
++ poke-label
|= [syd=desk lab=@tas]
=+ pax=/(scot %p our)/[syd]/[lab]
(poke-info "labeled {(spud pax)}" `[syd %| lab])
::
++ poke-merge
|= kiln-merge
?~ +< abet
abet:abet:(merge:(work syd) ali sud cas gim)
::
++ poke-mount
|= kiln-mount
=+ bem=(de-beam pax)
?~ bem
=+ "can't mount bad path: {<pax>}"
abet:(spam leaf+- ~)
abet:(emit %pass /mount %arvo %c [%mont pot u.bem])
::
2021-07-21 12:00:11 +03:00
++ poke-nuke
|= [=term desk=?]
=< abet
?. desk
(emit %pass /nuke %arvo %g [%nuke term])
%- emil
2021-07-23 14:07:58 +03:00
%+ turn (get-apps-have our term now)
2021-07-21 12:00:11 +03:00
|=([=dude ?] [%pass /nuke %arvo %g [%nuke dude]])
::
2021-09-06 17:27:17 +03:00
++ poke-pause
|= =desk
abet:abet:(pause:vats desk)
::
++ poke-permission
|= [syd=desk pax=path pub=?]
=< abet
%- emit
=/ =rite [%r ~ ?:(pub %black %white) ~]
[%pass /kiln/permission %arvo %c [%perm syd pax rite]]
::
++ poke-rein
|= [=desk =rein]
abet:abet:(set-rein:vats +<)
::
2021-09-06 17:27:17 +03:00
++ poke-resume
|= =desk
abet:abet:(resume:vats desk)
::
2021-08-20 01:57:31 +03:00
++ poke-revive
|= =desk
abet:abet:(revive:vats desk)
::
++ poke-rm
|= a=path
=+ b=.^(arch %cy a)
?~ fil.b
=+ ~[leaf+"No such file:" leaf+"{<a>}"]
abet:(spam -)
(poke-info "removed" `(fray a))
::
2015-09-02 01:20:17 +03:00
++ poke-schedule
|= [where=path tym=@da eve=@t]
2015-09-02 01:20:17 +03:00
=. where (welp where /sched)
2016-05-07 02:21:29 +03:00
%+ poke-info "scheduled"
2015-12-09 04:54:26 +03:00
=+ old=;;((map @da cord) (fall (file where) ~))
`(foal where %sched !>((~(put by old) tym eve)))
2015-09-02 01:20:17 +03:00
::
2021-08-20 01:57:31 +03:00
++ poke-suspend
|= =desk
abet:abet:(suspend:vats desk)
::
++ poke-sync
|= hos=kiln-sync
?: (~(has by syn) hos)
abet:(spam (render "already syncing" [sud her syd]:hos) ~)
abet:abet:start-sync:(auto hos)
::
++ poke-syncs :: print sync config
|= ~
=< abet %- spam
?: =(0 ~(wyt by syn))
[%leaf "no syncs configured"]~
%+ turn ~(tap in ~(key by syn))
|=(a=kiln-sync (render "sync configured" [sud her syd]:a))
2015-09-17 02:40:53 +03:00
::
++ poke-track
|= hos=kiln-sync
?: (~(has by syn) hos)
abet:(spam (render "already tracking" [sud her syd]:hos) ~)
abet:abet:start-track:(auto hos)
2019-11-05 10:37:58 +03:00
::
++ poke-uninstall
|= loc=desk
abet:(uninstall:vats +<)
::
++ poke-unmount
|= mon=kiln-unmount
?^ mon
=+ bem=(de-beam mon)
?~ bem
=+ "can't unmount bad path: {<mon>}"
abet:(spam leaf+- ~)
abet:(emit %pass /unmount-beam %arvo %c [%ogre [[p q r] s]:u.bem])
abet:(emit %pass /unmount-point %arvo %c [%ogre mon])
::
++ poke-unsync
|= hus=kiln-unsync
?. (~(has by syn) hus)
abet:(spam (render "not syncing" [sud her syd]:hus) ~)
%* . abet:abet:stop:(auto hus)
syn (~(del by syn) hus)
==
:: +peer: handle %watch
::
++ peer
|= =path
?> (team:title our src)
?+ path ~|(kiln-path/path !!)
[%vats ~] abet
::
[%ark ~]
abet(moz :_(moz [%give %fact ~ %kiln-vats-snap !>(ark)]))
==
::
2019-11-14 21:39:50 +03:00
++ take-agent
2019-11-19 07:36:21 +03:00
|= [=wire =sign:agent:gall]
2021-07-17 02:54:20 +03:00
?+ wire ~|([%kiln-bad-take-agent wire -.sign] !!)
[%fancy *]
?> ?=(%poke-ack -.sign)
(take-coup-fancy t.wire p.sign)
::
[%spam *]
?> ?=(%poke-ack -.sign)
(take-coup-spam t.wire p.sign)
::
[%link @ ~]
?> ?=(%poke-ack -.sign)
~> %slog.0^leaf/"kiln: linked {<`@tas`i.t.wire>} to console"
abet
2019-11-14 21:39:50 +03:00
==
::
2020-06-16 10:29:17 +03:00
++ take-arvo
2019-11-14 21:39:50 +03:00
|= [=wire =sign-arvo]
2021-07-17 02:54:20 +03:00
?- wire
2019-11-14 21:39:50 +03:00
[%sync %merg *] %+ take-mere-sync t.t.wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
[%find-ship *] %+ take-writ-find-ship t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%sync *] %+ take-writ-sync t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%autocommit *] %+ take-wake-autocommit t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%vats *] abet:(take:vats t.wire sign-arvo)
2021-05-24 01:43:41 +03:00
[%fuse-request @tas *]
=/ f (fuzz i.t.wire now)
?~ f
abet
abet:abet:(take:u.f t.t.wire sign-arvo)
2021-05-24 01:43:41 +03:00
[%fuse @tas *] ?> ?=(%mere +<.sign-arvo)
=/ syd=desk i.t.wire
?. ?=([%| *] +>.sign-arvo)
?~ p.p.sign-arvo
abet
2021-06-06 01:48:55 +03:00
=/ msg=tape "fuse merge conflict for {<syd>}"
%- (slog [leaf+msg >p.p.sign-arvo< ~])
abet
%- (slog leaf+"failed fuse for {<syd>}" p.p.sign-arvo)
abet
2019-11-14 21:39:50 +03:00
*
?+ +<.sign-arvo
((slog leaf+"kiln: strange card {<+<.sign-arvo wire>}" ~) abet)
%done %+ done wire
?>(?=(%done +<.sign-arvo) +>.sign-arvo)
2019-11-14 21:39:50 +03:00
%mere %+ take-mere wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
==
==
++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler
++ done
|= [way=wire saw=(unit error:ames)]
~? ?=(^ saw) [%kiln-nack u.saw]
abet
::
2015-09-02 01:20:17 +03:00
++ take-mere ::
|= [way=wire are=(each (set path) (pair term tang))]
2021-05-18 22:09:22 +03:00
?. ?=([@ ~] way)
abet
2015-09-02 01:20:17 +03:00
abet:abet:(mere:(take way) are)
::
++ take-coup-fancy ::
|= [way=wire saw=(unit tang)]
2015-09-02 01:20:17 +03:00
abet:abet:(coup-fancy:(take way) saw)
::
2017-11-30 07:31:13 +03:00
++ take-coup-spam ::
|= [way=wire saw=(unit tang)]
2017-11-30 07:31:13 +03:00
~? ?=(^ saw) [%kiln-spam-lame u.saw]
abet
::
2015-09-02 01:20:17 +03:00
++ take-mere-sync ::
|= [way=wire mes=(each (set path) (pair term tang))]
?> ?=([@ @ @ *] way)
=/ hos=kiln-sync
2015-09-02 01:20:17 +03:00
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
?. (~(has by syn) hos)
abet
2018-12-04 09:59:41 +03:00
abet:abet:(mere:(auto hos) mes)
2015-09-02 01:20:17 +03:00
::
2019-04-30 20:40:38 +03:00
++ take-writ-find-ship ::
|= [way=wire rot=riot]
?> ?=([@ @ @ *] way)
=/ hos=kiln-sync
2019-04-30 20:40:38 +03:00
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
?. (~(has by syn) hos)
abet
2019-04-30 20:40:38 +03:00
abet:abet:(take-find-ship:(auto hos) rot)
::
2015-09-17 01:39:11 +03:00
++ take-writ-sync ::
|= [way=wire rot=riot]
?> ?=([@ @ @ *] way)
=/ hos=kiln-sync
2015-09-02 01:20:17 +03:00
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
?. (~(has by syn) hos)
abet
2018-12-04 09:59:41 +03:00
abet:abet:(writ:(auto hos) rot)
2015-09-02 01:20:17 +03:00
::
2019-08-25 12:00:26 +03:00
++ take-wake-autocommit
|= [way=wire error=(unit tang)]
?^ error
%- (slog u.error)
~& %kiln-wake-autocommit-fail
abet
=. nex.commit-timer (add now tim.commit-timer)
=< abet
%- emil
2019-11-14 21:39:50 +03:00
:~ [%pass /commit %arvo %c [%dirk mon.commit-timer]]
[%pass way.commit-timer %arvo %b [%wait nex.commit-timer]]
2019-08-25 12:00:26 +03:00
==
::
::
2015-09-02 01:20:17 +03:00
++ spam
|= mes=(list tank)
2015-09-02 01:20:17 +03:00
((slog mes) ..spam)
2021-05-24 01:43:41 +03:00
:: state machine for fuses
::
++ fuzz
|= [syd=desk now=@da]
=/ pfu=(unit per-fuse) (~(get by fus) syd)
?~ pfu
~
=* kf kf.u.pfu
=* mox mox.u.pfu
2021-05-24 01:43:41 +03:00
=/ should-delete=flag |
%- some
2021-05-24 01:43:41 +03:00
|%
:: finalize
::
++ abet
?: should-delete
2021-05-24 01:43:41 +03:00
..fuzz(fus (~(del by fus) syd))
..fuzz(fus (~(put by fus) syd [mox kf]))
::
++ delete
^+ ..delete
=. should-delete &
..delete
:: queue moves
::
++ blab
|= new=(list card:agent:gall)
^+ +>
+>.$(moz (welp new moz))
:: +make-requests: send requests for each %trak source.
2021-05-24 01:43:41 +03:00
::
++ make-requests
^+ ..abet
=/ movs=(list card:agent:gall)
%+ murn
[[bas.kf *germ] con.kf]
|= [fs=fuse-source germ]
^- (unit card:agent:gall)
?^ ver.fs
:: static source, don't need to track
~
2021-06-22 03:44:29 +03:00
=/ bec=beak (realize-fuse-source fs &)
2021-05-24 01:43:41 +03:00
?> =(who.fs p.bec)
?> =(des.fs q.bec)
=/ hax=@ud (mug [kf (~(got by hxs) syd)])
2021-06-06 01:48:55 +03:00
=/ wir=wire
/kiln/fuse-request/[syd]/(scot %p p.bec)/[q.bec]/(scot %ud hax)
2021-06-22 03:44:29 +03:00
=/ rav=rave [%sing %w r.bec /]
2021-05-24 01:43:41 +03:00
=/ rif=riff [q.bec `rav]
`[%pass wir %arvo %c [%warp who.fs rif]]
:: No need to keep state if all the sources are static
?~ movs
delete
(blab movs)
::
++ send-fuse
^+ ..abet
2021-06-22 03:44:29 +03:00
=/ bas=beak (realize-fuse-source bas.kf |)
2021-05-24 01:43:41 +03:00
=/ con=(list [beak germ])
%+ turn
con.kf
|= [fs=fuse-source g=germ]
2021-06-22 03:44:29 +03:00
[(realize-fuse-source fs |) g]
2021-05-24 01:43:41 +03:00
%- blab
[%pass /kiln/fuse/[syd] %arvo %c [%fuse syd bas con]]~
::
++ fuse
^+ ..abet
send-fuse:make-requests
::
++ take
|= [wir=wire =sign-arvo]
^+ ..fuse
?> =((lent wir) 3)
=/ who=ship (slav %p (snag 0 wir))
=/ src=desk (snag 1 wir)
=/ hax=@ud (slav %ud (snag 2 wir))
?. =(hax (mug [kf (~(got by hxs) syd)]))
:: If the hash in the wire doesn't match the current request
:: this is a response for a previous fuse that we can ignore.
..take
2021-06-17 00:45:45 +03:00
?> ?=([?(%clay %behn) %writ *] sign-arvo)
=/ gif +.sign-arvo
2021-05-24 01:43:41 +03:00
?~ p.gif
%- (slog leaf+"|fuse request failed for {<src>} on <who> - cancelling")
delete
=/ cas=cass:clay !<(cass:clay +.r.u.p.gif)
=. mox (~(put by mox) [who src] ud.cas)
2021-05-24 01:43:41 +03:00
fuse
::
:: utility functions below
::
:: +realize-fuse-source: convert a fuse-source to a
:: fully realized beak.
::
++ realize-fuse-source
2021-06-22 03:44:29 +03:00
|= [fs=fuse-source incr=flag]
2021-05-24 01:43:41 +03:00
^- beak
:+ who.fs
des.fs
?@ ver.fs
2021-06-22 03:44:29 +03:00
(realize-case [who.fs des.fs incr])
2021-05-24 01:43:41 +03:00
`case`ver.fs
::
++ realize-case
2021-06-22 03:44:29 +03:00
|= [who=ship des=desk incr=flag]
2021-05-24 01:43:41 +03:00
^- case
=/ let=(unit @ud) (~(get by mox) [who des])
^- case
?~ let
da+now
2021-06-22 03:44:29 +03:00
:- %ud
?: incr
+(u.let)
u.let
2021-05-24 01:43:41 +03:00
--
2015-09-02 01:20:17 +03:00
::
++ auto
|= kiln-sync
2019-11-14 21:39:50 +03:00
=+ (~(gut by syn) [syd her sud] let=*@ud)
2015-09-02 01:20:17 +03:00
|%
++ abet
2019-11-14 21:39:50 +03:00
..auto(syn (~(put by syn) [syd her sud] let))
2015-06-18 02:44:00 +03:00
::
2015-09-02 01:20:17 +03:00
++ blab
|= new=(list card:agent:gall)
2015-09-02 01:20:17 +03:00
^+ +>
+>.$(moz (welp new moz))
2015-05-12 03:31:37 +03:00
::
2019-11-14 21:39:50 +03:00
++ warp
|= [=wire =ship =riff]
(blab [%pass wire %arvo %c [%warp ship riff]] ~)
::
2015-09-02 01:20:17 +03:00
++ spam |*(* %_(+> ..auto (^spam +<)))
++ stop
=> (spam (render "ended autosync" sud her syd) ~)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud ~)
2018-12-04 09:59:41 +03:00
:: XX duplicate of start-sync? see |track
2015-06-04 00:18:13 +03:00
::
2016-01-07 01:08:46 +03:00
++ start-track
=> (spam (render "activated track" sud her syd) ~)
=. let 1
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud `[%sing %y ud+let /])
2016-01-07 01:08:46 +03:00
::
++ start-sync
2019-04-30 20:40:38 +03:00
=> (spam (render "finding ship and desk" sud her syd) ~)
=/ =wire /kiln/find-ship/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud `[%sing %y ud+1 /])
2019-04-30 20:40:38 +03:00
::
++ take-find-ship
|= rot=riot
2019-05-14 00:45:53 +03:00
=> (spam (render "activated sync" sud her syd) ~)
2018-12-04 09:59:41 +03:00
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud `[%sing %w [%da now] /])
2015-05-12 03:31:37 +03:00
::
2015-09-02 01:20:17 +03:00
++ writ
2018-12-04 09:59:41 +03:00
|= rot=riot
2015-09-02 01:20:17 +03:00
?~ rot
=. +>.$
%^ spam
leaf+"sync cancelled, retrying"
(render "on sync" sud her syd)
~
start-sync
=. let ?. ?=(%w p.p.u.rot) let ud:;;(cass:clay q.q.r.u.rot)
2019-11-14 21:39:50 +03:00
=/ =wire /kiln/sync/merg/[syd]/(scot %p her)/[sud]
:: germ: merge mode for sync merges
::
:: Initial merges from any source must use the %init germ.
:: Subsequent merges may use any germ, but if the source is
:: a remote ship with which we have not yet merged, we won't
:: share a merge-base commit and all germs but %only-that will
:: fail.
::
:: We want to always use %only-that for the first remote merge.
:: But we also want local syncs (%base to %home or %kids) to
:: succeed after that first remote sync. To accomplish both we
:: simply use %only-that for the first three sync merges. (The
:: first two are from the pill.)
::
=/ =germ
=/ =cass
.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now))
?: =(0 ud.cass)
%init
?:((gth 2 ud.cass) %only-that %mate)
=< %- spam
?: =(our her) ~
[(render "beginning sync" sud her syd) ~]
2019-11-14 21:39:50 +03:00
(blab [%pass wire %arvo %c [%merg syd her sud ud+let germ]] ~)
2015-06-04 00:18:13 +03:00
::
2015-09-02 01:20:17 +03:00
++ mere
2018-12-04 09:59:41 +03:00
|= mes=(each (set path) (pair term tang))
?: ?=([%| %ali-unavailable *] mes)
2019-02-02 00:46:09 +03:00
=. +>.$
%^ spam
2019-05-03 04:06:31 +03:00
leaf+"merge cancelled, maybe because sunk; restarting"
2019-02-02 00:46:09 +03:00
(render "on sync" sud her syd)
~
start-sync:stop
2015-09-02 01:20:17 +03:00
=. let +(let)
=. +>.$
%- spam
2018-03-19 06:54:47 +03:00
?: ?=(%& -.mes)
2015-09-02 01:20:17 +03:00
[(render "sync succeeded" sud her syd) ~]
?+ p.p.mes
:* (render "sync failed" sud her syd)
2015-12-21 00:16:39 +03:00
leaf+"please manually merge the desks with"
leaf+"|merge %{(trip syd)} {(scow %p her)} %{(trip sud)}"
leaf+""
leaf+"error code: {<p.p.mes>}"
2015-09-02 01:20:17 +03:00
q.p.mes
==
::
%no-ali-disc
:~ (render "sync activated" sud her syd)
2015-12-21 00:16:39 +03:00
leaf+"note: blank desk {<sud>} on {<her>}"
2015-09-02 01:20:17 +03:00
==
==
2018-12-04 09:59:41 +03:00
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud `[%sing %y ud+let /])
2015-09-02 01:20:17 +03:00
--
::
++ work :: state machine
|= syd=desk
=/ ,per-desk
%+ ~(gut by rem) syd
2017-11-30 00:29:35 +03:00
=+ *per-desk
2015-09-02 01:20:17 +03:00
%_(- cas [%da now])
|%
++ abet :: resolve
..work(rem (~(put by rem) syd auto gem her sud cas))
2015-05-28 05:46:58 +03:00
::
2015-09-02 01:20:17 +03:00
++ blab
|= new=(list card:agent:gall)
2015-09-02 01:20:17 +03:00
^+ +>
+>.$(moz (welp new moz))
2015-05-28 05:46:58 +03:00
::
2015-09-02 01:20:17 +03:00
++ win . :: successful poke
++ lose
^+ .
~| %kiln-work-fail
.
::
++ perform ::
2015-09-02 01:20:17 +03:00
^+ .
?< ?=(%this gem)
?< ?=(%that gem)
2019-11-14 21:39:50 +03:00
(blab [%pass /kiln/[syd] %arvo %c [%merg syd her sud cas gem]] ~)
2015-05-26 04:20:45 +03:00
::
2015-09-02 01:20:17 +03:00
++ fancy-merge :: send to self
|= [syd=desk her=@p sud=desk gem=?(%auto germ)]
2015-09-02 01:20:17 +03:00
^+ +>
2019-11-14 21:39:50 +03:00
=/ =cage [%kiln-merge !>([syd her sud cas gem])]
2015-09-02 01:20:17 +03:00
%- blab :_ ~
2019-11-14 21:39:50 +03:00
[%pass /kiln/fancy/[^syd] %agent [our %hood] %poke cage]
2015-05-26 04:20:45 +03:00
::
2015-09-02 01:20:17 +03:00
++ spam ::|=(tang ((slog +<) ..spam))
|*(* +>(..work (^spam +<)))
++ merge
|= [her=@p sud=@tas cas=case gim=?(%auto germ)]
2015-09-02 01:20:17 +03:00
^+ +>
?. ?=(%auto gim)
2016-01-07 01:08:46 +03:00
perform(auto |, gem gim, her her, cas cas, sud sud)
?: =(0 ud:.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now)))
2015-09-02 01:20:17 +03:00
=> $(gim %init)
.(auto &)
=> $(gim %fine)
.(auto &)
2015-05-26 04:20:45 +03:00
::
2015-09-02 01:20:17 +03:00
++ coup-fancy
|= saw=(unit tang)
2015-09-02 01:20:17 +03:00
?~ saw
2020-05-14 05:28:04 +03:00
+>
2015-09-02 01:20:17 +03:00
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+-< leaf+-> u.saw)
2015-05-26 04:20:45 +03:00
::
2015-09-02 01:20:17 +03:00
++ mere
|= are=(each (set path) (pair term tang))
2015-09-02 01:20:17 +03:00
^+ +>
?: =(%meld gem)
2018-03-19 06:54:47 +03:00
?: ?=(%& -.are)
2015-09-02 01:20:17 +03:00
?. auto
=+ "merged with strategy {<gem>}"
2015-12-21 00:16:39 +03:00
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
2015-09-02 01:20:17 +03:00
:: ~? > =(~ p.are) [%mere-no-conflict syd]
2020-05-14 05:28:04 +03:00
=> .(+>.$ (spam leaf+"mashing conflicts" ~))
2015-09-02 01:20:17 +03:00
=+ tic=(cat 3 syd '-scratch')
2020-05-14 05:28:04 +03:00
=/ notations=(list [path (unit [mark vase])])
%+ turn ~(tap in p.are)
|= =path
=/ =mark -:(flop path)
=/ =dais .^(dais %cb /(scot %p our)/[syd]/(scot cas)/[mark])
=/ base .^(vase %cr (weld /(scot %p our)/[tic]/(scot cas) path))
=/ ali .^(vase %cr (weld /(scot %p her)/[sud]/(scot cas) path))
=/ bob .^(vase %cr (weld /(scot %p our)/[syd]/(scot cas) path))
=/ ali-dif (~(diff dais base) ali)
=/ bob-dif (~(diff dais base) bob)
=/ mash (~(mash dais base) [her sud ali-dif] [our syd bob-dif])
:- path
?~ mash
~
`[mark (~(pact dais base) u.mash)]
=/ [annotated=(list [path *]) unnotated=(list [path *])]
(skid notations |=([* v=*] ?=(^ v)))
=/ tic=desk (cat 3 syd '-scratch')
=/ tan=(list tank)
%- zing
^- (list (list tank))
:~ %- tape-to-tanks
"""
done setting up scratch space in {<[tic]>}
please resolve the following conflicts and run
|merge {<syd>} our {<[tic]>}
"""
%^ tanks-if-any
"annotated conflicts in:" (turn annotated head)
""
%^ tanks-if-any
"unannotated conflicts in:" (turn unnotated head)
"""
some conflicts could not be annotated.
for these, the scratch space contains
the most recent common ancestor of the
conflicting content.
"""
==
=< win
%- blab:(spam tan)
:_ ~
:* %pass /kiln/[syd] %arvo %c
%info
tic %&
%+ murn notations
|= [=path dif=(unit [=mark =vase])]
^- (unit [^path miso])
?~ dif
~
`[path %mut mark.u.dif vase.u.dif]
==
2015-09-02 01:20:17 +03:00
=+ "failed to merge with strategy meld"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
2018-03-19 06:54:47 +03:00
?: ?=(%& -.are)
2015-09-02 01:20:17 +03:00
=+ "merged with strategy {<gem>}"
2015-12-21 00:16:39 +03:00
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
2015-09-02 01:20:17 +03:00
?. auto
=+ "failed to merge with strategy {<gem>}"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
2015-09-02 01:20:17 +03:00
?+ gem
2015-12-21 00:16:39 +03:00
(spam leaf+"strange auto" >gem< ~)
2015-09-02 01:20:17 +03:00
::
%init
2015-09-02 01:20:17 +03:00
=+ :- "auto merge failed on strategy %init"
2015-05-12 03:31:37 +03:00
"I'm out of ideas"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+-< leaf+-> [>p.p.are< q.p.are])
2015-05-12 03:31:37 +03:00
::
%fine
?. ?=(%bad-fine-merge p.p.are)
2015-09-02 01:20:17 +03:00
=+ "auto merge failed on strategy %fine"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
=> (spam leaf+"%fine merge failed, trying %meet" ~)
2015-09-02 01:20:17 +03:00
perform(gem %meet)
2015-07-28 01:39:36 +03:00
::
%meet
?. ?=(%meet-conflict p.p.are)
2015-09-02 01:20:17 +03:00
=+ "auto merge failed on strategy %meet"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
=> (spam leaf+"%meet merge failed, trying %mate" ~)
2015-09-02 01:20:17 +03:00
perform(gem %mate)
2015-07-28 01:39:36 +03:00
::
%mate
?. ?=(%mate-conflict p.p.are)
2015-09-02 01:20:17 +03:00
=+ "auto merge failed on strategy %mate"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
2015-09-02 01:20:17 +03:00
=> .(gem %meld)
=+ tic=(cat 3 syd '-scratch')
=> =+ :- "%mate merge failed with conflicts,"
"setting up scratch space at %{(trip tic)}"
2015-12-21 00:16:39 +03:00
[tic=tic (spam leaf+-< leaf+-> q.p.are)]
2020-05-14 05:28:04 +03:00
=. ..mere (fancy-merge tic our syd %init)
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
?< ?=(%this gem)
?< ?=(%that gem)
2020-05-14 05:28:04 +03:00
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
[%pass /kiln/[syd] %arvo %c note]
2015-09-02 01:20:17 +03:00
==
::
++ tape-to-tanks
|= a=tape ^- (list tank)
(scan a (more (just '\0a') (cook |=(a=tape leaf+a) (star prn))))
2015-09-02 01:20:17 +03:00
::
++ tanks-if-any
|= [a=tape b=(list path) c=tape] ^- (list tank)
2015-09-02 01:20:17 +03:00
?: =(~ b) ~
(welp (tape-to-tanks "\0a{c}{a}") >b< ~)
2015-05-12 03:31:37 +03:00
--
--