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

mall: remove old hood libraries

Browse Source
This commit is contained in:
Philip Monk 2019-11-14 10:39:50 -08:00
parent 881517c872
commit 32ea09caf2
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
9 changed files with 353 additions and 2515 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
pkg/arvo/age/hood.hoon
View File

@ -12,7 +12,7 @@
:: they have been bundled into :hood
::
:: |command handlers
hood-helm-mall, hood-kiln-mall, hood-drum-mall, hood-write-mall
hood-helm, hood-kiln, hood-drum, hood-write
:: :: ::
:::: :: ::
:: :: ::
@ -51,10 +51,10 @@
|@ ++ $
|: paw=$:hood-part
?- hed
$drum ?>(?=($drum -.paw) `part:hood-drum-mall`paw)
$helm ?>(?=($helm -.paw) `part:hood-helm-mall`paw)
$kiln ?>(?=($kiln -.paw) `part:hood-kiln-mall`paw)
$write ?>(?=($write -.paw) `part:hood-write-mall`paw)
$drum ?>(?=($drum -.paw) `part:hood-drum`paw)
$helm ?>(?=($helm -.paw) `part:hood-helm`paw)
$kiln ?>(?=($kiln -.paw) `part:hood-kiln`paw)
$write ?>(?=($write -.paw) `part:hood-write`paw)
==
--
++ hood-head _-:$:hood-part :: initialize state
@ -62,10 +62,10 @@
=+ $:{our/@p hed/hood-head} ::
|@ ++ $
?- hed
$drum (make:hood-drum-mall our)
$helm *part:hood-helm-mall
$kiln *part:hood-kiln-mall
$write *part:hood-write-mall
$drum (make:hood-drum our)
$helm *part:hood-helm
$kiln *part:hood-kiln
$write *part:hood-write
==
--
++ hood-part-old hood-part :: old state for ++prep
@ -74,10 +74,10 @@
paw ::
:: ::
++ hood-part :: current module state
$% {$drum $2 pith-2:hood-drum-mall} ::
{$helm $0 pith:hood-helm-mall} ::
{$kiln $0 pith:hood-kiln-mall} ::
{$write $0 pith:hood-write-mall} ::
$% {$drum $2 pith-2:hood-drum} ::
{$helm $0 pith:hood-helm} ::
{$kiln $0 pith:hood-kiln} ::
{$write $0 pith:hood-write} ::
== ::
-- ::
:: :: ::
@ -129,10 +129,10 @@
^- (quip card:agent:mall hood-part)
(handle a)
:: per-module interface wrappers
++ from-drum (from-module %drum [..$ _se-abet]:(hood-drum-mall))
++ from-helm (from-module %helm [..$ _abet]:(hood-helm-mall))
++ from-kiln (from-module %kiln [..$ _abet]:(hood-kiln-mall))
++ from-write (from-module %write [..$ _abet]:(hood-write-mall))
++ from-drum (from-module %drum [..$ _se-abet]:(hood-drum))
++ from-helm (from-module %helm [..$ _abet]:(hood-helm))
++ from-kiln (from-module %kiln [..$ _abet]:(hood-kiln))
++ from-write (from-module %write [..$ _abet]:(hood-write))
--
--
|_ hid/bowl:mall :: gall environment

1110
pkg/arvo/lib/hood/drum-mall.hoon
View File

File diff suppressed because it is too large Load Diff

202
pkg/arvo/lib/hood/drum.hoon
View File

