mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-25 16:05:27 +03:00
mall: remove old hood libraries
This commit is contained in:
Philip Monk
parent
881517c872
commit
32ea09caf2
@ -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
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -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
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
==
|
||||
--
|
||||
@ -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)
|
||||
==
|
||||
--
|
||||
|
||||
@ -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])
|
||||
== ==
|
||||
--
|
||||
--
|
||||
@ -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
|
||||
++ emit
|
||||
|= card:agent:mall
|
||||
%_(+> moz [+< moz])
|
||||
::
|
||||
++ emil :: return cards
|
||||
|= (list card)
|
||||
|= (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])
|
||||
==
|
||||
== ==
|
||||
--
|
||||
--
|
||||
|
||||
@ -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] !!)
|
||||
--
|
||||
@ -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,14 +94,23 @@
|
||||
(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]]
|
||||
==
|
||||
::
|
||||
++ 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
|
||||
@ -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] !!)
|
||||
--
|
||||
|
||||
Loading…
Reference in New Issue
Block a user