mirror of
https://github.com/urbit/shrub.git
synced 2024-10-26 21:09:47 +03:00
Merge pull request #6790 from urbit/lf/back-to-school-arc
gall: security primitives for encrypted scry
This commit is contained in:
Pyry Kovanen
GitHub
commit
820c4e5507
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:feaae0eece54db3e92122263706c283674af581d14ffde8a29fb24e1873a35b1
|
||||
size 6453015
|
||||
oid sha256:c2ab6607450382e0ec80c7264dad2c72d69672eaf861eb1c24cde5a76921c6a3
|
||||
size 9972490
|
||||
|
||||
@ -85,7 +85,7 @@
|
||||
=^ cards state
|
||||
?+ mark ~|([%aqua-bad-mark mark] !!)
|
||||
%aqua-events (poke-aqua-events:ac !<((list aqua-event) vase))
|
||||
%pill (poke-pill:ac !<(pill vase))
|
||||
%pill (poke-pill:ac !<(pill vase))
|
||||
%noun (poke-noun:ac !<(* vase))
|
||||
%azimuth-action (poke-azimuth-action:ac !<(azimuth-action vase))
|
||||
==
|
||||
@ -663,34 +663,55 @@
|
||||
(pe ~bud) :: XX why ~bud? need an example
|
||||
::
|
||||
%read
|
||||
?~ pier=(~(get by ships.piers) from.ae)
|
||||
(pe from.ae)
|
||||
?~ pier=(~(get by ships.piers) ship.from.ae)
|
||||
(pe ship.from.ae)
|
||||
=/ cash (~(get by namespace.u.pier) path.ae)
|
||||
|-
|
||||
?^ cash
|
||||
?: (gth num.ae (lent u.cash))
|
||||
(pe from.ae)
|
||||
(pe ship.from.ae)
|
||||
::TODO depends on /ted/aqua/ames behavior in a weird indirect way
|
||||
=/ for=@p `@`(tail for.ae) ::NOTE moons & comets not supported
|
||||
=; task=task-arvo
|
||||
^$(ae [%event for /a/aqua/fine-response task], thus this)
|
||||
:+ %hear `lane:ames`[%| `@`from.ae]
|
||||
=/ for=@p `@`(tail lane.for.ae) ::NOTE moons & comets not supported
|
||||
%- push-events:(pe for)
|
||||
%- flop =< events
|
||||
%+ roll u.cash
|
||||
|= [=yowl:ames i=@ud events=(list unix-event)]
|
||||
:- +(i)
|
||||
:_ events
|
||||
:- /a/aqua/fine-response/[(scot %ud i)]
|
||||
^- task-arvo
|
||||
:+ %hear `lane:ames`[%| `@`ship.from.ae]
|
||||
^- blob:ames
|
||||
=/ =shot:ames
|
||||
::NOTE dec is important! so dumb!!
|
||||
(sift-shot:ames `@`(snag (dec num.ae) u.cash))
|
||||
::TODO runtime needs to update rcvr field also
|
||||
::NOTE rcvr life is allowed to be wrong
|
||||
(etch-shot:ames shot(sndr from.ae, rcvr for))
|
||||
%- etch-shot:ames
|
||||
:* [sndr=ship.from.ae rcvr=for]
|
||||
req=| sam=|
|
||||
sndr-tick=life.from.ae
|
||||
rcvr-tick=life.for.ae
|
||||
origin=~
|
||||
content=`@ux`yowl
|
||||
==
|
||||
::
|
||||
=/ pacs=(unit (list yowl:ames))
|
||||
=/ =path [%fine %hunk (scot %ud num.ae) '512' path.ae]
|
||||
%+ biff
|
||||
(peek-once:(pe from.ae) %ax %$ [%fine %message path.ae])
|
||||
(peek-once:(pe ship.from.ae) %ax %$ path)
|
||||
(soft (list yowl:ames))
|
||||
?~ pacs (pe from.ae)
|
||||
?~ pacs (pe ship.from.ae)
|
||||
=. u.pacs
|
||||
:: add request to each response packet payload
|
||||
::
|
||||
=+ pat=(spat path.ae)
|
||||
=+ wid=(met 3 pat)
|
||||
%- flop =< blobs
|
||||
%+ roll u.pacs
|
||||
|= [=yowl:ames num=_1 blobs=(list @ux)]
|
||||
:- +(num)
|
||||
:_ blobs
|
||||
(can 3 4^num 2^wid wid^`@`pat (met 3 yowl)^yowl ~)
|
||||
=. namespace.u.pier
|
||||
(~(put by namespace.u.pier) path.ae u.pacs)
|
||||
=. ships.piers
|
||||
(~(put by ships.piers) from.ae u.pier)
|
||||
(~(put by ships.piers) ship.from.ae u.pier)
|
||||
$(cash pacs, thus this)
|
||||
::
|
||||
%event
|
||||
|
||||
@ -491,7 +491,8 @@
|
||||
%+ roll cards.r
|
||||
|= [=card cards=(list card) s=_state]
|
||||
:_ =? scrying.s ?=([%pass ^ %arvo %a %keen @ *] card)
|
||||
(~(put ju scrying.s) tid [&2 &6 |6]:card)
|
||||
:: wire ship path
|
||||
scrying.s :: (~(put ju scrying.s) tid [&2 +>+>+>]:card)
|
||||
s
|
||||
:_ cards
|
||||
^- ^card
|
||||
|
||||
@ -213,7 +213,7 @@
|
||||
=< q
|
||||
%- need %- need
|
||||
%- scry:(ames-gate now eny roof)
|
||||
[~ / %x [[our %$ da+now] /peers/(scot %p her)]]
|
||||
[[~ ~] / %x [[our %$ da+now] /peers/(scot %p her)]]
|
||||
::
|
||||
++ gall-scry-nonce
|
||||
|= $: =gall-gate
|
||||
@ -227,7 +227,7 @@
|
||||
=< q
|
||||
%- need %- need
|
||||
%- scry:(gall-gate now eny roof)
|
||||
[~ / %n [[our dude da+now] [%$ (scot %p ship.sub) [term wire]:sub]]]
|
||||
[[~ ~] / %n [[our dude da+now] [%$ (scot %p ship.sub) [term wire]:sub]]]
|
||||
::
|
||||
++ load-agent
|
||||
|= [=ship =gall-gate =dude:gall =agent:gall]
|
||||
|
||||
@ -806,9 +806,11 @@
|
||||
[%deep =deep]
|
||||
[%stun =stun]
|
||||
::
|
||||
[%keen spar]
|
||||
[%keen sec=(unit [idx=@ key=@]) spar]
|
||||
[%chum spar]
|
||||
[%yawn spar]
|
||||
[%wham spar]
|
||||
[%plug =path]
|
||||
::
|
||||
$>(%born vane-task)
|
||||
$>(%init vane-task)
|
||||
@ -849,6 +851,8 @@
|
||||
[%send =lane =blob]
|
||||
[%nail =ship lanes=(list lane)]
|
||||
::
|
||||
[%stub num=@ud key=@]
|
||||
[%near spar dat=(unit (unit page))]
|
||||
[%tune spar roar=(unit roar)]
|
||||
::
|
||||
[%turf turfs=(list turf)]
|
||||
@ -953,10 +957,12 @@
|
||||
:: $hoot: request packet payload
|
||||
:: $yowl: serialized response packet payload
|
||||
:: $hunk: a slice of $yowl fragments
|
||||
:: $lock: keys for remote scry
|
||||
::
|
||||
+$ hoot @uxhoot
|
||||
+$ yowl @uxyowl
|
||||
+$ hunk [lop=@ len=@]
|
||||
+$ lock [idx=@ key=@]
|
||||
::
|
||||
:: +| %kinetics
|
||||
:: $dyad: pair of sender and receiver ships
|
||||
@ -1014,7 +1020,9 @@
|
||||
packets=(set =blob)
|
||||
heeds=(set duct)
|
||||
keens=(jug path duct)
|
||||
chums=(jug path duct)
|
||||
==
|
||||
+$ chain ((mop ,@ ,[key=@ =path]) lte)
|
||||
:: $peer-state: state for a peer with known life and keys
|
||||
::
|
||||
:: route: transport-layer destination for packets to peer
|
||||
@ -1054,6 +1062,7 @@
|
||||
closing=(set bone)
|
||||
corked=(set bone)
|
||||
keens=(map path keen-state)
|
||||
=chain
|
||||
==
|
||||
+$ keen-state
|
||||
$+ keen-state
|
||||
@ -2749,7 +2758,7 @@
|
||||
+$ boat (map [=wire =ship =term] [acked=? =path]) :: outgoing subs
|
||||
+$ boar (map [=wire =ship =term] nonce=@) :: and their nonces
|
||||
::
|
||||
+$ path-state
|
||||
+$ plot
|
||||
$: bob=(unit @ud)
|
||||
fan=((mop @ud (pair @da (each page @uvI))) lte)
|
||||
==
|
||||
@ -2758,8 +2767,18 @@
|
||||
eny=@uvJ :: entropy
|
||||
time=@da :: current event time
|
||||
==
|
||||
+$ hutch [rev=@ud idx=@ud key=@]
|
||||
::
|
||||
+$ farm
|
||||
$+ farm
|
||||
$~ [%plot ~ ~]
|
||||
$% [%coop p=hutch q=(map path plot)]
|
||||
[%plot p=(unit plot) q=(map @ta farm)]
|
||||
==
|
||||
::
|
||||
|
||||
+$ egg :: migratory agent state
|
||||
$% [%nuke sky=(map spur @ud)] :: see /sys/gall $yoke
|
||||
$% [%nuke sky=(map spur @ud) cop=(map coop hutch)] :: see /sys/gall $yoke
|
||||
$: %live
|
||||
control-duct=duct
|
||||
run-nonce=@t
|
||||
@ -2772,10 +2791,30 @@
|
||||
old-state=[%| vase]
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur path-state)
|
||||
sky=farm
|
||||
ken=(jug spar:ames wire)
|
||||
pen=(jug spar:ames wire)
|
||||
gem=(jug coop [path page])
|
||||
== ==
|
||||
+$ egg-any $%([%15 egg] [%16 egg])
|
||||
+$ egg-any $%([%15 egg-15] [%16 egg])
|
||||
+$ egg-15
|
||||
$% [%nuke sky=(map spur @ud)]
|
||||
$: %live
|
||||
control-duct=duct
|
||||
run-nonce=@t
|
||||
sub-nonce=@
|
||||
=stats
|
||||
=bitt
|
||||
=boat
|
||||
=boar
|
||||
code=~
|
||||
old-state=[%| vase]
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur plot)
|
||||
ken=(jug spar:ames wire)
|
||||
== ==
|
||||
::
|
||||
+$ bowl :: standard app state
|
||||
$: $: our=ship :: host
|
||||
src=ship :: guest
|
||||
@ -2814,6 +2853,7 @@
|
||||
:: TODO: add more flags?
|
||||
::
|
||||
+$ verb ?(%odd)
|
||||
+$ coop spur
|
||||
::
|
||||
:: +agent: app core
|
||||
::
|
||||
@ -2830,6 +2870,12 @@
|
||||
[%grow =spur =page]
|
||||
[%tomb =case =spur]
|
||||
[%cull =case =spur]
|
||||
::
|
||||
[%tend =coop =path =page]
|
||||
[%germ =coop]
|
||||
[%snip =coop]
|
||||
::
|
||||
[%keen secret=? spar:ames]
|
||||
==
|
||||
+$ task
|
||||
$% [%watch =path]
|
||||
|
||||
@ -126,8 +126,15 @@
|
||||
?. ?=([~ %known *] next)
|
||||
~
|
||||
$(peer +.u.next)
|
||||
:: +trace: print if .verb is set and we're tracking .ship
|
||||
::
|
||||
++ chain
|
||||
=< mop
|
||||
|%
|
||||
++ on ((^on ,@ ,[key=@ =path]) lte)
|
||||
+$ mop ^chain
|
||||
--
|
||||
::
|
||||
:: +trace: print if .verb is set and we're tracking .ship
|
||||
++ trace
|
||||
|= [mode=?(%ames %fine) verb=? =ship ships=(set ship) print=(trap tape)]
|
||||
^+ same
|
||||
@ -354,14 +361,18 @@
|
||||
::
|
||||
+| %serialization
|
||||
::
|
||||
++ etch
|
||||
++ etch-data
|
||||
|= [=path data=$@(~ (cask))]
|
||||
=/ sig=@ (full path data)
|
||||
?~ data sig
|
||||
(mix sig (lsh 9 (jam data)))
|
||||
++ etch-open
|
||||
|= [=path =hunk data=$@(~ (cask))]
|
||||
(etch path hunk (etch-data path data))
|
||||
::
|
||||
++ etch
|
||||
|= [=path =hunk mes=@]
|
||||
^- (list yowl)
|
||||
=/ mes=@
|
||||
=/ sig=@ (full path data)
|
||||
?~ data sig
|
||||
(mix sig (lsh 9 (jam data)))
|
||||
::(cat 9 sig (jam data))
|
||||
::
|
||||
=/ las (met 13 mes)
|
||||
=/ tip (dec (add [lop len]:hunk))
|
||||
@ -469,6 +480,31 @@
|
||||
%- some ;; shut-packet %- cue %- need
|
||||
(~(de sivc:aes:crypto (shaz symmetric-key) vec) siv len cyf)
|
||||
::
|
||||
++ is-our-bulk
|
||||
|= [our=ship =ames-state =balk]
|
||||
^- ?
|
||||
=- ~? =(| -)
|
||||
[%fine-mismatch our=[rift life]:ames-state her=[her rif lyf]:balk]
|
||||
-
|
||||
?& =(our her.balk)
|
||||
=(rift.ames-state rif.balk)
|
||||
=(life.ames-state lyf.balk)
|
||||
==
|
||||
::
|
||||
++ check-fine-key
|
||||
|= [=ames-state =balk key-idx=@]
|
||||
^- ?
|
||||
?~ link=(get:on:chain chain.ames-state key-idx)
|
||||
|
|
||||
=/ gol path.u.link
|
||||
=/ =path [van.balk car.balk spr.balk]
|
||||
|- ^- ?
|
||||
?~ gol &
|
||||
?~ path |
|
||||
?. =(i.path i.gol)
|
||||
|
|
||||
$(path t.path, gol t.gol)
|
||||
::
|
||||
++ is-peer-dead
|
||||
|= [now=@da =peer-state]
|
||||
^+ peer-state
|
||||
@ -596,7 +632,10 @@
|
||||
$= dead
|
||||
$: flow=[%flow (unit dead-timer)]
|
||||
cork=[%cork (unit dead-timer)]
|
||||
== ==
|
||||
==
|
||||
::
|
||||
=chain
|
||||
==
|
||||
::
|
||||
+$ dead-timer [=duct =wire date=@da]
|
||||
+$ azimuth-state [=symmetric-key =life =rift =public-key sponsor=ship]
|
||||
@ -830,7 +869,7 @@
|
||||
::
|
||||
+$ ship-state-13
|
||||
$+ ship-state-13
|
||||
$% [%alien alien-agenda]
|
||||
$% [%alien alien-agenda-17]
|
||||
[%known peer-state-13]
|
||||
==
|
||||
::
|
||||
@ -1133,7 +1172,7 @@
|
||||
== ==
|
||||
+$ ship-state-17
|
||||
$+ ship-state-17
|
||||
$% [%alien alien-agenda]
|
||||
$% [%alien alien-agenda-17]
|
||||
[%known peer-state-17]
|
||||
==
|
||||
+$ peer-state-17
|
||||
@ -1177,9 +1216,18 @@
|
||||
snub=[form=?(%allow %deny) ships=(set ship)]
|
||||
cong=[msg=@ud mem=@ud]
|
||||
==
|
||||
::
|
||||
+$ alien-agenda-17
|
||||
$+ alien-agenda
|
||||
$: messages=(list [=duct =plea])
|
||||
packets=(set =blob)
|
||||
heeds=(set duct)
|
||||
keens=(jug path duct)
|
||||
==
|
||||
::
|
||||
+$ ship-state-16
|
||||
$+ ship-state-16
|
||||
$% [%alien alien-agenda]
|
||||
$% [%alien alien-agenda-17]
|
||||
[%known peer-state-16]
|
||||
==
|
||||
::
|
||||
@ -1248,21 +1296,22 @@
|
||||
+$ task-11-and-16
|
||||
$+ task-11-and-16
|
||||
$% [%kroc dry=?]
|
||||
[%keen spar]
|
||||
[%snub ships=(list ship)]
|
||||
$<(?(%snub %kroc) task-17)
|
||||
==
|
||||
::
|
||||
+$ task-17
|
||||
$+ task-17
|
||||
$% $<(%deep task)
|
||||
$% $<(?(%deep %keen) task)
|
||||
[%keen spar]
|
||||
$: %deep
|
||||
$% [%nack =ship =nack=bone =message-blob]
|
||||
[%sink =ship =target=bone naxplanation=[=message-num =error]]
|
||||
[%drop =ship =nack=bone =message-num]
|
||||
[%cork =ship =bone]
|
||||
[%kill =ship =bone]
|
||||
==
|
||||
==
|
||||
$% [%nack =ship =nack=bone =message-blob]
|
||||
[%sink =ship =target=bone naxplanation=[=message-num =error]]
|
||||
[%drop =ship =nack=bone =message-num]
|
||||
[%cork =ship =bone]
|
||||
[%kill =ship =bone]
|
||||
== ==
|
||||
==
|
||||
::
|
||||
+$ queued-event-17
|
||||
@ -1318,7 +1367,7 @@
|
||||
+$ note
|
||||
$~ [%b %wait *@da]
|
||||
$% $: %a
|
||||
$>(%deep task:ames)
|
||||
$>(?(%deep %keen) task:ames)
|
||||
==
|
||||
$: %b
|
||||
$>(?(%wait %rest) task:behn)
|
||||
@ -1347,7 +1396,10 @@
|
||||
::
|
||||
+$ sign
|
||||
$~ [%behn %wake ~]
|
||||
$% $: %behn
|
||||
$% $: %ames
|
||||
$>(%tune gift:ames)
|
||||
==
|
||||
$: %behn
|
||||
$>(%wake gift:behn)
|
||||
==
|
||||
$: %gall
|
||||
@ -1669,6 +1721,7 @@
|
||||
==
|
||||
[%adult state=_ames-state.adult-gate]
|
||||
== == ==
|
||||
|
||||
|^ ?- old
|
||||
[%4 %adult *]
|
||||
$(old [%5 %adult (state-4-to-5:load:adult-core state.old)])
|
||||
@ -1878,9 +1931,14 @@
|
||||
%- ~(put to q) ^- queued-event-17
|
||||
?. ?=(%call -.e) e
|
||||
=/ task=task-16 ((harden task-16) wrapped-task.e)
|
||||
%= e
|
||||
wrapped-task ?.(?=(%kroc -.task) task [%kroc ~])
|
||||
%= e
|
||||
wrapped-task
|
||||
^- task-17
|
||||
?+ -.task task
|
||||
%kroc [%kroc ~]
|
||||
==
|
||||
==
|
||||
::
|
||||
++ event-17-to-19
|
||||
|= events=(qeu queued-event-17)
|
||||
^- (qeu queued-event)
|
||||
@ -1891,6 +1949,8 @@
|
||||
=/ task=task-17 ((harden task-17) wrapped-task.e)
|
||||
%= e
|
||||
wrapped-task
|
||||
?: ?=(%keen -.task)
|
||||
[%keen ~ +.task]
|
||||
?. ?=([%deep %nack *] task) task
|
||||
=/ msg =>([cue=cue arg=message-blob.task] ~+((cue arg)))
|
||||
=/ hed
|
||||
@ -1931,9 +1991,13 @@
|
||||
15+(state-14-to-15:load:adult-core +.u.cached-state)
|
||||
=? u.cached-state ?=(%15 -.u.cached-state)
|
||||
16+(state-15-to-16:load:adult-core +.u.cached-state)
|
||||
=? u.cached-state ?=(%16 -.u.cached-state)
|
||||
17+(state-16-to-17:load:adult-core +.u.cached-state)
|
||||
=^ moz u.cached-state
|
||||
?. ?=(%16 -.u.cached-state) [~ u.cached-state]
|
||||
:_ 17+(state-16-to-17:load:adult-core +.u.cached-state)
|
||||
?. ?=(%17 -.u.cached-state) [~ u.cached-state]
|
||||
:_ [%18 +.u.cached-state]
|
||||
~> %slog.0^leaf/"ames: init dead flow consolidation timer"
|
||||
:- [[/ames]~ %pass /dead-flow %b %wait `@da`(add now ~m2)]
|
||||
?^ moz moz :: if we have just added the timer in state-7-to-8, skip
|
||||
=; recork-timer=(list [@da duct])
|
||||
?^ recork-timer ~
|
||||
@ -1942,7 +2006,7 @@
|
||||
%+ skim
|
||||
;; (list [@da duct])
|
||||
=< q.q %- need %- need
|
||||
(rof ~ /ames %bx [[our %$ da+now] /debug/timers])
|
||||
(rof [~ ~] /ames %bx [[our %$ da+now] /debug/timers])
|
||||
|=([@da =duct] ?=([[%ames %recork *] *] duct))
|
||||
::
|
||||
=^ moz u.cached-state
|
||||
@ -2014,7 +2078,7 @@
|
||||
++ get-sponsors
|
||||
;; (list ship)
|
||||
=< q.q %- need %- need
|
||||
(rof ~ /ames %j `beam`[[our %saxo %da now] /(scot %p our)])
|
||||
(rof [~ ~] /ames %j `beam`[[our %saxo %da now] /(scot %p our)])
|
||||
::
|
||||
+| %tasks
|
||||
:: +on-take-flub: vane not ready to process message, pretend it
|
||||
@ -2209,7 +2273,7 @@
|
||||
++ do-rift
|
||||
=/ =rift
|
||||
=- ~|(%no-rift (,@ q.q:(need (need -))))
|
||||
(rof ~ /ames %j `beam`[[our %rift %da now] /(scot %p our)])
|
||||
(rof [~ ~] /ames %j `beam`[[our %rift %da now] /(scot %p our)])
|
||||
?: =(rift rift.ames-state)
|
||||
event-core
|
||||
~& "ames: fixing rift from {<rift.ames-state>} to {<rift>}"
|
||||
@ -2234,7 +2298,7 @@
|
||||
=/ tim
|
||||
;; (list [@da ^duct])
|
||||
=< q.q %- need %- need
|
||||
(rof ~ /ames %bx [[our %$ da+now] /debug/timers])
|
||||
(rof [~ ~] /ames %bx [[our %$ da+now] /debug/timers])
|
||||
(skim tim |=([@da hen=^duct] ?=([[%ames ?(%pump %recork) *] *] hen)))
|
||||
::
|
||||
:: set timers for flows that should have one set but don't
|
||||
@ -2576,6 +2640,50 @@
|
||||
%- (slog leaf+"ames: no peer-state for {(scow %p ship)}, ignoring" ~)
|
||||
event-core
|
||||
abet:on-tame:(abed-peer:pe ship u.peer-state)
|
||||
::
|
||||
::
|
||||
++ on-tune
|
||||
|= [=wire s=[=ship path=(pole knot)] roar=(unit roar)]
|
||||
^+ event-core
|
||||
:: XX save or decrypt path?
|
||||
:: XX crash in decryption/cue indicates misbehaving peer
|
||||
::
|
||||
=/ per (~(get by peers.ames-state) ship.s)
|
||||
?> ?=([~ %known *] per)
|
||||
?> ?=([%a %x @ %$ rest=*] path.s)
|
||||
?. ?=([%chum her=@ lyf=@ cyf=@ ~] rest.path.s)
|
||||
=> .(wire `(pole knot)`wire)
|
||||
~| bad-wire/wire
|
||||
?> ?=([%fine %shut idx=@ ~] wire)
|
||||
~| bad-path/rest.path.s
|
||||
?> ?=([%fine %shut kef=@ cyf=@ ~] rest.path.s)
|
||||
=/ [key=@ ,path] (~(got by chain.u.per) (slav %ud idx.wire))
|
||||
=/ raw=@t
|
||||
(dy:crub:crypto key (slav %uv cyf.rest.path.s))
|
||||
=/ pax=path
|
||||
(stab raw)
|
||||
=; dat=(unit (unit page))
|
||||
(emit duct [%give %near [ship.s pax] dat])
|
||||
?: ?| ?=(~ roar)
|
||||
?=(~ q.dat.u.roar)
|
||||
==
|
||||
~ :: XX weird
|
||||
?> ?=([%atom @] u.q.dat.u.roar)
|
||||
=- ``;;(page (cue -))
|
||||
(dy:crub:crypto key q.u.q.dat.u.roar)
|
||||
?> ?=([%chum *] wire)
|
||||
=/ pax
|
||||
%- stab
|
||||
(dy:crub:crypto symmetric-key.u.per (slav %uv cyf.rest.path.s))
|
||||
=/ dat=(unit (unit page))
|
||||
?: ?| ?=(~ roar)
|
||||
?=(~ q.dat.u.roar)
|
||||
==
|
||||
~ :: XX weird
|
||||
?> ?=([%atom @] u.q.dat.u.roar)
|
||||
=- `?~(- ~ `(,page (cue -)))
|
||||
(dy:crub:crypto symmetric-key.u.per q.u.q.dat.u.roar)
|
||||
(emit duct [%give %near [ship.s pax] dat])
|
||||
:: +on-cork: handle request to kill a flow
|
||||
::
|
||||
++ on-cork
|
||||
@ -3100,7 +3208,7 @@
|
||||
=/ turfs
|
||||
;; (list turf)
|
||||
=< q.q %- need %- need
|
||||
(rof ~ /ames %j `beam`[[our %turf %da now] /])
|
||||
(rof [~ ~] /ames %j `beam`[[our %turf %da now] /])
|
||||
::
|
||||
=* duct unix-duct.ames-state
|
||||
::
|
||||
@ -3121,6 +3229,18 @@
|
||||
:: +on-vega: handle kernel reload
|
||||
::
|
||||
++ on-vega event-core
|
||||
:: +on-plug: handle key reservation
|
||||
++ on-plug
|
||||
|= =path
|
||||
^+ event-core
|
||||
=/ key=@ (shaz eny) :: TODO: check key width
|
||||
=/ num=@ud
|
||||
?~ latest=(pry:on:chain chain.ames-state)
|
||||
1
|
||||
.+(key.u.latest)
|
||||
=. chain.ames-state
|
||||
(put:on:chain chain.ames-state num [key path])
|
||||
(emit duct %give %stub num key)
|
||||
:: +on-trim: handle request to free memory
|
||||
::
|
||||
:: %ruin comets not seen for six months
|
||||
@ -3144,16 +3264,41 @@
|
||||
+| %fine-entry-points
|
||||
::
|
||||
++ on-keen
|
||||
|= spar
|
||||
|= [sec=(unit [idx=@ key=@]) spar]
|
||||
^+ event-core
|
||||
=+ ~:(spit path) :: assert length
|
||||
=/ ship-state (~(get by peers.ames-state) ship)
|
||||
?: ?=([~ %known *] ship-state)
|
||||
abet:(on-keen:(abed-peer:pe ship +.u.ship-state) path duct)
|
||||
?~ sec
|
||||
abet:(on-keen:(abed-peer:pe ship +.u.ship-state) path duct)
|
||||
=. chain.u.ship-state (put:on:chain chain.u.ship-state [idx key /]:u.sec)
|
||||
=. peers.ames-state (~(put by peers.ames-state) ship u.ship-state)
|
||||
=/ enc
|
||||
(scot %uv (en:crub:crypto key.u.sec (spat path)))
|
||||
=/ lav /a/x/1//fine/shut/(scot %ud idx.u.sec)/[enc]
|
||||
=/ wir /fine/shut/(scot %ud idx.u.sec)
|
||||
(emit duct %pass wir %a %keen ~ ship lav)
|
||||
:: XX: key exchange over ames forces all encrypted scries to be
|
||||
:: to a known peer
|
||||
?> ?=(~ sec)
|
||||
%^ enqueue-alien-todo ship ship-state
|
||||
|= todos=alien-agenda
|
||||
todos(keens (~(put ju keens.todos) path duct))
|
||||
::
|
||||
++ on-chum
|
||||
|= spar
|
||||
^+ event-core
|
||||
=/ ship-state (~(get by peers.ames-state) ship)
|
||||
?. ?=([~ %known *] ship-state)
|
||||
%^ enqueue-alien-todo ship ship-state
|
||||
|= todos=alien-agenda
|
||||
todos(chums (~(put ju chums.todos) path duct))
|
||||
=/ cyf
|
||||
(scot %uv (en:crub:crypto symmetric-key.u.ship-state (spat path)))
|
||||
=/ lav
|
||||
/a/x/1//chum/(scot %p our)/(scot %ud life.ames-state)/[cyf]
|
||||
(emit duct [%pass /chum %a %keen ~ ship lav])
|
||||
::
|
||||
++ on-cancel-scry
|
||||
|= [all=? spar]
|
||||
^+ event-core
|
||||
@ -5206,8 +5351,10 @@
|
||||
%kroc (on-kroc:event-core bones.task)
|
||||
%deep (on-deep:event-core deep.task)
|
||||
%stun (on-stun:event-core stun.task)
|
||||
%plug (on-plug:event-core +.task)
|
||||
::
|
||||
%keen (on-keen:event-core +.task)
|
||||
%chum (on-chum:event-core +.task)
|
||||
%yawn (on-cancel-scry:event-core | +.task)
|
||||
%wham (on-cancel-scry:event-core & +.task)
|
||||
==
|
||||
@ -5231,6 +5378,8 @@
|
||||
?- sign
|
||||
[@ %done *] (on-take-done:event-core wire error.sign)
|
||||
[@ %boon *] (on-take-boon:event-core wire payload.sign)
|
||||
::
|
||||
[%ames %tune *] (on-tune:event-core wire [[ship path] roar]:sign)
|
||||
::
|
||||
[%behn %wake *] (on-take-wake:event-core wire error.sign)
|
||||
::
|
||||
@ -5291,7 +5440,7 @@
|
||||
?: ?=(%pawn (clan:title ship)) 0
|
||||
;; @ud
|
||||
=< q.q %- need %- need
|
||||
(rof ~ /ames %j `beam`[[our %rift %da now] /(scot %p ship)])
|
||||
(rof [~ ~] /ames %j `beam`[[our %rift %da now] /(scot %p ship)])
|
||||
:- -.ship-state
|
||||
:_ +.peer-state
|
||||
=, -.peer-state
|
||||
@ -5372,7 +5521,7 @@
|
||||
++ state-12-to-13
|
||||
|= old=ames-state-12
|
||||
^- ames-state-13
|
||||
=+ !<(=rift q:(need (need (rof ~ /ames %j our-beam))))
|
||||
=+ !<(=rift q:(need (need (rof [~ ~] /ames %j our-beam))))
|
||||
=+ pk=sec:ex:crypto-core.old
|
||||
:* peers=(~(run by peers.old) ship-state-12-to-13)
|
||||
unix-duct.old
|
||||
@ -5414,7 +5563,7 @@
|
||||
++ state-14-to-15
|
||||
|= old=ames-state-14
|
||||
^- ames-state-15
|
||||
old(rift !<(=rift q:(need (need (rof ~ /ames %j our-beam)))))
|
||||
old(rift !<(=rift q:(need (need (rof [~ ~] /ames %j our-beam)))))
|
||||
::
|
||||
++ state-15-to-16
|
||||
|= old=ames-state-15
|
||||
@ -5486,32 +5635,42 @@
|
||||
++ state-18-to-19
|
||||
|= old=ames-state-18
|
||||
^- ^ames-state
|
||||
%= old
|
||||
peers
|
||||
%- ~(run by peers.old)
|
||||
|= s=ship-state-17
|
||||
?: ?=(%alien -.s) s
|
||||
%= s
|
||||
snd.+
|
||||
%- malt
|
||||
%+ turn
|
||||
~(tap by snd.+.s)
|
||||
|= [=bone m=message-pump-state-17]
|
||||
:- bone
|
||||
%= m
|
||||
unsent-messages
|
||||
%- ~(gas to *(qeu message))
|
||||
%+ turn
|
||||
~(tap to unsent-messages.m)
|
||||
|= b=message-blob
|
||||
^- message
|
||||
=/ hed
|
||||
?: =(1 (end 0 bone)) %plea
|
||||
?: =(0 (end 0 (rsh 0 bone))) %boon
|
||||
%naxplanation
|
||||
=/ msg =>([cue=cue arg=b] ~+((cue arg)))
|
||||
;;(message [hed msg])
|
||||
== == ==
|
||||
%= old
|
||||
::
|
||||
dead [dead.old ~]
|
||||
::
|
||||
peers
|
||||
%- ~(run by peers.old)
|
||||
|= s=ship-state-17
|
||||
^- ship-state
|
||||
?: ?=(%alien -.s)
|
||||
%= s
|
||||
keens [keens.s ~]
|
||||
==
|
||||
%= s
|
||||
::
|
||||
keens [keens.s ~]
|
||||
::
|
||||
snd.+
|
||||
%- malt
|
||||
%+ turn
|
||||
~(tap by snd.+.s)
|
||||
|= [=bone m=message-pump-state-17]
|
||||
:- bone
|
||||
%= m
|
||||
unsent-messages
|
||||
%- ~(gas to *(qeu message))
|
||||
%+ turn
|
||||
~(tap to unsent-messages.m)
|
||||
|= b=message-blob
|
||||
^- message
|
||||
=/ hed
|
||||
?: =(1 (end 0 bone)) %plea
|
||||
?: =(0 (end 0 (rsh 0 bone))) %boon
|
||||
%naxplanation
|
||||
=/ msg =>([cue=cue arg=b] ~+((cue arg)))
|
||||
;;(message [hed msg])
|
||||
== == ==
|
||||
--
|
||||
:: +scry: dereference namespace
|
||||
::
|
||||
@ -5525,6 +5684,59 @@
|
||||
=* lot=coin $/r.bem
|
||||
=* tyl s.bem
|
||||
::
|
||||
?: ?& =(&+our why)
|
||||
=([%ud 1] r.bem)
|
||||
=(%$ syd)
|
||||
=(%x ren)
|
||||
==
|
||||
=> .(tyl `(pole knot)`tyl)
|
||||
?+ tyl ~
|
||||
::
|
||||
[%fine %shut kef=@ enc=@ ~]
|
||||
=/ key-idx (slav %ud kef.tyl)
|
||||
=/ key (got:on:chain chain.ames-state (slav %ud kef.tyl))
|
||||
=/ pat=(unit path)
|
||||
(rush `@t`(dy:crub:crypto key.key (slav %uv enc.tyl)) stap)
|
||||
?~ pat
|
||||
[~ ~]
|
||||
?~ blk=(de-part:balk our rift.ames-state life.ames-state u.pat)
|
||||
[~ ~]
|
||||
?. (check-fine-key ames-state u.blk key-idx)
|
||||
~& key-validation-failed/[u.pat key-idx chain.ames-state]
|
||||
[~ ~]
|
||||
=/ res (rof [~ ~] /ames (as-omen:balk u.blk))
|
||||
?~ res
|
||||
~& %bailing-close
|
||||
[~ ~]
|
||||
?~ u.res
|
||||
``atom+!>(~)
|
||||
?~ key=(get:on:chain chain.ames-state key-idx)
|
||||
~
|
||||
=- ``atom+!>(-)
|
||||
`@uv`(en:crub:crypto -.u.key (jam [p q.q]:u.u.res))
|
||||
::
|
||||
[%chum her=@ lyf=@ cyf=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
=/ lyf (slaw %ud lyf.tyl)
|
||||
=/ cyf (slaw %uv cyf.tyl)
|
||||
?: |(?=(~ who) ?=(~ lyf) ?=(~ cyf))
|
||||
[~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. &(?=([~ %known *] per) =(life.u.per u.lyf))
|
||||
~
|
||||
=/ bal=(unit balk)
|
||||
?~ tex=(de:crub:crypto symmetric-key.u.per u.cyf) ~
|
||||
?~ pax=(rush u.tex stap) ~
|
||||
(de-part:balk our 0 0 u.pax)
|
||||
?~ bal
|
||||
[~ ~]
|
||||
?~ res=(rof `[u.who ~ ~] /ames (as-omen:balk u.bal))
|
||||
~
|
||||
=- ``atom+!>(`@ux`-)
|
||||
%+ en:crub:crypto symmetric-key.u.per
|
||||
?~(u.res ~ (jam [p q.q]:u.u.res))
|
||||
==
|
||||
::
|
||||
:: only respond for the local identity, %$ desk, current timestamp
|
||||
::
|
||||
?. ?& =(&+our why)
|
||||
@ -5536,6 +5748,8 @@
|
||||
~
|
||||
:: /ax//whey (list mass)
|
||||
:: /ax/protocol/version @
|
||||
:: /ax/chain/[idx] [idx=@ud key=@uvJ]
|
||||
:: /ax/chain/latest [idx=@ud key=@uvJ]
|
||||
:: /ax/peers (map ship ?(%alien %known))
|
||||
:: /ax/peers/[ship] ship-state
|
||||
:: /ax/peers/[ship]/last-contact (unit @da)
|
||||
@ -5545,140 +5759,37 @@
|
||||
:: /ax/snubbed (?(%allow %deny) (list ship))
|
||||
:: /ax/fine/hunk/[path/...] (list @ux) scry response fragments
|
||||
:: /ax/fine/ducts/[path/] (list duct)
|
||||
:: /ax/fine/shut/[path/] @ux encrypted response
|
||||
:: /ax/rift @
|
||||
:: /ax/corked/[ship] (set bone)
|
||||
:: /ax/closing/[ship] (set bone)
|
||||
::
|
||||
?. ?=(%x ren) ~
|
||||
=> .(tyl `(pole knot)`tyl)
|
||||
?+ tyl ~
|
||||
[%$ %whey ~]
|
||||
=/ maz=(list mass)
|
||||
=+ [known alien]=(skid ~(val by peers.ames-state) |=(^ =(%known +<-)))
|
||||
:~ peers-known+&+known
|
||||
peers-alien+&+alien
|
||||
==
|
||||
``mass+!>(maz)
|
||||
::
|
||||
[%protocol %version ~]
|
||||
``noun+!>(protocol-version)
|
||||
::
|
||||
[%peers ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (map ship ?(%alien %known))
|
||||
(~(run by peers.ames-state) head)
|
||||
::
|
||||
[%peers her=@ req=*]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ peer (~(get by peers.ames-state) u.who)
|
||||
?+ req.tyl [~ ~]
|
||||
~
|
||||
?~ peer
|
||||
[~ ~]
|
||||
``noun+!>(u.peer)
|
||||
::
|
||||
[%last-contact ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (unit @da)
|
||||
?. ?=([~ %known *] peer)
|
||||
~
|
||||
`last-contact.qos.u.peer
|
||||
::
|
||||
[%forward-lane ~]
|
||||
::
|
||||
:: this duplicates the routing hack from +send-blob:event-core
|
||||
:: so long as neither the peer nor the peer's sponsoring galaxy is us,
|
||||
:: and the peer has been reached recently:
|
||||
::
|
||||
:: - no route to the peer, or peer has not been contacted recently:
|
||||
:: send to the peer's sponsoring galaxy
|
||||
:: - direct route to the peer: use that
|
||||
:: - indirect route to the peer: send to both that route and the
|
||||
:: the peer's sponsoring galaxy
|
||||
::
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (list lane)
|
||||
?: =(our u.who)
|
||||
~
|
||||
?: ?=([~ %known *] peer)
|
||||
(get-forward-lanes our +.u.peer peers.ames-state)
|
||||
=/ sax (rof ~ /ames %j `beam`[[our %saxo %da now] /(scot %p u.who)])
|
||||
?. ?=([~ ~ *] sax)
|
||||
~
|
||||
=/ gal (rear ;;((list ship) q.q.u.u.sax))
|
||||
?: =(our gal)
|
||||
~
|
||||
[%& gal]~
|
||||
==
|
||||
::
|
||||
[%bones her=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
=/ res
|
||||
=, u.per
|
||||
[snd=~(key by snd) rcv=~(key by rcv)]
|
||||
``noun+!>(res)
|
||||
::
|
||||
[%snd-bones her=@ bon=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ ost (slaw %ud bon.tyl)
|
||||
?~ ost [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
=/ mps (~(get by snd.u.per) u.ost)
|
||||
?~ mps [~ ~]
|
||||
=/ res
|
||||
u.mps
|
||||
``noun+!>(!>(res))
|
||||
::
|
||||
[%snubbed ~]
|
||||
``noun+!>([form.snub.ames-state ~(tap in ships.snub.ames-state)])
|
||||
::
|
||||
[%fine %hunk lop=@t len=@t pax=^]
|
||||
:: public endpoints
|
||||
?: ?=([%fine %hunk lop=@t len=@t pax=^] tyl)
|
||||
::TODO separate endpoint for the full message (instead of packet list)
|
||||
:: .pax is expected to be a scry path of the shape /vc/desk/rev/etc,
|
||||
:: so we need to give it the right shape
|
||||
::
|
||||
?~ blk=(de-path-soft:balk pax.tyl) ~
|
||||
::
|
||||
?. ?& =(our her.u.blk)
|
||||
=(rift.ames-state rif.u.blk)
|
||||
=(life.ames-state lyf.u.blk)
|
||||
==
|
||||
~& [%fine-mismatch our=[rift life]:ames-state her=[her rif lyf]:u.blk]
|
||||
?. (is-our-bulk our ames-state u.blk)
|
||||
~
|
||||
=+ nom=(as-omen:balk u.blk)
|
||||
~| nom
|
||||
|^
|
||||
=/ van ?@(vis.nom (end 3 vis.nom) way.vis.nom)
|
||||
?+ van ~
|
||||
%c
|
||||
=+ pem=(rof lyc /ames nom(vis %cp))
|
||||
?. ?=(^ pem) ~
|
||||
?. ?=(^ u.pem) ~
|
||||
~| u.u.pem
|
||||
=+ per=!<([r=dict:clay w=dict:clay] q.u.u.pem)
|
||||
?. =([%black ~ ~] rul.r.per) ~
|
||||
=/ kyr ?@(vis.nom (rsh 3 vis.nom) car.vis.nom)
|
||||
?. =(%c van)
|
||||
(en-hunk (rof ~ /ames nom))
|
||||
::
|
||||
%e
|
||||
=/ kyr ?@(vis.nom (rsh 3 vis.nom) car.vis.nom)
|
||||
%- en-hunk
|
||||
?+ kyr ~
|
||||
%x (rof ~ /ames nom)
|
||||
==
|
||||
::
|
||||
%g
|
||||
=/ kyr ?@(vis.nom (rsh 3 vis.nom) car.vis.nom)
|
||||
%- en-hunk
|
||||
?+ kyr ~
|
||||
%x (rof ~ /ames nom)
|
||||
==
|
||||
==
|
||||
=+ pem=(rof [~ ~] /ames nom(vis %cp))
|
||||
?. ?=(^ pem) ~
|
||||
?. ?=(^ u.pem) ~
|
||||
~| u.u.pem
|
||||
=+ per=!<([r=dict:clay w=dict:clay] q.u.u.pem)
|
||||
?. =([%black ~ ~] rul.r.per) ~
|
||||
(en-hunk (rof [~ ~] /ames nom))
|
||||
::
|
||||
++ en-hunk
|
||||
|= res=(unit (unit cage))
|
||||
@ -5688,38 +5799,139 @@
|
||||
::
|
||||
=/ hu-co (etch-hunk our [life crypto-core]:ames-state)
|
||||
?- res
|
||||
[~ ~] ``noun+!>((etch:hu-co pax.tyl hunk ~))
|
||||
[~ ~ *] ``noun+!>((etch:hu-co pax.tyl hunk [p q.q]:u.u.res))
|
||||
[~ ~] ``noun+!>((etch-open:hu-co pax.tyl hunk ~))
|
||||
[~ ~ *] ``noun+!>((etch-open:hu-co pax.tyl hunk [p q.q]:u.u.res))
|
||||
==
|
||||
--
|
||||
:: private endpoints
|
||||
?. =([~ ~] lyc) ~
|
||||
?+ tyl ~
|
||||
[%$ %whey ~]
|
||||
=/ maz=(list mass)
|
||||
=+ [known alien]=(skid ~(val by peers.ames-state) |=(^ =(%known +<-)))
|
||||
:~ peers-known+&+known
|
||||
peers-alien+&+alien
|
||||
==
|
||||
``mass+!>(maz)
|
||||
::
|
||||
[%chain %latest ~]
|
||||
``noun+!>(`[idx=@ key=@ =path]`(need (ram:on:chain chain.ames-state)))
|
||||
::
|
||||
[%chain idx=@ ~]
|
||||
?~ idx=(slaw %ud idx.tyl)
|
||||
[~ ~]
|
||||
?~ key=(get:on:chain chain.ames-state u.idx)
|
||||
[~ ~]
|
||||
``noun+!>(`[idx=@ key=@]`[u.idx key.u.key])
|
||||
::
|
||||
[%peers ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (map ship ?(%alien %known))
|
||||
(~(run by peers.ames-state) head)
|
||||
::
|
||||
[%peers her=@ req=*]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ peer (~(get by peers.ames-state) u.who)
|
||||
?+ req.tyl [~ ~]
|
||||
~
|
||||
?~ peer
|
||||
[~ ~]
|
||||
``noun+!>(u.peer)
|
||||
::
|
||||
[%last-contact ~]
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (unit @da)
|
||||
?. ?=([~ %known *] peer)
|
||||
~
|
||||
`last-contact.qos.u.peer
|
||||
::
|
||||
[%forward-lane ~]
|
||||
::
|
||||
:: this duplicates the routing hack from +send-blob:event-core
|
||||
:: so long as neither the peer nor the peer's sponsoring galaxy is us,
|
||||
:: and the peer has been reached recently:
|
||||
::
|
||||
:: - no route to the peer, or peer has not been contacted recently:
|
||||
:: send to the peer's sponsoring galaxy
|
||||
:: - direct route to the peer: use that
|
||||
:: - indirect route to the peer: send to both that route and the
|
||||
:: the peer's sponsoring galaxy
|
||||
::
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (list lane)
|
||||
?: =(our u.who)
|
||||
~
|
||||
?: ?=([~ %known *] peer)
|
||||
(get-forward-lanes our +.u.peer peers.ames-state)
|
||||
=/ sax (rof ~ /ames %j `beam`[[our %saxo %da now] /(scot %p u.who)])
|
||||
?. ?=([~ ~ *] sax)
|
||||
~
|
||||
=/ gal (rear ;;((list ship) q.q.u.u.sax))
|
||||
?: =(our gal)
|
||||
~
|
||||
[%& gal]~
|
||||
==
|
||||
::
|
||||
[%bones her=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
=/ res
|
||||
=, u.per
|
||||
[snd=~(key by snd) rcv=~(key by rcv)]
|
||||
``noun+!>(res)
|
||||
::
|
||||
[%snd-bones her=@ bon=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ ost (slaw %ud bon.tyl)
|
||||
?~ ost [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
=/ mps (~(get by snd.u.per) u.ost)
|
||||
?~ mps [~ ~]
|
||||
=/ res
|
||||
u.mps
|
||||
``noun+!>(!>(res))
|
||||
::
|
||||
[%snubbed ~]
|
||||
``noun+!>([form.snub.ames-state ~(tap in ships.snub.ames-state)])
|
||||
::
|
||||
[%fine %ducts pax=^]
|
||||
?~ bulk=(de-path-soft:balk pax.tyl) ~
|
||||
?~ peer=(~(get by peers.ames-state) her.u.bulk)
|
||||
[~ ~]
|
||||
?. ?=([~ %known *] peer)
|
||||
[~ ~] :: TODO handle aliens
|
||||
?~ spr.u.bulk [~ ~]
|
||||
=/ =path =,(u.bulk [van car (scot cas) spr])
|
||||
?~ keen=(~(get by keens.u.peer) path)
|
||||
[~ ~]
|
||||
``noun+!>(listeners:u.keen)
|
||||
::
|
||||
[%rift ~]
|
||||
``noun+!>(rift.ames-state)
|
||||
::
|
||||
[%corked her=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
``noun+!>(corked.u.per)
|
||||
::
|
||||
[%closing her=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
``noun+!>(closing.u.per)
|
||||
::
|
||||
[%protocol %version ~]
|
||||
``noun+!>(protocol-version)
|
||||
::
|
||||
==
|
||||
::
|
||||
[%fine %ducts pax=^]
|
||||
?~ bulk=(de-path-soft:balk pax.tyl) ~
|
||||
?~ peer=(~(get by peers.ames-state) her.u.bulk)
|
||||
[~ ~]
|
||||
?. ?=([~ %known *] peer)
|
||||
[~ ~] :: TODO handle aliens
|
||||
?~ spr.u.bulk [~ ~]
|
||||
=/ =path =,(u.bulk [van car (scot cas) spr])
|
||||
?~ keen=(~(get by keens.u.peer) path)
|
||||
[~ ~]
|
||||
``noun+!>(listeners:u.keen)
|
||||
::
|
||||
[%rift ~]
|
||||
``noun+!>(rift.ames-state)
|
||||
::
|
||||
[%corked her=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
``noun+!>(corked.u.per)
|
||||
::
|
||||
[%closing her=@ ~]
|
||||
=/ who (slaw %p her.tyl)
|
||||
?~ who [~ ~]
|
||||
=/ per (~(get by peers.ames-state) u.who)
|
||||
?. ?=([~ %known *] per) [~ ~]
|
||||
``noun+!>(closing.u.per)
|
||||
==
|
||||
|
||||
--
|
||||
|
||||
@ -243,11 +243,12 @@
|
||||
=* lot=coin $/r.bem
|
||||
=* tyl s.bem
|
||||
::
|
||||
:: only respond for the local identity, %$ desk, current timestamp
|
||||
:: only respond for the local identity, %$ desk, current timestamp, root gang
|
||||
::
|
||||
?. ?& =(&+our why)
|
||||
=([%$ %da now] lot)
|
||||
=(%$ syd)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
~
|
||||
:: /bx//whey (list mass) memory usage labels
|
||||
|
||||
@ -1518,7 +1518,7 @@
|
||||
[%c care (scot case) desk path]
|
||||
:- [time path]
|
||||
%- emil
|
||||
:~ [hen %pass wire %a %keen ship path]
|
||||
:~ [hen %pass wire %a %keen ~ ship path]
|
||||
[hen %pass wire %b %wait time]
|
||||
==
|
||||
::
|
||||
@ -5934,6 +5934,7 @@
|
||||
::
|
||||
=/ for=(unit ship) ?~(lyc ~ ?~(u.lyc ~ `n.u.lyc))
|
||||
?: &(=(our his) ?=(?(%d %x) ren) =(%$ syd) =([%da now] u.luk))
|
||||
?. =([~ ~] lyc) ~
|
||||
?- ren
|
||||
%d (read-buc-d tyl)
|
||||
%x (read-buc-x tyl)
|
||||
|
||||
@ -146,7 +146,7 @@
|
||||
++ sponsor
|
||||
^- ship
|
||||
=/ dat=(unit (unit cage))
|
||||
(rof `[our ~ ~] /dill j/[[our sein/da/now] /(scot %p our)])
|
||||
(rof [~ ~] /dill j/[[our sein/da/now] /(scot %p our)])
|
||||
;;(ship q.q:(need (need dat)))
|
||||
::
|
||||
++ init :: initialize
|
||||
@ -490,11 +490,12 @@
|
||||
?. ?=(%& -.why) ~
|
||||
=* his p.why
|
||||
::
|
||||
:: only respond for the local identity, %$ desk, current timestamp
|
||||
:: only respond for the local identity, %$ desk, current timestamp, root gang
|
||||
::
|
||||
?. ?& =(&+our why)
|
||||
=([%$ %da now] lot)
|
||||
=(%$ syd)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
~
|
||||
:: /%x//whey (list mass) memory usage labels
|
||||
|
||||
@ -917,12 +917,12 @@
|
||||
%gen
|
||||
=/ bek=beak [our desk.generator.action da+now]
|
||||
=/ sup=spur path.generator.action
|
||||
=/ ski (rof ~ /eyre %ca bek sup)
|
||||
=/ ski (rof [~ ~] /eyre %ca bek sup)
|
||||
=/ cag=cage (need (need ski))
|
||||
?> =(%vase p.cag)
|
||||
=/ gat=vase !<(vase q.cag)
|
||||
=/ res=toon
|
||||
%- mock :_ (look rof ~ /eyre)
|
||||
%- mock :_ (look rof ?.(authenticated ~ [~ ~]) /eyre)
|
||||
:_ [%9 2 %0 1] |.
|
||||
%+ slam
|
||||
%+ slam gat
|
||||
@ -1137,7 +1137,7 @@
|
||||
++ do-scry
|
||||
|= [care=term =desk =path]
|
||||
^- (unit (unit cage))
|
||||
(rof ~ /eyre care [our desk da+now] path)
|
||||
(rof [~ ~] /eyre care [our desk da+now] path)
|
||||
::
|
||||
++ error-response
|
||||
|= [status=@ud =tape]
|
||||
@ -1152,7 +1152,7 @@
|
||||
^- (quip move server-state)
|
||||
:: if the agent isn't running, we synchronously serve a 503
|
||||
::
|
||||
?. !<(? q:(need (need (rof ~ /eyre %gu [our app da+now] /$))))
|
||||
?. !<(? q:(need (need (rof [~ ~] /eyre %gu [our app da+now] /$))))
|
||||
%^ return-static-data-on-duct 503 'text/html'
|
||||
%: error-page
|
||||
503
|
||||
@ -1545,7 +1545,7 @@
|
||||
++ code
|
||||
^- @ta
|
||||
=/ res=(unit (unit cage))
|
||||
(rof ~ /eyre %j [our %code da+now] /(scot %p our))
|
||||
(rof [~ ~] /eyre %j [our %code da+now] /(scot %p our))
|
||||
(rsh 3 (scot %p ;;(@ q.q:(need (need res)))))
|
||||
:: +session-cookie-string: compose session cookie
|
||||
::
|
||||
@ -1756,7 +1756,7 @@
|
||||
=/ =wire /eauth/keen/(scot %p ship)/(scot %uv nonce)
|
||||
=. time (sub time (mod time ~h1))
|
||||
=/ =spar:ames [ship /e/x/(scot %da time)//eauth/url]
|
||||
[duct %pass wire %a ?-(kind %keen keen+spar, %yawn yawn+spar)]
|
||||
[duct %pass wire %a ?-(kind %keen keen+[~ spar], %yawn yawn+spar)]
|
||||
::
|
||||
++ send-boon
|
||||
|= boon=eauth-boon
|
||||
@ -2746,7 +2746,7 @@
|
||||
?~ sub
|
||||
((trace 0 |.("no subscription for request-id {(scow %ud request-id)}")) ~)
|
||||
=/ des=(unit (unit cage))
|
||||
(rof ~ /eyre %gd [our app.u.sub da+now] /$)
|
||||
(rof [~ ~] /eyre %gd [our app.u.sub da+now] /$)
|
||||
?. ?=([~ ~ *] des)
|
||||
((trace 0 |.("no desk for app {<app.u.sub>}")) ~)
|
||||
`!<(=desk q.u.u.des)
|
||||
@ -2782,7 +2782,7 @@
|
||||
=* have=mark mark.event
|
||||
=/ convert=(unit vase)
|
||||
=/ cag=(unit (unit cage))
|
||||
(rof ~ /eyre %cf [our desk.event da+now] /[have]/json)
|
||||
(rof [~ ~] /eyre %cf [our desk.event da+now] /[have]/json)
|
||||
?. ?=([~ ~ *] cag) ~
|
||||
`q.u.u.cag
|
||||
?~ convert
|
||||
@ -3302,7 +3302,7 @@
|
||||
?~ u [%| "invalid scry path"]
|
||||
:: perform scry
|
||||
::
|
||||
?~ res=(rof ~ /eyre u.u) [%| "failed scry"]
|
||||
?~ res=(rof [~ ~] /eyre u.u) [%| "failed scry"]
|
||||
?~ u.res [%| "no scry result"]
|
||||
=* mark p.u.u.res
|
||||
=* vase q.u.u.res
|
||||
@ -3331,7 +3331,7 @@
|
||||
%c
|
||||
[%& q.beam]
|
||||
%g
|
||||
=/ res (rof ~ /eyre %gd [our q.beam da+now] /$)
|
||||
=/ res (rof [~ ~] /eyre %gd [our q.beam da+now] /$)
|
||||
?. ?=([~ ~ *] res)
|
||||
[%| "no desk for app {<q.beam>}"]
|
||||
[%& !<(=desk q.u.u.res)]
|
||||
@ -3341,7 +3341,7 @@
|
||||
|= [=vase from=mark to=mark =desk]
|
||||
^- (each ^vase tape)
|
||||
?: =(from to) [%& vase]
|
||||
=/ tub (rof ~ /eyre %cc [our desk da+now] /[from]/[to])
|
||||
=/ tub (rof [~ ~] /eyre %cc [our desk da+now] /[from]/[to])
|
||||
?. ?=([~ ~ %tube *] tub)
|
||||
[%| "no tube from {(trip from)} to {(trip to)}"]
|
||||
=/ tube !<(tube:clay q.u.u.tub)
|
||||
@ -4116,12 +4116,41 @@
|
||||
[~ ~]
|
||||
?. =(our who)
|
||||
?. =([%da now] p.lot)
|
||||
[~ ~]
|
||||
~
|
||||
~& [%r %scry-foreign-host who]
|
||||
~
|
||||
::
|
||||
?: ?=([%eauth %url ~] tyl)
|
||||
?. &(?=(%x ren) ?=(%$ syd)) ~
|
||||
=* endpoint endpoint.auth.server-state.ax
|
||||
?. ?=(%da -.p.lot) [~ ~]
|
||||
:: we cannot answer for something prior to the last set time,
|
||||
:: or something beyond the present moment.
|
||||
::
|
||||
?: ?| (lth q.p.lot time.endpoint)
|
||||
(gth q.p.lot now)
|
||||
==
|
||||
~
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (unit @t)
|
||||
=< eauth-url:eauth:authentication
|
||||
(per-server-event [eny *duct now rof] server-state.ax)
|
||||
::
|
||||
?: ?=([%cache @ @ ~] tyl)
|
||||
?. &(?=(%x ren) ?=(%$ syd)) ~
|
||||
=, server-state.ax
|
||||
?~ aeon=(slaw %ud i.t.tyl) [~ ~]
|
||||
?~ url=(slaw %t i.t.t.tyl) [~ ~]
|
||||
?~ entry=(~(get by cache) u.url) ~
|
||||
?. =(u.aeon aeon.u.entry) ~
|
||||
?~ val=val.u.entry ~
|
||||
?: &(auth.u.val !=([~ ~] lyc)) ~
|
||||
``noun+!>(u.val)
|
||||
:: private endpoints
|
||||
?. ?=([~ ~] lyc) ~
|
||||
?: &(?=(%x ren) ?=(%$ syd))
|
||||
=, server-state.ax
|
||||
?+ tyl [~ ~]
|
||||
?+ tyl ~
|
||||
[%$ %whey ~] =- ``mass+!>(`(list mass)`-)
|
||||
:~ bindings+&+bindings.server-state.ax
|
||||
auth+&+auth.server-state.ax
|
||||
@ -4143,21 +4172,6 @@
|
||||
%approved ``noun+!>((~(has in approved.cors-registry) u.origin))
|
||||
%rejected ``noun+!>((~(has in rejected.cors-registry) u.origin))
|
||||
==
|
||||
::
|
||||
[%eauth %url ~]
|
||||
=* endpoint endpoint.auth.server-state.ax
|
||||
?. ?=(%da -.p.lot) [~ ~]
|
||||
:: we cannot answer for something prior to the last set time,
|
||||
:: or something beyond the present moment.
|
||||
::
|
||||
?: ?| (lth q.p.lot time.endpoint)
|
||||
(gth q.p.lot now)
|
||||
==
|
||||
~
|
||||
:^ ~ ~ %noun
|
||||
!> ^- (unit @t)
|
||||
=< eauth-url:eauth:authentication
|
||||
(per-server-event [eny *duct now rof] server-state.ax)
|
||||
::
|
||||
[%authenticated %cookie @ ~]
|
||||
?~ cookies=(slaw %t i.t.t.tyl) [~ ~]
|
||||
@ -4166,28 +4180,19 @@
|
||||
%- =< request-is-authenticated:authentication
|
||||
(per-server-event [eny *duct now rof] server-state.ax)
|
||||
%*(. *request:http header-list ['cookie' u.cookies]~)
|
||||
::
|
||||
[%cache @ @ ~]
|
||||
?~ aeon=(slaw %ud i.t.tyl) [~ ~]
|
||||
?~ url=(slaw %t i.t.t.tyl) [~ ~]
|
||||
?~ entry=(~(get by cache) u.url) [~ ~]
|
||||
?. =(u.aeon aeon.u.entry) [~ ~]
|
||||
?~ val=val.u.entry [~ ~]
|
||||
``noun+!>(u.val)
|
||||
::
|
||||
[%'_~_' *]
|
||||
=/ mym (scry-mime now rof (deft:de-purl:html tyl))
|
||||
?: ?=(%| -.mym) [~ ~]
|
||||
``noun+!>(p.mym)
|
||||
==
|
||||
?. ?=(%$ ren)
|
||||
[~ ~]
|
||||
?+ syd [~ ~]
|
||||
?. ?=(%$ ren) ~
|
||||
?+ syd ~
|
||||
%bindings ``noun+!>(bindings.server-state.ax)
|
||||
%connections ``noun+!>(connections.server-state.ax)
|
||||
%authentication-state ``noun+!>(auth.server-state.ax)
|
||||
%channel-state ``noun+!>(channel-state.server-state.ax)
|
||||
::
|
||||
::
|
||||
%host
|
||||
%- (lift (lift |=(a=hart:eyre [%hart !>(a)])))
|
||||
^- (unit (unit hart:eyre))
|
||||
|
||||
@ -56,6 +56,7 @@
|
||||
:: leaves: retry nacked %leaves timer, if set
|
||||
::
|
||||
+$ state
|
||||
$+ state
|
||||
$: system-duct=duct
|
||||
outstanding=(map [wire duct] (qeu remote-request))
|
||||
contacts=(set ship)
|
||||
@ -70,6 +71,7 @@
|
||||
$: disclosing=(unit (set ship))
|
||||
attributing=[=ship =path]
|
||||
==
|
||||
+$ brood [=coop =hutch]
|
||||
:: $yoke: agent runner state
|
||||
::
|
||||
:: control-duct: TODO document
|
||||
@ -87,7 +89,7 @@
|
||||
:: ken: open keen requests
|
||||
::
|
||||
+$ yoke
|
||||
$% [%nuke sky=(map spur @ud)]
|
||||
$% [%nuke sky=(map spur @ud) cop=(map coop hutch)]
|
||||
$: %live
|
||||
control-duct=duct
|
||||
run-nonce=@t
|
||||
@ -100,19 +102,236 @@
|
||||
agent=(each agent vase)
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur path-state)
|
||||
sky=farm
|
||||
ken=(jug spar:ames wire)
|
||||
pen=(jug spar:ames wire)
|
||||
gem=(jug coop [path page])
|
||||
== ==
|
||||
::
|
||||
+$ plot
|
||||
$: bob=(unit @ud)
|
||||
fan=((mop @ud (pair @da (each page @uvI))) lte)
|
||||
==
|
||||
::
|
||||
++ of-farm
|
||||
|_ =farm
|
||||
++ key-coops
|
||||
|= pos=path
|
||||
^- (list coop)
|
||||
=/ frm (get-farm pos)
|
||||
?~ frm ~
|
||||
=. farm u.frm
|
||||
|-
|
||||
?: ?=(%coop -.farm)
|
||||
~[pos]
|
||||
%- zing
|
||||
%+ turn ~(tap by q.farm)
|
||||
|= [seg=@ta f=^farm]
|
||||
^- (list coop)
|
||||
^$(pos (snoc pos seg), farm f)
|
||||
::
|
||||
++ migrate
|
||||
|= from=(map spur plot)
|
||||
=/ from ~(tap by from)
|
||||
|- ^+ farm
|
||||
?~ from farm
|
||||
=. farm (need (put i.from))
|
||||
$(from t.from)
|
||||
::
|
||||
++ match-coop
|
||||
=| wer=path
|
||||
|= =path
|
||||
^- (unit coop)
|
||||
?: ?=(%coop -.farm)
|
||||
`(flop wer)
|
||||
?~ path
|
||||
~
|
||||
?~ nex=(~(get by q.farm) i.path)
|
||||
~
|
||||
$(wer [i.path wer], path t.path, farm u.nex)
|
||||
::
|
||||
++ put
|
||||
|= [=path =plot]
|
||||
^- (unit _farm)
|
||||
?: ?=(%coop -.farm)
|
||||
`farm(q (~(put by q.farm) path plot))
|
||||
?~ path
|
||||
`farm(p `plot)
|
||||
=/ nex (~(get by q.farm) i.path)
|
||||
=/ res
|
||||
$(path t.path, farm ?~(nex *^farm u.nex))
|
||||
?~ res ~
|
||||
`farm(q (~(put by q.farm) i.path u.res))
|
||||
::
|
||||
++ grow
|
||||
|= [=spur now=@da =page]
|
||||
=/ ski (gut spur)
|
||||
%+ put spur
|
||||
=- ski(fan (put:on-path fan.ski -< -> &/page))
|
||||
?~ las=(ram:on-path fan.ski)
|
||||
[(fall bob.ski 1) now]
|
||||
:_ (max now +(p.val.u.las))
|
||||
?~(bob.ski +(key.u.las) +((max key.u.las u.bob.ski)))
|
||||
::
|
||||
++ germ
|
||||
|= [=coop =hutch]
|
||||
^- (unit _farm)
|
||||
?~ coop
|
||||
?. |(=(%coop -.farm) =([%page ~ ~] farm))
|
||||
~
|
||||
`[%coop hutch ~]
|
||||
?: ?=(%coop -.farm)
|
||||
~
|
||||
?~ nex=(~(get by q.farm) i.coop)
|
||||
~
|
||||
$(coop t.coop, farm u.nex)
|
||||
::
|
||||
++ tend
|
||||
|= [=coop =path =plot]
|
||||
^- (unit _farm)
|
||||
?~ coop
|
||||
?. ?=(%coop -.farm)
|
||||
~
|
||||
`farm(q (~(put by q.farm) path plot))
|
||||
?. ?=(%plot -.farm)
|
||||
~
|
||||
?~ nex=(~(get by q.farm) i.coop)
|
||||
~
|
||||
$(coop t.coop, farm u.nex)
|
||||
::
|
||||
++ del
|
||||
|= =path
|
||||
^+ farm
|
||||
?: ?=(%coop -.farm)
|
||||
farm(q (~(del by q.farm) path))
|
||||
?~ path
|
||||
farm(p ~)
|
||||
?~ nex=(~(get by q.farm) i.path)
|
||||
farm
|
||||
$(path t.path, farm u.nex)
|
||||
::
|
||||
++ gut
|
||||
|= =path
|
||||
^- plot
|
||||
(fall (get path) *plot)
|
||||
::
|
||||
++ put-hutch
|
||||
|= [=path =hutch]
|
||||
^- (unit _farm)
|
||||
?~ path
|
||||
?: ?=(%coop -.farm)
|
||||
`farm(p hutch)
|
||||
?. =([%plot ~ ~] farm)
|
||||
~
|
||||
`[%coop hutch ~]
|
||||
?: ?=(%coop -.farm)
|
||||
~
|
||||
=/ nex (~(gut by q.farm) i.path *^farm)
|
||||
=/ res $(path t.path, farm nex)
|
||||
?~ res ~
|
||||
`farm(q (~(put by q.farm) i.path u.res))
|
||||
::
|
||||
++ get-hutch
|
||||
|= =path
|
||||
^- (unit hutch)
|
||||
?~ path
|
||||
?. ?=(%coop -.farm)
|
||||
~
|
||||
`p.farm
|
||||
?: ?=(%coop -.farm)
|
||||
~
|
||||
?~ nex=(~(get by q.farm) i.path)
|
||||
~
|
||||
$(path t.path, farm u.nex)
|
||||
::
|
||||
++ get-farm
|
||||
|= =path
|
||||
^- (unit ^farm)
|
||||
?: ?=(%coop -.farm)
|
||||
?~ (~(get by q.farm) path)
|
||||
~
|
||||
`farm
|
||||
?~ path ~
|
||||
?~ nex=(~(get by q.farm) i.path)
|
||||
~
|
||||
$(path t.path, farm u.nex)
|
||||
::
|
||||
++ get
|
||||
|= =path
|
||||
^- (unit plot)
|
||||
?: ?=(%coop -.farm)
|
||||
(~(get by q.farm) path)
|
||||
?~ path
|
||||
p.farm
|
||||
?~ nex=(~(get by q.farm) i.path)
|
||||
~
|
||||
$(path t.path, farm u.nex)
|
||||
++ tap-plot
|
||||
=| wer=path
|
||||
|- ^- (list [path plot])
|
||||
=* tap-plot $
|
||||
?: ?=(%coop -.farm)
|
||||
%+ turn ~(tap by q.farm)
|
||||
|= [=path =plot]
|
||||
[(welp wer path) plot]
|
||||
%+ welp ?~(p.farm ~ [wer u.p.farm]~)
|
||||
%- zing
|
||||
%+ turn ~(tap by q.farm)
|
||||
|= [seg=@ta f=^farm]
|
||||
^- (list [path plot])
|
||||
tap-plot(wer (snoc wer seg), farm f)
|
||||
::
|
||||
++ run-plot
|
||||
|* fun=gate
|
||||
%- ~(gas by *(map path _(fun)))
|
||||
%+ turn tap-plot
|
||||
|= [=path =plot]
|
||||
[path (fun plot)]
|
||||
::
|
||||
++ gas-hutch
|
||||
|= =(list [=coop =hutch])
|
||||
^- (unit _farm)
|
||||
?~ list
|
||||
`farm
|
||||
=/ nex
|
||||
(put-hutch i.list)
|
||||
?~ nex ~
|
||||
$(farm u.nex, list t.list)
|
||||
::
|
||||
++ tap-hutch
|
||||
=| wer=path
|
||||
%- ~(gas in *(set [=coop =hutch]))
|
||||
|- ^- (list [=coop =hutch])
|
||||
=* loop $
|
||||
?: ?=(%coop -.farm)
|
||||
[wer p.farm]~
|
||||
%- zing
|
||||
%+ turn ~(tap by q.farm)
|
||||
|= [seg=@ta f=^farm]
|
||||
^- (list [=coop =hutch])
|
||||
loop(wer (snoc wer seg), farm f)
|
||||
--
|
||||
::
|
||||
++ on-path ((on @ud (pair @da (each page @uvI))) lte)
|
||||
:: $blocked-move: enqueued move to an agent
|
||||
::
|
||||
+$ blocked-move [=duct =routes move=(each deal unto)]
|
||||
::
|
||||
:: $fine-request: key exchange request for $coop
|
||||
::
|
||||
+$ fine-request
|
||||
[%0 =path]
|
||||
::
|
||||
:: $fine-response: key exchange response for $coop
|
||||
::
|
||||
+$ fine-response
|
||||
[%0 bod=(unit brood)]
|
||||
::
|
||||
+$ ames-response
|
||||
$% [%d =mark noun=*]
|
||||
[%x ~]
|
||||
==
|
||||
::
|
||||
:: $ames-request: network request (%plea)
|
||||
::
|
||||
:: %m: poke
|
||||
@ -293,10 +512,17 @@
|
||||
code agent
|
||||
agent &+agent
|
||||
run-nonce (scot %uw (end 5 (shas %yoke-nonce eny)))
|
||||
sky
|
||||
?~ yak ~
|
||||
(~(run by sky.u.yak) (corl (late ~) (lead ~)))
|
||||
==
|
||||
::
|
||||
sky
|
||||
?~ yak *farm
|
||||
=| =farm
|
||||
=. farm (need (~(gas-hutch of-farm farm) ~(tap by cop.u.yak)))
|
||||
=/ sky=(list [=spur bob=@ud]) ~(tap by sky.u.yak)
|
||||
|-
|
||||
?~ sky farm
|
||||
=. farm (need (~(put of-farm farm) spur.i.sky [`bob.i.sky ~]))
|
||||
$(sky t.sky)
|
||||
==
|
||||
::
|
||||
=/ old mo-core
|
||||
=/ wag
|
||||
@ -583,6 +809,30 @@
|
||||
=. mo-core (mo-give %unto %kick ~)
|
||||
mo-core
|
||||
==
|
||||
++ mo-handle-key
|
||||
~/ %mo-handle-stub
|
||||
|= [=(pole knot) syn=sign-arvo]
|
||||
?. ?=([agent=@ nonce=@ rest=*] pole)
|
||||
~& [%mo-handle-key-bad-wire wire]
|
||||
!!
|
||||
=* dap agent.pole
|
||||
=/ yoke (~(get by yokes.state) agent.pole)
|
||||
?. ?=([~ %live *] yoke)
|
||||
%- (slog leaf+"gall: {<`@t`dap>} dead, got %stub" ~)
|
||||
mo-core
|
||||
?. =(run-nonce.u.yoke nonce.pole)
|
||||
%- (slog leaf+"gall: got old stub for {<dap>}" ~)
|
||||
mo-core
|
||||
=/ =routes [disclosing=~ attributing=[our /]]
|
||||
=/ ap-core (ap-abed:ap agent.pole routes)
|
||||
?+ rest.pole ~|(mo-handle-key-bad-wire/wire !!)
|
||||
[%pug rest=*]
|
||||
?> ?=([%ames %stub *] syn)
|
||||
ap-abet:(ap-stub:ap-core rest.rest.pole [num key]:syn)
|
||||
::
|
||||
[%bod rest=*]
|
||||
ap-abet:(ap-take-brood:ap-core rest.rest.pole syn)
|
||||
==
|
||||
:: +mo-handle-use: handle a typed +sign incoming on /use.
|
||||
::
|
||||
:: (Note that /use implies the +sign should be routed to an agent.)
|
||||
@ -710,10 +960,11 @@
|
||||
%+ ~(jab by yokes.state) dap
|
||||
|= =^yoke
|
||||
?: ?=(%nuke -.yoke) yoke
|
||||
:- %nuke
|
||||
%- ~(run by sky.yoke)
|
||||
|= path-state
|
||||
(fall (clap bob (bind (ram:on-path fan) head) max) 0)
|
||||
:+ %nuke
|
||||
%- ~(run-plot of-farm sky.yoke)
|
||||
|= plot
|
||||
(fall (clap bob (bind (ram:on-path fan) head) max) 0)
|
||||
~(tap-hutch of-farm sky.yoke)
|
||||
:: +mo-load: install agents
|
||||
::
|
||||
++ mo-load
|
||||
@ -736,6 +987,30 @@
|
||||
?~ kil mo-core
|
||||
~> %slog.0^leaf/"gall: stopping {<i.kil>}"
|
||||
$(kil t.kil, mo-core (mo-idle prov i.kil))
|
||||
::
|
||||
++ mo-authorized-coop
|
||||
|= [lyc=(set ship) =farm dap=term =path =coop]
|
||||
%- ~(all in lyc)
|
||||
|= =ship
|
||||
=/ cag (mo-peek | dap [~ ship path] %c (snoc coop (scot %p ship)))
|
||||
?. ?=([~ ~ ^] cag)
|
||||
%.n
|
||||
?~ res=((soft ,?) q.q.u.u.cag)
|
||||
%.n
|
||||
u.res
|
||||
::
|
||||
++ mo-authorized
|
||||
|= [lyc=gang =farm dap=term =path]
|
||||
^- ?
|
||||
?: =([~ ~] lyc)
|
||||
%.y
|
||||
?~ (~(get-hutch of-farm farm) path)
|
||||
%.y
|
||||
?: ?=(~ lyc)
|
||||
%.n
|
||||
?~ coop=(~(match-coop of-farm farm) path)
|
||||
%.n
|
||||
(mo-authorized-coop u.lyc farm dap path u.coop)
|
||||
:: +mo-peek: call to +ap-peek (which is not accessible outside of +mo).
|
||||
::
|
||||
++ mo-peek
|
||||
@ -762,7 +1037,7 @@
|
||||
=/ =case da+now
|
||||
=/ yok (~(got by yokes.state) dap)
|
||||
=/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion?
|
||||
=/ sky (rof ~ /gall %cb [our desk case] /[mark.deal])
|
||||
=/ sky (rof [~ ~] /gall %cb [our desk case] /[mark.deal])
|
||||
?- sky
|
||||
?(~ [~ ~])
|
||||
=/ ror "gall: raw-poke fail :{(trip dap)} {<mark.deal>}"
|
||||
@ -786,7 +1061,7 @@
|
||||
=/ mars-path /[a.mars]/[b.mars]
|
||||
=/ yok (~(got by yokes.state) dap)
|
||||
=/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion?
|
||||
=/ sky (rof ~ /gall %cc [our desk case] mars-path)
|
||||
=/ sky (rof [~ ~] /gall %cc [our desk case] mars-path)
|
||||
?- sky
|
||||
?(~ [~ ~])
|
||||
=/ ror "gall: poke cast fail :{(trip dap)} {<mars>}"
|
||||
@ -839,6 +1114,21 @@
|
||||
%_ mo-core
|
||||
blocked.state (~(put by blocked.state) agent blocked)
|
||||
==
|
||||
:: +mo-handle-key-request: handle request for keys
|
||||
++ mo-handle-key-request
|
||||
|= [=ship agent-name=term =path]
|
||||
^+ mo-core
|
||||
=/ yok=(unit yoke) (~(get by yokes.state) agent-name)
|
||||
?. ?=([~ %live *] yok)
|
||||
(mo-give %done ~)
|
||||
=/ ap-core (ap-abed:ap agent-name [~ our /gall])
|
||||
=^ bod=(each (unit brood) tang) mo-core
|
||||
(ap-serve-brood:ap-core ship path)
|
||||
?: ?=(%| -.bod)
|
||||
(mo-give %done `keys/p.bod)
|
||||
=/ =fine-response [%0 p.bod]
|
||||
=. mo-core (mo-give %boon fine-response)
|
||||
(mo-give %done ~)
|
||||
:: +mo-handle-ames-request: handle %ames request message.
|
||||
::
|
||||
++ mo-handle-ames-request
|
||||
@ -856,7 +1146,7 @@
|
||||
(mo-give %flub ~)
|
||||
?: ?=(%.n -.agent.u.yok)
|
||||
(mo-give %flub ~)
|
||||
::
|
||||
::
|
||||
=/ =wire /sys/req/(scot %p ship)/[agent-name]
|
||||
::
|
||||
=/ =deal
|
||||
@ -867,6 +1157,7 @@
|
||||
%u [%leave ~]
|
||||
==
|
||||
(mo-pass wire %g %deal [ship our /] agent-name deal)
|
||||
|
||||
:: +mo-spew: handle request to set verbosity toggles on debug output
|
||||
::
|
||||
++ mo-spew
|
||||
@ -965,6 +1256,82 @@
|
||||
yokes.state running
|
||||
moves moves
|
||||
==
|
||||
++ ap-request-brood
|
||||
|= [=wire =ship =(pole knot)]
|
||||
^+ ap-core
|
||||
?. ?=([%g %x cas=@ app=@ rest=*] pole)
|
||||
%. ap-core
|
||||
%+ trace odd.veb.bug.state
|
||||
[leaf+"gall: {<agent-name>}: brood request {<pole>} invalid, dropping"]~
|
||||
=. pen.yoke (~(put ju pen.yoke) [ship pole] wire)
|
||||
=/ =fine-request [%0 rest.pole]
|
||||
=/ =plea:ames [%g /gk/[app.pole] fine-request]
|
||||
=/ out=^wire (welp /key/[agent-name]/[run-nonce.yoke]/bod/(scot %p ship) pole)
|
||||
(ap-move [hen %pass out %a %plea ship plea]~)
|
||||
::
|
||||
++ ap-take-brood
|
||||
|= [=wire syn=sign-arvo]
|
||||
^+ ap-core
|
||||
~| ap-take-brood/wire
|
||||
?> ?=([@ *] wire) :: TODO: strip crash semantics
|
||||
=/ =ship (slav %p i.wire)
|
||||
=/ wis=(list ^wire) ~(tap in (~(get ju pen.yoke) [ship t.wire]))
|
||||
?+ syn ~|(weird-sign-ap-take-brood/-.syn !!)
|
||||
[%ames %boon *]
|
||||
=/ bud (fall ((soft fine-response) payload.syn) *fine-response)
|
||||
|-
|
||||
?~ wis
|
||||
=. pen.yoke (~(del by pen.yoke) [ship t.wire])
|
||||
ap-core
|
||||
?~ bod.bud
|
||||
=. ap-core (ap-generic-take i.wis %ames %near [ship t.wire] ~)
|
||||
$(wis t.wis)
|
||||
=. ap-core (ap-pass i.wis %arvo %a %keen `[idx key]:hutch.u.bod.bud ship t.wire)
|
||||
$(wis t.wis)
|
||||
::
|
||||
[%ames %done *]
|
||||
?~ error.syn
|
||||
ap-core
|
||||
|-
|
||||
?~ wis
|
||||
=. pen.yoke (~(del by pen.yoke) [ship t.wire])
|
||||
ap-core
|
||||
=. ap-core
|
||||
%. (ap-generic-take i.wis %ames %near [ship t.wire] ~)
|
||||
%+ trace odd.veb.bug.state
|
||||
[leaf/"gall: {<agent-name>} bad brood res {<ship>} {<t.wire>}"]~
|
||||
$(wis t.wis)
|
||||
==
|
||||
::
|
||||
++ ap-serve-brood
|
||||
|= [=ship =(pole knot)]
|
||||
^- [(each (unit brood) tang) _mo-core]
|
||||
?. ?=([%$ ver=@ rest=*] pole)
|
||||
:_ ap-abet
|
||||
|+[leaf/"gall: {<agent-name>} bad brood req {<ship>} {<pole>}"]~
|
||||
=/ ver (slav %ud ver.pole)
|
||||
?. =(1 ver)
|
||||
:_ ap-abet
|
||||
|+[leaf/"gall: {<agent-name>} bad brood ver {<ver>} {<ship>} {<rest.pole>}"]~
|
||||
?~ cop=(ap-match-coop rest.pole)
|
||||
%. [&+~ ap-abet]
|
||||
%+ trace odd.veb.bug.state
|
||||
[leaf/"gall: {<agent-name>} no coop match {<ship>} {<rest.pole>}"]~
|
||||
=/ cag=(unit (unit cage))
|
||||
(ap-peek %| %c (snoc u.cop (scot %p ship)))
|
||||
=/ has-perms=?
|
||||
?. ?=([~ ~ ^] cag)
|
||||
|
|
||||
?~ res=((soft ,?) q.q.u.u.cag)
|
||||
|
|
||||
u.res
|
||||
=/ =hutch (need (~(get-hutch of-farm sky.yoke) u.cop))
|
||||
?. has-perms
|
||||
%. [[%.y ~] ap-abet]
|
||||
%+ trace odd.veb.bug.state
|
||||
[leaf/"gall: {<agent-name>} no perms for {<coop>} {<ship>} {<rest.pole>}"]~
|
||||
=/ =brood [u.cop hutch]
|
||||
[[%.y `brood] ap-abet]
|
||||
::
|
||||
++ ap-yawn-all
|
||||
^- (list card:agent)
|
||||
@ -1002,19 +1369,75 @@
|
||||
==
|
||||
=^ maybe-tang ap-core (ap-ingest ~ |.([will *agent]))
|
||||
ap-core
|
||||
++ ap-match-coop
|
||||
|= =path
|
||||
^- (unit coop)
|
||||
(~(match-coop of-farm sky.yoke) path)
|
||||
::
|
||||
++ ap-keen
|
||||
|= [=wire secret=? =spar:ames]
|
||||
^+ ap-core
|
||||
?: secret
|
||||
(ap-request-brood wire spar)
|
||||
=. ken.yoke (~(put ju ken.yoke) spar wire)
|
||||
(ap-pass wire %arvo %a %keen ~ spar)
|
||||
::
|
||||
::
|
||||
:: +ap-tend: bind path in namespace, encrypted
|
||||
++ ap-tend
|
||||
|= [=coop =path =page]
|
||||
?~ cop=(~(get-hutch of-farm sky.yoke) coop)
|
||||
?. (~(has by gem.yoke) coop)
|
||||
%. ap-core
|
||||
%+ trace &
|
||||
[leaf+"gall: {<agent-name>} no such coop {<coop>}, dropping %grow at {<path>}"]~
|
||||
=. gem.yoke (~(put ju gem.yoke) coop path page)
|
||||
ap-core
|
||||
=. sky.yoke (need (~(grow of-farm sky.yoke) (welp coop path) now page))
|
||||
ap-core
|
||||
::
|
||||
++ ap-germ
|
||||
|= =coop
|
||||
=/ pen (~(get by gem.yoke) coop)
|
||||
=/ exists !=(~ (~(get of-farm sky.yoke) coop))
|
||||
=? gem.yoke &(!exists ?=(~ pen))
|
||||
(~(put by gem.yoke) coop ~)
|
||||
=/ =wire (welp /key/[agent-name]/[run-nonce.yoke]/pug coop)
|
||||
(ap-move [hen %pass wire %a %plug [%g %x agent-name %$ '1' coop]]~)
|
||||
::
|
||||
++ ap-stub
|
||||
|= [=coop num=@ud key=@]
|
||||
^+ ap-core
|
||||
=/ =hutch
|
||||
?^ h=(~(get-hutch of-farm sky.yoke) coop)
|
||||
u.h
|
||||
*hutch
|
||||
=. hutch [.+(rev.hutch) num key]
|
||||
=. sky.yoke
|
||||
?^ new-sky=(~(put-hutch of-farm sky.yoke) coop hutch)
|
||||
u.new-sky
|
||||
sky.yoke
|
||||
=/ gem ~(tap in (~(get ju gem.yoke) coop))
|
||||
|- ^+ ap-core
|
||||
?~ gem ap-core
|
||||
$(gem t.gem, ap-core (ap-tend coop i.gem))
|
||||
::
|
||||
++ ap-snip
|
||||
|= =coop
|
||||
ap-core
|
||||
:: ap-core(cop.yoke (~(del by cop.yoke) coop)) :: TODO: fix
|
||||
:: +ap-grow: bind a path in the agent's scry namespace
|
||||
::
|
||||
++ ap-grow
|
||||
|= [=spur =page]
|
||||
^+ ap-core
|
||||
:: check here, and no-op, so that +need below does not crash
|
||||
?: =(~ (ap-match-coop spur))
|
||||
%. ap-core
|
||||
%+ trace &
|
||||
[leaf+"gall: {<agent-name>}: grow {<spur>} has coop, dropping"]~
|
||||
=- ap-core(sky.yoke -)
|
||||
%+ ~(put by sky.yoke) spur
|
||||
=/ ski (~(gut by sky.yoke) spur *path-state)
|
||||
=- ski(fan (put:on-path fan.ski -< -> &/page))
|
||||
?~ las=(ram:on-path fan.ski)
|
||||
[?~(bob.ski 0 +(u.bob.ski)) now]
|
||||
:_ (max now +(p.val.u.las))
|
||||
?~(bob.ski +(key.u.las) +((max key.u.las u.bob.ski)))
|
||||
(need (~(grow of-farm sky.yoke) spur now page))
|
||||
:: +ap-tomb: tombstone -- replace bound value with hash
|
||||
::
|
||||
++ ap-tomb
|
||||
@ -1022,7 +1445,7 @@
|
||||
^+ ap-core
|
||||
=- ap-core(sky.yoke -)
|
||||
=/ yon ?>(?=(%ud -.case) p.case)
|
||||
=/ old (~(get by sky.yoke) spur)
|
||||
=/ old (~(get of-farm sky.yoke) spur)
|
||||
?~ old :: no-op if nonexistent
|
||||
%. sky.yoke
|
||||
%+ trace odd.veb.bug.state
|
||||
@ -1039,7 +1462,8 @@
|
||||
[leaf+"gall: {<agent-name>}: tomb {<[case spur]>} no-op"]~
|
||||
::
|
||||
%& :: replace with hash
|
||||
%+ ~(put by sky.yoke) spur
|
||||
%- need
|
||||
%+ ~(put of-farm sky.yoke) spur
|
||||
u.old(fan (put:on-path fan.u.old yon u.val(q |/(shax (jam p.q.u.val)))))
|
||||
==
|
||||
:: +ap-cull: delete all bindings up to and including .case
|
||||
@ -1052,7 +1476,7 @@
|
||||
^+ ap-core
|
||||
=- ap-core(sky.yoke -)
|
||||
=/ yon ?>(?=(%ud -.case) p.case)
|
||||
=/ old (~(get by sky.yoke) spur)
|
||||
=/ old (~(get of-farm sky.yoke) spur)
|
||||
?~ old :: no-op if nonexistent
|
||||
%. sky.yoke
|
||||
%+ trace odd.veb.bug.state
|
||||
@ -1070,7 +1494,12 @@
|
||||
%+ weld
|
||||
"gall: {<agent-name>}: cull {<[case spur]>} out of range, "
|
||||
"min: {<key.fis>}, max: {<key.u.las>}"
|
||||
%+ ~(put by sky.yoke) spur :: delete all older paths
|
||||
=; nex=(unit farm)
|
||||
?^ nex u.nex
|
||||
%. sky.yoke
|
||||
%+ trace &
|
||||
[leaf+"gall: {<agent-name>}: cull {<[case spur]>} invalid path structure"]~
|
||||
%+ ~(put of-farm sky.yoke) spur :: delete all older paths
|
||||
[`yon (lot:on-path fan.u.old `yon ~)]
|
||||
:: +ap-from-internal: internal move to move.
|
||||
::
|
||||
@ -1082,7 +1511,7 @@
|
||||
::
|
||||
+$ carp $+ carp (wind neet gift:agent)
|
||||
+$ neet $+ neet
|
||||
$< ?(%grow %tomb %cull)
|
||||
$< ?(%grow %tomb %cull %tend %germ %snip %keen)
|
||||
$% note:agent
|
||||
[%agent [=ship name=term] task=[%raw-poke =mark =noun]]
|
||||
[%huck [=ship name=term] =note-arvo]
|
||||
@ -1125,7 +1554,7 @@
|
||||
=/ =case da+now
|
||||
=/ bek=beak [our q.beak.yoke case]
|
||||
=/ mars-path /[a.mars]/[b.mars]
|
||||
=/ sky (rof ~ /gall %cc bek mars-path)
|
||||
=/ sky (rof [~ ~] /gall %cc bek mars-path)
|
||||
?- sky
|
||||
?(~ [~ ~])
|
||||
%- (slog leaf+"watch-as fact conversion find-fail" >sky< ~)
|
||||
@ -1305,7 +1734,7 @@
|
||||
=/ tub=(unit tube:clay)
|
||||
?: =(have want) `(bake same ^vase)
|
||||
=/ tuc=(unit (unit cage))
|
||||
(rof ~ /gall %cc [our q.beak.yoke da+now] /[have]/[want])
|
||||
(rof [~ ~] /gall %cc [our q.beak.yoke da+now] /[have]/[want])
|
||||
?. ?=([~ ~ *] tuc) ~
|
||||
`!<(tube:clay q.u.u.tuc)
|
||||
?~ tub
|
||||
@ -1340,7 +1769,9 @@
|
||||
== ::
|
||||
:* wex=boat.yoke :: outgoing
|
||||
sup=bitt.yoke :: incoming
|
||||
sky=(~(run by sky.yoke) tail) :: bindings
|
||||
^= sky :: bindings
|
||||
%- ~(run-plot of-farm sky.yoke)
|
||||
(bake tail ,plot)
|
||||
== ::
|
||||
:* act=change.stats.yoke :: tick
|
||||
eny=eny.stats.yoke :: nonce
|
||||
@ -1362,7 +1793,7 @@
|
||||
%- zing
|
||||
%+ turn ~(tap by `(jug spar:ames wire)`ken.yoke)
|
||||
|= [=spar:ames wyz=(set wire)]
|
||||
(turn ~(tap in wyz) |=(=wire [%pass wire %arvo %a %keen spar]))
|
||||
(turn ~(tap in wyz) |=(=wire [%pass wire %arvo %a %keen ~ spar]))
|
||||
=^ error ap-core
|
||||
(ap-install(agent.yoke &+agent) `old-state)
|
||||
?~ error
|
||||
@ -1452,7 +1883,7 @@
|
||||
?: ?=(%spider agent-name)
|
||||
:- [%fact mark.unto !>(noun.unto)]
|
||||
ap-core
|
||||
=/ sky (rof ~ /gall %cb [our q.beak.yoke case] /[mark.unto])
|
||||
=/ sky (rof [~ ~] /gall %cb [our q.beak.yoke case] /[mark.unto])
|
||||
?. ?=([~ ~ *] sky)
|
||||
(mean leaf+"gall: ames mark fail {<mark.unto>}" ~)
|
||||
::
|
||||
@ -1724,7 +2155,7 @@
|
||||
++ ap-mule
|
||||
|= run=_^?(|.(*step:agent))
|
||||
^- (each step:agent tang)
|
||||
=/ res (mock [run %9 2 %0 1] (look rof ~ /gall/[agent-name]))
|
||||
=/ res (mock [run %9 2 %0 1] (look rof [~ ~] /gall/[agent-name]))
|
||||
?- -.res
|
||||
%0 [%& !<(step:agent [-:!>(*step:agent) p.res])]
|
||||
%1 [%| (smyt ;;(path p.res)) ~]
|
||||
@ -1735,7 +2166,7 @@
|
||||
++ ap-mule-peek
|
||||
|= run=_^?(|.(*(unit (unit cage))))
|
||||
^- (each (unit (unit cage)) tang)
|
||||
=/ res (mock [run %9 2 %0 1] (look rof ~ /gall/[agent-name]))
|
||||
=/ res (mock [run %9 2 %0 1] (look rof [~ ~] /gall/[agent-name]))
|
||||
?- -.res
|
||||
%0 [%& !<((unit (unit cage)) [-:!>(*(unit (unit cage))) p.res])]
|
||||
%1 [%| (smyt ;;(path p.res)) ~]
|
||||
@ -1794,6 +2225,10 @@
|
||||
[%pass * %grow *] $(caz t.caz, ap-core (ap-grow +.q.i.caz))
|
||||
[%pass * %tomb *] $(caz t.caz, ap-core (ap-tomb +.q.i.caz))
|
||||
[%pass * %cull *] $(caz t.caz, ap-core (ap-cull +.q.i.caz))
|
||||
[%pass * %tend *] $(caz t.caz, ap-core (ap-tend +.q.i.caz))
|
||||
[%pass * %germ *] $(caz t.caz, ap-core (ap-germ +.q.i.caz))
|
||||
[%pass * %snip *] $(caz t.caz, ap-core (ap-snip +.q.i.caz))
|
||||
[%pass * %keen *] $(caz t.caz, ap-core (ap-keen p.i.caz +.q.i.caz))
|
||||
[%pass * ?(%agent %arvo %pyre) *] $(caz t.caz, fex [i.caz fex])
|
||||
[%give *] $(caz t.caz, fex [i.caz fex])
|
||||
[%slip *] !!
|
||||
@ -1806,7 +2241,7 @@
|
||||
%+ roll fex
|
||||
|= [=carp ken=_ken.yoke]
|
||||
?+ carp ken
|
||||
[%pass * %arvo %a %keen spar=*] (~(put ju ken) [spar.q p]:carp)
|
||||
[%pass * %arvo %a %keen @ spar=*] (~(put ju ken) [spar.q p]:carp)
|
||||
[%pass * %arvo %a %yawn spar=*] (~(del ju ken) [spar.q p]:carp)
|
||||
==
|
||||
:: +ap-handle-kicks: handle cancels of bitt.watches
|
||||
@ -1934,7 +2369,11 @@
|
||||
=/ =path path.plea.task
|
||||
=/ =noun payload.plea.task
|
||||
::
|
||||
~| [ship=ship plea-path=path]
|
||||
?: ?=([%gk @ ~] path)
|
||||
=/ agent-name i.t.path
|
||||
=+ ;;(=fine-request noun)
|
||||
=< mo-abet
|
||||
(mo-handle-key-request:mo-core ship agent-name path.fine-request)
|
||||
?> ?=([%ge @ ~] path)
|
||||
=/ agent-name i.t.path
|
||||
::
|
||||
@ -1983,20 +2422,30 @@
|
||||
[%14 spore-14]
|
||||
[%15 spore-15]
|
||||
==
|
||||
+$ spore-15 spore
|
||||
+$ spore-15
|
||||
$+ spore-15
|
||||
$: system-duct=duct
|
||||
outstanding=(map [wire duct] (qeu remote-request))
|
||||
contacts=(set ship)
|
||||
eggs=(map term egg-15)
|
||||
blocked=(map term (qeu blocked-move))
|
||||
=bug
|
||||
leaves=(unit [=duct =wire date=@da])
|
||||
==
|
||||
+$ spore-14
|
||||
$: system-duct=duct
|
||||
outstanding=(map [wire duct] (qeu remote-request))
|
||||
contacts=(set ship)
|
||||
eggs=(map term egg)
|
||||
eggs=(map term egg-15)
|
||||
blocked=(map term (qeu blocked-move))
|
||||
=bug
|
||||
==
|
||||
::
|
||||
+$ spore-13
|
||||
$: system-duct=duct
|
||||
outstanding=(map [wire duct] (qeu remote-request))
|
||||
contacts=(set ship)
|
||||
eggs=(map term egg)
|
||||
eggs=(map term egg-15)
|
||||
blocked=(map term (qeu blocked-move-13))
|
||||
=bug
|
||||
==
|
||||
@ -2027,7 +2476,7 @@
|
||||
old-state=[%| vase]
|
||||
=beak
|
||||
marks=(map duct mark)
|
||||
sky=(map spur path-state)
|
||||
sky=(map spur farm)
|
||||
== ==
|
||||
+$ spore-11
|
||||
$: system-duct=duct
|
||||
@ -2186,7 +2635,7 @@
|
||||
%- ~(urn by eggs.old)
|
||||
|= [a=term e=egg-11]
|
||||
^- egg-12
|
||||
live/e(marks [marks.e sky:*$>(%live egg)])
|
||||
live/e(marks [marks.e sky:*$>(%live egg-12)])
|
||||
==
|
||||
::
|
||||
:: added ken
|
||||
@ -2199,11 +2648,10 @@
|
||||
eggs
|
||||
%- ~(urn by eggs.old)
|
||||
|= [a=term e=egg-12]
|
||||
^- egg
|
||||
^- egg-15
|
||||
?: ?=(%nuke -.e) e
|
||||
e(sky [sky.e ken:*$>(%live egg)])
|
||||
!! :: e(sky [sky.e ken:*$>(%live egg-13)])
|
||||
==
|
||||
:: added provenance path to routes
|
||||
::
|
||||
++ spore-13-to-14
|
||||
|= old=spore-13
|
||||
@ -2238,15 +2686,25 @@
|
||||
%= old
|
||||
eggs
|
||||
%- ~(urn by eggs.old)
|
||||
|= [=term e=egg]
|
||||
|= [=term e=egg-15]
|
||||
^- egg
|
||||
?: ?=(%nuke -.e) e(sky *(map spur @ud))
|
||||
%= e
|
||||
?: ?=(%nuke -.e) [%nuke ~ ~]
|
||||
%= e
|
||||
ken [ken.e ~ ~]
|
||||
::
|
||||
sky
|
||||
%- molt
|
||||
%+ turn ~(tap by sky.e)
|
||||
|= [=spur p=path-state]
|
||||
:- spur
|
||||
=| =farm
|
||||
=/ ski ~(tap by sky.e)
|
||||
|- ^+ farm
|
||||
?~ ski
|
||||
farm
|
||||
=/ [=spur p=plot] i.ski
|
||||
=; new
|
||||
?~ nex=(~(put of-farm farm) spur new)
|
||||
~& %weird
|
||||
!! :: shouldn't continue else loss of ref integrity
|
||||
:: $(ski t.ski)
|
||||
$(farm u.nex, ski t.ski)
|
||||
:- ~
|
||||
=/ m ~(val by fan.p)
|
||||
%+ gas:on-path *_fan.p
|
||||
@ -2276,6 +2734,7 @@
|
||||
?. ?=([%$ *] path) :: [%$ *] is for the vane, all else is for the agent
|
||||
?. ?& =(our ship)
|
||||
=([%$ %da now] coin)
|
||||
=([~ ~] lyc)
|
||||
== ~
|
||||
?. (~(has by yokes.state) dap) [~ ~]
|
||||
?. ?=(^ path) ~
|
||||
@ -2288,6 +2747,7 @@
|
||||
=(~ path)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
=; hav=?
|
||||
[~ ~ noun+!>(hav)]
|
||||
@ -2298,6 +2758,7 @@
|
||||
=(~ path)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
=/ yok=(unit yoke) (~(get by yokes.state) dap)
|
||||
?. ?=([~ %live *] yok)
|
||||
@ -2308,6 +2769,7 @@
|
||||
=(~ path)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
:+ ~ ~
|
||||
:- %apps !> ^- (set [=dude live=?])
|
||||
@ -2324,6 +2786,7 @@
|
||||
=(~ path)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
:+ ~ ~
|
||||
:- %nonces !> ^- (map dude @)
|
||||
@ -2335,6 +2798,7 @@
|
||||
?=([@ @ ^] path)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
=/ yok (~(get by yokes.state) dap)
|
||||
?. ?=([~ %live *] yok)
|
||||
@ -2348,6 +2812,7 @@
|
||||
?: ?& =(%v care)
|
||||
=([%$ %da now] coin)
|
||||
=(our ship)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
=/ yok (~(get by yokes.state) dap)
|
||||
?. ?=([~ %live *] yok)
|
||||
@ -2371,8 +2836,10 @@
|
||||
=> .(path t.path)
|
||||
=/ yok (~(get by yokes.state) q.bem)
|
||||
?. ?=([~ %live *] yok) [~ ~]
|
||||
?~ ski=(~(get by sky.u.yok) path) [~ ~]
|
||||
?~ ski=(~(get of-farm sky.u.yok) path) [~ ~]
|
||||
?~ las=(ram:on-path fan.u.ski) [~ ~]
|
||||
?. (mo-authorized:mo lyc sky.u.yok q.bem path)
|
||||
~
|
||||
``case/!>(ud/key.u.las)
|
||||
::
|
||||
?: &(?=(%x care) ?=([%'1' *] path))
|
||||
@ -2382,6 +2849,7 @@
|
||||
?: ?=(%$ q.bem) :: app %$ reserved
|
||||
?+ path ~
|
||||
[%whey ~]
|
||||
?. ?=([~ ~] lyc) ~
|
||||
=/ blocked
|
||||
=/ queued (~(run by blocked.state) |=((qeu blocked-move) [%.y +<]))
|
||||
(sort ~(tap by queued) aor)
|
||||
@ -2408,8 +2876,10 @@
|
||||
::
|
||||
?~ yok=(~(get by yokes.state) q.bem) ~
|
||||
?: ?=(%nuke -.u.yok) ~
|
||||
=/ ski (~(get by sky.u.yok) path)
|
||||
?~ ski ~
|
||||
?~ ski=(~(get of-farm sky.u.yok) path)
|
||||
~
|
||||
?. (mo-authorized:mo lyc sky.u.yok q.bem path)
|
||||
~
|
||||
=/ res=(unit (each page @uvI))
|
||||
?+ -.r.bem ~
|
||||
%ud (bind (get:on-path fan.u.ski p.r.bem) tail)
|
||||
@ -2434,8 +2904,18 @@
|
||||
=> .(path t.path)
|
||||
=/ yok (~(get by yokes.state) q.bem)
|
||||
?. ?=([~ %live *] yok) ~
|
||||
=/ keys=(list coop) (~(key-coops of-farm sky.u.yok) path)
|
||||
=/ authorized=?
|
||||
?: =([~ ~] lyc) %.y
|
||||
|-
|
||||
?~ keys %.y
|
||||
?< ?=(~ lyc)
|
||||
?. (mo-authorized-coop:mo u.lyc sky.u.yok q.bem path i.keys)
|
||||
%.n
|
||||
$(keys t.keys)
|
||||
?. authorized ~
|
||||
:^ ~ ~ %file-list !> ^- (list ^path)
|
||||
%+ skim ~(tap in ~(key by sky.u.yok))
|
||||
%+ skim (turn ~(tap-plot of-farm sky.u.yok) head)
|
||||
|= =spur
|
||||
?& =(path (scag (lent path) spur))
|
||||
!=(path spur)
|
||||
@ -2448,7 +2928,9 @@
|
||||
=> .(path t.path)
|
||||
=/ yok (~(get by yokes.state) q.bem)
|
||||
?. ?=([~ %live *] yok) ~
|
||||
?~ ski=(~(get by sky.u.yok) path) ~
|
||||
?~ ski=(~(get of-farm sky.u.yok) path) ~
|
||||
?. (mo-authorized:mo lyc sky.u.yok q.bem path)
|
||||
~
|
||||
=/ res=(unit (pair @da (each noun @uvI)))
|
||||
?+ -.r.bem ~
|
||||
%ud (get:on-path fan.u.ski p.r.bem)
|
||||
@ -2491,6 +2973,10 @@
|
||||
?: =(/clear-huck wire)
|
||||
=/ =gift ?>(?=([%behn %heck %gall *] syn) +>+.syn)
|
||||
[[duct %give gift]~ gall-payload]
|
||||
=/ mo-core (mo-abed:mo duct)
|
||||
?: ?=([%key *] wire)
|
||||
~| [%gall-take-key-failed wire]
|
||||
mo-abet:(mo-handle-key:mo-core t.wire syn)
|
||||
::
|
||||
?: ?=([%nacked-leaves ~] wire)
|
||||
=; core=_mo-core:mo
|
||||
@ -2515,7 +3001,7 @@
|
||||
=< mo-abet
|
||||
%. [t.wire ?:(?=([%behn %heck *] syn) syn.syn syn)]
|
||||
?- i.wire
|
||||
%sys mo-handle-sys:(mo-abed:mo duct)
|
||||
%use mo-handle-use:(mo-abed:mo duct)
|
||||
%sys mo-handle-sys:mo-core
|
||||
%use mo-handle-use:mo-core
|
||||
==
|
||||
--
|
||||
|
||||
@ -395,7 +395,7 @@
|
||||
::
|
||||
?. ?=(%& -.why) ~
|
||||
=* his p.why
|
||||
?: &(?=(%x ren) =(tyl //whey))
|
||||
?: &(?=(%x ren) =(tyl //whey) =([~ ~] lyc))
|
||||
=/ maz=(list mass)
|
||||
:~ nex+&+next-id.state.ax
|
||||
outbound+&+outbound-duct.state.ax
|
||||
|
||||
@ -1065,7 +1065,7 @@
|
||||
::
|
||||
:: XX review for security, stability, cases other than now
|
||||
::
|
||||
?. =(lot [%$ %da now]) ~
|
||||
?. &(=(lot [%$ %da now]) =([~ ~] lyc)) ~
|
||||
::
|
||||
?: &(?=(%x ren) =(tyl //whey))
|
||||
=/ maz=(list mass)
|
||||
|
||||
@ -72,7 +72,7 @@
|
||||
++ get-dais
|
||||
|= [=beak =mark rof=roof]
|
||||
^- dais:clay
|
||||
?~ ret=(rof ~ /khan %cb beak /[mark])
|
||||
?~ ret=(rof [~ ~] /khan %cb beak /[mark])
|
||||
~|(mark-unknown+mark !!)
|
||||
?~ u.ret
|
||||
~|(mark-invalid+mark !!)
|
||||
@ -82,7 +82,7 @@
|
||||
++ get-tube
|
||||
|= [=beak =mark =out=mark rof=roof]
|
||||
^- tube:clay
|
||||
?~ ret=(rof ~ /khan %cc beak /[mark]/[out-mark])
|
||||
?~ ret=(rof [~ ~] /khan %cc beak /[mark]/[out-mark])
|
||||
~|(tube-unknown+[mark out-mark] !!)
|
||||
?~ u.ret
|
||||
~|(tube-invalid+[mark out-mark] !!)
|
||||
|
||||
@ -88,11 +88,12 @@
|
||||
|= [lyc=gang pov=path car=term bem=beam]
|
||||
^- (unit (unit cage))
|
||||
|^
|
||||
:: only respond for the local identity, current timestamp
|
||||
:: only respond for the local identity, current timestamp, root gang
|
||||
::
|
||||
?. ?& =(our p.bem)
|
||||
=(%$ q.bem)
|
||||
=([%da now] r.bem)
|
||||
=([~ ~] lyc)
|
||||
==
|
||||
~
|
||||
?+ car ~
|
||||
|
||||
@ -5256,7 +5256,7 @@
|
||||
|= [rof=roof pov=path our=ship now=@da who=ship]
|
||||
;; ship
|
||||
=< q.q %- need %- need
|
||||
(rof ~ pov %j `beam`[[our %sein %da now] /(scot %p who)])
|
||||
(rof [~ ~] pov %j `beam`[[our %sein %da now] /(scot %p who)])
|
||||
--
|
||||
:: middle core: stateless queries for default numeric sponsorship
|
||||
::
|
||||
|
||||
@ -26,11 +26,13 @@
|
||||
^- (list card:agent:gall)
|
||||
=/ rcvr=ship (lane-to-ship lan)
|
||||
=/ hear-lane (ship-to-lane sndr)
|
||||
=/ [ames=? =packet] (decode-packet pac)
|
||||
?: &(!ames !resp==(& (cut 0 [2 1] pac)))
|
||||
=/ [=peep =purr] (decode-request-info `@ux`(rsh 3^64 content.packet))
|
||||
=/ =shot (sift-shot pac)
|
||||
?: &(!sam.shot req.shot) :: is fine request
|
||||
=/ [%0 =peep] (sift-wail `@ux`content.shot)
|
||||
%+ emit-aqua-events our
|
||||
[%read [rcvr path.peep] [hear-lane num.peep]]~
|
||||
:_ ~
|
||||
:- %read
|
||||
[[[rcvr rcvr-tick.shot] path.peep] [hear-lane sndr-tick.shot] num.peep]
|
||||
%+ emit-aqua-events our
|
||||
[%event rcvr /a/newt/0v1n.2m9vh %hear hear-lane pac]~
|
||||
:: +lane-to-ship: decode a ship from an aqua lane
|
||||
|
||||
@ -14,20 +14,24 @@
|
||||
|= [who=@p way=wire %blit blits=(list blit:dill)]
|
||||
^- (list card:agent:gall)
|
||||
=/ last-line
|
||||
%+ roll blits
|
||||
|= [b=blit:dill line=tape]
|
||||
?- -.b
|
||||
%put (tape p.b)
|
||||
%klr (tape (zing (turn p.b tail)))
|
||||
%nel ~& "{<who>}: {line}" ""
|
||||
%hop line
|
||||
%bel line
|
||||
%clr ""
|
||||
%sag ~& [%save-jamfile-to p.b] line
|
||||
%sav ~& [%save-file-to p.b] line
|
||||
%url ~& [%activate-url p.b] line
|
||||
%wyp ""
|
||||
==
|
||||
|^ (roll blits ha-blit)
|
||||
::
|
||||
++ ha-blit
|
||||
|= [b=blit:dill line=tape]
|
||||
?- -.b
|
||||
%put (tape p.b)
|
||||
%klr (tape (zing (turn p.b tail)))
|
||||
%mor `tape`(roll p.b ha-blit)
|
||||
%nel ~& "{<who>}: {line}" ""
|
||||
%hop line
|
||||
%bel line
|
||||
%clr ""
|
||||
%sag ~& [%save-jamfile-to p.b] line
|
||||
%sav ~& [%save-file-to p.b] line
|
||||
%url ~& [%activate-url p.b] line
|
||||
%wyp ""
|
||||
==
|
||||
--
|
||||
~? !=(~ last-line) last-line
|
||||
~
|
||||
--
|
||||
|
||||
27
pkg/arvo/ted/keen-shut.hoon
Normal file
27
pkg/arvo/ted/keen-shut.hoon
Normal file
@ -0,0 +1,27 @@
|
||||
/- spider
|
||||
/+ strandio
|
||||
=, strand=strand:spider
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
=/ m (strand ,vase)
|
||||
^- form:m
|
||||
=+ !<([~ =spar:ames] arg)
|
||||
;< ~ bind:m
|
||||
(keen-shut:strandio /keen spar)
|
||||
;< [* dat=(unit (unit page))] bind:m
|
||||
(take-near:strandio /keen)
|
||||
?~ dat
|
||||
~& mysterious/~
|
||||
(pure:m !>(~))
|
||||
?~ u.dat
|
||||
~& non-existent/~
|
||||
(pure:m !>(~))
|
||||
::
|
||||
;< =bowl:spider bind:m get-bowl:strandio
|
||||
=+ .^ =dais:clay %cb
|
||||
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.u.dat]
|
||||
==
|
||||
=/ res (mule |.((vale.dais q.u.u.dat)))
|
||||
?. ?=(%| -.res)
|
||||
(pure:m p.res)
|
||||
~|(%keen-mark-fail (mean leaf+"-keen: ames vale fail {<mark>}" p.res))
|
||||
@ -1,67 +0,0 @@
|
||||
/- spider
|
||||
/+ *ph-io
|
||||
=>
|
||||
|%
|
||||
++ wait-for-agent-start
|
||||
|= [=ship agent=term]
|
||||
=/ m (strand:spider ,~)
|
||||
^- form:m
|
||||
=* loop $
|
||||
;< [her=^ship =unix-effect] bind:m take-unix-effect
|
||||
?: (is-dojo-output:util ship her unix-effect "activated app base/{(trip agent)}")
|
||||
(pure:m ~)
|
||||
loop
|
||||
::
|
||||
++ start-agent
|
||||
|= [=ship agent=term]
|
||||
=/ m (strand:spider ,~)
|
||||
^- form:m
|
||||
=* loop $
|
||||
;< ~ bind:m (dojo ship "|start {<agent>}")
|
||||
;< ~ bind:m (wait-for-agent-start ship agent)
|
||||
(pure:m ~)
|
||||
::
|
||||
++ wait-for-goad
|
||||
|= =ship
|
||||
=/ m (strand:spider ,~)
|
||||
^- form:m
|
||||
=* loop $
|
||||
;< [her=^ship =unix-effect] bind:m take-unix-effect
|
||||
?: (is-dojo-output:util ship her unix-effect "p=%hood q=%bump")
|
||||
(pure:m ~)
|
||||
loop
|
||||
::
|
||||
++ start-group-agents
|
||||
|= =ship
|
||||
=/ m (strand:spider ,~)
|
||||
^- form:m
|
||||
;< ~ bind:m (start-agent ship %group-store)
|
||||
(pure:m ~)
|
||||
--
|
||||
=, strand=strand:spider
|
||||
^- thread:spider
|
||||
|= args=vase
|
||||
=/ m (strand ,vase)
|
||||
;< ~ bind:m start-azimuth
|
||||
;< ~ bind:m (spawn ~bud)
|
||||
;< ~ bind:m (spawn ~marbud)
|
||||
;< ~ bind:m (spawn ~zod)
|
||||
;< ~ bind:m (spawn ~marzod)
|
||||
;< ~ bind:m (init-ship ~bud |)
|
||||
;< ~ bind:m (init-ship ~marbud |)
|
||||
;< ~ bind:m (wait-for-goad ~marbud)
|
||||
;< ~ bind:m (init-ship ~zod |)
|
||||
;< ~ bind:m (init-ship ~marzod |)
|
||||
;< ~ bind:m (wait-for-goad ~marzod)
|
||||
;< ~ bind:m (start-group-agents ~marbud)
|
||||
;< ~ bind:m (start-group-agents ~marzod)
|
||||
;< ~ bind:m (dojo ~marbud ":group-store|create 'test-group'")
|
||||
;< ~ bind:m (wait-for-output ~marbud ">=")
|
||||
;< ~ bind:m (sleep ~s1)
|
||||
;< ~ bind:m (breach-and-hear ~marzod ~marbud)
|
||||
;< ~ bind:m (init-ship ~marzod |)
|
||||
;< ~ bind:m (wait-for-goad ~marzod)
|
||||
;< ~ bind:m (start-group-agents ~marzod)
|
||||
;< ~ bind:m (sleep ~s3)
|
||||
;< ~ bind:m end
|
||||
(pure:m *vase)
|
||||
@ -7,7 +7,7 @@
|
||||
;< ~ bind:m start-simple
|
||||
;< ~ bind:m (init-ship ~bud &)
|
||||
;< ~ bind:m (init-ship ~dev &)
|
||||
;< ~ bind:m (dojo ~bud "-keen /cx/~dev/kids/1/desk/bill")
|
||||
;< ~ bind:m (wait-for-output ~bud "[ ~")
|
||||
;< ~ bind:m (dojo ~bud "-keen ~dev /c/x/1/kids/sys/kelvin")
|
||||
;< ~ bind:m (wait-for-output ~bud "kal=[lal=%zuse num={(scow %ud zuse)}]")
|
||||
;< ~ bind:m end
|
||||
(pure:m *vase)
|
||||
|
||||
@ -1,66 +0,0 @@
|
||||
/- spider
|
||||
/+ io=ph-io, *strandio
|
||||
=>
|
||||
=, io
|
||||
|%
|
||||
++ strand strand:spider
|
||||
++ start-agents
|
||||
|= =ship
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m (dojo ship "|start %graph-store")
|
||||
;< ~ bind:m (dojo ship "|start %graph-push-hook")
|
||||
;< ~ bind:m (dojo ship "|start %graph-pull-hook")
|
||||
;< ~ bind:m (dojo ship "|start %group-store")
|
||||
;< ~ bind:m (dojo ship "|start %group-push-hook")
|
||||
;< ~ bind:m (dojo ship "|start %group-pull-hook")
|
||||
;< ~ bind:m (dojo ship "|start %metadata-store")
|
||||
;< ~ bind:m (dojo ship "|start %metadata-hook")
|
||||
;< ~ bind:m (sleep `@dr`300)
|
||||
(pure:m ~)
|
||||
::
|
||||
++ make-link
|
||||
|= [title=@t url=@t]
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m (dojo ~bud ":graph-store|add-post [~bud %test] ~[[%text '{(trip title)}'] [%url '{(trip url)}']]")
|
||||
(pure:m ~)
|
||||
--
|
||||
|
||||
^- thread:spider
|
||||
|= vase
|
||||
=/ m (strand ,vase)
|
||||
;< ~ bind:m start-azimuth
|
||||
;< ~ bind:m (spawn ~bud)
|
||||
;< ~ bind:m (spawn ~dev)
|
||||
;< ~ bind:m (init-ship ~bud |)
|
||||
;< ~ bind:m (init-ship ~dev |)
|
||||
;< ~ bind:m (start-agents ~bud)
|
||||
;< ~ bind:m (start-agents ~dev)
|
||||
;< ~ bind:m (send-hi ~bud ~dev)
|
||||
;< ~ bind:m (dojo ~bud "-graph-create [%create [~bud %test] 'test' '' `%graph-validator-link [%policy [%open ~ ~]] 'link']")
|
||||
;< ~ bind:m (sleep ~s5)
|
||||
;< ~ bind:m (dojo ~dev "-graph-join [%join [~bud %test] ~bud]")
|
||||
;< ~ bind:m (sleep ~s5)
|
||||
;< ~ bind:m (send-hi ~bud ~dev)
|
||||
;< ~ bind:m (poke-our %aqua noun+!>([%pause-events ~[~dev]]))
|
||||
;< ~ bind:m (make-link 'one' 'one')
|
||||
;< ~ bind:m (make-link 'two' 'one')
|
||||
;< ~ bind:m (make-link 'thre' 'one')
|
||||
;< ~ bind:m (make-link 'four' 'one')
|
||||
;< ~ bind:m (make-link 'five' 'one')
|
||||
;< ~ bind:m (make-link 'six' 'one')
|
||||
;< ~ bind:m (make-link 'seven' 'one')
|
||||
;< ~ bind:m (sleep ~s40)
|
||||
:: five unacked events is sufficent to cause a clog, and by extension a
|
||||
:: %kick
|
||||
;< ~ bind:m (poke-our %aqua noun+!>([%unpause-events ~[~dev]]))
|
||||
;< ~ bind:m (sleep ~s10)
|
||||
;< ~ bind:m (make-link 'eight' 'one')
|
||||
;< ~ bind:m (make-link 'nine' 'one')
|
||||
;< ~ bind:m (sleep ~s10)
|
||||
;< ~ bind:m (dojo ~dev ":graph-pull-hook +dbug %bowl")
|
||||
;< ~ bind:m (dojo ~dev ":graph-store +dbug")
|
||||
;< ~ bind:m (dojo ~bud ":graph-push-hook +dbug %bowl")
|
||||
;< ~ bind:m (dojo ~bud ":graph-store +dbug")
|
||||
;< ~ bind:m end
|
||||
(pure:m *vase)
|
||||
::(pure:m *vase)
|
||||
70
pkg/arvo/ted/ph/tend.hoon
Normal file
70
pkg/arvo/ted/ph/tend.hoon
Normal file
@ -0,0 +1,70 @@
|
||||
/- spider
|
||||
/+ *ph-io, strandio
|
||||
/* tend-agent %hoon /tests/app/tend/hoon
|
||||
=, strand=strand:spider
|
||||
=< all
|
||||
|%
|
||||
++ tend
|
||||
|= zuse=@ud
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m (dojo ~bud ":tend [%tend /foo /baz %kelvin %zuse {(scow %ud zuse)}]")
|
||||
;< ~ bind:m (sleep:strandio ~s2)
|
||||
;< ~ bind:m (dojo ~bud ":tend +dbug %bowl")
|
||||
(pure:m ~)
|
||||
::
|
||||
++ keen-wait-for-result
|
||||
|= [cas=@ud zuse=@ud]
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m (dojo ~dev ":tend [%keen ~bud {(scow %ud cas)} /tend//foo/baz]")
|
||||
;< ~ bind:m (wait-for-output ~dev "kal=[lal=%zuse num={(scow %ud zuse)}]")
|
||||
(pure:m ~)
|
||||
::
|
||||
++ setup
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m start-simple
|
||||
:: testing usual case
|
||||
;< ~ bind:m (init-ship ~bud &)
|
||||
;< ~ bind:m (init-ship ~dev &)
|
||||
;< ~ bind:m (dojo ~bud "|mount %base")
|
||||
;< ~ bind:m (dojo ~dev "|mount %base")
|
||||
;< ~ bind:m (copy-file ~bud /app/tend/hoon tend-agent)
|
||||
;< ~ bind:m (copy-file ~dev /app/tend/hoon tend-agent)
|
||||
;< ~ bind:m (dojo ~bud "|start %tend")
|
||||
;< ~ bind:m (dojo ~dev "|start %tend")
|
||||
(pure:m ~)
|
||||
::
|
||||
++ all
|
||||
^- thread:spider
|
||||
|= vase
|
||||
=/ m (strand ,vase)
|
||||
;< ~ bind:m test-normal
|
||||
;< ~ bind:m test-larval-ames
|
||||
(pure:m *vase)
|
||||
::
|
||||
++ test-larval-ames
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m setup
|
||||
;< ~ bind:m (dojo ~bud ":tend [%germ /foo]")
|
||||
;< ~ bind:m (sleep:strandio ~s2)
|
||||
;< ~ bind:m (tend zuse)
|
||||
;< ~ bind:m (keen-wait-for-result 0 zuse)
|
||||
=/ zuse (dec zuse)
|
||||
;< ~ bind:m (tend zuse)
|
||||
;< ~ bind:m (keen-wait-for-result 1 zuse)
|
||||
;< ~ bind:m end
|
||||
(pure:m ~)
|
||||
::
|
||||
++ test-normal
|
||||
=/ m (strand ,~)
|
||||
;< ~ bind:m setup
|
||||
;< ~ bind:m (send-hi ~bud ~dev) :: make sure both ames have metamorphosed
|
||||
;< ~ bind:m (dojo ~bud ":tend [%germ /foo]")
|
||||
;< ~ bind:m (sleep:strandio ~s2)
|
||||
;< ~ bind:m (tend zuse)
|
||||
;< ~ bind:m (keen-wait-for-result 0 zuse)
|
||||
=/ zuse (dec zuse)
|
||||
;< ~ bind:m (tend zuse)
|
||||
;< ~ bind:m (keen-wait-for-result 1 zuse)
|
||||
;< ~ bind:m end
|
||||
(pure:m ~)
|
||||
--
|
||||
@ -7,42 +7,52 @@
|
||||
:: $test-arm: test with name (derived from its arm name in a test core)
|
||||
:: $test-func: single test, as gate; sample is entropy, produces failures
|
||||
::
|
||||
+$ test [=path func=test-func]
|
||||
+$ test [=beam func=test-func]
|
||||
+$ test-arm [name=term func=test-func]
|
||||
+$ test-func (trap tang)
|
||||
+$ args quiet=_&
|
||||
--
|
||||
=>
|
||||
|%
|
||||
:: +run-test: execute an individual test
|
||||
|_ =args
|
||||
++ build-file
|
||||
|= =beam
|
||||
=/ m (strand ,[(unit vase) tang])
|
||||
^- form:m
|
||||
;< res=(unit vase) bind:m
|
||||
(build-file:strandio beam)
|
||||
%+ pure:m res
|
||||
?. =(res ~)
|
||||
~
|
||||
~[leaf+"FAILED"]
|
||||
:: +run-test: execute an individual test
|
||||
::
|
||||
++ run-test
|
||||
|= [pax=path test=test-func]
|
||||
|= [bem=beam test=test-func]
|
||||
^- [ok=? =tang]
|
||||
=+ name=(spud pax)
|
||||
=+ run=(mule test)
|
||||
?- -.run
|
||||
%| |+(welp p.run leaf+"CRASHED {name}" ~)
|
||||
%| |+p.run
|
||||
%& ?: =(~ p.run)
|
||||
&+[leaf+"OK {name}"]~
|
||||
|+(flop `tang`[leaf+"FAILED {name}" p.run])
|
||||
&+~
|
||||
|+(flop `tang`[leaf+"FAILED" p.run])
|
||||
==
|
||||
:: +resolve-test-paths: add test names to file paths to form full identifiers
|
||||
::
|
||||
++ resolve-test-paths
|
||||
|= paths-to-tests=(map path (list test-arm))
|
||||
|= paths-to-tests=(map beam (list test-arm))
|
||||
^- (list test)
|
||||
%- sort :_ |=([a=test b=test] !(aor path.a path.b))
|
||||
%- sort :_ |=([a=test b=test] !(aor s.beam.a s.beam.b))
|
||||
^- (list test)
|
||||
%- zing
|
||||
%+ turn ~(tap by paths-to-tests)
|
||||
|= [=path test-arms=(list test-arm)]
|
||||
|= [=beam test-arms=(list test-arm)]
|
||||
^- (list test)
|
||||
:: for each test, add the test's name to :path
|
||||
::
|
||||
%+ turn test-arms
|
||||
|= =test-arm
|
||||
^- test
|
||||
[(weld path /[name.test-arm]) func.test-arm]
|
||||
[beam(s (weld s.beam /[name.test-arm])) func.test-arm]
|
||||
:: +get-test-arms: convert test arms to functions and produce them
|
||||
::
|
||||
++ get-test-arms
|
||||
@ -55,7 +65,7 @@
|
||||
=/ fire-arm=nock
|
||||
~| [%failed-to-compile-test-arm name]
|
||||
q:(~(mint ut typ) p:!>(*tang) [%limb name])
|
||||
[name |.(;;(tang ~>(%bout.[1 name] .*(cor fire-arm))))]
|
||||
[name |.(;;(tang ?:(quiet.args .*(cor fire-arm) ~>(%bout.[1 name] .*(cor fire-arm)))))]
|
||||
:: +has-test-prefix: does the arm define a test we should run?
|
||||
::
|
||||
++ has-test-prefix
|
||||
@ -92,6 +102,15 @@
|
||||
?. hov
|
||||
~|(no-tests-at-path+i.bez !!)
|
||||
loop(bez t.bez, fiz (~(put in fiz) [[-.i.bez (snoc xup %hoon)] `tex]))
|
||||
++ print-failures
|
||||
|= ls=(list [=beam =tang])
|
||||
^+ same
|
||||
?~ ls
|
||||
same
|
||||
=/ =tank
|
||||
[%rose ["\0a" "/={(trip q.beam.i.ls)}={(spud s.beam.i.ls)}:\0a" ""] tang.i.ls]
|
||||
~> %slog.[3 tank]
|
||||
$(ls t.ls)
|
||||
--
|
||||
^- thread:spider
|
||||
|= arg=vase
|
||||
@ -112,28 +131,33 @@
|
||||
(turn paz |=(p=path ~|([%test-not-beam p] (need (de-beam p)))))
|
||||
;< fiz=(set [=beam test=(unit term)]) bind:m (find-test-files bez)
|
||||
=> .(fiz (sort ~(tap in fiz) aor))
|
||||
=| test-arms=(map path (list test-arm))
|
||||
=| build-ok=?
|
||||
=| test-arms=(map beam (list test-arm))
|
||||
=| build-failed=(list [beam tang])
|
||||
|- ^- form:m
|
||||
=* gather-tests $
|
||||
?^ fiz
|
||||
;< cor=(unit vase) bind:m (build-file:strandio beam.i.fiz)
|
||||
;< [cor=(unit vase) =tang] bind:m (build-file beam.i.fiz)
|
||||
?~ cor
|
||||
~> %slog.0^leaf+"FAILED {(spud s.beam.i.fiz)} (build)"
|
||||
gather-tests(fiz t.fiz, build-ok |)
|
||||
~> %slog.0^leaf+"built {(spud s.beam.i.fiz)}"
|
||||
gather-tests(fiz t.fiz, build-failed [[beam.i.fiz tang] build-failed])
|
||||
=/ arms=(list test-arm) (get-test-arms u.cor)
|
||||
:: if test path specified an arm prefix, filter arms to match
|
||||
=? arms ?=(^ test.i.fiz)
|
||||
%+ skim arms
|
||||
|= test-arm
|
||||
=((end [3 (met 3 u.test.i.fiz)] name) u.test.i.fiz)
|
||||
=. test-arms (~(put by test-arms) (snip s.beam.i.fiz) arms)
|
||||
=. test-arms (~(put by test-arms) beam.i.fiz(s (snip s.beam.i.fiz)) arms)
|
||||
gather-tests(fiz t.fiz)
|
||||
%- pure:m !> ^= ok
|
||||
=; res=_build-failed
|
||||
%- (print-failures res)
|
||||
%- pure:m !> ^= failed
|
||||
%+ turn res
|
||||
|= [=beam *]
|
||||
beam
|
||||
%+ roll (resolve-test-paths test-arms)
|
||||
|= [[=path =test-func] ok=_build-ok]
|
||||
^+ ok
|
||||
=/ res (run-test path test-func)
|
||||
%- (slog (flop tang.res))
|
||||
&(ok ok.res)
|
||||
|= [[=beam =test-func] failed=_build-failed]
|
||||
^+ failed
|
||||
=/ res (run-test beam test-func)
|
||||
?: -.res
|
||||
failed
|
||||
:_ failed
|
||||
[beam +.res]
|
||||
|
||||
@ -256,6 +256,14 @@
|
||||
;< ~ bind:m (send-events (insert-files:util her desk [pax warped] ~))
|
||||
(pure:m warped)
|
||||
::
|
||||
++ copy-file
|
||||
=/ m (strand ,~)
|
||||
|= [her=ship pax=path file=@t]
|
||||
^- form:m
|
||||
;< ~ bind:m
|
||||
(send-events (insert-files:util her %base [pax file] ~))
|
||||
(sleep ~s1)
|
||||
::
|
||||
:: Check /sur/aquarium/hoon on the given has the given contents.
|
||||
::
|
||||
++ check-file-touched
|
||||
|
||||
@ -62,15 +62,26 @@
|
||||
::TODO should be rename -dill-output
|
||||
++ is-dojo-output
|
||||
|= [who=ship her=ship uf=unix-effect what=tape]
|
||||
|^
|
||||
?& =(who her)
|
||||
?=(%blit -.q.uf)
|
||||
::
|
||||
%+ lien p.q.uf
|
||||
|= =blit:dill
|
||||
?. ?=(%put -.blit)
|
||||
|
|
||||
!=(~ (find what p.blit))
|
||||
(lien p.q.uf handle-blit)
|
||||
==
|
||||
::
|
||||
++ handle-blit
|
||||
|= =blit:dill
|
||||
^- ?
|
||||
?: ?=(%mor -.blit)
|
||||
(lien p.blit handle-blit)
|
||||
?+ -.blit |
|
||||
%put !=(~ (find what p.blit))
|
||||
::
|
||||
%klr
|
||||
%+ lien p.blit
|
||||
|= [* q=(list @c)]
|
||||
!=(~ (find what q))
|
||||
==
|
||||
--
|
||||
::
|
||||
:: Test is successful if +is-dojo-output
|
||||
::
|
||||
|
||||
@ -197,6 +197,20 @@
|
||||
`[%done +>.sign-arvo.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ take-near
|
||||
|= =wire
|
||||
=/ m (strand ,[spar:ames (unit (unit page))])
|
||||
^- form:m
|
||||
|= tin=strand-input:strand
|
||||
?+ in.tin `[%skip ~]
|
||||
~ `[%wait ~]
|
||||
::
|
||||
[~ %sign * %ames %near ^ *]
|
||||
?. =(wire wire.u.in.tin)
|
||||
`[%skip ~]
|
||||
`[%done +>.sign-arvo.u.in.tin]
|
||||
==
|
||||
::
|
||||
++ take-poke-ack
|
||||
|= =wire
|
||||
=/ m (strand ,~)
|
||||
@ -335,7 +349,13 @@
|
||||
|= [=wire =spar:ames]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(send-raw-card %pass wire %arvo %a %keen spar)
|
||||
(send-raw-card %pass wire %arvo %a %keen ~ spar)
|
||||
::
|
||||
++ keen-shut
|
||||
|= [=wire =spar:ames]
|
||||
=/ m (strand ,~)
|
||||
^- form:m
|
||||
(send-raw-card %pass wire %keen & spar)
|
||||
::
|
||||
++ sleep
|
||||
|= for=@dr
|
||||
|
||||
@ -41,7 +41,7 @@
|
||||
[%pause-events who=ship]
|
||||
[%snap-ships lab=term hers=(list ship)]
|
||||
[%restore-snap lab=term]
|
||||
[%read [from=ship =path] [for=lane:ames num=@ud]]
|
||||
[%read [from=[=ship life=@ubC] =path] for=[=lane:ames life=@ubC] num=@ud]
|
||||
[%event who=ship ue=unix-event]
|
||||
==
|
||||
::
|
||||
@ -82,5 +82,10 @@
|
||||
[%kill ~]
|
||||
[%init ~]
|
||||
[%request id=@ud request=request:http]
|
||||
[%turf p=(list turf)]
|
||||
:: XX effects seen after running :aqua [%swap-files ~]
|
||||
[%vega ~]
|
||||
[%set-config =http-config:eyre]
|
||||
[%sessions p=(set @t)]
|
||||
==
|
||||
--
|
||||
|
||||
74
tests/app/tend.hoon
Normal file
74
tests/app/tend.hoon
Normal file
@ -0,0 +1,74 @@
|
||||
/+ verb, default-agent, dbug
|
||||
|%
|
||||
+$ state-0 [%0 ~]
|
||||
+$ card card:agent:gall
|
||||
+$ coop coop:gall
|
||||
+$ action
|
||||
$% [%tend =coop =path =page]
|
||||
[%germ =coop]
|
||||
[%snip =coop]
|
||||
[%keen =ship case=@ud =path]
|
||||
==
|
||||
--
|
||||
::
|
||||
=| state-0
|
||||
=* state -
|
||||
%+ verb |
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card:agent:gall _this)
|
||||
[~ this]
|
||||
::
|
||||
++ on-save !>([%0 ~])
|
||||
++ on-load
|
||||
|= old=vase
|
||||
^- (quip card:agent:gall _this)
|
||||
[~ this(state [%0 ~])]
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
~| mark/mark
|
||||
?> =(%noun mark)
|
||||
=+ ;;(=action q.vase)
|
||||
:_ this
|
||||
?: ?=(%keen -.action)
|
||||
=/ =path
|
||||
%+ welp /g/x/(scot %ud case.action)/[dap.bowl]//1
|
||||
path.action
|
||||
[%pass /keen %keen & ship.action path]~
|
||||
[%pass /foo action]~
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
~& peek-path/path
|
||||
~& eny/eny.bowl
|
||||
?. ?=([%c *] path)
|
||||
[~ ~]
|
||||
``noun+!>(&)
|
||||
++ on-watch on-watch:def
|
||||
++ on-arvo
|
||||
|= [=wire syn=sign-arvo]
|
||||
^- (quip card _this)
|
||||
?: =(/keen wire)
|
||||
?: ?=([%ames %near *] syn)
|
||||
?. ?=([~ ~ *] dat.syn)
|
||||
~& no-item/dat.syn
|
||||
`this
|
||||
=/ =path /(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[p.u.u.dat.syn]
|
||||
=+ .^ =dais:clay %cb
|
||||
path
|
||||
==
|
||||
:_ this
|
||||
[%pass /flog %arvo %d %flog %text (noah ;;(vale.dais q.u.u.dat.syn))]~
|
||||
`this
|
||||
`this
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
@ -3,6 +3,7 @@
|
||||
/+ *test, v=test-ames-gall
|
||||
/* kelvin %hoon /sys/kelvin
|
||||
=> |%
|
||||
++ dbug `?`|
|
||||
++ kelvin-roof
|
||||
^- roof
|
||||
::
|
||||
@ -55,7 +56,7 @@
|
||||
=/ fine-behn-wire=wire (weld /fine/behn/wake/~bud scry-path)
|
||||
=/ future-path=path /c/x/5/kids/sys/kelvin
|
||||
=/ future-behn=wire (weld /fine/behn/wake/~bud future-path)
|
||||
=/ =task:ames [%keen ~bud scry-path]
|
||||
=/ =task:ames [%keen ~ ~bud scry-path]
|
||||
::
|
||||
=/ request=shot:ames
|
||||
:* [sndr=~nec rcvr=~bud]
|
||||
@ -65,7 +66,7 @@
|
||||
origin=~
|
||||
content=(etch-request-content ~nec (weld /~bud/1/1 scry-path) 1)
|
||||
==
|
||||
~& > 'poke requester %ames with a %keen task'
|
||||
~? > dbug 'poke requester %ames with a %keen task'
|
||||
=^ t1 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
@ -76,7 +77,7 @@
|
||||
==
|
||||
==
|
||||
::
|
||||
~& > 'poke requester %ames with a second %keen task'
|
||||
~? > dbug 'poke requester %ames with a second %keen task'
|
||||
:- t1 |. :- %|
|
||||
=^ t2 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
@ -92,14 +93,14 @@
|
||||
?~ keen=(~(get by keens.peer) scry-path)
|
||||
~
|
||||
listeners:u.keen
|
||||
~& > 'checks two listeners for the requested scry path'
|
||||
~? > dbug 'checks two listeners for the requested scry path'
|
||||
=/ t3=tang
|
||||
%+ expect-eq
|
||||
!>((sy ~[~[/keen-duct-1] ~[/keen-duct-2]]))
|
||||
!>(listeners)
|
||||
::
|
||||
:- t3 |. :- %|
|
||||
~& > 'gives a remote scry response to listeners'
|
||||
~? > dbug 'gives a remote scry response to listeners'
|
||||
=/ [sig=@ux meows=(list @ux)]
|
||||
%: ames-scry-hunk:v ames.bud
|
||||
[~1111.1.2 0xbeef.dead kelvin-roof]
|
||||
@ -143,18 +144,18 @@
|
||||
origin=~
|
||||
content=(etch-request-content ~nec (weld /~bud/1/1 future-path) 1)
|
||||
==
|
||||
~& > 'poke requester %ames with a %keen task for a future case'
|
||||
~? > dbug 'poke requester %ames with a %keen task for a future case'
|
||||
=^ t5 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-3] %keen ~bud future-path]
|
||||
[~[/keen-duct-3] %keen ~ ~bud future-path]
|
||||
:~ [~[//unix] [%give %send [%& ~bud] (etch-shot:ames request)]]
|
||||
[~[//unix] %pass future-behn %b %wait ~1111.1.1..00.00.01]
|
||||
==
|
||||
==
|
||||
::
|
||||
:- t5 |. :- %|
|
||||
~& > 'cancel %keen task, from requester'
|
||||
~? > dbug 'cancel %keen task, from requester'
|
||||
=^ t6 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
@ -163,26 +164,26 @@
|
||||
==
|
||||
::
|
||||
:- t6 |. :- %|
|
||||
~& > 'poke requester %ames with a new %keen task for a future case'
|
||||
~? > dbug 'poke requester %ames with a new %keen task for a future case'
|
||||
=^ t7 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-4] %keen ~bud future-path]
|
||||
[~[/keen-duct-4] %keen ~ ~bud future-path]
|
||||
:~ [~[//unix] [%give %send [%& ~bud] (etch-shot:ames request)]]
|
||||
[~[//unix] %pass future-behn %b %wait ~1111.1.1..00.00.01]
|
||||
==
|
||||
==
|
||||
::
|
||||
:- t7 |. :- %|
|
||||
~& > 'poke requester %ames with a second %keen task for a future case'
|
||||
~? > dbug 'poke requester %ames with a second %keen task for a future case'
|
||||
=^ t8 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
[~[/keen-duct-5] %keen ~bud future-path]
|
||||
[~[/keen-duct-5] %keen ~ ~bud future-path]
|
||||
~
|
||||
==
|
||||
:- t8 |. :- %|
|
||||
~& > 'cancel scry for all listeners (%wham)'
|
||||
~? > dbug 'cancel scry for all listeners (%wham)'
|
||||
=^ t9 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
@ -199,7 +200,7 @@
|
||||
?~ keen=(~(get by keens.peer) scry-path)
|
||||
~
|
||||
listeners:u.keen
|
||||
~& > 'checks no more listeners'
|
||||
~? > dbug 'checks no more listeners'
|
||||
(expect-eq !>(~) !>(listeners))
|
||||
::
|
||||
++ test-fine-misordered
|
||||
@ -213,7 +214,7 @@
|
||||
:: (ames-call:v ames.bud ~[/none] [%spew ~[%msg %snd %rcv %odd]] *roof)
|
||||
=/ scry-path=path /g/x/0/dap//some/data/atom
|
||||
=/ fine-behn-wire=wire (weld /fine/behn/wake/~bud scry-path)
|
||||
=/ =task:ames [%keen ~bud scry-path]
|
||||
=/ =task:ames [%keen ~ ~bud scry-path]
|
||||
::
|
||||
=/ requests=(list shot:ames)
|
||||
%+ turn (gulf 1 3)
|
||||
@ -229,7 +230,7 @@
|
||||
=+ ^= [req1 req2 req3]
|
||||
?> ?=([^ ^ ^ *] requests)
|
||||
[i i.t i.t.t]:requests
|
||||
~& > 'poke requester %ames with a %keen task'
|
||||
~? > dbug 'poke requester %ames with a %keen task'
|
||||
=^ t1 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
@ -265,7 +266,7 @@
|
||||
[[~bud [1 sig]] ~ ~]
|
||||
::
|
||||
:- t1 |. :- %|
|
||||
~& > 'hear first response fragment'
|
||||
~? > dbug 'hear first response fragment'
|
||||
=^ t2 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.2 0xbeef.dead *roof]
|
||||
@ -282,7 +283,7 @@
|
||||
==
|
||||
::
|
||||
:- t2 |. :- %|
|
||||
~& > 'hear third response fragment'
|
||||
~? > dbug 'hear third response fragment'
|
||||
=^ t3 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.2 0xbeef.dead *roof]
|
||||
@ -294,7 +295,7 @@
|
||||
~
|
||||
==
|
||||
:- t3 |. :- %&
|
||||
~& > 'hear second response fragment'
|
||||
~? > dbug 'hear second response fragment'
|
||||
=^ t4 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.3 0xbeef.dead *roof]
|
||||
|
||||
@ -2,6 +2,7 @@
|
||||
::
|
||||
/+ *test, v=test-ames-gall
|
||||
|%
|
||||
++ dbug `?`|
|
||||
++ test-watch
|
||||
%- run-chain
|
||||
|. :- %|
|
||||
@ -12,7 +13,7 @@
|
||||
::=^ * ames.bud
|
||||
:: (ames-call:v ames.bud ~[/none] [%spew ~[%msg %snd %rcv %odd]] *roof)
|
||||
:: poke %sub to tell it to subscribe
|
||||
~& > 'poke %sub to tell it to subscribe'
|
||||
~? > dbug 'poke %sub to tell it to subscribe'
|
||||
=/ =task:gall [%deal [~nec ~nec /] %sub %poke watch+!>(~bud)]
|
||||
=^ t1 gall.nec
|
||||
%: gall-check-call:v gall.nec
|
||||
@ -26,7 +27,7 @@
|
||||
==
|
||||
:- t1 |. :- %|
|
||||
:: handle gall passing the %watch to itself, which passes to ames
|
||||
~& > 'handle gall passing the %watch to itself, which passes to ames'
|
||||
~? > dbug 'handle gall passing the %watch to itself, which passes to ames'
|
||||
=^ t2 gall.nec
|
||||
%: gall-check-call:v gall.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
@ -40,7 +41,7 @@
|
||||
==
|
||||
:- t2 |. :- %|
|
||||
:: subscriber ames handles %plea from gall, gives a packet to vere
|
||||
~& > 'subscriber ames handles %plea from gall, gives a packet to vere'
|
||||
~? > dbug 'subscriber ames handles %plea from gall, gives a packet to vere'
|
||||
=^ t3 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.1 0xdead.beef *roof]
|
||||
@ -60,7 +61,7 @@
|
||||
==
|
||||
:- t3 |. :- %|
|
||||
:: publisher ames hears %watch, passes to gall
|
||||
~& > 'publisher ames hears %watch, passes to gall'
|
||||
~? > dbug 'publisher ames hears %watch, passes to gall'
|
||||
=^ t4 ames.bud
|
||||
%: ames-check-call:v ames.bud
|
||||
[~1111.1.2 0xbeef.dead *roof]
|
||||
@ -77,7 +78,7 @@
|
||||
==
|
||||
:- t4 |. :- %|
|
||||
:: publisher gall hears %watch from ames, passes to itself
|
||||
~& > 'publisher gall hears %watch from ames, passes to itself'
|
||||
~? > dbug 'publisher gall hears %watch from ames, passes to itself'
|
||||
=^ t5 gall.bud
|
||||
%: gall-check-call:v gall.bud
|
||||
[~1111.1.2 0xbeef.dead *roof]
|
||||
@ -91,7 +92,7 @@
|
||||
==
|
||||
:- t5 |. :- %|
|
||||
:: publisher gall runs %pub with %watch, gives ack to itself
|
||||
~& > 'publisher gall runs %pub with %watch, gives ack to itself'
|
||||
~? > dbug 'publisher gall runs %pub with %watch, gives ack to itself'
|
||||
=^ t6 gall.bud
|
||||
%: gall-check-call:v gall.bud
|
||||
[~1111.1.2 0xbeef.dead *roof]
|
||||
@ -103,7 +104,7 @@
|
||||
==
|
||||
:- t6 |. :- %|
|
||||
:: gall gives ack to ames
|
||||
~& > 'gall gives ack to ames'
|
||||
~? > dbug 'gall gives ack to ames'
|
||||
=^ t7 gall.bud
|
||||
%: gall-check-take:v gall.bud
|
||||
[~1111.1.2 0xbeef.dead *roof]
|
||||
@ -114,7 +115,7 @@
|
||||
==
|
||||
:- t7 |. :- %|
|
||||
:: publisher ames hears ack from gall, sends over the network
|
||||
~& > 'publisher ames hears ack from gall, sends over the network'
|
||||
~? > dbug 'publisher ames hears ack from gall, sends over the network'
|
||||
=^ t8 ames.bud
|
||||
%: ames-check-take:v ames.bud
|
||||
[~1111.1.2 0xbeef.dead *roof]
|
||||
@ -128,7 +129,7 @@
|
||||
==
|
||||
:- t8 |. :- %|
|
||||
:: subscriber ames hears watch-ack packet, gives to gall
|
||||
~& > 'subscriber ames hears watch-ack packet, gives to gall'
|
||||
~? > dbug 'subscriber ames hears watch-ack packet, gives to gall'
|
||||
=^ t9 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.3 0xdead.beef *roof]
|
||||
@ -148,7 +149,7 @@
|
||||
==
|
||||
:- t9 |. :- %|
|
||||
:: gall gives %done to itself
|
||||
~& > 'gall gives %done to itself'
|
||||
~? > dbug 'gall gives %done to itself'
|
||||
=^ t10 gall.nec
|
||||
%: gall-check-take:v gall.nec
|
||||
[~1111.1.3 0xdead.beef *roof]
|
||||
@ -161,7 +162,7 @@
|
||||
==
|
||||
:- t10 |. :- %|
|
||||
:: gall gives watch-ack to itself
|
||||
~& > 'gall gives watch-ack to itself'
|
||||
~? > dbug 'gall gives watch-ack to itself'
|
||||
=^ t11 gall.nec
|
||||
%: gall-check-take:v gall.nec
|
||||
[~1111.1.3 0xdead.beef *roof]
|
||||
@ -172,7 +173,7 @@
|
||||
==
|
||||
:- t11 |. :- %|
|
||||
:: start the clog and kick process; give clog to publisher gall
|
||||
~& > 'start the clog and kick process; give clog to publisher gall'
|
||||
~? > dbug 'start the clog and kick process; give clog to publisher gall'
|
||||
=^ t12 gall.bud
|
||||
%: gall-check-take:v gall.bud
|
||||
[~1111.1.4 0xbeef.dead *roof]
|
||||
@ -184,7 +185,7 @@
|
||||
==
|
||||
:- t12 |. :- %|
|
||||
:: gall gives %kick %boon to ames
|
||||
~& > 'gall gives %kick %boon to ames'
|
||||
~? > dbug 'gall gives %kick %boon to ames'
|
||||
=^ t13 gall.bud
|
||||
%: gall-check-take:v gall.bud
|
||||
[~1111.1.4 0xbeef.dead *roof]
|
||||
@ -195,7 +196,7 @@
|
||||
==
|
||||
:- t13 |. :- %|
|
||||
:: ames gives kick over the network
|
||||
~& > 'ames gives kick over the network'
|
||||
~? > dbug 'ames gives kick over the network'
|
||||
=^ t14 ames.bud
|
||||
%: ames-check-take:v ames.bud
|
||||
[~1111.1.4 0xbeef.dead *roof]
|
||||
@ -211,7 +212,7 @@
|
||||
==
|
||||
:- t14 |. :- %|
|
||||
:: subscriber ames receives kick, gives to gall and gives ack to unix
|
||||
~& > 'subscriber ames receives kick, gives to gall and gives ack to unix'
|
||||
~? > dbug 'subscriber ames receives kick, gives to gall and gives ack to unix'
|
||||
=^ t15 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.5 0xdead.beef *roof]
|
||||
@ -233,7 +234,7 @@
|
||||
==
|
||||
:- t15 |. :- %|
|
||||
:: subscriber gall receives kick %boon from ames, gives to self
|
||||
~& > 'subscriber gall receives kick %boon from ames, gives to self'
|
||||
~? > dbug 'subscriber gall receives kick %boon from ames, gives to self'
|
||||
=^ t16 gall.nec
|
||||
%: gall-check-take:v gall.nec
|
||||
[~1111.1.5 0xdead.beef *roof]
|
||||
@ -247,7 +248,7 @@
|
||||
==
|
||||
==
|
||||
:: subscriber gall receives %kick from itself
|
||||
~& > 'subscriber gall receives %kick from itself'
|
||||
~? > dbug 'subscriber gall receives %kick from itself'
|
||||
=^ t17 gall.nec
|
||||
%: gall-check-take:v gall.nec
|
||||
[~1111.1.5 0xdead.beef *roof]
|
||||
@ -261,7 +262,7 @@
|
||||
==
|
||||
:- t17 |. :- %|
|
||||
:: gall receives %deal %watch from itself, passes to ames
|
||||
~& > 'gall receives %deal %watch from itself, passes to ames'
|
||||
~? > dbug 'gall receives %deal %watch from itself, passes to ames'
|
||||
=^ t18 gall.nec
|
||||
%: gall-check-call:v gall.nec
|
||||
[~1111.1.5 0xdead.beef *roof]
|
||||
@ -273,7 +274,7 @@
|
||||
==
|
||||
:- t18 |. :- %|
|
||||
:: subscriber ames sends new %watch
|
||||
~& > 'subscriber ames sends new %watch'
|
||||
~? > dbug 'subscriber ames sends new %watch'
|
||||
=^ t19 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.5 0xdead.beef *roof]
|
||||
@ -292,7 +293,7 @@
|
||||
==
|
||||
:- t19 |. :- %|
|
||||
:: subscriber ames sends %cork
|
||||
~& > 'subscriber ames sends %cork'
|
||||
~? > dbug 'subscriber ames sends %cork'
|
||||
=^ t20 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
[~1111.1.5 0xdead.beef *roof]
|
||||
@ -310,7 +311,7 @@
|
||||
==
|
||||
==
|
||||
:: publisher ames hears %kick ack
|
||||
~& > 'publisher ames hears %kick ack'
|
||||
~? > dbug 'publisher ames hears %kick ack'
|
||||
:- t20 |. :- %|
|
||||
=^ t21 ames.bud
|
||||
%: ames-check-call:v ames.bud
|
||||
@ -324,7 +325,7 @@
|
||||
==
|
||||
==
|
||||
:: publisher ames hears new %watch
|
||||
~& > 'publisher ames hears new %watch'
|
||||
~? > dbug 'publisher ames hears new %watch'
|
||||
:- t21 |. :- %|
|
||||
=^ t22 ames.bud
|
||||
%: ames-check-call:v ames.bud
|
||||
@ -339,7 +340,7 @@
|
||||
==
|
||||
==
|
||||
:: publisher gall hears new %watch, passes to self
|
||||
~& > 'publisher gall hears new %watch, passes to self'
|
||||
~? > dbug 'publisher gall hears new %watch, passes to self'
|
||||
:- t22 |. :- %|
|
||||
=^ t23 gall.bud
|
||||
%: gall-check-call:v gall.bud
|
||||
@ -351,7 +352,7 @@
|
||||
==
|
||||
==
|
||||
:: publisher gall runs :pub's +on-watch, gives ack to self
|
||||
~& > 'publisher gall runs :pub\'s +on-watch, gives ack to self'
|
||||
~? > dbug 'publisher gall runs :pub\'s +on-watch, gives ack to self'
|
||||
:- t23 |. :- %|
|
||||
=^ t24 gall.bud
|
||||
%: gall-check-call:v gall.bud
|
||||
@ -363,7 +364,7 @@
|
||||
==
|
||||
==
|
||||
:: publisher gall hears %watch-ack, gives to ames
|
||||
~& > 'publisher gall hears %watch-ack, gives to ames'
|
||||
~? > dbug 'publisher gall hears %watch-ack, gives to ames'
|
||||
:- t24 |. :- %|
|
||||
=^ t25 gall.bud
|
||||
%: gall-check-take:v gall.bud
|
||||
@ -374,7 +375,7 @@
|
||||
==
|
||||
==
|
||||
:: publisher ames hears done from gall, sends over the network
|
||||
~& > 'publisher ames hears done from gall, sends over the network'
|
||||
~? > dbug 'publisher ames hears done from gall, sends over the network'
|
||||
:- t25 |. :- %|
|
||||
=^ t26 ames.bud
|
||||
%: ames-check-take:v ames.bud
|
||||
@ -388,7 +389,7 @@
|
||||
== ==
|
||||
==
|
||||
:: publisher ames hears %cork, passes to itself
|
||||
~& > 'publisher ames hears %cork, passes to itself'
|
||||
~? > dbug 'publisher ames hears %cork, passes to itself'
|
||||
:- t26 |. :- %|
|
||||
=^ t27 ames.bud
|
||||
%: ames-check-call:v ames.bud
|
||||
@ -403,7 +404,7 @@
|
||||
==
|
||||
:- t27 |. :- %|
|
||||
:: publisher ames hear cork plea from self, give %done to self
|
||||
~& > 'publisher ames hear cork plea from self, give %done to self'
|
||||
~? > dbug 'publisher ames hear cork plea from self, give %done to self'
|
||||
=^ t28 ames.bud
|
||||
%: ames-check-call:v ames.bud
|
||||
[~1111.1.8 0xbeef.dead *roof]
|
||||
@ -413,7 +414,7 @@
|
||||
==
|
||||
==
|
||||
:: publisher ames hears cork done from self, sends ack and $cork to self
|
||||
~& > 'publisher ames hears cork done from self, sends ack and $cork to self'
|
||||
~? > dbug 'publisher ames hears cork done from self, sends ack and $cork to self'
|
||||
:- t28 |. :- %|
|
||||
=^ t29 ames.bud
|
||||
%: ames-check-take:v ames.bud
|
||||
@ -428,7 +429,7 @@
|
||||
== ==
|
||||
==
|
||||
:: subscriber ames hears %watch-ack, gives to gall
|
||||
~& > 'subscriber ames hears %watch-ack, gives to gall'
|
||||
~? > dbug 'subscriber ames hears %watch-ack, gives to gall'
|
||||
:- t29 |. :- %|
|
||||
=^ t30 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
@ -447,7 +448,7 @@
|
||||
==
|
||||
==
|
||||
:: subscriber gall hears new %watch-ack from ames, gives to self
|
||||
~& > 'subscriber gall hears new %watch-ack from ames, gives to self'
|
||||
~? > dbug 'subscriber gall hears new %watch-ack from ames, gives to self'
|
||||
:- t30 |. :- %|
|
||||
=^ t31 gall.nec
|
||||
%: gall-check-take:v gall.nec
|
||||
@ -464,7 +465,7 @@
|
||||
==
|
||||
==
|
||||
:: subscriber gall hears new %watch-ack from self, tells :sub
|
||||
~& > 'subscriber gall hears new %watch-ack from self, tells :sub'
|
||||
~? > dbug 'subscriber gall hears new %watch-ack from self, tells :sub'
|
||||
:- t31 |. :- %|
|
||||
=^ t32 gall.nec
|
||||
%: gall-check-take:v gall.nec
|
||||
@ -475,7 +476,7 @@
|
||||
~
|
||||
==
|
||||
:: subscriber ames hears %cork ack, sends $kill to self
|
||||
~& > 'subscriber ames hears %cork ack, sends $kill to self'
|
||||
~? > dbug 'subscriber ames hears %cork ack, sends $kill to self'
|
||||
:- t32 |. :- %|
|
||||
=^ t33 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
@ -493,7 +494,7 @@
|
||||
==
|
||||
==
|
||||
:: subscriber ames hears $kill from self, deletes the flow
|
||||
~& > 'subscriber ames hears $kill from self, deletes the flow'
|
||||
~? > dbug 'subscriber ames hears $kill from self, deletes the flow'
|
||||
:- t33 |. :- %|
|
||||
=^ t34 ames.nec
|
||||
%: ames-check-call:v ames.nec
|
||||
|
||||
@ -539,7 +539,7 @@
|
||||
++ test-fine-request
|
||||
^- tang
|
||||
=/ want=path /c/z/1/kids/sys
|
||||
=^ moves1 nec (call nec ~[/g/talk] %keen ~bud want)
|
||||
=^ moves1 nec (call nec ~[/g/talk] %keen ~ ~bud want)
|
||||
=/ req=hoot:ames
|
||||
%+ snag 0
|
||||
%+ murn ;;((list move:ames) moves1)
|
||||
@ -697,4 +697,24 @@
|
||||
!> [~[/g/talk] %give %boon [%post '¡hola!']]
|
||||
!> (snag 0 `(list move:ames)`moves7)
|
||||
==
|
||||
::
|
||||
++ test-plug ^- tang
|
||||
=^ moves nec
|
||||
(call nec ~[/g/talk] %plug /foo)
|
||||
=/ expected-key
|
||||
3.782.450.905.364.316.746.465.724.430.826.633.339.627.682.402.565.789.971.442.035.627.125.517.743.962.901.817.756.764.395.497.041.697.150.935.487.420.935.470.530.023.121.462.879.251.503.082.973.208.842.762
|
||||
%- zing
|
||||
:-
|
||||
%+ expect-eq !>(moves)
|
||||
!> ^- (list move:ames)
|
||||
:~ [~[/g/talk] %give %stub 1 expected-key]
|
||||
==
|
||||
=^ moves2 bud
|
||||
(call bud ~[/g/talk] %keen `[1 expected-key] ~nec /foo/bar)
|
||||
:_ ~
|
||||
%+ expect-eq !>(moves2)
|
||||
!> ^- (list move:ames)
|
||||
:~ [~[/g/talk] [%pass /fine/shut/1 [%a [%keen sec=~ ship=~nec path=/a/x/1//fine/shut/1/0v1.vvaek.7boon.0tp04.21q1h.be1i0.494an.qimof.e2fku.ern01]]]]
|
||||
==
|
||||
::
|
||||
--
|
||||
|
||||
@ -1313,7 +1313,7 @@
|
||||
|= =time
|
||||
%+ ex ~[/http-blah]
|
||||
=. time (sub time (mod time ~h1))
|
||||
[%pass wire %a %keen ~sampel /e/x/(scot %da time)//eauth/url]
|
||||
[%pass wire %a %keen ~ ~sampel /e/x/(scot %da time)//eauth/url]
|
||||
::
|
||||
++ ex-yawn
|
||||
|= =time
|
||||
|
||||
@ -1,46 +1,33 @@
|
||||
/+ *test
|
||||
/= gall-raw /sys/vane/gall
|
||||
::
|
||||
=/ gall-gate (gall-raw ~nec)
|
||||
=/ nec (gall-raw ~nec)
|
||||
::
|
||||
|%
|
||||
++ time ~1111.1.1
|
||||
:: +test-init: test %init
|
||||
::
|
||||
++ test-init
|
||||
^- tang
|
||||
::
|
||||
=/ time ~1111.1.1
|
||||
::
|
||||
=/ call-args
|
||||
=/ =duct ~[/init]
|
||||
=/ =task:gall [%init ~]
|
||||
[duct task]
|
||||
::
|
||||
=/ expected-moves=(list move:gall-gate) ~
|
||||
::
|
||||
=/ res
|
||||
(gall-call gall-gate time *roof call-args expected-moves)
|
||||
::
|
||||
-.res
|
||||
=^ moves nec
|
||||
(gall-call nec time *roof call-args)
|
||||
(expect-eq !>(moves) !>(*(list move:nec)))
|
||||
:: +gall-call: have %gall run a +task and assert it produces expected-moves
|
||||
::
|
||||
++ gall-call
|
||||
|= $: gall-gate=_gall-gate
|
||||
|= $: nec=_nec
|
||||
now=@da
|
||||
scry=roof
|
||||
call-args=[=duct wrapped-task=(hobo task:gall)]
|
||||
expected-moves=(list move:gall-gate)
|
||||
==
|
||||
=/ gall-core (gall-gate now=now eny=`@`0xdead.beef scry=scry)
|
||||
::
|
||||
=/ res
|
||||
=/ =type -:!>(*task:gall)
|
||||
(call:gall-core duct.call-args dud=~ wrapped-task.call-args)
|
||||
::
|
||||
=/ output=tang
|
||||
%+ expect-eq
|
||||
!> expected-moves
|
||||
!> -.res
|
||||
::
|
||||
[output +.res]
|
||||
=/ gall-core (nec now=now eny=`@`0xdead.beef scry=scry)
|
||||
(call:gall-core duct.call-args dud=~ wrapped-task.call-args)
|
||||
--
|
||||
|
||||
71
tests/tend.hoon
Normal file
71
tests/tend.hoon
Normal file
@ -0,0 +1,71 @@
|
||||
/+ verb, default-agent, dbug
|
||||
|%
|
||||
+$ state-0 [%0 ~]
|
||||
+$ card card:agent:gall
|
||||
+$ coop coop:gall
|
||||
+$ action
|
||||
$% [%tend =coop =path =page]
|
||||
[%germ =coop]
|
||||
[%snip =coop]
|
||||
[%keen case=@ud =path]
|
||||
==
|
||||
--
|
||||
::
|
||||
=| state-0
|
||||
=* state -
|
||||
%+ verb |
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card:agent:gall _this)
|
||||
[~ this]
|
||||
::
|
||||
++ on-save !>([%0 ~])
|
||||
++ on-load
|
||||
|= old=vase
|
||||
^- (quip card:agent:gall _this)
|
||||
[~ this(state [%0 ~])]
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
~| mark/mark
|
||||
?> =(%noun mark)
|
||||
=+ ;;(=action q.vase)
|
||||
:_ this
|
||||
?: ?=(%keen -.action)
|
||||
=/ =path
|
||||
%+ welp /g/x/(scot %ud case.action)
|
||||
path.action
|
||||
[%pass /keen %keen & ?:(=(our.bowl ~met) ~hex ~met) path]~
|
||||
[%pass /foo action]~
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
~& peek-path/path
|
||||
~& eny/eny.bowl
|
||||
?. ?=([%c *] path)
|
||||
[~ ~]
|
||||
``noun+!>(&)
|
||||
++ on-watch on-watch:def
|
||||
++ on-arvo
|
||||
|= [=wire syn=sign-arvo]
|
||||
^- (quip card _this)
|
||||
~& syn
|
||||
?: =(/keen wire)
|
||||
?: ?=([%ames %near *] syn)
|
||||
?. ?=([~ ~ *] dat.syn)
|
||||
~& no-item/dat.syn
|
||||
`this
|
||||
~& ;;([@tas @tas] q.u.u.dat.syn)
|
||||
`this
|
||||
`this
|
||||
`this
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user