mirror of
https://github.com/urbit/shrub.git
synced 2024-12-01 14:42:02 +03:00
1306 lines
50 KiB
Plaintext
1306 lines
50 KiB
Plaintext
:: :: ::
|
|
:::: /hoon/ames/arvo :::::: vane prelude
|
|
!: :: ::
|
|
|= pit/vase :: kernel vase
|
|
=> =~ ::
|
|
=, xmas
|
|
:: :: ::
|
|
:::: :::::: ames structures
|
|
:: :: ::
|
|
::
|
|
=* pipe channel:able:jael :: secure channel
|
|
=* gree farm:pki:jael :: pki information
|
|
|% ::
|
|
++ bait {p/skin q/@ud r/dove} :: fmt nrecvd spec
|
|
++ bath :: per friend
|
|
$: det/pipe :: secure channel
|
|
lun/(unit lane) :: latest route
|
|
zam/scar :: outbound boles
|
|
fon/(map bole lock) :: inbound locks
|
|
sal/(map bole colt) :: outbound flows
|
|
== ::
|
|
++ bole bone :: inbound opaque
|
|
++ cake {p/sock q/skin r/@} :: top level packet
|
|
++ chan path :: channel
|
|
++ clue :: live packet state
|
|
$: vig/? :: true iff virgin
|
|
tel/part :: block identity
|
|
fap/flap :: fragment hash
|
|
dat/rock :: fragment data
|
|
== ::
|
|
++ coal :: live packet state
|
|
$: out/@da :: sent date
|
|
lod/@da :: lost-by deadline
|
|
clu/clue :: packet to send
|
|
== ::
|
|
++ colt :: outbound state
|
|
$: seq/tick :: next tick to fill
|
|
lac/tick :: acked tick until
|
|
cob/(map tick comb) :: live messages
|
|
myn/mini :: packet pump
|
|
== ::
|
|
++ comb :: live message
|
|
$: cup/(unit coop) :: final ack
|
|
cha/path :: channel
|
|
num/frag :: number of fragments
|
|
ack/frag :: number acked
|
|
cly/(list clue) :: left to send
|
|
== ::
|
|
++ dove {p/@ud q/(map @ud @)} :: count 13-blocks
|
|
++ flap @uvH :: network packet id
|
|
++ flea (pair bole tick) :: message id
|
|
++ frag @ud :: fragment number
|
|
++ hand @uvH :: 128-bit hash
|
|
++ lock :: inbound sequencer
|
|
$: laq/tick :: acknowledged until
|
|
nys/(map tick bait) :: inbound partials
|
|
laz/(unit (trel tick flap lane)) :: awaiting app
|
|
exc/(map tick ares) :: negative acks
|
|
== ::
|
|
++ meal :: payload
|
|
$% {$back p/bone q/flap r/coop s/@dr} :: acknowledgment
|
|
{$bond p/flea q/chan r/*} :: message
|
|
{$carp p/moan q/(pair @ud @)} :: fragment
|
|
{$fore p/ship q/(unit lane) r/@} :: forwarded packet
|
|
== ::
|
|
++ mini :: pump data
|
|
$: saw/stat :: statistics
|
|
liv/(qeu coal) :: live packets
|
|
lop/(qeu clue) :: lost packets
|
|
== ::
|
|
++ moan :: message invariant
|
|
$: {kos/bole liq/tick} :: flow identity
|
|
syn/@ :: skin number
|
|
cnt/@ :: number of packets
|
|
== ::
|
|
++ mute :: awaiting channel
|
|
$: inn/(list (pair lane rock)) :: inbound packets
|
|
out/(list (trel duct chan *)) :: outbound messages
|
|
== ::
|
|
++ part (pair frag tick) :: fragment of packet
|
|
++ rock @uvO :: packet
|
|
++ silo :: global state
|
|
$: lyf/life :: current version
|
|
wyr/(map life ring) :: private keys
|
|
ech/(map ship mute) :: waiting partners
|
|
pol/(map ship bath) :: open partners
|
|
== ::
|
|
++ skin ?($none $open $fast $full) :: encoding stem
|
|
++ stat :: pump statistics
|
|
$: $: cur/@ud :: window q length
|
|
max/@ud :: max pax out
|
|
rey/@ud :: retry q length
|
|
== ::
|
|
$: rtt/@dr :: roundtrip estimate
|
|
las/@da :: last sent
|
|
lad/@da :: last deadline
|
|
== ::
|
|
== ::
|
|
++ tick @ud :: message sequence no
|
|
-- ::
|
|
:: ::
|
|
:::: :::: arvo structures
|
|
:: ::
|
|
|% ::
|
|
++ flam |=(a/flap `@p`(mug a)) :: debug flap
|
|
++ msec |=(a/@dr `@ud`(div a (div ~s1 1.000))) :: debug @dr
|
|
++ move %+ pair :: local move
|
|
duct ::
|
|
(wind note:able:xmas gift:able:xmas) ::
|
|
:: ::
|
|
:::: loft :::: main transceiver
|
|
:: ::
|
|
++ loft ::
|
|
=> |% ::
|
|
++ gift :: output
|
|
$% {$east p/duct q/ship r/chan s/*} :: network response
|
|
{$home p/lane q/@} :: resend to self
|
|
{$line p/ship q/@da r/code} :: add outbound key
|
|
{$link p/ship q/@da r/code} :: add inbound key
|
|
{$meet p/gree} :: add public key(s)
|
|
{$rest p/duct q/coop} :: message result
|
|
{$send p/lane q/@} :: transmit packet
|
|
{$veil p/ship} :: cache channel
|
|
{$west p/ship q/bole r/chan s/*} :: outbound message
|
|
== ::
|
|
++ task :: input
|
|
$% {$clue p/ship q/pipe} :: update channel
|
|
{$done p/ship q/bole r/coop} :: completion
|
|
{$hear p/lane q/@} :: incoming packet
|
|
{$mess p/ship q/duct r/chan s/*} :: forward message
|
|
{$rend p/ship q/bole r/chan s/*} :: backward message
|
|
{$wake $~} :: wakeup
|
|
==
|
|
--
|
|
=| $: $: now/@da
|
|
eny/@
|
|
==
|
|
silo
|
|
fex/(list gift)
|
|
==
|
|
=* syl ->-
|
|
|% ::
|
|
++ abet [(flop fex) syl] :: resolve
|
|
++ apex :: compute
|
|
|= job/task
|
|
^+ +>
|
|
?- -.job
|
|
$clue (dear p.job q.job)
|
|
$done abet:(done:(etre p.job) q.job r.job)
|
|
$hear
|
|
=+ kec=(bite q.job)
|
|
?> =(our q.p.kec)
|
|
=+ buh=(~(get by pol) p.p.kec)
|
|
?~ buh
|
|
~& [%ames-from p.p.kec]
|
|
=+ nut=(~(gut by ech) p.p.kec *mute)
|
|
%_ +>.$
|
|
fex [[%veil p.p.kec] fex]
|
|
ech (~(put by ech) p.p.kec nut(inn [+.job inn.nut]))
|
|
==
|
|
abet:(~(hear et p.p.kec u.buh) p.job (shaf %flap q.job) q.kec r.kec)
|
|
::
|
|
$mess
|
|
=+ buh=(~(get by pol) p.job)
|
|
?~ buh
|
|
~& [%ames-unto p.job]
|
|
=+ nut=(~(gut by ech) p.job *mute)
|
|
%_ +>.$
|
|
fex [[%veil p.job] fex]
|
|
ech (~(put by ech) p.job nut(out [+>.job out.nut]))
|
|
==
|
|
=/ etc ~(. et p.job u.buh)
|
|
=^ kos etc (blow:etc q.job)
|
|
abet:(mess:etc kos r.job s.job)
|
|
::
|
|
$rend
|
|
abet:(mess:(etre p.job) q.job r.job s.job)
|
|
::
|
|
$wake
|
|
|- ^+ +>.^$
|
|
?~ pol +>.^$
|
|
=+ lef=$(pol l.pol)
|
|
=+ ryt=$(pol r.pol, fex fex.lef)
|
|
=+ top=~(to-wake et(fex fex.ryt) n.pol)
|
|
+>.^$(fex fex.top, pol [+<.top pol.lef pol.ryt])
|
|
==
|
|
:: ::
|
|
++ dear :: neighbor update
|
|
|= {who/@p det/pipe}
|
|
^+ +>
|
|
=+ noz=(~(get by ech) who)
|
|
?~ noz
|
|
::
|
|
:: we're not waiting for this ship; we must have it
|
|
::
|
|
=+ bah=(~(got by pol) who)
|
|
+>.$(pol (~(put by pol) who bah(det det)))
|
|
::
|
|
:: new neighbor; run all waiting i/o
|
|
::
|
|
=. pol (~(put by pol) who [det ~ [2 ~ ~] ~ ~])
|
|
=+ [inn out]=[(flop inn.u.noz) (flop out.u.noz)]
|
|
=. +>.$
|
|
|- ^+ +>.^$
|
|
?~ inn +>.^$
|
|
$(inn t.inn, +>.^$ (apex `task`[%hear i.inn]))
|
|
|- ^+ +>.^$
|
|
?~ out +>.^$
|
|
$(out t.out, +>.^$ (apex `task`[%mess who i.out]))
|
|
::
|
|
++ doze :: sleep until
|
|
|- ^- (unit @da)
|
|
?~ pol ~
|
|
;: (cury hunt lth)
|
|
$(pol l.pol)
|
|
$(pol r.pol)
|
|
~(to-wait et p.n.pol q.n.pol)
|
|
==
|
|
:: ::
|
|
++ etre :: old neighbor
|
|
|= who/@p
|
|
~(. et who (~(got by pol) who))
|
|
:: ::
|
|
++ et :: per neighbor
|
|
|_ $: who/ship
|
|
bah/bath
|
|
==
|
|
++ abet +>(pol (~(put by pol) who bah)) :: resolve
|
|
++ acme |=(fic/gift +>(fex [fic fex])) :: effect
|
|
++ blow :: register duct
|
|
|= hen/duct
|
|
^- {bole _+>}
|
|
=+ kus=(~(get by q.zam.bah) hen)
|
|
?^ kus [u.kus +>.$]
|
|
:- p.zam.bah
|
|
%= +>.$
|
|
p.zam.bah (add 2 p.zam.bah)
|
|
q.zam.bah (~(put by q.zam.bah) hen p.zam.bah)
|
|
r.zam.bah (~(put by r.zam.bah) p.zam.bah hen)
|
|
==
|
|
::
|
|
++ done
|
|
|= {kos/bole cop/coop}
|
|
^+ +>
|
|
(in-task %done +<)
|
|
:: ::
|
|
++ have :: receive message
|
|
|= {kos/bole cha/chan val/*}
|
|
^+ +>
|
|
?: =(0 (end 0 1 kos))
|
|
=+ hen=(~(got by r.zam.bah) kos)
|
|
::
|
|
:: if the bole is even, this is a backward flow,
|
|
:: like a subscription update; ack automatically.
|
|
::
|
|
(acme:(in-task %done kos ~) %east hen who cha val)
|
|
::
|
|
:: if the bole is odd, it's a forward flow. we
|
|
:: need to wait for the target to actively ack it.
|
|
::
|
|
(acme %west who kos cha val)
|
|
::
|
|
++ hear ::
|
|
|= {lyn/lane dam/flap syn/skin msg/@} :: hear packet
|
|
^+ +>
|
|
(in-task %hear +<)
|
|
:: ::
|
|
++ mess :: send message
|
|
|= {kos/bole cha/chan val/*}
|
|
^+ +>
|
|
(to-task kos %mess cha val)
|
|
:: ::
|
|
++ sack :: send acknowledgment
|
|
|= {kos/bole dam/flap cop/coop}
|
|
=+ ^= yex
|
|
((knit who lyf wyr det.bah) now eny [%back (mix kos 1) dam cop ~s0])
|
|
=. +>.$ (to-gifs p.yex)
|
|
|- ^+ +>.^$
|
|
?~ q.yex +>.^$
|
|
$(q.yex t.q.yex, +>.^$ (send ~ i.q.yex))
|
|
:: ::
|
|
++ send :: send packet
|
|
|= {urg/(unit lane) pac/rock}
|
|
^+ +>
|
|
?: =(our who) (acme [%send *lane pac])
|
|
=+ zaw=sax.det.bah
|
|
|- ^+ +>.^$
|
|
?~ zaw +>.^$
|
|
=+ ^= lun ^- (unit lane)
|
|
?: (lth i.zaw 256)
|
|
::
|
|
:: galaxies are mapped into reserved IP space,
|
|
:: which the interpreter maps into a DNS request.
|
|
::
|
|
[~ %if ~2000.1.1 31.337 (mix i.zaw .0.0.1.0)]
|
|
?: =(who i.zaw) lun.bah
|
|
=+ hab=(~(get by pol) i.zaw)
|
|
?~(hab ~ lun.u.hab)
|
|
?~ lun
|
|
$(zaw t.zaw)
|
|
=. pac ?: &(=(i.zaw who) =(~ urg))
|
|
pac
|
|
::
|
|
:: forwarded packets are not signed/encrypted,
|
|
:: because (a) we don't need to; (b) we don't
|
|
:: want to turn one packet into two. the wrapped
|
|
:: packet may exceed 8192 bits, but it's unlikely
|
|
:: to blow the MTU (IP MTU == 1500).
|
|
::
|
|
(spit [our i.zaw] %none (jam `meal`[%fore who urg pac]))
|
|
=. +>.^$ (acme %send u.lun pac)
|
|
::
|
|
:: stop if we have an %if (direct) address;
|
|
:: continue if we only have %ix (forwarded).
|
|
::
|
|
?:(?=($if -.u.lun) +>.^$ $(zaw t.zaw))
|
|
::
|
|
++ in-gift
|
|
|= hox/gift:hose
|
|
^+ +>
|
|
?- -.hox
|
|
$fore
|
|
?: =(our her.hox)
|
|
(acme %home org.hox pac.hox)
|
|
(send(who her.hox) [~ org.hox] pac.hox)
|
|
::
|
|
$have (have +.hox)
|
|
$link (acme %link who exp.hox key.hox)
|
|
$meet (acme hox)
|
|
$rack (to-task kos.hox %back dam.hox cop.hox ~s0)
|
|
$rout +>(lun.bah `lyn.hox)
|
|
$sack (sack +.hox)
|
|
==
|
|
::
|
|
++ in-gifs
|
|
|= hoz/(list gift:hose)
|
|
?~ hoz +>
|
|
$(hoz t.hoz, +> (in-gift i.hoz))
|
|
::
|
|
++ to-gift
|
|
|= rax/gift:rail
|
|
?- -.rax
|
|
$line (acme %line who ~2018.1.1 q.rax)
|
|
$mack (acme %rest (~(got by r.zam.bah) p.rax) q.rax)
|
|
$send (send ~ q.rax)
|
|
==
|
|
::
|
|
++ to-gifs
|
|
|= raz/(list gift:rail)
|
|
?~ raz +>
|
|
$(raz t.raz, +> (to-gift i.raz))
|
|
::
|
|
++ in-task
|
|
|= kyz/task:hose
|
|
^+ +>
|
|
=^ hoz fon.bah abet:(~(apex hose [who wyr det.bah] ~ fon.bah) kyz)
|
|
(in-gifs hoz)
|
|
::
|
|
++ to-task
|
|
|= {kos/bole kyz/task:rail}
|
|
^+ +>
|
|
=+ cot=((bond |.(zeal:rail)) (~(get by sal.bah) kos))
|
|
=^ raz cot abet:(work:(to-rail kos cot) kyz)
|
|
(to-gifs raz)
|
|
::
|
|
++ to-rail
|
|
|= {kos/bole cot/colt}
|
|
~(. rail [[who lyf wyr det.bah] [now eny] kos (yawn:pump myn.cot) ~] cot)
|
|
::
|
|
++ to-wait
|
|
|- ^- (unit @da)
|
|
?~ sal.bah ~
|
|
;: (cury hunt lth)
|
|
$(sal.bah l.sal.bah)
|
|
$(sal.bah r.sal.bah)
|
|
wait:(to-rail p.n.sal.bah q.n.sal.bah)
|
|
==
|
|
::
|
|
++ to-wake
|
|
|- ^+ +.$
|
|
?~ sal.bah +.$
|
|
=+ lef=$(sal.bah l.sal.bah)
|
|
=+ ryt=$(sal.bah r.sal.bah, fex fex.lef)
|
|
=+ top=(work:(to-rail(fex fex.ryt) p.n.sal.bah q.n.sal.bah) %wake ~)
|
|
+.$(fex fex.ryt, sal.bah [[kos cot]:top sal.bah.lef sal.bah.ryt])
|
|
--
|
|
--
|
|
::
|
|
:::: inbound cores
|
|
::
|
|
:: ::
|
|
:::: bite :::: packet format
|
|
:: ::
|
|
++ bite :: packet to cake
|
|
|= pac/rock ^- cake
|
|
=+ [mag=(end 5 1 pac) bod=(rsh 5 1 pac)]
|
|
=+ :* vez=(end 0 3 mag) :: protocol version
|
|
chk=(cut 0 [3 20] mag) :: checksum
|
|
wix=(bex +((cut 0 [23 2] mag))) :: width of receiver
|
|
vix=(bex +((cut 0 [25 2] mag))) :: width of sender
|
|
tay=(cut 0 [27 5] mag) :: message type
|
|
==
|
|
?> =(7 vez)
|
|
?> =(chk (end 0 20 (mug bod)))
|
|
:+ [(end 3 wix bod) (cut 3 [wix vix] bod)]
|
|
(kins tay)
|
|
(rsh 3 (add wix vix) bod)
|
|
::
|
|
++ kins |=(tay/@ (snag tay `(list skin)`[%none %open %fast %full ~]))
|
|
++ ksin |=(sin/skin `@`?-(sin $none 0, $open 1, $fast 2, $full 3))
|
|
::
|
|
++ spit :: cake to packet
|
|
|= kec/cake ^- @
|
|
=+ wim=(met 3 p.p.kec)
|
|
=+ dum=(met 3 q.p.kec)
|
|
=+ yax=?:((lte wim 2) 0 ?:((lte wim 4) 1 ?:((lte wim 8) 2 3)))
|
|
=+ qax=?:((lte dum 2) 0 ?:((lte dum 4) 1 ?:((lte dum 8) 2 3)))
|
|
=+ wix=(bex +(yax))
|
|
=+ vix=(bex +(qax))
|
|
=+ bod=:(mix p.p.kec (lsh 3 wix q.p.kec) (lsh 3 (add wix vix) r.kec))
|
|
=+ tay=(ksin q.kec)
|
|
%+ mix
|
|
%+ can 0
|
|
:~ [3 7]
|
|
[20 (mug bod)]
|
|
[2 yax]
|
|
[2 qax]
|
|
[5 tay]
|
|
==
|
|
(lsh 5 1 bod)
|
|
:: ::
|
|
:::: nose :::: packet decoder
|
|
:: ::
|
|
++ nose !:
|
|
=> |%
|
|
++ gift :: side effect
|
|
$% {$link exp/@da key/code} :: learn symmetric key
|
|
{$meet doy/gree} :: learn public key(s)
|
|
== ::
|
|
--
|
|
|= $: him/@p
|
|
wyr/(map life ring)
|
|
det/pipe
|
|
==
|
|
|= {syn/skin msg/@}
|
|
^- (pair (list gift) {aut/? ham/meal})
|
|
|^ ?- syn
|
|
$none [~ | (maul msg)]
|
|
$fast
|
|
=+ [mag=`hand`(end 7 1 msg) bod=(rsh 7 1 msg)]
|
|
=+ key=q:(~(got by inn.det) mag)
|
|
=+ clr=(need (de:crub:crypto key bod))
|
|
[~ & (maul clr)]
|
|
::
|
|
$full
|
|
=+ mex=;;({p/{p/life q/life} q/gree r/@} (cue msg))
|
|
=+ rig=(~(got by wyr) p.p.mex)
|
|
=+ pas=(whom q.p.mex q.mex)
|
|
=+ mes=(need (tear:as:(nol:nu:crub:crypto rig) pas r.mex))
|
|
=+ [key out]=;;((pair @ux @ux) (cue mes))
|
|
:- :~ [%link ~2018.1.1 key]
|
|
[%meet q.mex]
|
|
==
|
|
[& (maul out)]
|
|
::
|
|
$open
|
|
=+ mex=;;({p/{$~ q/life} q/gree r/@} (cue msg))
|
|
=+ pas=(whom q.p.mex q.mex)
|
|
=+ out=(need (sure:as:(com:nu:crub:crypto pas) r.mex))
|
|
[[%meet q.mex]~ & (maul r.mex)]
|
|
==
|
|
++ maul |=(@ `meal`;;(meal (cue +<))) :: unpack message
|
|
++ whom :: select public key
|
|
|= {lyf/life gyr/gree}
|
|
^- pass
|
|
::
|
|
:: if we have the public key for this life, use it.
|
|
:: otherwise, use the key the sender sent, without
|
|
:: without checking its validity. invalid public-key
|
|
:: data will crash the packet when we install it.
|
|
::
|
|
%- (bond |.(pub.dat:(~(got by (~(got by gyr) lyf)) him)))
|
|
(bind (~(get by pub.det) lyf) |=(cert:pki:jael pub.dat))
|
|
--
|
|
:: ::
|
|
:::: hose ::
|
|
:: ::
|
|
++ hose :: input decoder
|
|
=> |% ::
|
|
++ gift :: action
|
|
$% {$fore her/ship org/lane pac/rock} :: send forward
|
|
{$have kos/bole cha/chan val/*} :: report message
|
|
{$link exp/@da key/code} :: learn symmetric key
|
|
{$meet doy/gree} :: learn public key
|
|
{$rack kos/bole dam/flap cop/coop} :: report ack
|
|
{$rout lyn/lane} :: learn route
|
|
{$sack kos/bole dam/flap cop/coop} :: send ack
|
|
== ::
|
|
++ task :: event
|
|
$% {$done kos/bole cop/coop} :: commit message
|
|
{$hear lyn/lane dam/flap syn/skin msg/@} :: raw packet
|
|
== ::
|
|
-- ::
|
|
=| $: $: him/ship ::
|
|
wyr/(map life ring) ::
|
|
det/pipe ::
|
|
== ::
|
|
fex/(list gift) ::
|
|
fon/(map bole lock) ::
|
|
==
|
|
|% ::
|
|
++ abet [(flop fex) fon] :: resolve
|
|
++ acme |=(fic/gift +>(fex [fic fex])) :: effect
|
|
++ acts :: effects
|
|
|=(fix/(list gift) +>(fex (weld (flop fix) fex))) ::
|
|
:: ::
|
|
++ apex :: input
|
|
|= job/task
|
|
^+ +>
|
|
?- -.job
|
|
$done
|
|
=+ loc=(~(got by fon) kos.job)
|
|
?> ?=(^ laz.loc)
|
|
=< hy-abet
|
|
(~(hy-done hy [kos.job p.u.laz.loc] [& [q r]:u.laz.loc] loc) cop.job)
|
|
::
|
|
$hear
|
|
=+ pet=((nose him wyr det) syn.job msg.job)
|
|
=. +>.$ (acts p.pet)
|
|
:: if packet is authenticated, use its routing info
|
|
=. +>.$ ?.(aut.q.pet +>.$ (acme %rout lyn.job))
|
|
?- -.ham.q.pet
|
|
$back
|
|
~| %unsecured-back
|
|
?>(aut.q.pet (acme %rack [p q r]:ham.q.pet))
|
|
::
|
|
$bond
|
|
=+ loc=((bond |.(*lock)) (~(get by fon) p.p.ham.q.pet))
|
|
=< hy-abet
|
|
%. [q r]:ham.q.pet
|
|
~(hy-bond hy p.ham.q.pet [aut.q.pet [dam lyn]:job] loc)
|
|
::
|
|
$carp
|
|
=+ loc=((bond |.(*lock)) (~(get by fon) kos.p.ham.q.pet))
|
|
=< hy-abet
|
|
%. [(kins syn.p.ham.q.pet) cnt.p.ham.q.pet q.ham.q.pet]
|
|
~(hy-carp hy [kos liq]:p.ham.q.pet [aut.q.pet [dam lyn]:job] loc)
|
|
::
|
|
$fore
|
|
(acme %fore p.ham.q.pet (born lyn.job q.ham.q.pet) r.ham.q.pet)
|
|
==
|
|
==
|
|
:: ::
|
|
++ born :: set forward origin
|
|
|= {lyn/lane urg/(unit lane)}
|
|
^- lane
|
|
:: a forwarded packet contains its origin address,
|
|
:: but only after the first hop. if the address
|
|
:: field is empty, we fill it in with the address
|
|
:: we received the packet from. but we replace
|
|
:: %if with %ix, to show that the ultimate receiver
|
|
:: may not be able to send back to the origin
|
|
:: (due to non-full-cone NAT).
|
|
?~ urg lyn
|
|
?. ?=($if -.u.urg)
|
|
u.urg
|
|
[%ix +.u.urg]
|
|
::
|
|
++ hy :: message assembler
|
|
=| $: $: kos/bole :: sender
|
|
liq/tick :: message number
|
|
==
|
|
$: aut/? :: authenticated
|
|
dam/flap :: critical flap
|
|
lyn/lane :: origin address
|
|
==
|
|
lock
|
|
==
|
|
=* loq ->+
|
|
|% ::
|
|
++ hy-abet ..hy(fon (~(put by fon) kos loq)) :: resolve
|
|
++ hy-acme |=(fic/gift +>(+> (acme fic))) :: effect
|
|
++ hy-acts |=(fix/(list gift) +>(+> (acts fix))) :: effects
|
|
++ hy-bond :: full message
|
|
|= {cha/chan val/*}
|
|
^+ +>
|
|
?: (lth liq laq)
|
|
:: we already acked this msg; ack it again
|
|
:: ~& [%hi-bond-low [kos liq] laq]
|
|
hy-cong
|
|
?: (gth liq laq)
|
|
:: later than the next msg; ignore
|
|
~& [%hy-bond-after [kos liq] laq]
|
|
+>
|
|
?: !=(~ laz)
|
|
:: this msg is already being processed; ignore
|
|
~& [%hy-bond-during [kos liq] laq]
|
|
+>
|
|
:: report completed message
|
|
%. [%have kos cha val]
|
|
%= hy-acme
|
|
:: delete partial message
|
|
nys (~(del by nys) liq)
|
|
:: record message in application processing
|
|
laz `[liq dam lyn]
|
|
==
|
|
:: ::
|
|
++ hy-done :: message completed
|
|
|= cop/coop
|
|
^+ +>
|
|
(hy-cone(laq +(laq), laz ~) cop)
|
|
:: ::
|
|
++ hy-carp :: process fragment
|
|
|= {syn/skin cnt/@ud far/(pair @ud @)}
|
|
^+ +>
|
|
:: ~& [%carp fap/`@p`(mug fap) syn/syn cnt/cnt far/p.far]
|
|
?: (lth liq laq)
|
|
:: fragment of a message we've already acknowledged - ack it again.
|
|
:: ~& [%hy-carp-late liq laq]
|
|
hy-cong
|
|
?: (gth liq laq)
|
|
:: fragment of a message after the next we expect - drop it.
|
|
:: ~& [%hy-carp-early liq laq]
|
|
+>
|
|
:: neb: current incomplete message
|
|
=+ neb=`bait`(~(gut by nys) liq [syn 0 [cnt ~]])
|
|
:: all fragments must agree on the message parameters
|
|
?> &(=(p.neb syn) (gth p.r.neb p.far) =(p.r.neb cnt))
|
|
=+ doy=(~(get by q.r.neb) p.far)
|
|
?^ doy
|
|
:: we've already heard this fragment
|
|
(hy-conk ~)
|
|
:: install fragment
|
|
=: q.r.neb (~(put by q.r.neb) p.far q.far)
|
|
q.neb +(q.neb)
|
|
==
|
|
?. =(q.neb p.r.neb)
|
|
:: message not yet complete, reinstall incomplete
|
|
(hy-conk(nys (~(put by nys) liq neb)) ~)
|
|
:: decode complete message
|
|
=+ pet=((nose him wyr det) syn (hy-golf r.neb))
|
|
:: record decoder effects
|
|
=. +>.$ (hy-acts p.pet)
|
|
=. aut |(aut aut.q.pet)
|
|
?- -.ham.q.pet
|
|
$back ~|(%unsecured-back ?>(aut (hy-acme %rack kos [q r]:ham.q.pet)))
|
|
$carp ~|(%meta-carp !!)
|
|
$fore (hy-acme %fore p.ham.q.pet (born lyn q.ham.q.pet) r.ham.q.pet)
|
|
$bond ~| %bogus-assembly
|
|
?> &(aut =([kos liq] p.ham.q.pet))
|
|
(hy-bond [q r]:ham.q.pet)
|
|
==
|
|
::
|
|
++ hy-cong (hy-conk (~(get by exc) liq)) :: duplicate ack
|
|
++ hy-conk :: ack current
|
|
|=(cop/coop (hy-acme %sack kos dam cop))
|
|
++ hy-cone :: record ack
|
|
|= cop/coop
|
|
=> ?~(cop . .(exc (~(put by exc) liq u.cop)))
|
|
(hy-conk cop)
|
|
:: ::
|
|
++ hy-golf :: assemble fragments
|
|
|= duv/dove
|
|
=+ [nix=0 rax=*(list @)]
|
|
|- ^- @
|
|
?: =(p.duv nix)
|
|
(can 13 (turn (flop rax) |=(a/@ [1 a])))
|
|
$(nix +(nix), rax [(need (~(get by q.duv) nix)) rax])
|
|
--
|
|
--
|
|
:: ::
|
|
:::: outbound cores ::::
|
|
:: ::
|
|
::
|
|
:::: packet pump
|
|
::
|
|
++ pump :: packet pump
|
|
=> |% ::
|
|
++ gift :: effect
|
|
$% {$good p/flap q/part r/@dr s/coop} :: logical ack
|
|
{$send p/flap q/part r/rock} :: release packet
|
|
== ::
|
|
++ task :: event
|
|
$% {$back p/flap q/coop r/@dr} :: raw ack
|
|
{$cull p/tick} :: cancel message
|
|
{$pack p/(list clue)} :: submit packets
|
|
{$wake $~} :: random wakeup
|
|
== ::
|
|
--
|
|
|%
|
|
++ yawn ::
|
|
|= myn/mini ::
|
|
^+ zu
|
|
~(. zu ~ myn) ::
|
|
::
|
|
++ zu :: state machine
|
|
|_ $: fex/(list gift) :: effects
|
|
mini :: state
|
|
==
|
|
:: ::
|
|
++ abba :: a older than b
|
|
|= {a/part b/part}
|
|
|((lth q.a q.b) &(=(q.a q.b) (lth p.a p.b)))
|
|
:: ::
|
|
++ abet :: resolve
|
|
^- {(list gift:pump) mini}
|
|
:: =. . aver
|
|
[(flop fex) +<+]
|
|
:: ::
|
|
++ aver :: verify
|
|
?> (lte cur.saw max.saw)
|
|
?> !=(0 max.saw)
|
|
?. =(cur.saw (lent ~(tap to liv)))
|
|
~& [%aver-cur cur.saw (lent ~(tap to liv))]
|
|
!!
|
|
?> =(rey.saw (lent ~(tap to lop)))
|
|
?> =+ |= {a/coal b/coal}
|
|
&((lth out.a out.b) (lth lod.a lod.b))
|
|
|- ?| ?=($~ liv)
|
|
?& ?| ?=($~ r.liv)
|
|
?& (+< n.r.liv n.liv)
|
|
$(liv r.liv)
|
|
== ==
|
|
?| ?=($~ l.liv)
|
|
?& (+< n.liv n.l.liv)
|
|
$(liv l.liv)
|
|
== ==
|
|
==
|
|
==
|
|
?> =+ |= {a/part b/part}
|
|
|((lth q.a q.b) &(=(q.a q.b) (lth p.a p.b)))
|
|
|- ?| ?=($~ lop)
|
|
?& ?| ?=($~ r.lop)
|
|
?& (+< tel.n.r.lop tel.n.lop)
|
|
$(lop r.lop)
|
|
== ==
|
|
?| ?=($~ l.lop)
|
|
?& (+< tel.n.lop tel.n.l.lop)
|
|
$(lop l.lop)
|
|
== ==
|
|
==
|
|
==
|
|
.
|
|
:: ::
|
|
++ back :: process raw ack
|
|
|= {now/@da dam/flap cop/coop lag/@dr}
|
|
^+ +>
|
|
=- =/ rtt ?~(ack ~s0 (sub now out.u.ack))
|
|
=. rtt ?:((gth rtt lag) (sub rtt lag) rtt)
|
|
(done:(lose(liv lov) ded) ack dam cop rtt)
|
|
|- ^- $: ack/(unit coal)
|
|
ded/(list coal)
|
|
lov/(qeu coal)
|
|
==
|
|
?~ liv [~ ~ ~]
|
|
=+ ryt=$(liv r.liv)
|
|
?^ ack.ryt
|
|
::
|
|
:: found in front, no need to search back.
|
|
::
|
|
[ack.ryt ded.ryt [n.liv l.liv lov.ryt]]
|
|
::
|
|
:: lose unacked packets sent before an acked virgin.
|
|
::
|
|
=+ ^- $: top/?
|
|
ack/(unit coal)
|
|
ded/(list coal)
|
|
lov/(qeu coal)
|
|
==
|
|
?: =(dam fap.clu.n.liv)
|
|
[| `n.liv ~ l.liv]
|
|
[& $(liv l.liv)]
|
|
?~ ack [~ ~ liv]
|
|
=. ded ?:(top [n.liv ded] ded)
|
|
=? ded vig.clu.u.ack (weld ~(tap to r.liv) ded)
|
|
=. lov ?:(top [n.liv lov ~] lov)
|
|
[ack ded lov]
|
|
:: ::
|
|
++ clap :: ordered enqueue
|
|
::
|
|
:: the `lop` queue isn't really a queue in case of
|
|
:: resent packets; packets from older messages
|
|
:: need to be sent first. unfortunately hoon.hoon
|
|
:: lacks a general sorted/balanced heap right now.
|
|
:: so we implement a balanced queue insert by hand.
|
|
::
|
|
|= clu/clue
|
|
%_ +>
|
|
lop
|
|
|- ^+ lop
|
|
?~ lop [clu ~ ~]
|
|
?: ?| (abba tel.clu tel.n.lop)
|
|
?& =(tel.clu tel.n.lop)
|
|
(lth fap.clu fap.n.lop)
|
|
== ==
|
|
[n.lop l.lop $(lop r.lop)]
|
|
[n.lop $(lop l.lop) r.lop]
|
|
==
|
|
:: ::
|
|
++ cull :: clear message
|
|
|= tiq/tick
|
|
%_ +>
|
|
liv
|
|
|- ^+ liv
|
|
?~ liv ~
|
|
=+ vil=[n.liv $(liv l.liv) $(liv r.liv)]
|
|
?. =(tiq q.tel.clu.n.liv) vil
|
|
~(nip to `(qeu coal)`vil)
|
|
::
|
|
lop
|
|
|- ^+ lop
|
|
?~ lop ~
|
|
=+ pol=[n.lop $(lop l.lop) $(lop r.lop)]
|
|
?: =(tiq q.tel.n.lop) pol
|
|
~(nip to `(qeu clue)`pol)
|
|
==
|
|
:: ::
|
|
++ done :: process cooked ack
|
|
|= {lyd/(unit coal) dam/flap cop/coop rtt/@dr}
|
|
^+ +>
|
|
?~ lyd +>
|
|
%_ +>
|
|
cur.saw (dec cur.saw)
|
|
fex [[%good dam tel.clu.u.lyd rtt cop] fex]
|
|
==
|
|
:: ::
|
|
++ fire :: send a packet
|
|
|= {now/@da clu/clue}
|
|
^+ +>
|
|
?> (lth cur.saw max.saw)
|
|
=+ out=?:((lte now las.saw) +(las.saw) now)
|
|
=+ lod=(add now (mul 2 rtt.saw))
|
|
=. lod ?:((gth lod lad.saw) lod +(lad.saw))
|
|
:: ~& [%fire (flam fap.clu) `@da`out `@da`lod]
|
|
%= +>.$
|
|
fex [[%send fap.clu tel.clu dat.clu] fex]
|
|
las.saw out
|
|
lad.saw lod
|
|
cur.saw +(cur.saw)
|
|
liv (~(put to liv) [out lod clu])
|
|
==
|
|
:: ::
|
|
++ flay :: time out packets
|
|
|= now/@da
|
|
^+ +>
|
|
=- (lose(liv q.ole) p.ole)
|
|
^= ole
|
|
=| ded/(list coal)
|
|
|- ^+ [p=ded q=liv]
|
|
?~ liv [ded ~]
|
|
?: (gte now lod.n.liv)
|
|
::
|
|
:: everything in front of a dead packet is dead
|
|
::
|
|
$(liv l.liv, ded (welp ~(tap to r.liv) [n.liv ded]))
|
|
=+ ryt=$(liv r.liv)
|
|
[p.ryt [n.liv l.liv q.ryt]]
|
|
:: ::
|
|
++ lose :: abandon packets
|
|
|= cud/(list coal)
|
|
^+ +>
|
|
?~ cud +>
|
|
=. +> (clap clu.i.cud)
|
|
%= $
|
|
cud t.cud
|
|
cur.saw (dec cur.saw)
|
|
rey.saw +(rey.saw)
|
|
==
|
|
:: ::
|
|
++ ship :: send packets
|
|
|= {now/@da cly/(list clue)}
|
|
^+ +>
|
|
?: (gte cur.saw max.saw) +>
|
|
?: =(0 rey.saw)
|
|
?~ cly +>
|
|
$(cly t.cly, +> (fire now i.cly))
|
|
=^ clu lop ~(get to lop)
|
|
$(+> (fire(rey.saw (dec rey.saw)) now clu))
|
|
:: ::
|
|
++ wait :: next wakeup
|
|
^- (unit @da)
|
|
=+ tup=`(unit coal)`~(top to liv)
|
|
?~(tup ~ `lod.u.tup)
|
|
:: ::
|
|
++ want :: window space
|
|
^- @ud
|
|
?: (gte cur.saw max.saw) 0
|
|
=+ gap=(sub max.saw cur.saw)
|
|
?: (gte rey.saw gap) 0
|
|
(sub gap rey.saw)
|
|
::
|
|
++ work ::
|
|
|= {now/@da job/task} :: perform
|
|
^+ +>
|
|
?- -.job
|
|
$back (back now [p q r]:job)
|
|
$cull (cull p.job)
|
|
$pack (ship now p.job)
|
|
$wake (flay now)
|
|
==
|
|
--
|
|
--
|
|
:: ::
|
|
:::: knit :::: message encoder
|
|
:: ::
|
|
++ knit
|
|
=> |%
|
|
++ gift :: side effect
|
|
$% {$line exp/@da key/code} :: set symmetric key
|
|
== ::
|
|
--
|
|
|= {her/@p lyf/life wyr/(map life ring) det/pipe}
|
|
|= {now/@da eny/@ ham/meal}
|
|
=+ hom=(jam ham)
|
|
^- (pair (list gift) (list rock))
|
|
=< weft
|
|
|%
|
|
++ wain :: message identity
|
|
^- flea
|
|
?+ -.ham [0 0]
|
|
$bond p.ham
|
|
$carp [kos liq]:p.ham
|
|
==
|
|
::
|
|
++ wasp ^-({p/skin q/@} [%none hom]) :: null security
|
|
++ weft :: fragment message
|
|
^- (pair (list gift) (list rock))
|
|
=+ gum=wisp
|
|
:- p.gum
|
|
=+ wit=(met 13 q.q.gum)
|
|
?: =(1 wit)
|
|
:: message fits in one packet, don't fragment
|
|
[(spit [our her] p.q.gum q.q.gum) ~]
|
|
=+ ruv=(rip 13 q.q.gum)
|
|
=+ inx=0
|
|
|- ^- (list rock)
|
|
?~ ruv ~
|
|
:_ $(ruv t.ruv, inx +(inx))
|
|
%+ spit
|
|
[our her]
|
|
wasp(ham [%carp [wain (ksin p.q.gum) wit] inx i.ruv])
|
|
::
|
|
++ wisp :: generate message
|
|
^- (pair (list gift) (pair skin @))
|
|
?: =(%carp -.ham)
|
|
[~ wasp]
|
|
?^ out.det
|
|
:- ~
|
|
:- %fast
|
|
%^ cat 7
|
|
p.u.out.det
|
|
(en:crub:crypto q.q.u.out.det hom)
|
|
=+ cry=(nol:nu:crub:crypto (~(got by wyr) lyf))
|
|
?~ cur.det
|
|
:- ~
|
|
:- %open
|
|
%^ jam
|
|
[~ lyf]
|
|
`gree`!!
|
|
(sign:as:cry hom)
|
|
=+ key=(shaz :(mix (mug ham) now eny))
|
|
:- [%line ~2018.1.1 key]~
|
|
:- %full
|
|
%^ jam
|
|
[u.cur.det lyf]
|
|
`gree`!!
|
|
(seal:as:cry pub.dat:(~(got by pub.det) u.cur.det) (jam key hom))
|
|
--
|
|
:: ::
|
|
:::: rail :::: message manager
|
|
:: ::
|
|
++ rail ::
|
|
=> |% ::
|
|
++ gift ::
|
|
$% {$line p/@da q/code} :: sent key
|
|
{$mack p/bole q/coop} :: message ack
|
|
{$send p/flap q/rock} :: release packet
|
|
== ::
|
|
++ task ::
|
|
$% {$back p/flap q/coop r/@dr} :: raw ack
|
|
{$mess p/chan q/*} :: send message
|
|
{$wake $~} :: random wakeup
|
|
== ::
|
|
-- ::
|
|
=| $: $: $: her/ship
|
|
lyf/life
|
|
wyr/(map life ring)
|
|
det/pipe
|
|
==
|
|
$: now/@da
|
|
eny/@
|
|
==
|
|
kos/bole
|
|
mup/_(yawn:pump)
|
|
fex/(list gift)
|
|
==
|
|
colt
|
|
==
|
|
=* cot ->
|
|
|% ::
|
|
++ abet [(flop fex) `colt`cot] :: resolve
|
|
++ view :: inspect
|
|
|% ::
|
|
++ bulk :: queue count
|
|
^- @ud
|
|
|-(?~(cob 0 :(add 1 $(cob l.cob) $(cob r.cob))))
|
|
:: ::
|
|
++ wait :: next wakeup
|
|
^- (unit @da)
|
|
wait:mup
|
|
--
|
|
::
|
|
++ work ::
|
|
|= job/task :: compute
|
|
^+ +>
|
|
=< +>:wy-abet:wy-work
|
|
|% ::
|
|
++ wy-abet +:wy-able :: resolve
|
|
++ wy-able wy-tire:wy-ably:wy-feed:wy-ably :: converge
|
|
++ wy-ably :: drain
|
|
^+ .
|
|
=^ fix myn abet:mup
|
|
=. mup (yawn:pump myn)
|
|
|- ^+ +>.$
|
|
?~ fix +>.$
|
|
$(fix t.fix, +>.$ (wy-abut i.fix))
|
|
:: ::
|
|
++ wy-abut :: pump effect
|
|
|= fic/gift:pump
|
|
^+ +>
|
|
?- -.fic
|
|
$good
|
|
~& [%ok her `@p`(mug p.fic) r.fic]
|
|
(wy-good q.fic s.fic)
|
|
::
|
|
$send
|
|
~& [%go her `@p`(mug p.fic) q.fic]
|
|
+>(fex [[%send p.fic r.fic] fex])
|
|
==
|
|
:: ::
|
|
++ wy-back :: hear an ack
|
|
|= {dam/flap cop/coop lag/@dr}
|
|
~& [%wy-back (flam dam) cop lag]
|
|
+>(mup (work:mup now %back dam cop lag))
|
|
:: ::
|
|
++ wy-feed :: feed pump
|
|
^+ .
|
|
=^ cly . (wy-find want.mup)
|
|
~& [%wy-feed want.mup (lent cly)]
|
|
+(mup (work:mup now %pack cly))
|
|
:: ::
|
|
++ wy-find :: collect packets
|
|
|= may/@ud
|
|
^- {(list clue) _+>}
|
|
=- [(flop -<) ->]
|
|
=+ [inx=lac hav=*(list clue)]
|
|
|- ^- {(list clue) _+>.^$}
|
|
?: |(=(0 may) =(inx seq)) [hav +>.^$]
|
|
=^ hey +>.^$ (wy-flow inx may hav)
|
|
$(inx +(inx), may p.hey, hav q.hey)
|
|
:: ::
|
|
++ wy-flow :: collect by message
|
|
|= {tiq/tick may/@ud hav/(list clue)}
|
|
=+ mob=(~(got by cob) tiq)
|
|
|- ^- {(pair @ud (list clue)) _+>.^$}
|
|
?: |(=(0 may) ?=($~ cly.mob))
|
|
[[may hav] +>.^$(cob (~(put by cob) tiq mob))]
|
|
%= $
|
|
may (dec may)
|
|
hav [i.cly.mob hav]
|
|
cly.mob t.cly.mob
|
|
==
|
|
:: ::
|
|
++ wy-good :: message ack
|
|
|= {paz/part cop/coop}
|
|
^+ +>
|
|
=+ bum=(~(get by cob) q.paz)
|
|
?: |(?=($~ bum) =(~ cly.u.bum))
|
|
~& [%wy-good-ignore paz ?=($~ cop)]
|
|
+>.$
|
|
?^ cop
|
|
::
|
|
:: a failure; save this nack, clear the message
|
|
::
|
|
~& [%wy-good-fail q.paz]
|
|
%_ +>.$
|
|
mup (work:mup now %cull q.paz)
|
|
cob (~(put by cob) q.paz u.bum(cly ~, cup `cop))
|
|
==
|
|
?> (lth ack.u.bum num.u.bum)
|
|
=. ack.u.bum +(ack.u.bum)
|
|
=. cup.u.bum ?.(=(ack.u.bum num.u.bum) ~ [~ ~])
|
|
+>.$(cob (~(put by cob) q.paz u.bum))
|
|
:: ::
|
|
++ wy-mess :: send
|
|
|= {cha/chan val/*}
|
|
^+ +>
|
|
=+ yex=((knit her lyf wyr det) now eny [%bond [(mix kos 1) seq] cha val])
|
|
=. fex (weld (flop p.yex) fex)
|
|
~& [?:(=(0 (end 0 1 kos)) %tx %bx) her kos seq cha (lent fex)]
|
|
%_ +>.$
|
|
seq +(seq)
|
|
cob
|
|
%+ ~(put by cob)
|
|
seq
|
|
^- comb
|
|
:* ~
|
|
cha
|
|
(lent q.yex)
|
|
0
|
|
=+ inx=0
|
|
|- ?~ q.yex ~
|
|
:_ $(q.yex +.q.yex, inx +(inx))
|
|
[& [inx seq] (shaf %flap i.q.yex) i.q.yex]
|
|
==
|
|
==
|
|
:: ::
|
|
++ wy-tire :: report results
|
|
|- ^+ +
|
|
=+ zup=(~(get by cob) lac)
|
|
?~ zup +.$
|
|
?~ cup.u.zup +.$
|
|
~& [?:(=(0 (end 0 1 kos)) %ta %ba) her kos lac]
|
|
%= $
|
|
lac +(lac)
|
|
cob (~(del by cob) lac)
|
|
fex :_(fex [%mack kos `coop`u.cup.u.zup])
|
|
==
|
|
:: ::
|
|
++ wy-wake :: timeout
|
|
^+ .
|
|
.(mup (work:mup now %wake ~))
|
|
::
|
|
++ wy-work
|
|
^+ .
|
|
?- -.job
|
|
$back (wy-back +.job)
|
|
$mess (wy-mess +.job)
|
|
$wake wy-wake
|
|
==
|
|
--
|
|
:: ::
|
|
++ zeal :: default state
|
|
^- colt
|
|
:* 0 :: seq/tick
|
|
0 :: lac/tick
|
|
~ :: cob/(map tick comb)
|
|
^- mini
|
|
:* ^- stat
|
|
:* :* 0 :: cur/@ud
|
|
2 :: max/@ud
|
|
0 :: rey/@ud
|
|
==
|
|
:* ~s5 :: rtt/@dr
|
|
~2010.1.1 :: las/@da
|
|
~2010.1.1 :: lad/@da
|
|
== ==
|
|
~
|
|
~
|
|
== ==
|
|
--
|
|
--
|
|
. ==
|
|
:: ::
|
|
:::: :::: kernel interface
|
|
:: ::
|
|
=| $: syl/silo :: kernel state
|
|
== ::
|
|
|= {now/@da eny/@ ski/sley} :: current invocation
|
|
=> |%
|
|
++ love ~(. loft [now eny] syl ~) :: create loft
|
|
++ lung :: gift to move
|
|
|= gax/gift:loft
|
|
^- move
|
|
?- -.gax
|
|
$east [p.gax %give [%east s.gax]]
|
|
$home [~ %give gax]
|
|
$link [~ %pass ~ %j gax]
|
|
$line [~ %pass ~ %j gax]
|
|
$meet [~ %pass ~ %j gax]
|
|
$rest [p.gax %give %rest q.gax]
|
|
$send [~ %give gax]
|
|
$veil [~ %pass /det/(scot %p p.gax) %j gax]
|
|
$west
|
|
=+ pax=/msg/(scot %p p.gax)/(scot %ud q.gax)
|
|
=+ cad=[%west p.gax +.r.gax s.gax]
|
|
=+ dat=?+(-.r.gax !! $c [%c cad], $e [%e cad], $g [%g cad])
|
|
[~ %pass pax dat]
|
|
==
|
|
::
|
|
++ work
|
|
|= job/task:loft
|
|
^- {(list move) q/_..^$}
|
|
=^ fex syl abet:(apex:love job)
|
|
[(turn fex lung) ..^$]
|
|
--
|
|
|% :: vane interface
|
|
++ neon
|
|
|= our/ship
|
|
^- (vane task:able gift:able sign:able note:able silo silo)
|
|
=| syl/silo
|
|
|%
|
|
++ load |=(silo +>)
|
|
++ stay syl
|
|
++ plow
|
|
=| $: now/@da
|
|
eny/@e
|
|
sky/roof
|
|
==
|
|
|%
|
|
++ doze ~
|
|
++ peek
|
|
|= $: lyc/(unit (set ship))
|
|
car/term
|
|
bem/beam
|
|
==
|
|
^- (unit (unit (cask vase)))
|
|
~
|
|
::
|
|
++ spin
|
|
=| $: hen/duct
|
|
moz/(list move)
|
|
==
|
|
|%
|
|
++ call
|
|
|= tac/task:able
|
|
^+ +>
|
|
=* job ^- task:loft
|
|
?- -.tac
|
|
$hear tac
|
|
$mess [%mess p.tac hen q.tac r.tac]
|
|
$wake tac
|
|
==
|
|
=^ fex syl abet:(apex:love job)
|
|
+>.$(moz (weld (turn fex lung) moz))
|
|
::
|
|
++ take
|
|
|= {tea/wire hin/sign:able}
|
|
=* job ^- task:loft
|
|
?+ -.tea !!
|
|
$msg
|
|
?> ?=({@ @ $~} +.tea)
|
|
=+ [who kos]=[(slav %p i.t.tea) (slav %ud i.t.t.tea)]
|
|
?- +<.hin
|
|
$rend
|
|
[%rend who kos p.+.hin q.+.hin]
|
|
$mack
|
|
[%done who kos ?~(p.+.hin ~ `coop`[~ `[%fail u.p.+.hin]])]
|
|
==
|
|
==
|
|
=^ fex syl abet:(apex:love job)
|
|
+>.$(moz (weld (turn fex lung) moz))
|
|
--
|
|
--
|
|
--
|
|
++ call :: handle request
|
|
|= $: hen/duct
|
|
hic/(hypo task:able:xmas)
|
|
==
|
|
^- {p/(list move) q/_..^$}
|
|
%- work
|
|
^- task:loft
|
|
?- -.q.hic
|
|
$hear q.hic
|
|
$mess [%mess p.q.hic hen q.q.hic r.q.hic]
|
|
$wake q.hic
|
|
==
|
|
::
|
|
++ doze
|
|
|= {now/@da hen/duct}
|
|
^- (unit @da)
|
|
doze:love
|
|
::
|
|
++ load
|
|
|= old/silo
|
|
^+ ..^$
|
|
..^$(syl old)
|
|
::
|
|
++ scry
|
|
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
|
|
^- (unit (unit cage))
|
|
~
|
|
::
|
|
++ stay syl
|
|
++ take :: accept response
|
|
|= {tea/wire hen/duct hin/(hypo sign-arvo)}
|
|
^- {p/(list move) q/_..^$}
|
|
%- work
|
|
?+ -.tea !!
|
|
$msg
|
|
?> ?=({@ @ $~} +.tea)
|
|
=+ [who kos]=[(slav %p i.t.tea) (slav %ud i.t.t.tea)]
|
|
?> ?=(?($rend $mack) +<.q.hin)
|
|
?- +<.q.hin
|
|
$rend [%rend who kos p.+.q.hin q.+.q.hin]
|
|
$mack [%done who kos ?~(p.+.q.hin ~ `coop`[~ `[%fail u.p.+.q.hin]])]
|
|
==
|
|
::
|
|
$det
|
|
?> ?=({@ $~} +.tea)
|
|
=+ who=(slav %p i.t.tea)
|
|
?> ?=($veil +<.q.hin)
|
|
[%clue who p.+.q.hin]
|
|
==
|
|
--
|