@ -20,8 +20,7 @@
|:($:source +<(mir ((pair @ud (list @c))))) :: style-less mir
:: ::
++ pith-2 ::
$: sys/(unit bone) :: local console
eel/(set gill:gall) :: connect to
$: eel/(set gill:gall) :: connect to
ray/(set well:gall) ::
fur/(map dude:gall (unit server)) :: servers
bin/(map bone source) :: terminals
@ -44,7 +43,7 @@
off/@ud :: window offset
kil/kill :: kill buffer
inx/@ud :: ring index
fug/(map gill:gall (unit target)) :: connections
fug/(map gill:gall (unit target)) :: connections
mir/(pair @ud stub) :: mirrored terminal
== ::
++ history :: past input
@ -82,49 +81,52 @@
^- (list term)
?: lit
:~ %dojo
%eth-watcher
%azimuth-tracker
:: %eth-watcher
:: %azimuth-tracker
==
%+ welp
?: ?=(%pawn (clan:title our)) ~
:~ %acme
%dns
%eth-watcher
%azimuth-tracker
==
:~ %lens
%dojo
%modulo
%launch
%publish
%clock
%weather
%group-store
%group-hook
%permission-store
%permission-hook
%permission-group-hook
%invite-store
%invite-hook
%invite-view
%chat-store
%chat-hook
%chat-view
%chat-cli
:~ %dojo
%lens
==
:: %+ welp
:: ?: ?=(%pawn (clan:title our)) ~
:: :~ %acme
:: %dns
:: %eth-watcher
:: %azimuth-tracker
:: ==
:: :~ %lens
:: %dojo
:: %modulo
:: %launch
:: %publish
:: %clock
:: %weather
:: %group-store
:: %group-hook
:: %permission-store
:: %permission-hook
:: %permission-group-hook
:: %invite-store
:: %invite-hook
:: %invite-view
:: %chat-store
:: %chat-hook
:: %chat-view
:: %chat-cli
:: ==
::
++ deft-fish :: default connects
|= our/ship
%- ~(gas in *(set gill:gall))
^- (list gill:gall)
[[our %chat-cli] [our %dojo] ~]
:: [[our %talk] [our %dojo] ~]
[[our %dojo] ~]
::
++ make :: initial part
|= our/ship
^- part
:* %drum
%2
sys=~
eel=(deft-fish our)
ray=~
fur=~
@ -144,26 +146,11 @@
::
::::
::
|= {hid/bowl:gall part} :: main drum work
=+ (~(gut by bin) ost.hid *source)
|= {hid/bowl:mall part} :: main drum work
=/ ost 0
=+ (~(gut by bin) ost *source)
=* dev -
=> |% :: arvo structures
++ pear :: request
$% {$sole-action p/sole-action} ::
== ::
++ lime :: update
$% {$dill-blit dill-blit:dill} ::
== ::
++ card :: general card
$% {$conf wire dock ship term} ::
{$diff lime} ::
{$peer wire dock path} ::
{$poke wire dock pear} ::
{$pull wire dock ~} ::
== ::
++ move (pair bone card) :: user-level move
--
|_ {moz/(list move) biz/(list dill-blit:dill)}
|_ {moz/(list card:agent:mall) biz/(list dill-blit:dill)}
++ diff-sole-effect-phat :: app event
|= {way/wire fec/sole-effect}
=< se-abet =< se-view
@ -180,7 +167,7 @@
::
++ poke-set-boot-apps ::
|= lit/?
^- (quip move part)
^- (quip card:agent:mall part)
:: We do not run se-abet:se-view here because that starts the apps,
:: and some apps are not ready to start (eg Talk crashes because the
:: terminal has width 0). It appears the first message to drum must
@ -220,13 +207,33 @@
|= {pax/path txt/@}
se-abet:(se-blit-sys [%sav pax txt]) ::
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-drum-bad-mark mark] !!)
%drum-put =;(f (f !<(_+<.f vase)) poke-put)
%drum-link =;(f (f !<(_+<.f vase)) poke-link)
%drum-unlink =;(f (f !<(_+<.f vase)) poke-unlink)
%drum-exit =;(f (f !<(_+<.f vase)) poke-exit)
%drum-start =;(f (f !<(_+<.f vase)) poke-start)
%drum-set-boot-apps =;(f (f !<(_+<.f vase)) poke-set-boot-apps)
==
::
++ reap-phat :: ack connect
|= {way/wire saw/(unit tang)}
=< se-abet =< se-view
=+ gyl=(de-gill way)
?~ saw
(se-join gyl)
(se-dump:(se-drop & gyl) u.saw)
:: Don't print stack trace because we probably just crashed to
:: indicate we don't connect to the console.
::
(se-drop & gyl)
::
++ take ::
|= [=wire =sign-arvo]
%+ take-onto wire
?> ?=(%onto +<.sign-arvo)
+>.sign-arvo
::
++ take-coup-phat :: ack poke
|= {way/wire saw/(unit tang)}
@ -236,7 +243,7 @@
?: (se-aint gyl) +>.$
%- se-dump:(se-drop & gyl)
:_ u.saw
>[%drum-coup-fail src.hid ost.hid gyl]<
>[%drum-coup-fail src.hid gyl]<
::
++ take-onto :: ack start
|= {way/wire saw/(each suss:gall tang)}
@ -251,42 +258,47 @@
+>.$(fur (~(put by fur) q.wel `[p.wel %da r.p.saw]))
==
::
++ take-agent
|= [=wire =sign:agent:mall]
?+ wire ~|([%drum-bad-take-agent wire -.sign] !!)
[%drum %phat *]
?- -.sign
%http-response !!
%poke-ack (take-coup-phat t.t.wire p.sign)
%watch-ack (reap-phat t.t.wire p.sign)
%kick (quit-phat t.t.wire)
%fact
%+ diff-sole-effect-phat t.t.wire
?> ?=(%sole-effect p.cage.sign)
!<(sole-effect q.cage.sign)
==
==
::
++ quit-phat ::
|= way/wire
=< se-abet =< se-view
=+ gyl=(de-gill way)
~& [%drum-quit src.hid ost.hid gyl]
~& [%drum-quit src.hid gyl]
(se-drop %| gyl)
:: :: ::
:::: :: ::
:: :: ::
++ se-abet :: resolve
^- (quip move part)
^- (quip card:agent:mall part)
=* pith +<+.$
?. se-ably
=. . se-adit
[(flop moz) pith]
=. sys ?^(sys sys `ost.hid)
=. . se-subze:se-adze:se-adit
:_ pith(bin (~(put by bin) ost.hid dev))
%- flop
^- (list move)
?~ biz moz
:_ moz
[ost.hid %diff %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]
::
++ se-ably (~(has by sup.hid) ost.hid) :: caused by console
:_ pith(bin (~(put by bin) ost dev))
^- (list card:agent:mall)
?~ biz (flop moz)
:_ (flop moz)
=/ =dill-blit:dill ?~(t.biz i.biz [%mor (flop biz)])
[%give %fact `/drum %dill-blit !>(dill-blit)]
::
++ se-adit :: update servers
^+ .
%+ roll
:: ensure dojo is first in the list,
:: guaranteeing its display on-boot.
::
%+ sort ~(tap in ray)
|= [a=well:gall b=well:gall]
?: |(=(%dojo q.a) =(%dojo q.b)) =(%dojo q.a)
(aor a b)
:: ensure dojo connects after talk
=* dojo-on-top aor
%+ roll (sort ~(tap in ray) dojo-on-top)
=< .(con +>)
|: $:{wel/well:gall con/_..se-adit} ^+ con
=. +>.$ con
@ -294,7 +306,8 @@
?: &(?=(^ hig) |(?=(~ u.hig) =(p.wel syd.u.u.hig))) +>.$
=. +>.$ (se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
%- se-emit(fur (~(put by fur) q.wel ~))
[ost.hid %conf [%drum p.wel q.wel ~] [our.hid q.wel] our.hid p.wel]
=/ =wire [%drum p.wel q.wel ~]
[%pass wire %arvo %m %conf [our.hid q.wel] our.hid p.wel]
::
++ se-adze :: update connections
^+ .
@ -307,14 +320,14 @@
(se-peer gil)
::
++ se-subze :: downdate connections
=< .(dev (~(got by bin) ost.hid))
=. bin (~(put by bin) ost.hid dev)
=< .(dev (~(got by bin) ost))
=. bin (~(put by bin) ost dev)
^+ .
%- ~(rep by bin)
=< .(con +>)
|: $:{{ost/bone dev/source} con/_.} ^+ con
=+ xeno=se-subze-local:%_(con ost.hid ost, dev dev)
xeno(ost.hid ost.hid.con, dev dev.con, bin (~(put by bin) ost dev.xeno))
=+ xeno=se-subze-local:%_(con ost ost, dev dev)
xeno(ost ost.con, dev dev.con, bin (~(put by bin) ost dev.xeno))
::
++ se-subze-local
^+ .
@ -329,7 +342,7 @@
++ se-aint :: ignore result
|= gyl/gill:gall
^- ?
?. (~(has by bin) ost.hid) &
?. (~(has by bin) ost) &
=+ gyr=(~(get by fug) gyl)
|(?=(~ gyr) ?=(~ u.gyr))
::
@ -430,7 +443,6 @@
++ se-dump :: print tanks
|= tac/(list tank)
^+ +>
?. se-ably ((slog tac) +>.$)
=/ wol/wall
(zing (turn (flop tac) |=(a/tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
@ -466,8 +478,7 @@
::
++ se-blit-sys :: output to system
|= bil/dill-blit:dill ^+ +>
?~ sys ~&(%se-blit-no-sys +>)
(se-emit [u.sys %diff %dill-blit bil])
(se-emit %give %fact `/drum %dill-blit !>(bil))
::
++ se-show :: show buffer, raw
|= lin/(pair @ud stub)
@ -504,9 +515,9 @@
?: |(?=(~ gul) (se-aint u.gul)) +
(se-just ta-vew:(se-tame u.gul))
::
++ se-emit :: emit move
|= mov/move
%_(+> moz [mov moz])
++ se-emit
|= card:agent:mall
%_(+> moz [+< moz])
::
++ se-text :: return text
|= txt/tape
@ -514,21 +525,20 @@
?. ((sane %t) (crip txt)) :: XX upstream validation
~& bad-text+<`*`txt>
+>
?. se-ably ((slog [%leaf txt]~) +>.$)
(se-blit %out (tuba txt))
::
++ se-poke :: send a poke
|= {gyl/gill:gall par/pear}
(se-emit [ost.hid %poke (en-gill gyl) gyl par])
|= {gyl/gill:gall par/cage}
(se-emit %pass (en-gill gyl) %agent gyl %poke par)
::
++ se-peer :: send a peer
|= gyl/gill:gall
%- se-emit(fug (~(put by fug) gyl ~))
[ost.hid %peer (en-gill gyl) gyl /sole]
[%pass (en-gill gyl) %agent gyl %watch /sole/drum]
::
++ se-pull :: cancel subscription
|= gyl/gill:gall
(se-emit [ost.hid %pull (en-gill gyl) gyl ~])
(se-emit %pass (en-gill gyl) %agent gyl %leave ~)
::
++ se-tame :: switch connection
|= gyl/gill:gall
@ -546,12 +556,12 @@
^+ ..ta
..ta(fug (~(put by fug) gyl ``target`+<+))
::
++ ta-poke |=(a/pear +>(..ta (se-poke gyl a))) :: poke gyl
++ ta-poke |=(a/cage +>(..ta (se-poke gyl a))) :: poke gyl
::
++ ta-act :: send action
|= act/sole-action
^+ +>
(ta-poke %sole-action act)
(ta-poke %sole-action !>(['drum' act]))
::
++ ta-aro :: hear arrow
|= key/?($d $l $r $u)

237
pkg/arvo/lib/hood/helm-mall.hoon
View File

@ -1,237 +0,0 @@
:: :: ::
:::: /hoon/helm/hood/lib :: ::
:: :: ::
/? 310 :: version
/- sole
/+ pill
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ part {$helm $0 pith} :: helm state
++ pith :: helm content
$: hoc/(map bone session) :: consoles
== ::
++ session ::
$: say/sole-share:sole :: console state
mud/(unit (sole-dialog:sole @ud)) :: console dialog
mass-timer/{way/wire nex/@da tim/@dr}
== ::
:: :: ::
:::: :: ::
:: :: ::
++ hood-nuke :: block/unblock
$: him/ship ::
== ::
++ hood-reset :: reset command
$~ ::
++ helm-verb :: reset command
$~ ::
++ hood-reload :: reload command
(list term) ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|: $:{bowl:mall part} :: main helm work
=/ ost 0
=+ sez=(~(gut by hoc) ost $:session)
=| moz=(list card:agent:mall)
|%
++ abet
[(flop moz) %_(+<+.$ hoc (~(put by hoc) ost sez))]
::
++ emit
|= card:agent:mall
%_(+> moz [+< moz])
::
++ flog
|= =flog:dill
(emit %pass /di %arvo %d %flog flog)
::
++ emil :: return cards
|= (list card:agent:mall)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ poke-rekey :: rotate private keys
|= des=@t
=/ sed=(unit seed:able:jael)
%+ biff
(bind (slaw %uw des) cue)
(soft seed:able:jael)
=< abet
?~ sed
~& %invalid-private-key
+>.$
?. =(our who.u.sed)
~& [%wrong-private-key-ship who.u.sed]
+>.$
(emit %pass / %arvo %j %rekey lyf.u.sed key.u.sed)
::
++ poke-moon :: rotate moon keys
|= sed=(unit [=ship =udiff:point:able:jael])
=< abet
?~ sed
+>.$
(emit %pass / %arvo %j %moon u.sed)
::
++ poke-nuke :: initialize
|= him/ship =< abet
(emit %pass /helm %arvo %a %nuke him)
::
++ poke-mass
|= ~ =< abet
(flog %crud %hax-heft ~)
::
++ poke-automass
|= recur=@dr
=. mass-timer.sez
[/helm/automass (add now recur) recur]
abet:(emit %pass way.mass-timer.sez %arvo %b %wait nex.mass-timer.sez)
::
++ poke-cancel-automass
|= ~
abet:(emit %pass way.mass-timer.sez %arvo %b %rest nex.mass-timer.sez)
::
++ poke-bonk
|= ~
~& .^((unit @da) %a /(scot %p our)/time/(scot %da now)/(scot %p our))
%- %- slog :_ ~ .^(tank %b /(scot %p our)/timers/(scot %da now))
abet:(emit %pass /bonk %arvo %a %bonk ~)
::
++ take-wake-automass
|= [way=wire error=(unit tang)]
?^ error
%- (slog u.error)
~& %helm-wake-automass-fail
abet
=. nex.mass-timer.sez (add now tim.mass-timer.sez)
=< abet
%- emil
:~ [%pass /heft %arvo %d %flog %crud %hax-heft ~]
[%pass way.mass-timer.sez %arvo %b %wait nex.mass-timer.sez]
==
::
++ poke-send-hi
|= {her/ship mes/(unit tape)} =< abet
%- emit
:* %pass /helm/hi/(scot %p her)
%agent [her %hood] %poke
%helm-hi !>(?~(mes '' (crip u.mes)))
==
::
::
++ poke-hi
|= mes/@t
~| %poke-hi-fail
?: =(%fail mes)
~& %poke-hi-fail
!!
abet:(flog %text "< {<src>}: {(trip mes)}")
::
++ poke-atom
|= ato/@
=+ len=(scow %ud (met 3 ato))
=+ gum=(scow %p (mug ato))
=< abet
(flog %text "< {<src>}: atom: {len} bytes, mug {gum}")
::
++ coup-hi
|= {pax/path cop/(unit tang)} =< abet
?> ?=({@t ~} pax)
(flog %text "hi {(trip i.pax)} {?~(cop "" "un")}successful")
::
++ poke-reload |=(all/(list term) (poke-reload-desk %home all))
++ poke-reload-desk :: reload vanes
|: $:{syd/desk all/(list term)} =< abet
%- emil
%- flop
%+ turn all
=+ top=`path`/(scot %p our)/[syd]/(scot %da now)
=/ van/(list {term ~})
:- zus=[%zuse ~]
~(tap by dir:.^(arch %cy (welp top /sys/vane)))
|= nam/@tas
=. nam
?. =(1 (met 3 nam))
nam
=+ ^- zaz/(list {p/knot ~})
(skim van |=({a/term ~} =(nam (end 3 1 a))))
?> ?=({{@ ~} ~} zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ zus==('z' tip)
=+ way=?:(zus (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
=+ fil=.^(@ %cx (welp way /hoon))
[%pass /reload %arvo %d %flog %veer ?:(=('z' tip) %$ tip) way fil]
:: +poke-reset: send %lyra to initiate kernel upgrade
::
:: And reinstall %zuse and the vanes with %veer.
:: Trigger with |reset.
::
++ poke-reset
|= hood-reset
=< abet
%- emil %- flop
^- (list card:agent:mall)
=/ top=path /(scot %p our)/home/(scot %da now)/sys
=/ hun .^(@ %cx (welp top /hoon/hoon))
=/ arv .^(@ %cx (welp top /arvo/hoon))
:- [%pass /reset %arvo %d %flog %lyra `@t`hun `@t`arv]
%+ turn
(module-ova:pill top)
|=([=wire =flog:dill] [%pass wire %arvo %d %flog flog])
::
++ poke-verb :: toggle verbose
|= ~ =< abet
(flog %verb ~)
::
++ poke-knob
|= [error-tag=@tas level=?(%hush %soft %loud)] =< abet
(emit %pass /helm %arvo %d %knob error-tag level)
::
++ poke-serve
|= [=binding:eyre =generator:eyre] =< abet
(emit %pass /helm/serv %arvo %e %serve binding generator)
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-helm-bad-mark mark] !!)
%helm-hi =;(f (f !<(_+<.f vase)) poke-hi)
%helm-mass =;(f (f !<(_+<.f vase)) poke-mass)
%helm-reload =;(f (f !<(_+<.f vase)) poke-reload)
%helm-reload-desk =;(f (f !<(_+<.f vase)) poke-reload-desk)
%helm-reset =;(f (f !<(_+<.f vase)) poke-reset)
%helm-send-hi =;(f (f !<(_+<.f vase)) poke-send-hi)
%helm-verb =;(f (f !<(_+<.f vase)) poke-verb)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)
%helm-rekey =;(f (f !<(_+<.f vase)) poke-rekey)
%helm-nuke =;(f (f !<(_+<.f vase)) poke-nuke)
%helm-automass =;(f (f !<(_+<.f vase)) poke-automass)
%helm-bonk =;(f (f !<(_+<.f vase)) poke-bonk)
%helm-cancel-automass =;(f (f !<(_+<.f vase)) poke-cancel-automass)
%helm-moon =;(f (f !<(_+<.f vase)) poke-moon)
%helm-serve =;(f (f !<(_+<.f vase)) poke-serve)
==
::
++ take-agent
|= [=wire =sign:agent:mall]
?+ wire ~|([%helm-bad-take-agent wire -.sign] !!)
[%helm %hi *] ?> ?=(%poke-ack -.sign)
(coup-hi t.t.wire p.sign)
==
::
++ take-bound
|= [wir=wire success=? binding=binding:eyre] =< abet
(flog %text "bound: {<success>}")
::
++ take
|= [=wire =sign-arvo]
?+ wire ~|([%helm-bad-take-wire wire +<.sign-arvo] !!)
[%automass *] %+ take-wake-automass t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%serv *] %+ take-bound t.wire
?>(?=(%bound +<.sign-arvo) +>.sign-arvo)
==
--

133
pkg/arvo/lib/hood/helm.hoon
View File

@ -33,37 +33,24 @@
:: :: ::
:::: :: ::
:: :: ::
|: $:{bowl:gall part} :: main helm work
|: $:{bowl:mall part} :: main helm work
=/ ost 0
=+ sez=(~(gut by hoc) ost $:session)
=> |% :: arvo structures
++ card ::
$% [%bonk wire ~] ::
{$conf wire dock ship term} ::
{$flog wire flog:dill} ::
[%knob wire @tas ?(%hush %soft %loud)] ::
{$nuke wire ship} ::
[%serve wire binding:eyre generator:eyre] ::
{$poke wire dock pear} ::
{$rest wire @da} ::
{$wait wire @da} ::
{$rekey wire life ring} ::
{$moon wire ship udiff:point:able:jael} ::
== ::
++ move (pair bone card) :: user-level move
++ pear :: poke fruit
$% {$hood-unsync desk ship desk} ::
{$helm-hi cord} ::
{$drum-start well:gall} ::
== ::
--
=+ moz=((list move))
=| moz=(list card:agent:mall)
|%
++ abet :: resolve
++ abet
[(flop moz) %_(+<+.$ hoc (~(put by hoc) ost sez))]
::
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emit
|= card:agent:mall
%_(+> moz [+< moz])
::
++ flog
|= =flog:dill
(emit %pass /di %arvo %d %flog flog)
::
++ emil :: return cards
|= (list card)
|= (list card:agent:mall)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
@ -80,38 +67,38 @@
?. =(our who.u.sed)
~& [%wrong-private-key-ship who.u.sed]
+>.$
(emit %rekey / lyf.u.sed key.u.sed)
(emit %pass / %arvo %j %rekey lyf.u.sed key.u.sed)
::
++ poke-moon :: rotate moon keys
|= sed=(unit [=ship =udiff:point:able:jael])
=< abet
?~ sed
+>.$
(emit %moon / u.sed)
(emit %pass / %arvo %j %moon u.sed)
::
++ poke-nuke :: initialize
|= him/ship =< abet
(emit %nuke /helm him)
(emit %pass /helm %arvo %a %nuke him)
::
++ poke-mass
|= ~ =< abet
(emit %flog /heft %crud %hax-heft ~)
(flog %crud %hax-heft ~)
::
++ poke-automass
|= recur=@dr
=. mass-timer.sez
[/helm/automass (add now recur) recur]
abet:(emit %wait way.mass-timer.sez nex.mass-timer.sez)
abet:(emit %pass way.mass-timer.sez %arvo %b %wait nex.mass-timer.sez)
::
++ poke-cancel-automass
|= ~
abet:(emit %rest way.mass-timer.sez nex.mass-timer.sez)
abet:(emit %pass way.mass-timer.sez %arvo %b %rest nex.mass-timer.sez)
::
++ poke-bonk
|= ~
~& .^((unit @da) %a /(scot %p our)/time/(scot %da now)/(scot %p our))
%- %- slog :_ ~ .^(tank %b /(scot %p our)/timers/(scot %da now))
abet:(emit %bonk /bonk ~)
abet:(emit %pass /bonk %arvo %a %bonk ~)
::
++ take-wake-automass
|= [way=wire error=(unit tang)]
@ -122,14 +109,17 @@
=. nex.mass-timer.sez (add now tim.mass-timer.sez)
=< abet
%- emil
:~ [%flog /heft %crud %hax-heft ~]
[%wait way.mass-timer.sez nex.mass-timer.sez]
:~ [%pass /heft %arvo %d %flog %crud %hax-heft ~]
[%pass way.mass-timer.sez %arvo %b %wait nex.mass-timer.sez]
==
::
++ poke-send-hi
|= {her/ship mes/(unit tape)} =< abet
%^ emit %poke /helm/hi/(scot %p her)
[[her %hood] %helm-hi ?~(mes '' (crip u.mes))]
%- emit
:* %pass /helm/hi/(scot %p her)
%agent [her %hood] %poke
%helm-hi !>(?~(mes '' (crip u.mes)))
==
::
::
++ poke-hi
@ -138,19 +128,19 @@
?: =(%fail mes)
~& %poke-hi-fail
!!
abet:(emit %flog /di %text "< {<src>}: {(trip mes)}")
abet:(flog %text "< {<src>}: {(trip mes)}")
::
++ poke-atom
|= ato/@
=+ len=(scow %ud (met 3 ato))
=+ gum=(scow %p (mug ato))
=< abet
(emit %flog /di %text "< {<src>}: atom: {len} bytes, mug {gum}")
(flog %text "< {<src>}: atom: {len} bytes, mug {gum}")
::
++ coup-hi
|= {pax/path cop/(unit tang)} =< abet
?> ?=({@t ~} pax)
(emit %flog ~ %text "hi {(trip i.pax)} {?~(cop "" "un")}successful")
(flog %text "hi {(trip i.pax)} {?~(cop "" "un")}successful")
::
++ poke-reload |=(all/(list term) (poke-reload-desk %home all))
++ poke-reload-desk :: reload vanes
@ -174,7 +164,7 @@
=+ zus==('z' tip)
=+ way=?:(zus (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
=+ fil=.^(@ %cx (welp way /hoon))
[%flog /reload [%veer ?:(=('z' tip) %$ tip) way fil]]
[%pass /reload %arvo %d %flog %veer ?:(=('z' tip) %$ tip) way fil]
:: +poke-reset: send %lyra to initiate kernel upgrade
::
:: And reinstall %zuse and the vanes with %veer.
@ -184,41 +174,64 @@
|= hood-reset
=< abet
%- emil %- flop
^- (list card)
^- (list card:agent:mall)
=/ top=path /(scot %p our)/home/(scot %da now)/sys
=/ hun .^(@ %cx (welp top /hoon/hoon))
=/ arv .^(@ %cx (welp top /arvo/hoon))
:- [%flog /reset [%lyra `@t`hun `@t`arv]]
:- [%pass /reset %arvo %d %flog %lyra `@t`hun `@t`arv]
%+ turn
(module-ova:pill top)
|=(a=[wire flog:dill] [%flog a])
|=([=wire =flog:dill] [%pass wire %arvo %d %flog flog])
::
++ poke-verb :: toggle verbose
|= ~ =< abet
(emit %flog /helm %verb ~)
(flog %verb ~)
::
++ poke-knob
|= [error-tag=@tas level=?(%hush %soft %loud)] =< abet
(emit %knob /helm error-tag level)
::
++ take-onto :: result of %conf
|= saw/(each suss:gall tang) =< abet
%- emit
?- -.saw
%| [%flog ~ %crud %onto `tang`p.saw]
%& [%flog ~ %text "<{<p.saw>}>"]
==
::
++ take-woot :: result of %want
|= {way/wire her/ship cop/coop} =< abet
(emit %flog ~ %text "woot: {<[way cop]>}")
(emit %pass /helm %arvo %d %knob error-tag level)
::
++ poke-serve
|= [=binding:eyre =generator:eyre] =< abet
(emit %serve /helm/serv binding generator)
(emit %pass /helm/serv %arvo %e %serve binding generator)
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-helm-bad-mark mark] !!)
%helm-hi =;(f (f !<(_+<.f vase)) poke-hi)
%helm-mass =;(f (f !<(_+<.f vase)) poke-mass)
%helm-reload =;(f (f !<(_+<.f vase)) poke-reload)
%helm-reload-desk =;(f (f !<(_+<.f vase)) poke-reload-desk)
%helm-reset =;(f (f !<(_+<.f vase)) poke-reset)
%helm-send-hi =;(f (f !<(_+<.f vase)) poke-send-hi)
%helm-verb =;(f (f !<(_+<.f vase)) poke-verb)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)
%helm-rekey =;(f (f !<(_+<.f vase)) poke-rekey)
%helm-nuke =;(f (f !<(_+<.f vase)) poke-nuke)
%helm-automass =;(f (f !<(_+<.f vase)) poke-automass)
%helm-bonk =;(f (f !<(_+<.f vase)) poke-bonk)
%helm-cancel-automass =;(f (f !<(_+<.f vase)) poke-cancel-automass)
%helm-moon =;(f (f !<(_+<.f vase)) poke-moon)
%helm-serve =;(f (f !<(_+<.f vase)) poke-serve)
==
::
++ take-agent
|= [=wire =sign:agent:mall]
?+ wire ~|([%helm-bad-take-agent wire -.sign] !!)
[%helm %hi *] ?> ?=(%poke-ack -.sign)
(coup-hi t.t.wire p.sign)
==
::
++ take-bound
|= [wir=wire success=? binding=binding:eyre] =< abet
(emit %flog ~ %text "bound: {<success>}")
(flog %text "bound: {<success>}")
::
++ take
|= [=wire =sign-arvo]
?+ wire ~|([%helm-bad-take-wire wire +<.sign-arvo] !!)
[%automass *] %+ take-wake-automass t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%serv *] %+ take-bound t.wire
?>(?=(%bound +<.sign-arvo) +>.sign-arvo)
==
--

767
pkg/arvo/lib/hood/kiln-mall.hoon
View File

@ -1,767 +0,0 @@
:: :: ::
:::: /hoon/kiln/hood/lib :: ::
:: :: ::
/? 310 :: version
:: :: ::
:::: :: ::
:: :: ::
=, clay
=, space:userlib
=, format
|% :: ::
++ part {$kiln $0 pith} :: kiln state
++ pith :: ::
$: 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/germ :: strategy
her/@p :: from ship
sud/@tas :: from desk
cas/case :: at case
== ::
:: :: ::
:::: :: ::
:: :: ::
++ kiln-commit term ::
++ kiln-mount ::
$: pax/path ::
pot/term ::
== ::
++ kiln-unmount $@(term {knot path}) ::
++ kiln-sync ::
$: syd/desk ::
her/ship ::
sud/desk ::
== ::
++ kiln-unsync ::
$: syd/desk ::
her/ship ::
sud/desk ::
== ::
++ kiln-merge ::
$: syd/desk ::
ali/ship ::
sud/desk ::
cas/case ::
gim/?($auto germ) ::
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|= {bowl:mall part} :: main kiln work
?> =(src our)
|_ moz/(list card:agent:mall)
++ abet :: resolve
[(flop moz) `part`+<+.$]
::
++ emit
|= card:agent:mall
%_(+> moz [+< moz])
::
++ emil :: return cards
|= (list card:agent:mall)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ render
|= {mez/tape sud/desk who/ship syd/desk}
:^ %palm [" " ~ ~ ~] leaf+mez
~[leaf+"from {<sud>}" leaf+"on {<who>}" leaf+"to {<syd>}"]
::
++ 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])
::
++ poke-cancel-autocommit
|= ~
abet:(emit %pass way.commit-timer %arvo %b [%rest nex.commit-timer])
::
++ 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])
::
++ 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-track ::
|= hos/kiln-sync
?: (~(has by syn) hos)
abet:(spam (render "already tracking" [sud her syd]:hos) ~)
abet:abet:start-track:(auto hos)
::
++ 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))
::
++ 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)
==
::
++ poke-merge ::
|= kiln-merge
abet:abet:(merge:(work syd) ali sud cas gim)
::
++ poke-cancel
|= syd/desk
abet:(emit %pass /cancel %arvo %c [%drop syd])
::
++ poke-info
|= {mez/tape tor/(unit toro)}
?~ tor
abet:(spam leaf+mez ~)
abet:(emit:(spam leaf+mez ~) %pass /kiln %arvo %c [%info u.tor])
::
++ poke-rm
|= a/path
=+ b=.^(arch %cy a)
?~ fil.b
=+ ~[leaf+"No such file:" leaf+"{<a>}"]
abet:(spam -)
(poke-info "removed" `(fray a))
::
++ poke-label
|= {syd/desk lab/@tas}
=+ pax=/(scot %p our)/[syd]/[lab]
(poke-info "labeled {(spud pax)}" `[syd %| lab])
::
++ poke-schedule
|= {where/path tym/@da eve/@t}
=. where (welp where /sched)
%+ poke-info "scheduled"
=+ old=;;((map @da cord) (fall (file where) ~))
`(foal where %sched !>((~(put by old) tym eve)))
::
++ poke-permission
|= {syd/desk pax/path pub/?}
=< abet
%- emit
=/ =rite [%r ~ ?:(pub %black %white) ~]
[%pass /kiln/permission %arvo %c [%perm syd pax rite]]
::
++ poke-autoload |=(lod/(unit ?) abet:(poke:autoload lod))
++ poke-start-autoload |=(~ abet:start:autoload)
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
%kiln-track =;(f (f !<(_+<.f vase)) poke-track)
%kiln-sync =;(f (f !<(_+<.f vase)) poke-sync)
%kiln-syncs =;(f (f !<(_+<.f vase)) poke-syncs)
%kiln-wipe-ford =;(f (f !<(_+<.f vase)) poke-wipe-ford)
%kiln-keep-ford =;(f (f !<(_+<.f vase)) poke-keep-ford)
%kiln-autoload =;(f (f !<(_+<.f vase)) poke-autoload)
%kiln-overload =;(f (f !<(_+<.f vase)) poke-overload)
%kiln-goad-gall =;(f (f !<(_+<.f vase)) poke-overload)
%kiln-wash-gall =;(f (f !<(_+<.f vase)) poke-wash-gall)
%kiln-unmount =;(f (f !<(_+<.f vase)) poke-unmount)
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-start-autoload =;(f (f !<(_+<.f vase)) poke-start-autoload)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
==
::
++ autoload
|%
++ emit
|= a/card:agent:mall
+>(..autoload (^emit a))
::
++ tracked-vanes
^- (list @tas)
~[%ames %behn %clay %dill %eyre %ford %gall %iris %jael]
::
++ our-home /(scot %p our)/home/(scot %da now)
++ sys-hash |=(pax/path .^(@uvI %cz :(welp our-home /sys pax)))
++ hash-vane
|= syd/@tas ^- (pair term @uvI)
[syd (sys-hash /vane/[syd]/hoon)]
::
++ rehash-vanes
^+ cur-vanes
(malt (turn tracked-vanes hash-vane))
::
::
++ poke
|= lod/(unit ?)
?^ lod
..autoload(autoload-on u.lod)
=. autoload-on !autoload-on
(spam leaf+"turned autoload {?:(autoload-on "on" "off")}" ~)
::
++ start
=. cur-hoon (sys-hash /hoon/hoon)
=. cur-arvo (sys-hash /arvo/hoon)
=. cur-zuse (sys-hash /zuse/hoon)
=. cur-vanes rehash-vanes
subscribe-next
::
++ subscribe-next
%- emit
[%pass /kiln/autoload %arvo %c [%warp our %home `[%next %z da+now /sys]]]
::
++ writ =>(check-new subscribe-next)
++ check-new
?. autoload-on
..check-new
=/ new-hoon (sys-hash /hoon/hoon)
=/ new-arvo (sys-hash /arvo/hoon)
?: |(!=(new-hoon cur-hoon) !=(new-arvo cur-arvo))
=. cur-hoon new-hoon
=. cur-arvo new-arvo
=. cur-vanes rehash-vanes
(emit %pass /kiln/reload/hoon %agent [our %hood] %poke %helm-reset !>(~))
:: XX updates cur-vanes?
=/ new-zuse (sys-hash /zuse/hoon)
?: !=(new-zuse cur-zuse)
=. cur-zuse new-zuse
=. cur-vanes rehash-vanes
=/ =cage [%helm-reload !>([%zuse tracked-vanes])]
(emit [%pass /kiln/reload/zuse %agent [our %hood] %poke cage])
(roll tracked-vanes load-vane)
::
++ load-vane
=< %_(. con ..load-vane)
|: $:{syd/@tas con/_.}
=. +>.$ con
=/ new-vane q:(hash-vane syd)
?: =(`new-vane (~(get by cur-vanes) syd))
+>.$
=. cur-vanes (~(put by cur-vanes) syd new-vane)
=/ =cage [%helm-reload !>(~[syd])]
(emit %pass /kiln/reload/[syd] %agent [our %hood] %poke cage)
::
++ coup-reload
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-reload-lame u.saw]
+>.$
--
::
++ poke-overload
:: +poke-overload: wipes ford cache at {start}, and then every {recur}.
|= [recur=@dr start=@da]
?> (gte start now)
abet:(emit %pass /kiln/overload/(scot %dr recur) %arvo %b [%wait start])
::
++ poke-wipe-ford
|=(percent=@ud abet:(emit %pass /kiln %arvo %f [%wipe percent]))
::
++ poke-keep-ford
|= [compiler-cache-size=@ud build-cache-size=@ud]
=< abet
(emit %pass /kiln %arvo %f [%keep compiler-cache-size build-cache-size])
::
++ poke-goad-gall
|= [force=? agent=(unit dude:gall)]
abet:(emit %pass /kiln %arvo %m %goad force agent)
::
++ poke-wash-gall |=(* abet:(emit %pass /kiln %arvo %m [%wash ~]))
::
++ mack
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-nack u.saw]
abet
::
++ take-agent
|= [=wire =sign:agent:mall]
?+ wire ~|([%kiln-bad-take-agent wire -.sign] !!)
[%kiln %fancy *] ?> ?=(%poke-ack -.sign)
(take-coup-fancy t.t.wire p.sign)
[%kiln %reload *] ?> ?=(%poke-ack -.sign)
(take-coup-reload t.t.wire p.sign)
[%kiln %spam *] ?> ?=(%poke-ack -.sign)
(take-coup-spam t.t.wire p.sign)
==
::
++ take-general
|= [=wire =sign-arvo]
?- wire
[%sync %merg *] %+ take-mere-sync t.t.wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
[%autoload *] %+ take-writ-autoload t.wire
?>(?=(%writ +<.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)
[%overload *] %+ take-wake-overload t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%autocommit *] %+ take-wake-autocommit t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
*
?+ +<.sign-arvo ~|([%kiln-bad-take-card +<.sign-arvo] !!)
%mack %+ mack wire
?>(?=(%mack +<.sign-arvo) +>.sign-arvo)
%made %+ take-made wire
?>(?=(%made +<.sign-arvo) +>.sign-arvo)
%mere %+ take-mere wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
==
==
++ take |=(way/wire ?>(?=({@ ~} way) (work i.way))) :: general handler
++ take-mere ::
|= {way/wire are/(each (set path) (pair term tang))}
abet:abet:(mere:(take way) are)
::
++ take-made
|= [way=wire date=@da result=made-result:ford]
:: hack for |overload
::
:: We might have gotten an ignorable response back for our cache priming
:: ford call. If it matches our magic wire, ignore it.
::
?: =(/prime/cache way)
~& %cache-primed
abet
abet:abet:(made:(take way) date result)
::
++ take-coup-fancy ::
|= {way/wire saw/(unit tang)}
abet:abet:(coup-fancy:(take way) saw)
::
++ take-coup-reload ::
|= {way/wire saw/(unit tang)}
abet:(coup-reload:autoload way saw)
::
++ take-coup-spam ::
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-spam-lame u.saw]
abet
::
++ take-mere-sync ::
|= {way/wire mes/(each (set path) (pair term tang))}
?> ?=({@ @ @ *} way)
=+ ^- hos/kiln-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(mere:(auto hos) mes)
::
++ take-writ-find-ship ::
|= {way/wire rot/riot}
?> ?=({@ @ @ *} way)
=+ ^- hos/kiln-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(take-find-ship:(auto hos) rot)
::
++ take-writ-sync ::
|= {way/wire rot/riot}
?> ?=({@ @ @ *} way)
=+ ^- hos/kiln-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(writ:(auto hos) rot)
::
++ take-writ-autoload
|= {way/wire rot/riot}
?> ?=(~ way)
?> ?=(^ rot)
abet:writ:autoload
::
++ take-wake-overload
|= {way/wire error=(unit tang)}
?^ error
%- (slog u.error)
~& %kiln-take-wake-overload-fail
abet
?> ?=({@ ~} way)
=+ tym=(slav %dr i.way)
~& %wake-overload-deprecated
abet
::
++ 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
:~ [%pass /commit %arvo %c [%dirk mon.commit-timer]]
[%pass way.commit-timer %arvo %b [%wait nex.commit-timer]]
==
::
::
++ spam
|= mes/(list tank)
((slog mes) ..spam)
::
++ auto
|= kiln-sync
=+ (~(gut by syn) [syd her sud] let=*@ud)
|%
++ abet
..auto(syn (~(put by syn) [syd her sud] let))
::
++ blab
|= new/(list card:agent:mall)
^+ +>
+>.$(moz (welp new moz))
::
++ warp
|= [=wire =ship =riff]
(blab [%pass wire %arvo %c [%warp ship riff]] ~)
::
++ spam |*(* %_(+> ..auto (^spam +<)))
++ stop
=> (spam (render "ended autosync" sud her syd) ~)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(warp wire her sud ~)
:: XX duplicate of start-sync? see |track
::
++ start-track
=> (spam (render "activated track" sud her syd) ~)
=. let 1
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(warp wire her sud `[%sing %y ud+let /])
::
++ start-sync
=> (spam (render "finding ship and desk" sud her syd) ~)
=/ =wire /kiln/find-ship/[syd]/(scot %p her)/[sud]
(warp wire her sud `[%sing %y ud+1 /])
::
++ take-find-ship
|= rot=riot
=> (spam (render "activated sync" sud her syd) ~)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(warp wire her sud `[%sing %w [%da now] /])
::
++ writ
|= rot=riot
?~ 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)
=/ =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 %that will fail.
::
:: We want to always use %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 %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 3 ud.cass) %that %mate)
=< %- spam
?: =(our her) ~
[(render "beginning sync" sud her syd) ~]
(blab [%pass wire %arvo %c [%merg syd her sud ud+let germ]] ~)
::
++ mere
|= mes=(each (set path) (pair term tang))
?: ?=([%| %bad-fetch-ali *] mes)
=. +>.$
%^ spam
leaf+"merge cancelled, maybe because sunk; restarting"
(render "on sync" sud her syd)
~
start-sync:stop
=. let +(let)
=. +>.$
%- spam
?: ?=(%& -.mes)
[(render "sync succeeded" sud her syd) ~]
?+ p.p.mes
:* (render "sync failed" sud her syd)
leaf+"please manually merge the desks with"
leaf+"|merge %{(trip syd)} {(scow %p her)} %{(trip sud)}"
leaf+""
leaf+"error code: {<p.p.mes>}"
q.p.mes
==
::
$no-ali-disc
:~ (render "sync activated" sud her syd)
leaf+"note: blank desk {<sud>} on {<her>}"
==
==
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(warp wire her sud `[%sing %y ud+let /])
--
::
++ work :: state machine
|= syd/desk
=+ ^- per-desk
%+ ~(gut by rem) syd
=+ *per-desk
%_(- cas [%da now])
|%
++ abet :: resolve
..work(rem (~(put by rem) syd auto gem her sud cas))
::
++ blab
|= new/(list card:agent:mall)
^+ +>
+>.$(moz (welp new moz))
::
++ win . :: successful poke
++ lose
^+ .
~| %kiln-work-fail
.
::
++ ford-fail
|=(tan/tang ~|(%ford-fail (mean tan)))
::
++ unwrap-tang
|* res/(each * tang)
?: ?=(%& -.res)
p.res
(ford-fail p.res)
::
++ perform ::
^+ .
(blab [%pass /kiln/[syd] %arvo %c [%merg syd her sud cas gem]] ~)
::
++ fancy-merge :: send to self
|= {syd/desk her/@p sud/desk gem/?($auto germ)}
^+ +>
=/ =cage [%kiln-merge !>([syd her sud cas gem])]
%- blab :_ ~
[%pass /kiln/fancy/[^syd] %agent [our %hood] %poke cage]
::
++ spam ::|=(tang ((slog +<) ..spam))
|*(* +>(..work (^spam +<)))
++ merge
|= {her/@p sud/@tas cas/case gim/?($auto germ)}
^+ +>
?. ?=($auto gim)
perform(auto |, gem gim, her her, cas cas, sud sud)
?: =(0 ud:.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now)))
=> $(gim %init)
.(auto &)
=> $(gim %fine)
.(auto &)
::
++ coup-fancy
|= saw/(unit tang)
?~ saw
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
[%pass /kiln/[syd] %arvo %c note]
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
lose:(spam leaf+-< leaf+-> u.saw)
::
++ mere
|= are/(each (set path) (pair term tang))
^+ +>
?: =(%meld gem)
?: ?=(%& -.are)
?. auto
=+ "merged with strategy {<gem>}"
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
:: ~? > =(~ p.are) [%mere-no-conflict syd]
=+ "mashing conflicts"
=> .(+>.$ (spam leaf+- ~))
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
=, ford
:* %pass /kiln/[syd] %arvo %f
:* %build live=%.n
^- schematic
:- %list
^- (list schematic)
:: ~& > kiln-mashing+[p.are syd=syd +<.abet]
%+ turn ~(tap in p.are)
|= pax/path
^- [schematic schematic]
:- [%$ %path -:!>(*path) pax]
=/ base=schematic [%scry %c %x `rail`[[our tic] (flop pax)]]
?> ?=([%da @] cas)
=/ alis=schematic
[%pin p.cas `schematic`[%scry %c %x [[our syd] (flop pax)]]]
=/ bobs=schematic
[%scry %c %x [[our syd] (flop pax)]]
=/ dali=schematic [%diff [our syd] base alis]
=/ dbob=schematic [%diff [our syd] base bobs]
=+ ^- for/mark
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
^- schematic
[%mash [our tic] for [[her sud] for dali] [[our syd] for dbob]]
== ==
=+ "failed to merge with strategy meld"
lose:(spam leaf+- >p.p.are< q.p.are)
?: ?=(%& -.are)
=+ "merged with strategy {<gem>}"
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
?. auto
=+ "failed to merge with strategy {<gem>}"
lose:(spam leaf+- >p.p.are< q.p.are)
?+ gem
(spam leaf+"strange auto" >gem< ~)
::
$init
=+ :- "auto merge failed on strategy %init"
"I'm out of ideas"
lose:(spam leaf+-< leaf+-> [>p.p.are< q.p.are])
::
$fine
?. ?=($bad-fine-merge p.p.are)
=+ "auto merge failed on strategy %fine"
lose:(spam leaf+- >p.p.are< q.p.are)
=> (spam leaf+"%fine merge failed, trying %meet" ~)
perform(gem %meet)
::
$meet
?. ?=($meet-conflict p.p.are)
=+ "auto merge failed on strategy %meet"
lose:(spam leaf+- >p.p.are< q.p.are)
=> (spam leaf+"%meet merge failed, trying %mate" ~)
perform(gem %mate)
::
$mate
?. ?=($mate-conflict p.p.are)
=+ "auto merge failed on strategy %mate"
lose:(spam leaf+- >p.p.are< q.p.are)
=> .(gem %meld)
=+ tic=(cat 3 syd '-scratch')
=> =+ :- "%mate merge failed with conflicts,"
"setting up scratch space at %{(trip tic)}"
[tic=tic (spam leaf+-< leaf+-> q.p.are)]
(fancy-merge tic our syd %init)
==
::
++ tape-to-tanks
|= a/tape ^- (list tank)
(scan a (more (just '\0a') (cook |=(a/tape leaf+a) (star prn))))
::
++ tanks-if-any
|= {a/tape b/(list path) c/tape} ^- (list tank)
?: =(~ b) ~
(welp (tape-to-tanks "\0a{c}{a}") >b< ~)
::
++ made
|= [date=@da result=made-result:ford]
:: |= {dep/@uvH reg/gage:ford}
^+ +>
::
?: ?=([%incomplete *] result)
=+ "failed to mash"
lose:(spam leaf+- tang.result)
?: ?=([%complete %error *] result)
=+ "failed to mash"
lose:(spam leaf+- message.build-result.result)
?> ?=([%complete %success %list *] result)
=+ ^- can/(list (pair path (unit miso)))
%+ turn results.build-result.result
|= res=build-result:ford
^- (pair path (unit miso))
?> ?=([%success ^ *] res)
~! res
=+ pax=(result-to-cage:ford head.res)
=+ dif=(result-to-cage:ford tail.res)
::
?. ?=($path p.pax)
~| "strange path mark: {<p.pax>}"
!!
[;;(path q.q.pax) ?:(?=($null p.dif) ~ `[%dif dif])]
:: ~& > kiln-made+[(turn can head) syd=syd +<.abet]
=+ notated=(skid can |=({path a/(unit miso)} ?=(^ a)))
=+ annotated=(turn `(list (pair path *))`-.notated head)
=+ unnotated=(turn `(list (pair path *))`+.notated head)
=+ `desk`(cat 3 syd '-scratch')
=+ ^- tan/(list tank)
%- zing
^- (list (list tank))
:~ %- tape-to-tanks
"""
done setting up scratch space in {<[-]>}
please resolve the following conflicts and run
|merge {<syd>} our {<[-]>}
"""
%^ tanks-if-any
"annotated conflicts in:" annotated
""
%^ tanks-if-any
"unannotated conflicts in:" unnotated
"""
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
(cat 3 syd '-scratch') %&
%+ murn can
|= {p/path q/(unit miso)}
`(unit (pair path miso))`?~(q ~ `[p u.q])
== ==
--
--

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

@ -12,7 +12,7 @@
++ part {$kiln $0 pith} :: kiln state
++ pith :: ::
$: rem/(map desk per-desk) ::
syn/(map kiln-sync {let/@ud ust/bone}) ::
syn/(map kiln-sync let/@ud) ::
autoload-on/? ::
cur-hoon/@uvI ::
cur-arvo/@uvI ::
@ -57,41 +57,18 @@
:: :: ::
:::: :: ::
:: :: ::
|= {bowl:gall part} :: main kiln work
|= {bowl:mall part} :: main kiln work
?> =(src our)
=> |% :: arvo structures
++ card ::
$% {$build wire ? schematic:ford} ::
{$drop wire @tas} ::
[%goad wire force=? agent=(unit dude:gall)] ::
{$info wire @tas nori} ::
{$mont wire @tas beam} ::
{$dirk wire @tas} ::
{$ogre wire $@(@tas beam)} ::
{$merg wire @tas @p @tas case germ} ::
{$perm wire desk path rite} ::
{$poke wire dock pear} ::
[%wash wire ~]
{$wipe wire @ud} ::
[%keep wire compiler-cache-size=@ud build-cache-size=@ud]
{$wait wire @da} ::
{$rest wire @da} ::
{$warp wire ship riff} ::
== ::
++ pear :: poke fruit
$% {$kiln-merge kiln-merge} ::
{$helm-reload (list term)} ::
{$helm-reset ~} ::
== ::
++ move (pair bone card) :: user-level move
--
|_ moz/(list move)
|_ moz/(list card:agent:mall)
++ abet :: resolve
[(flop moz) `part`+<+.$]
::
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
|= (list card)
++ emit
|= card:agent:mall
%_(+> moz [+< moz])
::
++ emil :: return cards
|= (list card:agent:mall)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
@ -103,17 +80,17 @@
++ poke-commit
|= [mon/kiln-commit auto=?]
=< abet
=. +>.$ (emit %dirk /commit mon)
=. +>.$ (emit %pass /commit %arvo %c [%dirk mon])
?. auto
+>.$
=/ recur ~s1
=. commit-timer
[/kiln/autocommit (add now recur) recur mon]
(emit %wait way.commit-timer nex.commit-timer)
(emit %pass way.commit-timer %arvo %b [%wait nex.commit-timer])
::
++ poke-cancel-autocommit
|= ~
abet:(emit %rest way.commit-timer nex.commit-timer)
abet:(emit %pass way.commit-timer %arvo %b [%rest nex.commit-timer])
::
++ poke-mount
|= kiln-mount
@ -121,7 +98,7 @@
?~ bem
=+ "can't mount bad path: {<pax>}"
abet:(spam leaf+- ~)
abet:(emit %mont /mount pot u.bem)
abet:(emit %pass /mount %arvo %c [%mont pot u.bem])
::
++ poke-unmount
|= mon/kiln-unmount
@ -130,8 +107,8 @@
?~ bem
=+ "can't unmount bad path: {<mon>}"
abet:(spam leaf+- ~)
abet:(emit %ogre /unmount-beam [[p q r] s]:u.bem)
abet:(emit %ogre /unmount-point mon)
abet:(emit %pass /unmount-beam %arvo %c [%ogre [[p q r] s]:u.bem])
abet:(emit %pass /unmount-point %arvo %c [%ogre mon])
::
++ poke-track ::
|= hos/kiln-sync
@ -167,13 +144,13 @@
::
++ poke-cancel
|= syd/desk
abet:(emit %drop /cancel syd)
abet:(emit %pass /cancel %arvo %c [%drop syd])
::
++ poke-info
|= {mez/tape tor/(unit toro)}
?~ tor
abet:(spam leaf+mez ~)
abet:(emit:(spam leaf+mez ~) %info /kiln u.tor)
abet:(emit:(spam leaf+mez ~) %pass /kiln %arvo %c [%info u.tor])
::
++ poke-rm
|= a/path
@ -199,14 +176,44 @@
|= {syd/desk pax/path pub/?}
=< abet
%- emit
[%perm /kiln/permission syd pax %r ~ ?:(pub %black %white) ~]
=/ =rite [%r ~ ?:(pub %black %white) ~]
[%pass /kiln/permission %arvo %c [%perm syd pax rite]]
::
++ poke-autoload |=(lod/(unit ?) abet:(poke:autoload lod))
++ poke-start-autoload |=(~ abet:start:autoload)
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
%kiln-track =;(f (f !<(_+<.f vase)) poke-track)
%kiln-sync =;(f (f !<(_+<.f vase)) poke-sync)
%kiln-syncs =;(f (f !<(_+<.f vase)) poke-syncs)
%kiln-wipe-ford =;(f (f !<(_+<.f vase)) poke-wipe-ford)
%kiln-keep-ford =;(f (f !<(_+<.f vase)) poke-keep-ford)
%kiln-autoload =;(f (f !<(_+<.f vase)) poke-autoload)
%kiln-overload =;(f (f !<(_+<.f vase)) poke-overload)
%kiln-goad-gall =;(f (f !<(_+<.f vase)) poke-overload)
%kiln-wash-gall =;(f (f !<(_+<.f vase)) poke-wash-gall)
%kiln-unmount =;(f (f !<(_+<.f vase)) poke-unmount)
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-start-autoload =;(f (f !<(_+<.f vase)) poke-start-autoload)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
==
::
++ autoload
|%
++ emit |=(a/card +>(..autoload (^emit a)))
++ emit
|= a/card:agent:mall
+>(..autoload (^emit a))
::
++ tracked-vanes
^- (list @tas)
~[%ames %behn %clay %dill %eyre %ford %gall %iris %jael]
@ -238,8 +245,7 @@
::
++ subscribe-next
%- emit
^- card
[%warp /kiln/autoload our %home `[%next %z da+now /sys]]
[%pass /kiln/autoload %arvo %c [%warp our %home `[%next %z da+now /sys]]]
::
++ writ =>(check-new subscribe-next)
++ check-new
@ -251,13 +257,14 @@
=. cur-hoon new-hoon
=. cur-arvo new-arvo
=. cur-vanes rehash-vanes
(emit %poke /kiln/reload/hoon [our %hood] %helm-reset ~)
(emit %pass /kiln/reload/hoon %agent [our %hood] %poke %helm-reset !>(~))
:: XX updates cur-vanes?
=/ new-zuse (sys-hash /zuse/hoon)
?: !=(new-zuse cur-zuse)
=. cur-zuse new-zuse
=. cur-vanes rehash-vanes
(emit %poke /kiln/reload/zuse [our %hood] %helm-reload [%zuse tracked-vanes])
=/ =cage [%helm-reload !>([%zuse tracked-vanes])]
(emit [%pass /kiln/reload/zuse %agent [our %hood] %poke cage])
(roll tracked-vanes load-vane)
::
++ load-vane
@ -268,7 +275,8 @@
?: =(`new-vane (~(get by cur-vanes) syd))
+>.$
=. cur-vanes (~(put by cur-vanes) syd new-vane)
(emit [%poke /kiln/reload/[syd] [our %hood] %helm-reload ~[syd]])
=/ =cage [%helm-reload !>(~[syd])]
(emit %pass /kiln/reload/[syd] %agent [our %hood] %poke cage)
::
++ coup-reload
|= {way/wire saw/(unit tang)}
@ -280,26 +288,63 @@
:: +poke-overload: wipes ford cache at {start}, and then every {recur}.
|= [recur=@dr start=@da]
?> (gte start now)
abet:(emit %wait /kiln/overload/(scot %dr recur) start)
abet:(emit %pass /kiln/overload/(scot %dr recur) %arvo %b [%wait start])
::
++ poke-wipe-ford
|=(percent=@ud abet:(emit %wipe /kiln percent))
|=(percent=@ud abet:(emit %pass /kiln %arvo %f [%wipe percent]))
::
++ poke-keep-ford
|= [compiler-cache-size=@ud build-cache-size=@ud]
abet:(emit %keep /kiln compiler-cache-size build-cache-size)
=< abet
(emit %pass /kiln %arvo %f [%keep compiler-cache-size build-cache-size])
::
++ poke-goad-gall
|= [force=? agent=(unit dude:gall)]
abet:(emit %goad /kiln force agent)
abet:(emit %pass /kiln %arvo %m %goad force agent)
::
++ poke-wash-gall |=(* abet:(emit %wash /kiln ~))
++ poke-wash-gall |=(* abet:(emit %pass /kiln %arvo %m [%wash ~]))
::
++ mack
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-nack u.saw]
abet
::
++ take-agent
|= [=wire =sign:agent:mall]
?+ wire ~|([%kiln-bad-take-agent wire -.sign] !!)
[%kiln %fancy *] ?> ?=(%poke-ack -.sign)
(take-coup-fancy t.t.wire p.sign)
[%kiln %reload *] ?> ?=(%poke-ack -.sign)
(take-coup-reload t.t.wire p.sign)
[%kiln %spam *] ?> ?=(%poke-ack -.sign)
(take-coup-spam t.t.wire p.sign)
==
::
++ take-general
|= [=wire =sign-arvo]
?- wire
[%sync %merg *] %+ take-mere-sync t.t.wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
[%autoload *] %+ take-writ-autoload t.wire
?>(?=(%writ +<.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)
[%overload *] %+ take-wake-overload t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%autocommit *] %+ take-wake-autocommit t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
*
?+ +<.sign-arvo ~|([%kiln-bad-take-card +<.sign-arvo] !!)
%mack %+ mack wire
?>(?=(%mack +<.sign-arvo) +>.sign-arvo)
%made %+ take-made wire
?>(?=(%made +<.sign-arvo) +>.sign-arvo)
%mere %+ take-mere wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
==
==
++ take |=(way/wire ?>(?=({@ ~} way) (work i.way))) :: general handler
++ take-mere ::
|= {way/wire are/(each (set path) (pair term tang))}
@ -386,8 +431,8 @@
=. nex.commit-timer (add now tim.commit-timer)
=< abet
%- emil
:~ [%dirk /commit mon.commit-timer]
[%wait way.commit-timer nex.commit-timer]
:~ [%pass /commit %arvo %c [%dirk mon.commit-timer]]
[%pass way.commit-timer %arvo %b [%wait nex.commit-timer]]
==
::
::
@ -397,39 +442,43 @@
::
++ auto
|= kiln-sync
=+ (~(gut by syn) [syd her sud] [let=*@ud ust=ost])
=+ (~(gut by syn) [syd her sud] let=*@ud)
|%
++ abet
..auto(syn (~(put by syn) [syd her sud] let ust))
..auto(syn (~(put by syn) [syd her sud] let))
::
++ blab
|= new/(list move)
|= new/(list card:agent:mall)
^+ +>
+>.$(moz (welp new moz))
::
++ warp
|= [=wire =ship =riff]
(blab [%pass wire %arvo %c [%warp ship riff]] ~)
::
++ spam |*(* %_(+> ..auto (^spam +<)))
++ stop
=> (spam (render "ended autosync" sud her syd) ~)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ust %warp wire her sud ~] ~)
(warp wire her sud ~)
:: XX duplicate of start-sync? see |track
::
++ start-track
=> (spam (render "activated track" sud her syd) ~)
=. let 1
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %y ud+let /]] ~)
(warp wire her sud `[%sing %y ud+let /])
::
++ start-sync
=> (spam (render "finding ship and desk" sud her syd) ~)
=/ =wire /kiln/find-ship/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %y ud+1 /]] ~)
(warp wire her sud `[%sing %y ud+1 /])
::
++ take-find-ship
|= rot=riot
=> (spam (render "activated sync" sud her syd) ~)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %w [%da now] /]] ~)
(warp wire her sud `[%sing %w [%da now] /])
::
++ writ
|= rot=riot
@ -441,7 +490,7 @@
~
start-sync
=. let ?. ?=($w p.p.u.rot) let ud:;;(cass:clay q.q.r.u.rot)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
=/ =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.
@ -464,7 +513,7 @@
=< %- spam
?: =(our her) ~
[(render "beginning sync" sud her syd) ~]
(blab [ost %merg wire syd her sud ud+let germ] ~)
(blab [%pass wire %arvo %c [%merg syd her sud ud+let germ]] ~)
::
++ mere
|= mes=(each (set path) (pair term tang))
@ -495,7 +544,7 @@
==
==
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %y ud+let /]] ~)
(warp wire her sud `[%sing %y ud+let /])
--
::
++ work :: state machine
@ -509,7 +558,7 @@
..work(rem (~(put by rem) syd auto gem her sud cas))
::
++ blab
|= new/(list move)
|= new/(list card:agent:mall)
^+ +>
+>.$(moz (welp new moz))
::
@ -530,13 +579,14 @@
::
++ perform ::
^+ .
(blab [ost %merg /kiln/[syd] syd her sud cas gem] ~)
(blab [%pass /kiln/[syd] %arvo %c [%merg syd her sud cas gem]] ~)
::
++ fancy-merge :: send to self
|= {syd/desk her/@p sud/desk gem/?($auto germ)}
^+ +>
=/ =cage [%kiln-merge !>([syd her sud cas gem])]
%- blab :_ ~
[ost %poke /kiln/fancy/[^syd] [our %hood] %kiln-merge [syd her sud cas gem]]
[%pass /kiln/fancy/[^syd] %agent [our %hood] %poke cage]
::
++ spam ::|=(tang ((slog +<) ..spam))
|*(* +>(..work (^spam +<)))
@ -556,7 +606,8 @@
?~ saw
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
[ost %merg /kiln/[syd] (cat 3 syd '-scratch') her sud cas gem]
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
[%pass /kiln/[syd] %arvo %c note]
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
lose:(spam leaf+-< leaf+-> u.saw)
@ -575,7 +626,8 @@
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
=, ford
:* ost %build /kiln/[syd] live=%.n
:* %pass /kiln/[syd] %arvo %f
:* %build live=%.n
^- schematic
:- %list
^- (list schematic)
@ -597,7 +649,7 @@
?~(- %$ i.-)
^- schematic
[%mash [our tic] for [[her sud] for dali] [[our syd] for dbob]]
==
== ==
=+ "failed to merge with strategy meld"
lose:(spam leaf+- >p.p.are< q.p.are)
?: ?=(%& -.are)
@ -704,11 +756,12 @@
=< win
%- blab:(spam tan)
:_ ~
:* ost %info /kiln/[syd]
:* %pass /kiln/[syd] %arvo %c
:* %info
(cat 3 syd '-scratch') %&
%+ murn can
|= {p/path q/(unit miso)}
`(unit (pair path miso))`?~(q ~ `[p u.q])
==
== ==
--
--

143
pkg/arvo/lib/hood/write-mall.hoon
View File

@ -1,143 +0,0 @@
:: File writer module
::
:::: /hoon/write/hood/lib
::
/? 310
=, format
=* as-octs as-octs:mimes:html
=, space:userlib
|%
+$ part {$write $0 pith} :: no state
+$ pith ~
--
::
::::
::
|%
++ data $%({$json json} {$mime mime})
--
::
::::
::
|= {bowl:mall part}
=* par +<+
|_ moz/(list card:agent:mall)
++ abet [(flop moz) `part`par]
++ emit
|= =card:agent:mall
%_(+> moz :_(moz card))
::
++ beak-now byk(r [%da now])
++ poke-wipe
|= sup/path ^+ abet :: XX determine extension, beak
=+ ext=%md
?~ (file (en-beam beak-now [ext sup]))
~|(not-found+[ext `path`(flop sup)] !!)
=- abet:(emit %pass /write %arvo %c %info -)
(fray (en-beam beak-now [ext sup]))
::
++ poke-tree
|= {sup/path mim/mime} ^+ abet :: XX determine extension, beak
(poke--data [`%md (flop sup)] %mime mim)
::
++ poke-paste
|= {typ/?($hoon $md $txt) txt/@t} ^+ abet
(poke--data [`typ /web/paste/(scot %da now)] %mime / (as-octs txt))
::
++ poke-comment
|= {sup/path him/ship txt/@t} ^+ abet
=+ pax=(welp (flop sup) /comments/(scot %da now))
=. txt
%+ rap 3 :~
'## `' (scot %p him) '`'
'\0a' txt
==
(poke--data [`%md pax] %mime / (as-octs txt))
::
++ poke-fora-post
|= {sup/path him/ship hed/@t txt/@t} ^+ abet
=+ pax=(welp (flop sup) /posts/(cat 3 (scot %da now) '~'))
=. txt
%- crip
"""
---
type: post
date: {<now>}
title: {(trip hed)}
author: {<him>}
navsort: bump
navuptwo: true
comments: reverse
---
{(trip txt)}
"""
(poke--data [`%md pax] %mime / (as-octs txt))
::
++ ames-secret
^- @t
=- (crip +:<.^(@p %j pax)>)
pax=/(scot %p our)/code/(scot %da now)/(scot %p our)
::
++ poke-sec-atom
|= {hot/host:eyre dat/@}
?> ?=(%& -.hot)
=. p.hot (scag 2 p.hot) :: ignore subdomain
=. dat (scot %uw (en:crub:crypto ames-secret dat))
(poke--data [`%atom [%sec p.hot]] %mime / (as-octs dat))
::
++ poke--data
|= {{ext/(unit @t) pax/path} dat/data} ^+ abet
?~ ext $(ext [~ -.dat])
=+ cay=?-(-.dat $json [-.dat !>(+.dat)], $mime [-.dat !>(+.dat)])
?: =(u.ext -.dat)
(made pax now [%complete %success %$ cay])
=< abet
%- emit :*
%pass write+pax %arvo %f
%build
live=%.n :: XX defer %nice
^- schematic:ford :: SYNTAX ERROR AT START OF LINE?
=/ =beak beak-now
[%cast [p q]:beak u.ext [%$ cay]]
==
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-write-bad-mark mark] !!)
%write-sec-atom =;(f (f !<(_+<.f vase)) poke-sec-atom)
%write-paste =;(f (f !<(_+<.f vase)) poke-paste)
%write-tree =;(f (f !<(_+<.f vase)) poke-tree)
%write-wipe =;(f (f !<(_+<.f vase)) poke-wipe)
==
::
++ made
|= [pax=wire date=@da result=made-result:ford]
^+ abet
:: |= {pax/wire @ res/gage:ford} ^+ abet
:: ?. =(our src)
:: ~|(foreign-write/[our=our src=src] !!)
?: ?=(%incomplete -.result)
(mean tang.result)
::
=/ build-result build-result.result
::
?: ?=([%error *] build-result)
(mean message.build-result)
::
=/ =cage (result-to-cage:ford build-result)
::
=- abet:(emit %pass /write %arvo %c %info -)
::
(foal :(welp (en-beam beak-now ~) pax /[-.cage]) cage)
::
++ take ::
|= [=wire =sign-arvo]
%+ made wire
?> ?=(%made +<.sign-arvo)
+>.sign-arvo
::
++ take-agent
|= [=wire =sign:agent:mall]
~|([%write-bad-take-agent wire -.sign] !!)
--

45
pkg/arvo/lib/hood/write.hoon
View File

@ -15,25 +15,25 @@
::
|%
++ data $%({$json json} {$mime mime})
++ card $% {$build wire ? schematic:ford}
{$info wire toro:clay}
==
--
::
::::
::
|= {bowl:gall part}
|= {bowl:mall part}
=* par +<+
|_ moz/(list {bone card})
|_ moz/(list card:agent:mall)
++ abet [(flop moz) `part`par]
++ emit |=(a/card %_(+> moz :_(moz [ost a])))
++ emit
|= =card:agent:mall
%_(+> moz :_(moz card))
::
++ beak-now byk(r [%da now])
++ poke-wipe
|= sup/path ^+ abet :: XX determine extension, beak
=+ ext=%md
?~ (file (en-beam beak-now [ext sup]))
~|(not-found+[ext `path`(flop sup)] !!)
=- abet:(emit %info write+~ -)
=- abet:(emit %pass /write %arvo %c %info -)
(fray (en-beam beak-now [ext sup]))
::
++ poke-tree
@ -94,12 +94,21 @@
(made pax now [%complete %success %$ cay])
=< abet
%- emit :*
%pass write+pax %arvo %f
%build
write+pax
live=%.n :: XX defer %nice
^- schematic:ford :: SYNTAX ERROR AT START OF LINE?
=/ =beak beak-now
[%cast [p q]:beak u.ext [%$ cay]]
live=%.n :: XX defer %nice
^- schematic:ford :: SYNTAX ERROR AT START OF LINE?
=/ =beak beak-now
[%cast [p q]:beak u.ext [%$ cay]]
==
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-write-bad-mark mark] !!)
%write-sec-atom =;(f (f !<(_+<.f vase)) poke-sec-atom)
%write-paste =;(f (f !<(_+<.f vase)) poke-paste)
%write-tree =;(f (f !<(_+<.f vase)) poke-tree)
%write-wipe =;(f (f !<(_+<.f vase)) poke-wipe)
==
::
++ made
@ -118,7 +127,17 @@
::
=/ =cage (result-to-cage:ford build-result)
::
=- abet:(emit %info write+~ -)
=- abet:(emit %pass /write %arvo %c %info -)
::
(foal :(welp (en-beam beak-now ~) pax /[-.cage]) cage)
::
++ take ::
|= [=wire =sign-arvo]
%+ made wire
?> ?=(%made +<.sign-arvo)
+>.sign-arvo
::
++ take-agent
|= [=wire =sign:agent:mall]
~|([%write-bad-take-agent wire -.sign] !!)
--