2019-06-29 01:27:59 +03:00
|
|
|
:: Ames extends Arvo's %pass/%give move semantics across the network.
|
|
|
|
::
|
|
|
|
:: A "forward flow" message, which is like a request, is passed to
|
|
|
|
:: Ames from a local vane. Ames transmits the message to the peer's
|
|
|
|
:: Ames, which passes the message to the destination vane.
|
|
|
|
::
|
|
|
|
:: Once the peer has processed the "forward flow" message, it sends a
|
|
|
|
:: message acknowledgment over the wire back to the local Ames. This
|
|
|
|
:: ack can either be positive or negative, in which case we call it a
|
|
|
|
:: "nack". (Don't confuse Ames nacks with TCP nacks, which are a
|
|
|
|
:: different concept).
|
|
|
|
::
|
|
|
|
:: When the local Ames receives either a positive message ack or a
|
|
|
|
:: combination of a nack and nack-trace (explained in more detail
|
|
|
|
:: below), it gives an %done move to the local vane that had
|
|
|
|
:: requested the original "forward flow" message be sent.
|
|
|
|
::
|
|
|
|
:: A "backward flow" message, which is similar to a response or a
|
|
|
|
:: subscription update, is given to Ames from a local vane. Ames
|
|
|
|
:: transmits the message to the peer's Ames, which gives the message
|
|
|
|
:: to the destination vane.
|
|
|
|
::
|
|
|
|
:: Ames will give a %memo to a vane upon hearing the message from a
|
|
|
|
:: remote. This message is a "backward flow" message, forming one of
|
|
|
|
:: potentially many responses to a "forward flow" message that a
|
|
|
|
:: local vane had passed to our local Ames, and which local Ames had
|
|
|
|
:: relayed to the remote. Ames gives the %memo on the same duct the
|
|
|
|
:: local vane had originally used to pass Ames the "forward flow"
|
|
|
|
:: message.
|
|
|
|
::
|
|
|
|
:: Backward flow messages are acked automatically by the receiver.
|
|
|
|
:: They cannot be nacked, and Ames only uses the ack internally,
|
|
|
|
:: without notifying the client vane.
|
|
|
|
::
|
|
|
|
:: Forward flow messages can be nacked, in which case the peer will
|
|
|
|
:: send both a message-nack packet and a nack-trace message, which is
|
|
|
|
:: sent on a special diagnostic flow so as not to interfere with
|
|
|
|
:: normal operation. The nack-trace is sent as a full Ames message,
|
|
|
|
:: instead of just a packet, because the contained error information
|
|
|
|
:: can be arbitrarily large.
|
|
|
|
::
|
|
|
|
:: Once the local Ames has received the nack-trace, it knows the peer
|
|
|
|
:: has received the full message and failed to process it. This
|
|
|
|
:: means if we later hear an ack packet on the failed message, we can
|
|
|
|
:: ignore it.
|
|
|
|
::
|
|
|
|
:: Also, due to Ames's exactly-once delivery semantics, we know that
|
|
|
|
:: when we receive a nack-trace for message n, we know the peer has
|
|
|
|
:: positively acked all messages m+1 through n-1, where m is the last
|
|
|
|
:: message for which we heard a nack-trace. If we haven't heard acks
|
|
|
|
:: on all those messages, we apply positive acks when we hear the
|
|
|
|
:: nack-trace.
|
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
:: protocol-version: current version of the ames wire protocol
|
|
|
|
::
|
2019-06-29 02:43:52 +03:00
|
|
|
!:
|
2019-05-25 05:03:33 +03:00
|
|
|
=/ protocol-version=?(%0 %1 %2 %3 %4 %5 %6 %7) %0
|
2019-06-29 02:43:52 +03:00
|
|
|
=, ames
|
|
|
|
=, able
|
2019-07-29 12:08:26 +03:00
|
|
|
=* point point:able:kale
|
|
|
|
=* public-keys-result public-keys-result:able:kale
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
2019-06-29 02:43:52 +03:00
|
|
|
=>
|
2019-05-25 05:03:33 +03:00
|
|
|
|%
|
2019-05-27 02:54:23 +03:00
|
|
|
+| %generics
|
2019-05-31 03:21:05 +03:00
|
|
|
:: $mk-item: constructor for +ordered-map item type
|
2019-05-27 02:54:23 +03:00
|
|
|
::
|
2019-05-31 03:21:05 +03:00
|
|
|
+* mk-item [key val] [key=key val=val]
|
|
|
|
:: +ordered-map: treap with user-specified horizontal order
|
|
|
|
::
|
|
|
|
:: Conceptually smaller items go on the left, so the item with the
|
|
|
|
:: smallest key can be popped off the head. If $key is `@` and
|
|
|
|
:: .compare is +lte, then the numerically smallest item is the head.
|
|
|
|
::
|
|
|
|
++ ordered-map
|
|
|
|
|* [key=mold val=mold]
|
|
|
|
=> |%
|
|
|
|
+$ item (mk-item key val)
|
|
|
|
--
|
|
|
|
:: +compare: item comparator for horizontal order
|
|
|
|
::
|
|
|
|
|= compare=$-([key key] ?)
|
|
|
|
|%
|
|
|
|
:: +check-balance: verify horizontal and vertical orderings
|
|
|
|
::
|
|
|
|
++ check-balance
|
|
|
|
=| [l=(unit key) r=(unit key)]
|
|
|
|
|= a=(tree item)
|
|
|
|
^- ?
|
|
|
|
:: empty tree is valid
|
|
|
|
::
|
|
|
|
?~ a %.y
|
|
|
|
:: nonempty trees must maintain several criteria
|
|
|
|
::
|
|
|
|
?& :: if .n.a is left of .u.l, assert horizontal comparator
|
|
|
|
::
|
2019-05-31 04:29:54 +03:00
|
|
|
?~(l %.y (compare key.n.a u.l))
|
2019-05-31 03:21:05 +03:00
|
|
|
:: if .n.a is right of .u.r, assert horizontal comparator
|
|
|
|
::
|
|
|
|
?~(r %.y (compare u.r key.n.a))
|
|
|
|
:: if .a is not leftmost element, assert vertical order between
|
|
|
|
:: .l.a and .n.a and recurse to the left with .n.a as right
|
|
|
|
:: neighbor
|
|
|
|
::
|
|
|
|
?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a)))
|
|
|
|
:: if .a is not rightmost element, assert vertical order
|
|
|
|
:: between .r.a and .n.a and recurse to the right with .n.a as
|
|
|
|
:: left neighbor
|
|
|
|
::
|
|
|
|
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
|
|
|
|
==
|
|
|
|
:: +put: ordered item insert
|
|
|
|
::
|
|
|
|
++ put
|
|
|
|
|= [a=(tree item) =key =val]
|
|
|
|
^- (tree item)
|
|
|
|
:: base case: replace null with single-item tree
|
|
|
|
::
|
|
|
|
?~ a [n=[key val] l=~ r=~]
|
|
|
|
:: base case: overwrite existing .key with new .val
|
|
|
|
::
|
|
|
|
?: =(key.n.a key) a(val.n val)
|
|
|
|
:: if item goes on left, recurse left then rebalance vertical order
|
|
|
|
::
|
|
|
|
?: (compare key key.n.a)
|
|
|
|
=/ l $(a l.a)
|
|
|
|
?> ?=(^ l)
|
2019-05-31 04:29:54 +03:00
|
|
|
?: (mor key.n.a key.n.l)
|
2019-05-31 03:21:05 +03:00
|
|
|
a(l l)
|
|
|
|
l(r a(l r.l))
|
|
|
|
:: item goes on right; recurse right then rebalance vertical order
|
|
|
|
::
|
|
|
|
=/ r $(a r.a)
|
|
|
|
?> ?=(^ r)
|
2019-05-31 04:29:54 +03:00
|
|
|
?: (mor key.n.a key.n.r)
|
2019-05-31 03:21:05 +03:00
|
|
|
a(r r)
|
|
|
|
r(l a(r l.r))
|
|
|
|
:: +peek: produce head (smallest item) or null
|
|
|
|
::
|
|
|
|
++ peek
|
|
|
|
|= a=(tree item)
|
|
|
|
^- (unit item)
|
|
|
|
::
|
|
|
|
?~ a ~
|
|
|
|
?~ l.a `n.a
|
|
|
|
$(a l.a)
|
|
|
|
:: +pop: produce .head (smallest item) and .rest or crash if empty
|
|
|
|
::
|
|
|
|
++ pop
|
|
|
|
|= a=(tree item)
|
|
|
|
^- [head=item rest=(tree item)]
|
|
|
|
::
|
|
|
|
?~ a !!
|
|
|
|
?~ l.a [n.a r.a]
|
|
|
|
::
|
|
|
|
=/ l $(a l.a)
|
|
|
|
:- head.l
|
|
|
|
:: load .rest.l back into .a and rebalance
|
|
|
|
::
|
2019-05-31 04:29:54 +03:00
|
|
|
?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l))
|
2019-05-31 03:21:05 +03:00
|
|
|
a(l rest.l)
|
|
|
|
rest.l(r a(r r.rest.l))
|
2019-05-31 21:59:28 +03:00
|
|
|
:: +nip: remove root; for internal use
|
2019-05-31 03:21:05 +03:00
|
|
|
::
|
2019-05-31 21:59:28 +03:00
|
|
|
++ nip
|
|
|
|
|= a=(tree item)
|
|
|
|
^- (tree item)
|
|
|
|
::
|
|
|
|
?> ?=(^ a)
|
|
|
|
:: delete .n.a; merge and balance .l.a and .r.a
|
|
|
|
::
|
|
|
|
|- ^- (tree item)
|
|
|
|
?~ l.a r.a
|
|
|
|
?~ r.a l.a
|
|
|
|
?: (mor key.n.l.a key.n.r.a)
|
|
|
|
l.a(r $(l.a r.l.a))
|
|
|
|
r.a(l $(r.a l.r.a))
|
|
|
|
:: +traverse: stateful partial inorder traversal
|
2019-05-31 03:21:05 +03:00
|
|
|
::
|
2019-06-01 00:00:53 +03:00
|
|
|
:: Mutates .state on each run of .f. Starts at .start key, or if
|
|
|
|
:: .start is ~, starts at the head (item with smallest key). Stops
|
2019-05-31 21:59:28 +03:00
|
|
|
:: when .f produces .stop=%.y. Traverses from smaller to larger
|
|
|
|
:: keys. Each run of .f can replace an item's value or delete the
|
|
|
|
:: item.
|
|
|
|
::
|
|
|
|
++ traverse
|
2019-05-31 20:59:45 +03:00
|
|
|
|* state=mold
|
|
|
|
|= $: a=(tree item)
|
|
|
|
=state
|
2019-05-31 21:59:28 +03:00
|
|
|
f=$-([state item] [(unit val) ? state])
|
2019-05-31 20:59:45 +03:00
|
|
|
==
|
2019-05-31 21:59:28 +03:00
|
|
|
^+ [state a]
|
2019-05-31 20:59:45 +03:00
|
|
|
:: acc: accumulator
|
|
|
|
::
|
2019-05-31 21:59:28 +03:00
|
|
|
:: .stop: set to %.y by .f when done traversing
|
|
|
|
:: .state: threaded through each run of .f and produced by +abet
|
|
|
|
::
|
2019-05-31 20:59:45 +03:00
|
|
|
=/ acc [stop=`?`%.n state=state]
|
2019-05-31 21:59:28 +03:00
|
|
|
=< abet =< main
|
2019-05-31 07:51:06 +03:00
|
|
|
|%
|
2019-05-31 20:59:45 +03:00
|
|
|
++ abet [state.acc a]
|
2019-05-31 21:59:28 +03:00
|
|
|
:: +main: main recursive loop; performs a partial inorder traversal
|
|
|
|
::
|
|
|
|
++ main
|
2019-05-31 07:51:06 +03:00
|
|
|
^+ .
|
2019-05-31 21:59:28 +03:00
|
|
|
:: stop if empty or we've been told to stop
|
|
|
|
::
|
2019-05-31 07:51:06 +03:00
|
|
|
?~ a .
|
2019-05-31 20:59:45 +03:00
|
|
|
?: stop.acc .
|
2019-06-01 09:57:57 +03:00
|
|
|
:: inorder traversal: left -> node -> right, until .f sets .stop
|
2019-05-31 21:59:28 +03:00
|
|
|
::
|
2019-05-31 07:51:06 +03:00
|
|
|
=> left
|
2019-06-01 09:57:57 +03:00
|
|
|
?: stop.acc .
|
|
|
|
=> node
|
|
|
|
?: stop.acc .
|
|
|
|
right
|
|
|
|
:: +node: run .f on .n.a, updating .a, .state, and .stop
|
|
|
|
::
|
|
|
|
++ node
|
|
|
|
^+ .
|
2019-05-31 21:59:28 +03:00
|
|
|
:: run .f on node, updating .stop.acc and .state.acc
|
|
|
|
::
|
2019-06-01 09:57:57 +03:00
|
|
|
=^ res acc
|
|
|
|
?> ?=(^ a)
|
|
|
|
(f state.acc n.a)
|
|
|
|
:: apply update to .a from .f's product
|
2019-05-31 21:59:28 +03:00
|
|
|
::
|
|
|
|
=. a
|
|
|
|
:: if .f requested node deletion, merge and balance .l.a and .r.a
|
|
|
|
::
|
|
|
|
?~ res (nip a)
|
|
|
|
:: we kept the node; replace its .val; order is unchanged
|
|
|
|
::
|
|
|
|
?> ?=(^ a)
|
|
|
|
a(val.n u.res)
|
|
|
|
::
|
2019-06-01 09:57:57 +03:00
|
|
|
..node
|
2019-06-18 02:23:32 +03:00
|
|
|
:: +left: recurse on left subtree, copying mutant back into .l.a
|
2019-05-31 21:59:28 +03:00
|
|
|
::
|
2019-05-31 07:51:06 +03:00
|
|
|
++ left
|
|
|
|
^+ .
|
2019-05-31 21:59:28 +03:00
|
|
|
?~ a .
|
|
|
|
=/ lef main(a l.a)
|
2019-05-31 07:51:06 +03:00
|
|
|
lef(a a(l a.lef))
|
2019-06-18 02:23:32 +03:00
|
|
|
:: +right: recurse on right subtree, copying mutant back into .r.a
|
2019-05-31 21:59:28 +03:00
|
|
|
::
|
|
|
|
++ right
|
2019-05-31 07:51:06 +03:00
|
|
|
^+ .
|
2019-05-31 21:59:28 +03:00
|
|
|
?~ a .
|
|
|
|
=/ rig main(a r.a)
|
2019-05-31 07:51:06 +03:00
|
|
|
rig(a a(r a.rig))
|
|
|
|
--
|
2019-05-31 03:21:05 +03:00
|
|
|
:: +tap: convert to list, smallest to largest
|
|
|
|
::
|
|
|
|
++ tap
|
|
|
|
|= a=(tree item)
|
|
|
|
^- (list item)
|
|
|
|
::
|
|
|
|
=| b=(list item)
|
|
|
|
|- ^+ b
|
|
|
|
?~ a b
|
|
|
|
::
|
|
|
|
$(a l.a, b [n.a $(a r.a)])
|
|
|
|
:: +gas: put a list of items
|
|
|
|
::
|
|
|
|
++ gas
|
|
|
|
|= [a=(tree item) b=(list item)]
|
|
|
|
^- (tree item)
|
|
|
|
::
|
|
|
|
?~ b a
|
|
|
|
$(b t.b, a (put a i.b))
|
2019-06-02 01:16:41 +03:00
|
|
|
:: +uni: unify two ordered maps
|
|
|
|
::
|
2019-06-25 19:00:03 +03:00
|
|
|
:: .b takes precedence over .a if keys overlap.
|
2019-06-01 06:05:21 +03:00
|
|
|
::
|
|
|
|
++ uni
|
|
|
|
|= [a=(tree item) b=(tree item)]
|
|
|
|
^- (tree item)
|
|
|
|
::
|
|
|
|
?~ b a
|
|
|
|
?~ a b
|
|
|
|
?: (mor key.n.a key.n.b)
|
|
|
|
::
|
|
|
|
?: =(key.n.b key.n.a)
|
|
|
|
[n.b $(a l.a, b l.b) $(a r.a, b r.b)]
|
|
|
|
::
|
|
|
|
?: (compare key.n.b key.n.a)
|
|
|
|
$(l.a $(a l.a, r.b ~), b r.b)
|
|
|
|
$(r.a $(a r.a, l.b ~), b l.b)
|
|
|
|
::
|
|
|
|
?: =(key.n.a key.n.b)
|
|
|
|
[n.b $(b l.b, a l.a) $(b r.b, a r.a)]
|
|
|
|
::
|
|
|
|
?: (compare key.n.a key.n.b)
|
|
|
|
$(l.b $(b l.b, r.a ~), a r.a)
|
|
|
|
$(r.b $(b r.b, l.a ~), a l.a)
|
2019-05-31 03:21:05 +03:00
|
|
|
--
|
2019-05-27 02:54:23 +03:00
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
+| %atomics
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ bone @udbone
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ fragment @uwfragment
|
2019-05-27 04:48:41 +03:00
|
|
|
+$ fragment-num @udfragmentnum
|
2019-07-28 10:50:32 +03:00
|
|
|
+$ message-blob @udmessageblob
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ message-num @udmessagenum
|
2019-06-11 23:22:24 +03:00
|
|
|
+$ private-key @uwprivatekey
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ public-key @uwpublickey
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ signature @uwsignature
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ symmetric-key @uwsymmetrickey
|
|
|
|
:: $rank: which kind of ship address, by length
|
|
|
|
::
|
|
|
|
:: 0: galaxy or star -- 2 bytes
|
|
|
|
:: 1: planet -- 4 bytes
|
|
|
|
:: 2: moon -- 8 bytes
|
|
|
|
:: 3: comet -- 16 bytes
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
|
|
|
+$ rank ?(%0 %1 %2 %3)
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
2019-05-27 06:22:38 +03:00
|
|
|
+| %kinetics
|
2019-05-27 04:48:41 +03:00
|
|
|
:: $channel: combined sender and receiver identifying data
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
2019-05-27 04:48:41 +03:00
|
|
|
+$ channel
|
2019-05-27 04:52:31 +03:00
|
|
|
$: [our=ship her=ship]
|
2019-05-29 01:05:59 +03:00
|
|
|
now=@da
|
2019-05-27 04:48:41 +03:00
|
|
|
:: our data, common to all dyads
|
|
|
|
::
|
|
|
|
$: =our=life
|
2019-06-25 00:48:35 +03:00
|
|
|
our-sponsor=ship
|
2019-05-27 04:48:41 +03:00
|
|
|
crypto-core=acru:ames
|
|
|
|
==
|
|
|
|
:: her data, specific to this dyad
|
|
|
|
::
|
|
|
|
$: =symmetric-key
|
|
|
|
=her=life
|
|
|
|
=her=public-key
|
2019-06-22 03:07:19 +03:00
|
|
|
her-sponsor=ship
|
2019-05-27 04:48:41 +03:00
|
|
|
== ==
|
2019-05-25 08:53:29 +03:00
|
|
|
:: $dyad: pair of sender and receiver ships
|
|
|
|
::
|
|
|
|
+$ dyad [sndr=ship rcvr=ship]
|
|
|
|
:: $packet: noun representation of an ames datagram packet
|
|
|
|
::
|
|
|
|
:: Roundtrips losslessly through atom encoding and decoding.
|
|
|
|
::
|
|
|
|
:: .origin is ~ unless the packet is being forwarded. If present,
|
|
|
|
:: it's an atom that encodes a route to another ship, such as an IPv4
|
|
|
|
:: address. Routes are opaque to Arvo and only have meaning in the
|
|
|
|
:: interpreter. This enforces that Ames is transport-agnostic.
|
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
+$ packet [dyad encrypted=? origin=(unit lane) content=*]
|
2019-05-27 02:54:23 +03:00
|
|
|
:: $open-packet: unencrypted packet payload, for comet self-attestation
|
|
|
|
::
|
2019-06-18 02:23:32 +03:00
|
|
|
:: The .signature applies to all other fields in this data structure.
|
|
|
|
::
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ open-packet
|
|
|
|
$: =signature
|
2019-06-18 02:23:32 +03:00
|
|
|
=public-key
|
|
|
|
sndr=ship
|
2019-05-27 02:54:23 +03:00
|
|
|
=sndr=life
|
|
|
|
rcvr=ship
|
2019-06-18 02:23:32 +03:00
|
|
|
=rcvr=life
|
2019-05-27 02:54:23 +03:00
|
|
|
==
|
|
|
|
:: $shut-packet: encrypted packet payload
|
|
|
|
::
|
|
|
|
+$ shut-packet
|
|
|
|
$: =sndr=life
|
|
|
|
=rcvr=life
|
|
|
|
=bone
|
|
|
|
=message-num
|
|
|
|
meat=(each fragment-meat ack-meat)
|
|
|
|
==
|
|
|
|
:: $fragment-meat: contents of a message-fragment packet
|
|
|
|
::
|
|
|
|
+$ fragment-meat
|
|
|
|
$: num-fragments=fragment-num
|
|
|
|
=fragment-num
|
|
|
|
=fragment
|
|
|
|
==
|
|
|
|
:: $ack-meat: contents of an acknowledgment packet; fragment or message
|
|
|
|
::
|
|
|
|
:: Fragment acks reference the $fragment-num of the target packet.
|
|
|
|
::
|
|
|
|
:: Message acks contain a success flag .ok, which is %.n in case of
|
|
|
|
:: negative acknowledgment (nack), along with .lag that describes the
|
|
|
|
:: time it took to process the message. .lag is zero if the message
|
|
|
|
:: was processed during a single Arvo event. At the moment, .lag is
|
|
|
|
:: always zero.
|
|
|
|
::
|
|
|
|
+$ ack-meat (each fragment-num [ok=? lag=@dr])
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
2019-05-27 04:52:31 +03:00
|
|
|
+| %statics
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
|
|
|
:: $ames-state: state for entire vane
|
|
|
|
::
|
|
|
|
+$ ames-state
|
|
|
|
$: peers=(map ship ship-state)
|
2019-06-08 13:13:38 +03:00
|
|
|
=unix=duct
|
2019-08-06 03:00:04 +03:00
|
|
|
sponsor-ping-timer=(unit [=duct date=@da])
|
2019-05-25 08:53:29 +03:00
|
|
|
=life
|
2019-06-25 00:48:35 +03:00
|
|
|
sponsor=ship
|
2019-05-25 08:53:29 +03:00
|
|
|
crypto-core=acru:ames
|
|
|
|
==
|
|
|
|
:: $ship-state: all we know about a peer
|
|
|
|
::
|
|
|
|
:: %alien: no PKI data, so enqueue actions to perform once we learn it
|
2019-05-28 06:15:17 +03:00
|
|
|
:: %known: we know their life and public keys, so we have a channel
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
|
|
|
+$ ship-state
|
2019-05-29 01:05:59 +03:00
|
|
|
$% [%alien pending-requests]
|
2019-05-28 06:15:17 +03:00
|
|
|
[%known peer-state]
|
|
|
|
==
|
2019-05-29 01:05:59 +03:00
|
|
|
:: $pending-requests: what to do when we learn a peer's life and keys
|
2019-05-28 06:15:17 +03:00
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
:: rcv-packets: packets we've received from unix
|
2019-07-28 10:50:32 +03:00
|
|
|
:: snd-messages: pleas local vanes have asked us to send
|
|
|
|
:: snd-packets: packets we've tried to send
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
+$ pending-requests
|
2019-05-28 06:15:17 +03:00
|
|
|
$: rcv-packets=(list [=lane =packet])
|
2019-07-28 10:50:32 +03:00
|
|
|
snd-messages=(list [=duct =plea])
|
2019-06-22 03:07:19 +03:00
|
|
|
snd-packets=(set =blob)
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
|
|
|
:: $peer-state: state for a peer with known life and keys
|
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
:: route: transport-layer destination for packets to peer
|
2019-08-08 07:57:04 +03:00
|
|
|
:: qos: quality of service; connection status to peer
|
2019-05-29 01:05:59 +03:00
|
|
|
:: ossuary: bone<->duct mapper
|
|
|
|
:: snd: per-bone message pumps to send messages as fragments
|
|
|
|
:: rcv: per-bone message stills to assemble messages from fragments
|
|
|
|
:: nax: unprocessed nacks (negative acknowledgments)
|
|
|
|
:: Each value is ~ when we've received the ack packet but not a
|
2019-06-19 02:15:50 +03:00
|
|
|
:: nack-trace, or an error when we've received a nack-trace but
|
|
|
|
:: not the ack packet.
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
:: When we hear a nack packet or an explanation, if there's no
|
|
|
|
:: entry in .nax, we make a new entry. Otherwise, if this new
|
2019-06-19 02:15:50 +03:00
|
|
|
:: information completes the packet+nack-trace, we remove the
|
2019-05-29 01:05:59 +03:00
|
|
|
:: entry and emit a nack to the local vane that asked us to send
|
|
|
|
:: the message.
|
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ peer-state
|
|
|
|
$: $: =symmetric-key
|
|
|
|
=life
|
|
|
|
=public-key
|
2019-06-22 03:07:19 +03:00
|
|
|
sponsor=ship
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
|
|
|
route=(unit [direct=? =lane])
|
2019-08-08 07:57:04 +03:00
|
|
|
=qos
|
2019-05-25 08:53:29 +03:00
|
|
|
=ossuary
|
2019-05-27 02:54:23 +03:00
|
|
|
snd=(map bone message-pump-state)
|
2019-05-29 01:05:59 +03:00
|
|
|
rcv=(map bone message-still-state)
|
2019-06-19 02:38:20 +03:00
|
|
|
nax=(set [=bone =message-num])
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
2019-08-08 07:57:04 +03:00
|
|
|
:: $qos: quality of service; how is our connection to a peer doing?
|
|
|
|
::
|
|
|
|
+$ qos
|
|
|
|
$~ [%unborn ~]
|
|
|
|
$% [%live last-contact=@da]
|
|
|
|
[%dead last-contact=@da]
|
|
|
|
[%unborn ~]
|
|
|
|
==
|
2019-05-27 04:38:19 +03:00
|
|
|
:: $ossuary: bone<->duct bijection and .next-bone to map to a duct
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
2019-06-19 02:42:58 +03:00
|
|
|
:: The first bone is 0. They increment by 4, since each flow includes
|
|
|
|
:: a bit for each message determining forward vs. backward and a
|
|
|
|
:: second bit for whether the message is on the normal flow or the
|
|
|
|
:: associated diagnostic flow (for nack-traces).
|
2019-06-11 23:46:20 +03:00
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ ossuary
|
2019-06-19 02:42:58 +03:00
|
|
|
$: =next=bone
|
2019-05-25 08:53:29 +03:00
|
|
|
by-duct=(map duct bone)
|
|
|
|
by-bone=(map bone duct)
|
|
|
|
==
|
2019-05-27 06:22:38 +03:00
|
|
|
:: $message-pump-state: persistent state for |message-pump
|
|
|
|
::
|
2019-05-27 07:34:18 +03:00
|
|
|
:: Messages queue up in |message-pump's .unsent-messages until they
|
|
|
|
:: can be packetized and fed into |packet-pump for sending. When we
|
|
|
|
:: pop a message off .unsent-messages, we push as many fragments as
|
|
|
|
:: we can into |packet-pump, then place the remaining in
|
2019-06-02 01:16:41 +03:00
|
|
|
:: .unsent-fragments.
|
2019-05-27 07:34:18 +03:00
|
|
|
::
|
|
|
|
:: When we hear a packet ack, we send it to |packet-pump. If we
|
2019-06-02 01:16:41 +03:00
|
|
|
:: haven't seen it before, |packet-pump reports the fresh ack.
|
2019-05-27 07:34:18 +03:00
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
:: When we hear a message ack (positive or negative), we treat that
|
|
|
|
:: as though all fragments have been acked. If this message is not
|
|
|
|
:: .current, then it's a future message and .current has not yet been
|
|
|
|
:: acked, so we place the message in .queued-message-acks.
|
|
|
|
::
|
|
|
|
:: If we hear a message ack before we've sent all the
|
|
|
|
:: fragments for that message, clear .unsent-fragments. If the
|
|
|
|
:: message ack was positive, print it out because it indicates the
|
|
|
|
:: peer is not behaving properly.
|
|
|
|
::
|
|
|
|
:: If the ack is for the current message, emit the message ack,
|
|
|
|
:: increment .current, and check if this next message is in
|
|
|
|
:: .queued-message-acks. If it is, emit the message (n)ack,
|
|
|
|
:: increment .current, and check the next message. Repeat until
|
|
|
|
:: .current is not fully acked.
|
2019-05-27 07:34:18 +03:00
|
|
|
::
|
|
|
|
:: When we hear a message nack, we send it to |packet-pump, which
|
|
|
|
:: deletes all packets from that message. If .current gets nacked,
|
|
|
|
:: clear .unsent-fragments and go into the same flow as when we hear
|
|
|
|
:: the last packet ack on a message.
|
|
|
|
::
|
|
|
|
:: The following equation is always true:
|
|
|
|
:: .next - .current == number of messages in flight
|
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
:: At the end of a task, |message-pump sends a %halt task to
|
2019-05-27 07:44:11 +03:00
|
|
|
:: |packet-pump, which can trigger a timer to be set or cleared based
|
|
|
|
:: on congestion control calculations. When it fires, the timer will
|
|
|
|
:: generally cause one or more packets to be resent.
|
|
|
|
::
|
2019-06-11 23:46:20 +03:00
|
|
|
:: Message sequence numbers start at 1 so the first message will be
|
|
|
|
:: greater than .last-acked.message-still-state on the receiver.
|
|
|
|
::
|
2019-06-21 04:36:16 +03:00
|
|
|
:: current: sequence number of earliest message sent or being sent
|
2019-05-27 07:34:18 +03:00
|
|
|
:: next: sequence number of next message to send
|
2019-05-27 06:22:38 +03:00
|
|
|
:: unsent-messages: messages to be sent after current message
|
|
|
|
:: unsent-fragments: fragments of current message waiting for sending
|
2019-05-29 05:56:05 +03:00
|
|
|
:: queued-message-acks: future message acks to be applied after current
|
2019-05-27 06:22:38 +03:00
|
|
|
:: packet-pump-state: state of corresponding |packet-pump
|
|
|
|
::
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ message-pump-state
|
2019-06-20 03:33:40 +03:00
|
|
|
$: current=_`message-num`1
|
2019-06-11 23:22:24 +03:00
|
|
|
next=_`message-num`1
|
2019-07-28 10:50:32 +03:00
|
|
|
unsent-messages=(qeu message-blob)
|
2019-05-27 04:38:19 +03:00
|
|
|
unsent-fragments=(list static-fragment)
|
2019-05-29 05:56:05 +03:00
|
|
|
queued-message-acks=(map message-num ok=?)
|
2019-05-27 02:54:23 +03:00
|
|
|
=packet-pump-state
|
|
|
|
==
|
2019-05-27 06:22:38 +03:00
|
|
|
:: $packet-pump-state: persistent state for |packet-pump
|
|
|
|
::
|
|
|
|
:: next-wake: last timer we've set, or null
|
2019-05-27 07:44:11 +03:00
|
|
|
:: live: packets in flight; sent but not yet acked
|
|
|
|
:: lost: packets to retry, since they timed out with no ack
|
2019-06-01 05:03:09 +03:00
|
|
|
:: metrics: congestion control information
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ packet-pump-state
|
|
|
|
$: next-wake=(unit @da)
|
2019-06-01 01:35:06 +03:00
|
|
|
live=(tree [live-packet-key live-packet-val])
|
2019-06-01 05:03:09 +03:00
|
|
|
metrics=pump-metrics
|
2019-05-27 02:54:23 +03:00
|
|
|
==
|
2019-06-04 15:38:08 +03:00
|
|
|
:: $pump-metrics: congestion control statistics for the |pump-gauge
|
|
|
|
::
|
|
|
|
:: num-live: number of sent packets in flight
|
|
|
|
:: num-lost: number of expired packets
|
|
|
|
:: last-sent-at: last date at which we sent a packet
|
|
|
|
:: last-dead-at: most recently packet expiry
|
|
|
|
:: rtt: roundtrip time estimate
|
|
|
|
:: max-live: current window size
|
|
|
|
::
|
2019-05-27 04:38:19 +03:00
|
|
|
+$ pump-metrics
|
2019-05-27 04:48:41 +03:00
|
|
|
$: num-live=@ud
|
|
|
|
num-lost=@ud
|
|
|
|
last-sent-at=@da
|
|
|
|
last-dead-at=@da
|
|
|
|
rtt=@dr
|
2019-06-04 15:38:08 +03:00
|
|
|
max-live=_7
|
2019-05-27 04:48:41 +03:00
|
|
|
==
|
2019-06-01 01:35:06 +03:00
|
|
|
+$ live-packet-key [=message-num =fragment-num]
|
|
|
|
+$ live-packet-val
|
2019-06-01 03:50:22 +03:00
|
|
|
$: sent-packet-state
|
2019-06-01 01:35:06 +03:00
|
|
|
num-fragments=fragment-num
|
|
|
|
=fragment
|
|
|
|
==
|
2019-06-01 03:50:22 +03:00
|
|
|
+$ sent-packet-state
|
|
|
|
$: expiry=@da
|
|
|
|
sent-date=@da
|
2019-05-27 04:38:19 +03:00
|
|
|
retried=?
|
|
|
|
==
|
|
|
|
+$ static-fragment
|
|
|
|
$: =message-num
|
|
|
|
num-fragments=fragment-num
|
2019-05-27 02:54:23 +03:00
|
|
|
=fragment-num
|
|
|
|
=fragment
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
2019-05-29 01:05:59 +03:00
|
|
|
:: $message-still-state: state of |message-still to assemble messages
|
|
|
|
::
|
|
|
|
:: last-acked: highest $message-num we've fully acknowledged
|
|
|
|
:: last-heard: highest $message-num we've heard all fragments on
|
|
|
|
:: pending-vane-ack: heard but not processed by local vane
|
|
|
|
:: live-messages: partially received messages
|
|
|
|
::
|
|
|
|
+$ message-still-state
|
2019-05-27 04:38:19 +03:00
|
|
|
$: last-acked=message-num
|
|
|
|
last-heard=message-num
|
2019-07-28 10:50:32 +03:00
|
|
|
pending-vane-ack=(qeu [=message-num message=*])
|
2019-05-27 04:38:19 +03:00
|
|
|
live-messages=(map message-num partial-rcv-message)
|
2019-06-19 03:38:25 +03:00
|
|
|
nax=(set message-num)
|
2019-05-27 04:38:19 +03:00
|
|
|
==
|
2019-05-29 01:05:59 +03:00
|
|
|
:: $partial-rcv-message: message for which we've received some fragments
|
|
|
|
::
|
|
|
|
:: num-fragments: total number of fragments in this message
|
|
|
|
:: num-received: how many fragments we've received so far
|
|
|
|
:: fragments: fragments we've received, eventually producing a $message
|
|
|
|
::
|
2019-05-27 04:38:19 +03:00
|
|
|
+$ partial-rcv-message
|
|
|
|
$: num-fragments=fragment-num
|
|
|
|
num-received=fragment-num
|
|
|
|
fragments=(map fragment-num fragment)
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
|
|
|
+| %dialectics
|
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
:: $move: output effect; either request or response
|
|
|
|
::
|
2019-05-28 06:15:17 +03:00
|
|
|
+$ move [=duct card=(wind note gift)]
|
2019-06-29 00:26:40 +03:00
|
|
|
:: $queued-event: event to be handled after initial boot completes
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
2019-06-29 00:26:40 +03:00
|
|
|
+$ queued-event
|
|
|
|
$% [%call =duct type=* wrapped-task=(hobo task)]
|
|
|
|
[%take =wire =duct type=* =sign]
|
2019-05-28 04:43:10 +03:00
|
|
|
==
|
|
|
|
:: $note: request to other vane
|
|
|
|
::
|
|
|
|
:: TODO: specialize gall interface for subscription management
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
:: Ames passes a %plea note to another vane when it receives a
|
2019-06-19 02:15:50 +03:00
|
|
|
:: message on a "forward flow" from a peer, originally passed from
|
|
|
|
:: one of the peer's vanes to the peer's Ames.
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
:: Ames passes a %plea to itself to trigger a heartbeat message to
|
2019-06-25 01:18:18 +03:00
|
|
|
:: our sponsor.
|
|
|
|
::
|
2019-06-25 02:52:22 +03:00
|
|
|
:: Ames passes a %private-keys to Jael to request our private keys.
|
|
|
|
:: Ames passes a %public-keys to Jael to request a peer's public
|
|
|
|
:: keys.
|
|
|
|
::
|
2019-05-28 04:43:10 +03:00
|
|
|
+$ note
|
2019-06-29 00:26:40 +03:00
|
|
|
$~ [%b %wait *@da]
|
|
|
|
$% $: %b
|
2019-05-28 04:43:10 +03:00
|
|
|
$% [%wait date=@da]
|
|
|
|
[%rest date=@da]
|
|
|
|
== ==
|
2019-08-08 07:57:04 +03:00
|
|
|
$: %d
|
|
|
|
$% [%flog flog:dill]
|
2019-05-28 04:43:10 +03:00
|
|
|
== ==
|
2019-06-29 01:27:59 +03:00
|
|
|
$: %k
|
2019-06-29 00:26:40 +03:00
|
|
|
$% [%private-keys ~]
|
2019-06-29 01:27:59 +03:00
|
|
|
[%public-keys ships=(set ship)]
|
2019-05-28 04:43:10 +03:00
|
|
|
[%turf ~]
|
|
|
|
== ==
|
2019-06-29 00:26:40 +03:00
|
|
|
$: @tas
|
2019-07-28 10:50:32 +03:00
|
|
|
$% [%plea =ship =plea]
|
2019-05-28 04:43:10 +03:00
|
|
|
== == ==
|
|
|
|
:: $sign: response from other vane
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
:: A vane gives a %boon sign to Ames on a duct on which it had
|
2019-06-19 02:15:50 +03:00
|
|
|
:: previously received a message on a "forward flow". Ames will
|
|
|
|
:: transmit the message to the peer that had originally sent the
|
|
|
|
:: message on the forward flow. The peer's Ames will then give the
|
|
|
|
:: message to the remote vane from which the forward flow message
|
|
|
|
:: originated.
|
|
|
|
::
|
2019-06-25 01:18:18 +03:00
|
|
|
:: Ames gives a %done sign to itself when our sponsor acks a
|
|
|
|
:: heartbeat message we sent it. This triggers a timer, which then
|
|
|
|
:: triggers the next heartbeat message to be sent.
|
|
|
|
::
|
2019-05-28 04:43:10 +03:00
|
|
|
+$ sign
|
2019-06-29 00:26:40 +03:00
|
|
|
$~ [%b %wake ~]
|
|
|
|
$% $: %b
|
2019-05-28 04:43:10 +03:00
|
|
|
$% [%wake error=(unit tang)]
|
|
|
|
== ==
|
2019-06-29 01:27:59 +03:00
|
|
|
$: %k
|
2019-07-23 05:16:19 +03:00
|
|
|
$% [%private-keys =life vein=(map life ring)]
|
2019-07-29 12:08:26 +03:00
|
|
|
[%public-keys =public-keys-result]
|
2019-06-22 01:17:09 +03:00
|
|
|
[%turf turfs=(list turf)]
|
2019-06-18 21:21:12 +03:00
|
|
|
== ==
|
2019-06-29 00:26:40 +03:00
|
|
|
$: @tas
|
2019-06-20 10:21:37 +03:00
|
|
|
$% [%done error=(unit error)]
|
2019-07-28 10:50:32 +03:00
|
|
|
[%boon payload=*]
|
2019-05-28 04:43:10 +03:00
|
|
|
== == ==
|
2019-05-27 06:22:38 +03:00
|
|
|
:: $message-pump-task: job for |message-pump
|
|
|
|
::
|
2019-06-25 19:00:03 +03:00
|
|
|
:: %memo: packetize and send application-level message
|
2019-06-20 10:21:37 +03:00
|
|
|
:: %hear: handle receipt of ack on fragment or message
|
2019-05-27 06:22:38 +03:00
|
|
|
:: %wake: handle timer firing
|
|
|
|
::
|
|
|
|
+$ message-pump-task
|
2019-07-28 10:50:32 +03:00
|
|
|
$% [%memo =message-blob]
|
2019-06-20 10:21:37 +03:00
|
|
|
[%hear =message-num =ack-meat]
|
2019-05-27 06:22:38 +03:00
|
|
|
[%wake ~]
|
|
|
|
==
|
|
|
|
:: $message-pump-gift: effect from |message-pump
|
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
:: %done: report message acknowledgment
|
2019-05-31 03:20:42 +03:00
|
|
|
:: %send: emit message fragment
|
|
|
|
:: %wait: set a new timer at .date
|
|
|
|
:: %rest: cancel timer at .date
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
|
|
|
+$ message-pump-gift
|
2019-06-20 10:21:37 +03:00
|
|
|
$% [%done =message-num ok=?]
|
2019-05-31 03:20:42 +03:00
|
|
|
[%send =static-fragment]
|
|
|
|
[%wait date=@da]
|
|
|
|
[%rest date=@da]
|
2019-05-27 06:22:38 +03:00
|
|
|
==
|
|
|
|
:: $packet-pump-task: job for |packet-pump
|
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
:: %hear: deal with a packet acknowledgment
|
|
|
|
:: %done: deal with message acknowledgment
|
|
|
|
:: %halt: finish event, possibly updating timer
|
2019-05-27 06:22:38 +03:00
|
|
|
:: %wake: handle timer firing
|
|
|
|
::
|
|
|
|
+$ packet-pump-task
|
2019-06-20 10:21:37 +03:00
|
|
|
$% [%hear =message-num =fragment-num]
|
|
|
|
[%done =message-num lag=@dr]
|
|
|
|
[%halt ~]
|
2019-05-27 06:22:38 +03:00
|
|
|
[%wake ~]
|
|
|
|
==
|
|
|
|
:: $packet-pump-gift: effect from |packet-pump
|
|
|
|
::
|
2019-05-31 03:20:42 +03:00
|
|
|
:: %send: emit message fragment
|
|
|
|
:: %wait: set a new timer at .date
|
|
|
|
:: %rest: cancel timer at .date
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
|
|
|
+$ packet-pump-gift
|
2019-05-31 03:20:42 +03:00
|
|
|
$% [%send =static-fragment]
|
|
|
|
[%wait date=@da]
|
|
|
|
[%rest date=@da]
|
2019-05-27 06:22:38 +03:00
|
|
|
==
|
2019-05-29 01:05:59 +03:00
|
|
|
:: $message-still-task: job for |message-still
|
|
|
|
::
|
2019-06-18 21:21:12 +03:00
|
|
|
:: %done: receive confirmation from vane of processing or failure
|
2019-06-20 10:21:37 +03:00
|
|
|
:: %drop: clear .message-num from .nax.state
|
2019-06-11 03:31:50 +03:00
|
|
|
:: %hear: handle receiving a message fragment packet
|
2019-08-06 02:05:40 +03:00
|
|
|
:: .ok: %.y unless previous failed attempt
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
+$ message-still-task
|
2019-06-18 21:21:12 +03:00
|
|
|
$% [%done ok=?]
|
2019-06-20 10:21:37 +03:00
|
|
|
[%drop =message-num]
|
2019-08-06 02:05:40 +03:00
|
|
|
[%hear =lane =shut-packet ok=?]
|
2019-05-29 01:05:59 +03:00
|
|
|
==
|
|
|
|
:: $message-still-gift: effect from |message-still
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
:: %memo: assembled from received packets
|
2019-06-20 10:21:37 +03:00
|
|
|
:: %send: emit an ack packet
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
+$ message-still-gift
|
2019-07-28 10:50:32 +03:00
|
|
|
$% [%memo =message-num message=*]
|
2019-06-20 10:21:37 +03:00
|
|
|
[%send =message-num =ack-meat]
|
2019-05-29 01:05:59 +03:00
|
|
|
==
|
2019-05-25 05:03:33 +03:00
|
|
|
--
|
2019-05-28 04:43:10 +03:00
|
|
|
:: external vane interface
|
|
|
|
::
|
|
|
|
|= pit=vase
|
2019-06-29 00:26:40 +03:00
|
|
|
:: larval ames, before %born sets .unix-duct; wraps adult ames core
|
|
|
|
::
|
|
|
|
=< =* adult-gate .
|
|
|
|
=| queued-events=(qeu queued-event)
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
|= [our=ship now=@da eny=@ scry-gate=sley]
|
2019-06-29 00:26:40 +03:00
|
|
|
=* larval-gate .
|
|
|
|
=* adult-core (adult-gate +<)
|
|
|
|
|%
|
|
|
|
:: +call: handle request $task
|
|
|
|
::
|
|
|
|
++ call
|
|
|
|
|= [=duct type=* wrapped-task=(hobo task)]
|
2019-07-23 05:16:19 +03:00
|
|
|
::
|
|
|
|
=/ =task
|
|
|
|
?. ?=(%soft -.wrapped-task)
|
|
|
|
wrapped-task
|
|
|
|
;;(task p.wrapped-task)
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %ames-call^our^-.task
|
2019-06-29 00:26:40 +03:00
|
|
|
:: %born: set .unix-duct and start draining .queued-events
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
?: ?=(%born -.task)
|
2019-06-29 00:26:40 +03:00
|
|
|
:: process %born using wrapped adult ames
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
=^ moves adult-gate (call:adult-core duct type task)
|
2019-06-29 00:26:40 +03:00
|
|
|
:: if no events were queued up, metamorphose
|
|
|
|
::
|
|
|
|
?~ queued-events
|
2019-07-23 05:16:19 +03:00
|
|
|
~& %alef-larva-metamorphose
|
2019-06-29 00:26:40 +03:00
|
|
|
[moves adult-gate]
|
2019-07-23 05:16:19 +03:00
|
|
|
~& %alef-larva-kick
|
2019-06-29 00:26:40 +03:00
|
|
|
:: kick off a timer to process the first of .queued-events
|
|
|
|
::
|
|
|
|
=. moves :_(moves [duct %pass /larva %b %wait now])
|
|
|
|
[moves larval-gate]
|
2019-07-23 05:16:19 +03:00
|
|
|
~& %alef-larva-call
|
2019-06-29 00:26:40 +03:00
|
|
|
:: any other event: enqueue it until we have a .unix-duct
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
=. queued-events (~(put to queued-events) %call duct type task)
|
2019-06-29 00:26:40 +03:00
|
|
|
[~ larval-gate]
|
|
|
|
:: +take: handle response $sign
|
|
|
|
::
|
|
|
|
++ take
|
|
|
|
|= [=wire =duct type=* =sign]
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %ames-take^our^-.sign
|
2019-06-29 00:26:40 +03:00
|
|
|
:: enqueue event if not a larval drainage timer
|
|
|
|
::
|
|
|
|
?. =(/larva wire)
|
2019-07-23 05:16:19 +03:00
|
|
|
~& %alef-larva-take
|
2019-06-29 00:26:40 +03:00
|
|
|
=. queued-events (~(put to queued-events) %take wire duct type sign)
|
|
|
|
[~ larval-gate]
|
|
|
|
:: larval event drainage timer; pop and process a queued event
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
?. ?=([%b %wake *] sign)
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %alef-larva-wtf
|
2019-07-23 05:16:19 +03:00
|
|
|
[~ larval-gate]
|
|
|
|
~& %alef-larva-wake
|
2019-06-29 00:26:40 +03:00
|
|
|
=^ first-event queued-events ~(get to queued-events)
|
|
|
|
=^ moves adult-gate
|
|
|
|
?- -.first-event
|
|
|
|
%call (call:adult-core +.first-event)
|
|
|
|
%take (take:adult-core +.first-event)
|
|
|
|
==
|
|
|
|
:: .queued-events has been cleared; metamorphose
|
|
|
|
::
|
|
|
|
?~ queued-events
|
2019-07-23 05:16:19 +03:00
|
|
|
~& %alef-metamorphosis
|
2019-06-29 00:26:40 +03:00
|
|
|
[moves adult-gate]
|
2019-07-23 05:16:19 +03:00
|
|
|
~& %alef-larva-drain
|
2019-06-29 00:26:40 +03:00
|
|
|
:: set timer to drain next event
|
|
|
|
::
|
|
|
|
=. moves :_(moves [duct %pass /larva %b %wait now])
|
|
|
|
[moves larval-gate]
|
|
|
|
:: lifecycle arms; mostly pass-throughs to the contained adult ames
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
:: TODO: don't coerce the old state
|
|
|
|
::
|
2019-06-29 00:26:40 +03:00
|
|
|
++ scry scry:adult-core
|
2019-07-24 02:55:35 +03:00
|
|
|
++ stay ~& %alef-larva-stay [%larva queued-events ames-state.adult-gate]
|
2019-06-29 00:26:40 +03:00
|
|
|
++ load
|
2019-07-31 21:51:31 +03:00
|
|
|
|= $= old
|
|
|
|
$% [%larva events=_queued-events state=_ames-state.adult-gate]
|
|
|
|
[%adult state=_ames-state.adult-gate]
|
|
|
|
==
|
2019-07-24 02:55:35 +03:00
|
|
|
::
|
|
|
|
?- -.old
|
|
|
|
%adult
|
2019-07-31 05:31:15 +03:00
|
|
|
~& %alef-load
|
2019-07-24 02:55:35 +03:00
|
|
|
(load:adult-core state.old)
|
|
|
|
::
|
|
|
|
%larva
|
2019-07-31 05:31:15 +03:00
|
|
|
~& %alef-load-larva
|
2019-07-24 02:55:35 +03:00
|
|
|
=. queued-events events.old
|
|
|
|
=. adult-gate (load:adult-core state.old)
|
|
|
|
larval-gate
|
|
|
|
==
|
2019-06-29 00:26:40 +03:00
|
|
|
--
|
|
|
|
:: adult ames, after metamorphosis from larva
|
|
|
|
::
|
|
|
|
=<
|
2019-05-28 04:43:10 +03:00
|
|
|
=| =ames-state
|
2019-07-23 05:16:19 +03:00
|
|
|
|= [our=ship now=@da eny=@ scry-gate=sley]
|
2019-05-28 04:43:10 +03:00
|
|
|
=* ames-gate .
|
|
|
|
|%
|
|
|
|
:: +call: handle request $task
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
:: TODO: better %crud and %hole handling
|
|
|
|
::
|
2019-05-28 04:43:10 +03:00
|
|
|
++ call
|
|
|
|
|= [=duct type=* wrapped-task=(hobo task)]
|
|
|
|
^- [(list move) _ames-gate]
|
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
=/ =task
|
|
|
|
?. ?=(%soft -.wrapped-task)
|
|
|
|
wrapped-task
|
2019-07-24 02:55:35 +03:00
|
|
|
~| %alef-bad-task^p.wrapped-task
|
2019-05-28 05:43:47 +03:00
|
|
|
;;(task p.wrapped-task)
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
=/ event-core (per-event [our now eny scry-gate] duct ames-state)
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
=^ moves ames-state
|
|
|
|
=< abet
|
|
|
|
?- -.task
|
2019-06-22 01:26:26 +03:00
|
|
|
%born on-born:event-core
|
2019-08-08 07:57:04 +03:00
|
|
|
%crud (on-crud:event-core [p q]:task)
|
2019-05-28 05:43:47 +03:00
|
|
|
%hear (on-hear:event-core [lane blob]:task)
|
2019-07-26 00:50:08 +03:00
|
|
|
%hole (on-hole:event-core [lane blob]:task)
|
2019-06-29 02:43:52 +03:00
|
|
|
%init (on-init:event-core ship=p.task)
|
2019-06-22 01:19:24 +03:00
|
|
|
%vega on-vega:event-core
|
2019-06-22 01:00:04 +03:00
|
|
|
%wegh on-wegh:event-core
|
2019-07-28 10:50:32 +03:00
|
|
|
%plea (on-plea:event-core [ship plea]:task)
|
2019-05-28 05:43:47 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
[moves ames-gate]
|
2019-05-28 04:43:10 +03:00
|
|
|
:: +take: handle response $sign
|
|
|
|
::
|
|
|
|
++ take
|
|
|
|
|= [=wire =duct type=* =sign]
|
|
|
|
^- [(list move) _ames-gate]
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
=/ event-core (per-event [our now eny scry-gate] duct ames-state)
|
2019-06-18 21:21:12 +03:00
|
|
|
::
|
|
|
|
=^ moves ames-state
|
|
|
|
=< abet
|
|
|
|
?- sign
|
2019-06-29 00:26:40 +03:00
|
|
|
[@ %done *] (on-take-done:event-core wire error.sign)
|
2019-07-28 10:50:32 +03:00
|
|
|
[@ %boon *] (on-take-boon:event-core wire payload.sign)
|
2019-06-19 02:15:50 +03:00
|
|
|
::
|
2019-06-29 00:26:40 +03:00
|
|
|
[%b %wake *] (on-take-wake:event-core wire error.sign)
|
2019-06-19 02:15:50 +03:00
|
|
|
::
|
2019-06-29 01:27:59 +03:00
|
|
|
[%k %turf *] (on-take-turf:event-core turfs.sign)
|
2019-07-29 12:08:26 +03:00
|
|
|
[%k %private-keys *] (on-priv:event-core [life vein]:sign)
|
|
|
|
[%k %public-keys *] (on-publ:event-core wire public-keys-result.sign)
|
2019-06-18 21:21:12 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
[moves ames-gate]
|
2019-05-28 04:43:10 +03:00
|
|
|
:: +stay: extract state before reload
|
|
|
|
::
|
2019-07-24 02:55:35 +03:00
|
|
|
++ stay [%adult ames-state]
|
2019-05-28 04:43:10 +03:00
|
|
|
:: +load: load in old state after reload
|
|
|
|
::
|
|
|
|
++ load
|
2019-07-24 02:55:35 +03:00
|
|
|
|= old-state=_ames-state
|
2019-07-31 05:31:15 +03:00
|
|
|
^+ ames-gate
|
2019-07-24 02:55:35 +03:00
|
|
|
ames-gate(ames-state old-state)
|
2019-05-28 04:43:10 +03:00
|
|
|
:: +scry: dereference namespace
|
|
|
|
::
|
|
|
|
++ scry
|
|
|
|
|= [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path]
|
|
|
|
^- (unit (unit cage))
|
|
|
|
::
|
|
|
|
[~ ~]
|
|
|
|
--
|
2019-05-28 05:43:47 +03:00
|
|
|
:: helpers
|
2019-05-28 04:43:10 +03:00
|
|
|
::
|
2019-05-25 05:03:33 +03:00
|
|
|
|%
|
2019-05-28 05:43:47 +03:00
|
|
|
++ per-event
|
|
|
|
=| moves=(list move)
|
2019-07-23 05:16:19 +03:00
|
|
|
|= [[our=ship now=@da eny=@ scry-gate=sley] =duct =ames-state]
|
2019-05-28 05:43:47 +03:00
|
|
|
|%
|
|
|
|
++ event-core .
|
|
|
|
++ abet [(flop moves) ames-state]
|
2019-05-28 06:15:17 +03:00
|
|
|
++ emit |=(=move event-core(moves [move moves]))
|
2019-06-20 10:47:13 +03:00
|
|
|
:: +on-take-done: handle notice from vane that it processed a message
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
2019-06-20 10:47:13 +03:00
|
|
|
++ on-take-done
|
2019-06-19 02:59:25 +03:00
|
|
|
|= [=wire error=(unit error)]
|
2019-06-18 21:21:12 +03:00
|
|
|
^+ event-core
|
2019-08-08 07:57:04 +03:00
|
|
|
:: if /ping wire, sponsor acked our ping; reset timer
|
2019-06-18 21:21:12 +03:00
|
|
|
::
|
2019-06-25 01:18:18 +03:00
|
|
|
?: =(/ping wire)
|
2019-08-06 03:00:04 +03:00
|
|
|
~& %ames-take-ping-done
|
|
|
|
set-sponsor-ping-timer
|
2019-08-08 07:57:04 +03:00
|
|
|
:: otherwise, we need to relay the vane ack to the foreign peer
|
2019-06-25 01:18:18 +03:00
|
|
|
::
|
2019-06-19 03:38:25 +03:00
|
|
|
=+ ^- [her=ship =bone] (parse-bone-wire wire)
|
|
|
|
::
|
2019-06-25 00:32:53 +03:00
|
|
|
=/ =peer-state (got-peer-state her)
|
2019-08-06 03:00:04 +03:00
|
|
|
=/ =channel [[our her] now |3.ames-state -.peer-state]
|
2019-07-29 09:37:49 +03:00
|
|
|
=/ peer-core (make-peer-core peer-state channel)
|
2019-07-28 10:50:32 +03:00
|
|
|
:: if processing succeded, send positive ack packet and exit
|
2019-06-19 03:38:25 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
?~ error
|
|
|
|
abet:(run-message-still:peer-core bone %done ok=%.y)
|
|
|
|
:: failed; send message nack packet
|
2019-06-19 03:38:25 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
=. event-core abet:(run-message-still:peer-core bone %done ok=%.n)
|
|
|
|
:: construct nack-trace message, referencing .failed $message-num
|
|
|
|
::
|
|
|
|
=/ failed=message-num last-acked:(~(got by rcv.peer-state) bone)
|
|
|
|
=/ =message-blob (jam [failed u.error])
|
|
|
|
:: send nack-trace message on associated .nack-trace-bone
|
2019-06-19 03:38:25 +03:00
|
|
|
::
|
2019-07-29 09:37:49 +03:00
|
|
|
=. peer-core (make-peer-core peer-state channel)
|
2019-06-19 03:38:25 +03:00
|
|
|
=/ nack-trace-bone=^bone (mix 0b10 bone)
|
|
|
|
::
|
2019-07-29 09:37:49 +03:00
|
|
|
abet:(run-message-pump:peer-core nack-trace-bone %memo message-blob)
|
2019-08-08 07:57:04 +03:00
|
|
|
:: +on-crud: handle event failure; print to dill
|
|
|
|
::
|
|
|
|
++ on-crud
|
|
|
|
|= =error
|
|
|
|
^+ event-core
|
|
|
|
(emit duct %pass /crud %d %flog %crud error)
|
2019-06-25 03:48:05 +03:00
|
|
|
:: +on-hear: handle raw packet receipt
|
2019-06-18 21:21:12 +03:00
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
++ on-hear
|
|
|
|
|= [=lane =blob]
|
|
|
|
^+ event-core
|
2019-08-06 02:05:40 +03:00
|
|
|
(on-hear-packet lane (decode-packet blob) ok=%.y)
|
2019-07-26 00:50:08 +03:00
|
|
|
:: +on-hole: handle packet crash notification
|
|
|
|
::
|
|
|
|
++ on-hole
|
|
|
|
|= [=lane =blob]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
~& %ames-hole
|
2019-08-06 02:05:40 +03:00
|
|
|
(on-hear-packet lane (decode-packet blob) ok=%.n)
|
2019-06-25 03:48:05 +03:00
|
|
|
:: +on-hear-packet: handle mildly processed packet receipt
|
|
|
|
::
|
|
|
|
++ on-hear-packet
|
2019-08-06 02:05:40 +03:00
|
|
|
|= [=lane =packet ok=?]
|
2019-06-25 03:48:05 +03:00
|
|
|
^+ event-core
|
|
|
|
::
|
2019-07-24 03:31:51 +03:00
|
|
|
?: =(our sndr.packet)
|
2019-08-02 02:46:36 +03:00
|
|
|
::~& %alef-self
|
2019-07-24 03:31:51 +03:00
|
|
|
event-core
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
%. +<
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
?. =(our rcvr.packet)
|
|
|
|
on-hear-forward
|
|
|
|
::
|
|
|
|
?: encrypted.packet
|
|
|
|
on-hear-shut
|
|
|
|
on-hear-open
|
2019-06-22 00:21:58 +03:00
|
|
|
:: +on-hear-forward: maybe forward a packet to someone else
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
2019-06-22 00:35:07 +03:00
|
|
|
:: TODO: filter for transitive closure of sponsors/sponsees.
|
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
++ on-hear-forward
|
2019-08-06 02:05:40 +03:00
|
|
|
|= [=lane =packet ok=?]
|
2019-05-28 05:43:47 +03:00
|
|
|
^+ event-core
|
|
|
|
::
|
2019-06-22 00:21:58 +03:00
|
|
|
=/ ship-state (~(get by peers.ames-state) rcvr.packet)
|
|
|
|
:: ignore packets to unfamiliar ships
|
|
|
|
::
|
|
|
|
?. ?=([~ %known *] ship-state)
|
|
|
|
event-core
|
|
|
|
:: if we don't have a lane to .rcvr, give up
|
|
|
|
::
|
|
|
|
?~ rcvr-lane=route.+.u.ship-state
|
|
|
|
event-core
|
|
|
|
:: set .origin.packet, re-encode, and send
|
|
|
|
::
|
|
|
|
=/ =blob (encode-packet packet(origin `lane))
|
|
|
|
::
|
|
|
|
(emit unix-duct.ames-state %give %send lane.u.rcvr-lane blob)
|
2019-06-18 02:23:32 +03:00
|
|
|
:: +on-hear-open: handle receipt of plaintext comet self-attestation
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
++ on-hear-open
|
2019-08-06 02:05:40 +03:00
|
|
|
|= [=lane =packet ok=?]
|
2019-05-28 05:43:47 +03:00
|
|
|
^+ event-core
|
2019-06-18 02:23:32 +03:00
|
|
|
:: if we already know .sndr, ignore duplicate attestation
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
2019-06-18 02:23:32 +03:00
|
|
|
=/ ship-state (~(get by peers.ames-state) sndr.packet)
|
|
|
|
?: ?=([~ %known *] ship-state)
|
|
|
|
event-core
|
|
|
|
::
|
|
|
|
=/ =open-packet ;;(open-packet packet)
|
|
|
|
:: assert .our and .her and lives match
|
|
|
|
::
|
2019-06-25 19:00:03 +03:00
|
|
|
?> .= sndr.open-packet sndr.packet
|
|
|
|
?> .= rcvr.open-packet our
|
|
|
|
?> .= sndr-life.open-packet 1
|
|
|
|
?> .= rcvr-life.open-packet life.ames-state
|
2019-06-18 02:23:32 +03:00
|
|
|
:: no ghost comets allowed
|
|
|
|
::
|
|
|
|
?> (lte 256 (^sein:title sndr.packet))
|
|
|
|
:: comet public-key must hash to its @p address
|
|
|
|
::
|
|
|
|
:: TODO how does this validation work elsewhere?
|
|
|
|
::
|
|
|
|
?> =(`@`sndr.packet `@`(shaf %pawn public-key.open-packet))
|
|
|
|
:: everything after .signature is signed
|
|
|
|
::
|
|
|
|
:: TODO: should this double-cue instead of re-jamming?
|
|
|
|
::
|
|
|
|
=/ signed=@ (jam +.open-packet)
|
|
|
|
?> (verify-signature signed [public-key signature]:open-packet)
|
|
|
|
:: store comet as peer in our state
|
|
|
|
::
|
|
|
|
=. peers.ames-state
|
|
|
|
%+ ~(put by peers.ames-state) sndr.packet
|
|
|
|
^- ^ship-state
|
|
|
|
:- %known
|
2019-06-22 00:40:38 +03:00
|
|
|
=| =peer-state
|
2019-06-18 02:23:32 +03:00
|
|
|
=/ our-private-key sec:ex:crypto-core.ames-state
|
|
|
|
=/ =symmetric-key
|
|
|
|
(derive-symmetric-key public-key.open-packet our-private-key)
|
|
|
|
::
|
2019-06-22 00:40:38 +03:00
|
|
|
%_ peer-state
|
2019-06-18 02:23:32 +03:00
|
|
|
symmetric-key symmetric-key
|
2019-06-22 00:40:38 +03:00
|
|
|
life sndr-life.open-packet
|
|
|
|
public-key public-key.open-packet
|
2019-06-22 03:07:19 +03:00
|
|
|
sponsor (^sein:title sndr.packet)
|
2019-06-22 00:40:38 +03:00
|
|
|
route `[direct=%.y lane]
|
2019-06-18 02:23:32 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
event-core
|
2019-06-22 00:35:07 +03:00
|
|
|
:: +on-hear-shut: handle receipt of encrypted packet
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
++ on-hear-shut
|
2019-08-06 02:05:40 +03:00
|
|
|
|= [=lane =packet ok=?]
|
2019-05-28 05:43:47 +03:00
|
|
|
^+ event-core
|
2019-05-28 06:59:53 +03:00
|
|
|
:: encrypted packet content must be an encrypted atom
|
|
|
|
::
|
|
|
|
?> ?=(@ content.packet)
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
=/ sndr-state (~(get by peers.ames-state) sndr.packet)
|
2019-06-01 06:32:13 +03:00
|
|
|
:: if we don't know them, enqueue the packet to be handled later
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
?. ?=([~ %known *] sndr-state)
|
2019-06-25 00:13:45 +03:00
|
|
|
%+ enqueue-alien-todo sndr.packet
|
|
|
|
|= todos=pending-requests
|
|
|
|
todos(rcv-packets [[lane packet] rcv-packets.todos])
|
2019-06-01 06:32:13 +03:00
|
|
|
:: decrypt packet contents using symmetric-key.channel
|
|
|
|
::
|
|
|
|
:: If we know them, we have a $channel with them, which we've
|
|
|
|
:: populated with a .symmetric-key derived from our private key
|
|
|
|
:: and their public key using elliptic curve Diffie-Hellman.
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
2019-05-28 06:59:53 +03:00
|
|
|
=/ =peer-state +.u.sndr-state
|
2019-08-06 03:00:04 +03:00
|
|
|
=/ =channel [[our sndr.packet] now |3.ames-state -.peer-state]
|
2019-05-28 06:59:53 +03:00
|
|
|
=/ =shut-packet (decrypt symmetric-key.channel content.packet)
|
2019-05-29 01:05:59 +03:00
|
|
|
:: ward against replay attacks
|
|
|
|
::
|
2019-06-01 06:32:13 +03:00
|
|
|
:: We only accept packets from a ship at their known life, and to
|
|
|
|
:: us at our current life.
|
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
?> =(sndr-life.shut-packet her-life.channel)
|
|
|
|
?> =(rcvr-life.shut-packet our-life.channel)
|
2019-08-08 07:57:04 +03:00
|
|
|
:: non-galaxy: update route with heard lane or forwarded lane
|
2019-06-22 00:40:38 +03:00
|
|
|
::
|
2019-07-26 01:56:33 +03:00
|
|
|
=? route.peer-state !=(%czar (clan:title her.channel))
|
2019-08-08 07:57:04 +03:00
|
|
|
?~ origin.packet
|
|
|
|
`[direct=%.n lane]
|
|
|
|
`[direct=%.n u.origin.packet]
|
|
|
|
:: perform peer-specific handling of packet
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-10 19:23:33 +03:00
|
|
|
=/ peer-core (make-peer-core peer-state channel)
|
2019-08-06 02:05:40 +03:00
|
|
|
abet:(on-hear-shut-packet:peer-core lane shut-packet ok)
|
2019-07-28 10:50:32 +03:00
|
|
|
:: +on-take-boon: receive request to give message to peer
|
2019-06-19 02:51:06 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
++ on-take-boon
|
|
|
|
|= [=wire payload=*]
|
2019-06-19 02:51:06 +03:00
|
|
|
^+ event-core
|
|
|
|
::
|
2019-06-21 00:46:31 +03:00
|
|
|
=+ ^- [her=ship =bone] (parse-bone-wire wire)
|
|
|
|
::
|
2019-06-25 00:32:53 +03:00
|
|
|
=/ =peer-state (got-peer-state her)
|
2019-08-06 03:00:04 +03:00
|
|
|
=/ =channel [[our her] now |3.ames-state -.peer-state]
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %ames-take-boon^our^her^bone=bone
|
2019-06-19 02:51:06 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
abet:(on-memo:(make-peer-core peer-state channel) bone payload)
|
|
|
|
:: +on-plea: handle request to send message
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
++ on-plea
|
|
|
|
|= [=ship =plea]
|
2019-06-09 09:26:01 +03:00
|
|
|
^+ event-core
|
2019-08-08 07:57:04 +03:00
|
|
|
:: if .plea is a sponsor ping; ack it
|
|
|
|
::
|
|
|
|
?: =([%a /ping ~] plea)
|
|
|
|
~& %ames-ack-ping^our^ship
|
|
|
|
(emit duct %give %done ~)
|
|
|
|
:: .plea is from local vane to foreign ship
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-06-22 00:35:07 +03:00
|
|
|
=/ ship-state (~(get by peers.ames-state) ship)
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-06-22 00:35:07 +03:00
|
|
|
?. ?=([~ %known *] ship-state)
|
2019-06-25 00:13:45 +03:00
|
|
|
%+ enqueue-alien-todo ship
|
|
|
|
|= todos=pending-requests
|
2019-07-28 10:50:32 +03:00
|
|
|
todos(snd-messages [[duct plea] snd-messages.todos])
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-06-22 00:35:07 +03:00
|
|
|
=/ =peer-state +.u.ship-state
|
2019-08-06 03:00:04 +03:00
|
|
|
=/ =channel [[our ship] now |3.ames-state -.peer-state]
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
=^ =bone ossuary.peer-state (bind-duct ossuary.peer-state duct)
|
|
|
|
~& %ames-plea^our^ship^[bone=bone]^vane.plea^path.plea
|
2019-06-21 00:46:31 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
abet:(on-memo:(make-peer-core peer-state channel) bone plea)
|
2019-06-19 02:59:25 +03:00
|
|
|
:: +on-take-wake: receive wakeup or error notification from behn
|
|
|
|
::
|
|
|
|
++ on-take-wake
|
|
|
|
|= [=wire error=(unit tang)]
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-06-25 01:18:18 +03:00
|
|
|
?: =(/ping wire)
|
2019-08-06 03:00:04 +03:00
|
|
|
=. sponsor-ping-timer.ames-state ~
|
2019-06-25 00:48:35 +03:00
|
|
|
ping-sponsor
|
|
|
|
::
|
2019-06-22 00:35:07 +03:00
|
|
|
=+ ^- [her=ship =bone] (parse-pump-timer-wire wire)
|
|
|
|
::
|
2019-06-25 00:32:53 +03:00
|
|
|
=/ =peer-state (got-peer-state her)
|
2019-08-06 03:00:04 +03:00
|
|
|
=/ =channel [[our her] now |3.ames-state -.peer-state]
|
2019-06-22 00:35:07 +03:00
|
|
|
::
|
|
|
|
abet:(on-wake:(make-peer-core peer-state channel) bone error)
|
2019-06-22 01:25:18 +03:00
|
|
|
:: +on-init: first boot; subscribe to our info from jael
|
|
|
|
::
|
2019-08-06 03:21:00 +03:00
|
|
|
:: A non-galaxy ship makes a %public-keys subscription to stay
|
|
|
|
:: updated about its sponsor. A galaxy is its own sponsor, so it
|
|
|
|
:: does not make such a request.
|
|
|
|
::
|
2019-06-22 01:25:18 +03:00
|
|
|
++ on-init
|
2019-06-25 02:52:22 +03:00
|
|
|
|= our=ship
|
2019-06-22 01:25:18 +03:00
|
|
|
^+ event-core
|
|
|
|
::
|
2019-08-06 04:19:17 +03:00
|
|
|
=. event-core (emit duct %pass /turf %k %turf ~)
|
|
|
|
=. event-core (emit duct %pass /private-keys %k %private-keys ~)
|
2019-08-06 03:21:00 +03:00
|
|
|
::
|
2019-08-06 04:19:17 +03:00
|
|
|
?: =(%czar (clan:title our))
|
|
|
|
event-core(sponsor.ames-state our)
|
|
|
|
(emit duct %pass /public-keys %k %public-keys [n=our ~ ~])
|
2019-06-25 02:52:22 +03:00
|
|
|
:: +on-priv: set our private key to jael's response
|
|
|
|
::
|
|
|
|
++ on-priv
|
2019-07-23 05:16:19 +03:00
|
|
|
|= [=life vein=(map life private-key)]
|
2019-06-25 02:52:22 +03:00
|
|
|
^+ event-core
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
=/ =private-key (~(got by vein) life)
|
2019-06-25 02:52:22 +03:00
|
|
|
=. life.ames-state life
|
|
|
|
=. crypto-core.ames-state (nol:nu:crub:crypto private-key)
|
2019-06-25 22:55:51 +03:00
|
|
|
:: recalculate each peer's symmetric key
|
|
|
|
::
|
|
|
|
=/ our-private-key sec:ex:crypto-core.ames-state
|
|
|
|
=. peers.ames-state
|
|
|
|
%- ~(run by peers.ames-state)
|
|
|
|
|= =ship-state
|
|
|
|
^+ ship-state
|
|
|
|
::
|
|
|
|
?. ?=(%known -.ship-state)
|
|
|
|
ship-state
|
|
|
|
::
|
|
|
|
=/ =peer-state +.ship-state
|
|
|
|
=. symmetric-key.peer-state
|
|
|
|
(derive-symmetric-key public-key.+.ship-state our-private-key)
|
|
|
|
::
|
|
|
|
[%known peer-state]
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
|
|
|
event-core
|
|
|
|
:: +on-publ: update pki data for peer or self
|
|
|
|
::
|
|
|
|
++ on-publ
|
2019-07-29 12:08:26 +03:00
|
|
|
|= [=wire =public-keys-result]
|
2019-06-25 02:52:22 +03:00
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
|^ ^+ event-core
|
2019-07-23 05:16:19 +03:00
|
|
|
::
|
2019-07-29 12:08:26 +03:00
|
|
|
?- public-keys-result
|
|
|
|
[%diff @ %rift *]
|
|
|
|
(on-publ-breach [who to.diff]:public-keys-result)
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
2019-07-29 12:08:26 +03:00
|
|
|
[%diff @ %keys *]
|
|
|
|
(on-publ-rekey [who to.diff]:public-keys-result)
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
2019-07-29 12:08:26 +03:00
|
|
|
[%diff @ %spon *]
|
|
|
|
(on-publ-sponsor [who to.diff]:public-keys-result)
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
2019-07-29 12:08:26 +03:00
|
|
|
[%full *] (on-publ-full points.public-keys-result)
|
2019-06-25 02:52:22 +03:00
|
|
|
==
|
2019-06-25 02:56:27 +03:00
|
|
|
:: +on-publ-breach: handle continuity breach of .ship; wipe its state
|
|
|
|
::
|
|
|
|
:: Abandon all pretense of continuity and delete all state
|
|
|
|
:: associated with .ship, including sent and unsent messages.
|
|
|
|
::
|
|
|
|
:: TODO: cancel all timers? otherwise we'll get spurious firings
|
|
|
|
:: from behn
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
|
|
|
++ on-publ-breach
|
|
|
|
|= [=ship =rift]
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %alef-breach^our^ship^rift
|
2019-06-25 02:56:27 +03:00
|
|
|
=. peers.ames-state (~(del by peers.ames-state) ship)
|
|
|
|
event-core
|
2019-06-25 03:14:02 +03:00
|
|
|
:: +on-publ-rekey: handle new key for peer
|
|
|
|
::
|
|
|
|
:: TODO: assert .crypto-suite compatibility
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
|
|
|
++ on-publ-rekey
|
|
|
|
|= $: =ship
|
|
|
|
=life
|
|
|
|
crypto-suite=@ud
|
2019-07-23 05:16:19 +03:00
|
|
|
=public-key
|
2019-06-25 02:52:22 +03:00
|
|
|
==
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %alef-rekey^our^ship^life^public-key
|
2019-07-23 05:16:19 +03:00
|
|
|
(insert-peer-state ship (got-peer-state ship) life public-key)
|
2019-06-25 22:55:51 +03:00
|
|
|
:: +on-publ-sponsor: handle new or lost sponsor for self or peer
|
2019-06-25 03:30:43 +03:00
|
|
|
::
|
|
|
|
:: TODO: handle sponsor loss
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
|
|
|
++ on-publ-sponsor
|
|
|
|
|= [=ship sponsor=(unit ship)]
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-08-06 03:00:04 +03:00
|
|
|
?~ sponsor
|
|
|
|
~| %lost-sponsor^our^ship !!
|
|
|
|
::
|
2019-08-06 07:12:01 +03:00
|
|
|
?: &(=(our ship) !=(our u.sponsor))
|
2019-08-06 03:00:04 +03:00
|
|
|
=. sponsor.ames-state u.sponsor
|
|
|
|
=. event-core set-sponsor-ping-timer
|
2019-06-25 22:55:51 +03:00
|
|
|
ping-sponsor
|
|
|
|
::
|
2019-06-25 03:30:43 +03:00
|
|
|
=/ =peer-state (got-peer-state ship)
|
2019-06-25 03:16:32 +03:00
|
|
|
::
|
|
|
|
=. sponsor.peer-state u.sponsor
|
|
|
|
::
|
|
|
|
=. peers.ames-state (~(put by peers.ames-state) ship %known peer-state)
|
|
|
|
event-core
|
2019-06-25 03:30:43 +03:00
|
|
|
:: +on-publ-full: handle new pki data for peer(s)
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
|
|
|
++ on-publ-full
|
|
|
|
|= points=(map ship point)
|
|
|
|
^+ event-core
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %alef-on-publ-full^our
|
2019-06-25 02:52:22 +03:00
|
|
|
::
|
2019-06-25 03:30:43 +03:00
|
|
|
=> .(points ~(tap by points))
|
|
|
|
|^ ^+ event-core
|
|
|
|
?~ points event-core
|
|
|
|
::
|
2019-08-06 03:00:04 +03:00
|
|
|
=+ ^- [=ship =point] i.points
|
|
|
|
:: (re)start sponsor ping on new sponsor
|
|
|
|
::
|
2019-08-06 07:12:01 +03:00
|
|
|
=? event-core
|
|
|
|
&(=(our ship) ?=(^ sponsor.point) !=(our u.sponsor.point))
|
2019-08-06 03:00:04 +03:00
|
|
|
=. sponsor.ames-state u.sponsor.point
|
|
|
|
=. event-core set-sponsor-ping-timer
|
|
|
|
ping-sponsor
|
2019-06-25 03:30:43 +03:00
|
|
|
::
|
|
|
|
=. event-core
|
|
|
|
?~ ship-state=(~(get by peers.ames-state) ship)
|
2019-08-01 07:24:54 +03:00
|
|
|
~& %alef-fresh-peer^ship^point
|
2019-06-25 03:30:43 +03:00
|
|
|
(fresh-peer ship point)
|
|
|
|
::
|
|
|
|
?: ?=([~ %alien *] ship-state)
|
2019-08-01 07:24:54 +03:00
|
|
|
~& %alef-meet-alien^ship^point
|
2019-06-25 03:30:43 +03:00
|
|
|
(meet-alien ship point +.u.ship-state)
|
2019-08-06 03:00:04 +03:00
|
|
|
::
|
2019-08-01 07:24:54 +03:00
|
|
|
~& %alef-update-known^ship^point
|
2019-06-25 03:30:43 +03:00
|
|
|
(update-known ship point +.u.ship-state)
|
|
|
|
::
|
|
|
|
$(points t.points)
|
|
|
|
::
|
|
|
|
++ fresh-peer
|
|
|
|
|= [=ship =point]
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
=/ =public-key pass:(~(got by keys.point) life.point)
|
|
|
|
(insert-peer-state ship *peer-state life.point public-key)
|
2019-06-25 03:30:43 +03:00
|
|
|
::
|
|
|
|
++ meet-alien
|
|
|
|
|= [=ship =point todos=pending-requests]
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
=/ =public-key pass:(~(got by keys.point) life.point)
|
2019-06-25 03:48:05 +03:00
|
|
|
=. event-core
|
2019-07-23 05:16:19 +03:00
|
|
|
(insert-peer-state ship *peer-state life.point public-key)
|
2019-06-25 03:48:05 +03:00
|
|
|
:: apply incoming packets
|
|
|
|
::
|
|
|
|
=. event-core
|
|
|
|
|- ^+ event-core
|
|
|
|
?~ rcv-packets.todos event-core
|
|
|
|
::
|
2019-08-06 02:05:40 +03:00
|
|
|
=. event-core
|
|
|
|
(on-hear-packet [lane packet ok=%.y]:i.rcv-packets.todos)
|
|
|
|
::
|
2019-06-25 03:48:05 +03:00
|
|
|
$(rcv-packets.todos t.rcv-packets.todos)
|
2019-06-26 21:45:07 +03:00
|
|
|
:: we're a comet; send self-attestation packet first
|
|
|
|
::
|
|
|
|
=? event-core =(%pawn (clan:title our))
|
|
|
|
(send-blob ship (attestation-packet ship life.point))
|
2019-06-25 03:48:05 +03:00
|
|
|
:: apply outgoing messages
|
|
|
|
::
|
|
|
|
=. event-core
|
|
|
|
|- ^+ event-core
|
|
|
|
?~ snd-messages.todos event-core
|
|
|
|
::
|
|
|
|
=. event-core
|
2019-07-29 09:37:49 +03:00
|
|
|
%- on-plea(duct duct.i.snd-messages.todos)
|
|
|
|
[ship plea.i.snd-messages.todos]
|
2019-06-25 03:48:05 +03:00
|
|
|
::
|
|
|
|
$(snd-messages.todos t.snd-messages.todos)
|
2019-06-26 21:45:07 +03:00
|
|
|
:: apply outgoing packet blobs
|
2019-06-25 03:48:05 +03:00
|
|
|
::
|
|
|
|
=. event-core
|
|
|
|
=/ blobs ~(tap in snd-packets.todos)
|
|
|
|
|- ^+ event-core
|
|
|
|
?~ blobs event-core
|
|
|
|
::
|
|
|
|
=. event-core (send-blob ship i.blobs)
|
|
|
|
$(blobs t.blobs)
|
|
|
|
::
|
|
|
|
event-core
|
2019-06-25 03:30:43 +03:00
|
|
|
::
|
|
|
|
++ update-known
|
|
|
|
|= [=ship =point =peer-state]
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-07-23 05:16:19 +03:00
|
|
|
=/ =public-key pass:(~(got by keys.point) life.point)
|
|
|
|
(insert-peer-state ship peer-state life.point public-key)
|
2019-06-25 03:30:43 +03:00
|
|
|
--
|
2019-06-25 03:48:05 +03:00
|
|
|
::
|
|
|
|
++ insert-peer-state
|
|
|
|
|= [=ship =peer-state =life =public-key]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=/ =private-key sec:ex:crypto-core.ames-state
|
|
|
|
=/ =symmetric-key (derive-symmetric-key public-key private-key)
|
|
|
|
::
|
|
|
|
=. life.peer-state life
|
|
|
|
=. public-key.peer-state public-key
|
|
|
|
=. symmetric-key.peer-state symmetric-key
|
2019-07-24 02:55:35 +03:00
|
|
|
:: automatically set galaxy route, since unix handles lookup
|
|
|
|
::
|
|
|
|
=? route.peer-state ?=(%czar (clan:title ship))
|
|
|
|
`[direct=%.y lane=[%& ship]]
|
2019-06-25 03:48:05 +03:00
|
|
|
::
|
|
|
|
=. peers.ames-state
|
|
|
|
(~(put by peers.ames-state) ship %known peer-state)
|
|
|
|
::
|
|
|
|
event-core
|
2019-06-25 02:52:22 +03:00
|
|
|
--
|
2019-06-22 01:17:09 +03:00
|
|
|
:: +on-take-turf: relay %turf move from jael to unix
|
|
|
|
::
|
|
|
|
++ on-take-turf
|
|
|
|
|= turfs=(list turf)
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
(emit unix-duct.ames-state %give %turf turfs)
|
2019-06-22 01:00:04 +03:00
|
|
|
:: +on-wegh: produce memory usage report
|
|
|
|
::
|
|
|
|
++ on-wegh
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=+ [known alien]=(skid ~(tap by peers.ames-state) |=(^ =(%known +<-)))
|
|
|
|
::
|
|
|
|
%- emit
|
|
|
|
:^ duct %give %mass
|
|
|
|
:+ %ames %|
|
|
|
|
:~ peers-known+&+known
|
|
|
|
peers-alien+&+alien
|
|
|
|
dot+&+ames-state
|
|
|
|
==
|
2019-06-22 01:26:26 +03:00
|
|
|
:: +on-born: handle unix process restart
|
2019-07-25 01:56:13 +03:00
|
|
|
::
|
2019-07-31 05:31:15 +03:00
|
|
|
++ on-born
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=. unix-duct.ames-state duct
|
|
|
|
::
|
|
|
|
=/ turfs
|
|
|
|
;; (list turf)
|
|
|
|
=< q.q %- need %- need
|
|
|
|
(scry-gate [%141 %noun] ~ %k `beam`[[our %turf %da now] /])
|
|
|
|
::
|
|
|
|
(emit unix-duct.ames-state %give %turf turfs)
|
2019-07-25 01:56:13 +03:00
|
|
|
:: +on-vega: handle kernel reload
|
|
|
|
::
|
2019-06-22 01:19:24 +03:00
|
|
|
++ on-vega event-core
|
2019-06-25 00:13:45 +03:00
|
|
|
:: +enqueue-alien-todo: helper to enqueue a pending request
|
|
|
|
::
|
2019-06-26 21:45:07 +03:00
|
|
|
:: Also requests key and life from Jael on first request.
|
|
|
|
:: On a comet, enqueues self-attestation packet on first request.
|
2019-06-25 00:13:45 +03:00
|
|
|
::
|
|
|
|
++ enqueue-alien-todo
|
|
|
|
|= [=ship mutate=$-(pending-requests pending-requests)]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=/ ship-state (~(get by peers.ames-state) ship)
|
|
|
|
:: create a default $pending-requests on first contact
|
|
|
|
::
|
|
|
|
=+ ^- [already-pending=? todos=pending-requests]
|
|
|
|
?~ ship-state
|
|
|
|
[%.n *pending-requests]
|
|
|
|
[%.y ?>(?=(%alien -.u.ship-state) +.u.ship-state)]
|
|
|
|
:: mutate .todos and apply to permanent state
|
|
|
|
::
|
|
|
|
=. todos (mutate todos)
|
|
|
|
=. peers.ames-state (~(put by peers.ames-state) ship %alien todos)
|
|
|
|
:: ask jael for .sndr life and keys on first contact
|
|
|
|
::
|
|
|
|
?: already-pending
|
|
|
|
event-core
|
2019-06-29 01:27:59 +03:00
|
|
|
(emit duct %pass /public-keys %k %public-keys [n=ship ~ ~])
|
2019-08-06 03:00:04 +03:00
|
|
|
:: +set-sponsor-ping-timer: trigger sponsor ping after timeout
|
|
|
|
::
|
|
|
|
++ set-sponsor-ping-timer
|
|
|
|
^+ event-core
|
|
|
|
:: make sure there's never more than one timer
|
|
|
|
::
|
|
|
|
=. event-core unset-sponsor-ping-timer
|
|
|
|
:: set new timer in state and emit request to behn
|
|
|
|
::
|
|
|
|
=/ date=@da (add now ~m1)
|
|
|
|
=. sponsor-ping-timer.ames-state `[duct date]
|
|
|
|
::
|
|
|
|
~& %ames-set-sponsor-timer^now^date
|
|
|
|
(emit duct %pass /ping %b %wait date)
|
|
|
|
:: +unset-sponsor-ping-timer: cancel timer to ping sponsor
|
2019-06-25 01:18:18 +03:00
|
|
|
::
|
2019-08-06 03:00:04 +03:00
|
|
|
++ unset-sponsor-ping-timer
|
2019-06-25 01:18:18 +03:00
|
|
|
^+ event-core
|
|
|
|
::
|
2019-08-06 03:00:04 +03:00
|
|
|
?~ timer=sponsor-ping-timer.ames-state
|
|
|
|
event-core
|
|
|
|
~& %ames-unset-sponsor-ping-timer
|
|
|
|
(emit duct.u.timer %pass /ping %b %rest date.u.timer)
|
2019-06-25 00:48:35 +03:00
|
|
|
:: +ping-sponsor: message our sponsor so they know our lane
|
|
|
|
::
|
2019-06-25 01:18:18 +03:00
|
|
|
++ ping-sponsor
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-08-06 02:05:40 +03:00
|
|
|
~& %ames-ping-sponsor^now
|
2019-07-29 09:37:49 +03:00
|
|
|
(emit duct %pass /ping %a %plea sponsor.ames-state %a /ping ~)
|
2019-06-22 03:07:19 +03:00
|
|
|
:: +send-blob: fire packet at .ship and maybe sponsors
|
|
|
|
::
|
|
|
|
:: Send to .ship and sponsors until we find a direct lane.
|
|
|
|
:: If we have no PKI data for a recipient, enqueue the packet and
|
|
|
|
:: request the information from Jael if we haven't already.
|
|
|
|
::
|
|
|
|
++ send-blob
|
|
|
|
|= [=ship =blob]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=/ ship-state (~(get by peers.ames-state) ship)
|
|
|
|
::
|
|
|
|
?. ?=([~ %known *] ship-state)
|
2019-06-25 00:13:45 +03:00
|
|
|
%+ enqueue-alien-todo ship
|
|
|
|
|= todos=pending-requests
|
|
|
|
todos(snd-packets (~(put in snd-packets.todos) blob))
|
2019-06-22 03:07:19 +03:00
|
|
|
::
|
|
|
|
=/ =peer-state +.u.ship-state
|
2019-08-06 03:00:04 +03:00
|
|
|
=/ =channel [[our ship] now |3.ames-state -.peer-state]
|
2019-06-22 03:07:19 +03:00
|
|
|
::
|
2019-08-06 03:00:04 +03:00
|
|
|
?~ route=route.peer-state
|
2019-06-22 03:07:19 +03:00
|
|
|
?: =(ship her-sponsor.channel)
|
|
|
|
event-core
|
|
|
|
$(ship her-sponsor.channel)
|
|
|
|
::
|
|
|
|
=. event-core
|
|
|
|
(emit unix-duct.ames-state %give %send lane.u.route blob)
|
|
|
|
::
|
|
|
|
?: direct.u.route
|
|
|
|
event-core
|
2019-08-06 03:00:04 +03:00
|
|
|
::
|
|
|
|
?: =(ship her-sponsor.channel)
|
|
|
|
event-core
|
|
|
|
$(ship her-sponsor.channel)
|
2019-07-30 04:03:40 +03:00
|
|
|
:: +attestation-packet: generate signed self-attestation for .her
|
|
|
|
::
|
|
|
|
:: Sent by a comet on first contact with a peer. Not acked.
|
|
|
|
::
|
|
|
|
++ attestation-packet
|
|
|
|
|= [her=ship =her=life]
|
|
|
|
^- blob
|
|
|
|
::
|
|
|
|
=/ signed=_+:*open-packet
|
|
|
|
:* ^= public-key pub:ex:crypto-core.ames-state
|
|
|
|
^= sndr our
|
|
|
|
^= sndr-life life.ames-state
|
|
|
|
^= rcvr her
|
|
|
|
^= rcvr-life her-life
|
|
|
|
==
|
|
|
|
::
|
|
|
|
=/ =private-key sec:ex:crypto-core.ames-state
|
|
|
|
=/ =signature (sign-open-packet private-key signed)
|
|
|
|
=/ =open-packet [signature signed]
|
|
|
|
=/ =packet [[our her] encrypted=%.n origin=~ open-packet]
|
|
|
|
::
|
|
|
|
(encode-packet packet)
|
2019-06-25 00:32:53 +03:00
|
|
|
:: +got-peer-state: lookup .her state or crash
|
|
|
|
::
|
|
|
|
++ got-peer-state
|
|
|
|
|= her=ship
|
|
|
|
^- peer-state
|
|
|
|
::
|
|
|
|
~| %freaky-alien^her
|
|
|
|
=- ?>(?=(%known -<) ->)
|
|
|
|
(~(got by peers.ames-state) her)
|
2019-06-09 09:26:01 +03:00
|
|
|
:: +make-peer-core: create nested |peer-core for per-peer processing
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
|
|
|
++ make-peer-core
|
|
|
|
|= [=peer-state =channel]
|
|
|
|
|%
|
|
|
|
++ peer-core .
|
|
|
|
++ emit |=(move peer-core(event-core (^emit +<)))
|
2019-08-08 07:57:04 +03:00
|
|
|
::
|
2019-06-05 07:36:10 +03:00
|
|
|
++ abet
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=. peers.ames-state
|
|
|
|
(~(put by peers.ames-state) her.channel %known peer-state)
|
|
|
|
::
|
|
|
|
event-core
|
2019-08-08 07:57:04 +03:00
|
|
|
:: +update-qos: update and maybe print connection status
|
|
|
|
::
|
|
|
|
++ update-qos
|
|
|
|
|= =new=qos
|
|
|
|
^+ peer-core
|
|
|
|
::
|
|
|
|
=^ old-qos qos.peer-state [qos.peer-state new-qos]
|
|
|
|
::
|
|
|
|
?~ text=(qos-update-text her.channel old-qos new-qos)
|
|
|
|
peer-core
|
|
|
|
(emit duct %pass /qos %d %flog %text u.text)
|
2019-06-10 19:23:33 +03:00
|
|
|
:: +on-hear-shut-packet: handle receipt of ack or message fragment
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-10 19:23:33 +03:00
|
|
|
++ on-hear-shut-packet
|
2019-08-06 02:05:40 +03:00
|
|
|
|= [=lane =shut-packet ok=?]
|
2019-06-05 07:36:10 +03:00
|
|
|
^+ peer-core
|
2019-08-08 07:57:04 +03:00
|
|
|
:: update and print connection status
|
|
|
|
::
|
|
|
|
=. peer-core %- update-qos
|
|
|
|
?- -.qos.peer-state
|
|
|
|
%unborn [%live last-contact=now]
|
|
|
|
%live [%live last-contact=now]
|
|
|
|
%dead ~| %undead-peer^her.channel !!
|
|
|
|
==
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-11 23:22:24 +03:00
|
|
|
=/ =bone bone.shut-packet
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-10 19:13:11 +03:00
|
|
|
?: ?=(%& -.meat.shut-packet)
|
2019-08-06 02:05:40 +03:00
|
|
|
(run-message-still bone %hear lane shut-packet ok)
|
|
|
|
:: ignore .ok for |message-pump; just try again on error
|
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
(run-message-pump bone %hear [message-num +.meat]:shut-packet)
|
2019-06-20 11:18:07 +03:00
|
|
|
:: +on-memo: handle request to send message
|
|
|
|
::
|
|
|
|
++ on-memo
|
2019-07-28 10:50:32 +03:00
|
|
|
|= [=bone payload=*]
|
2019-06-20 11:18:07 +03:00
|
|
|
^+ peer-core
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
=/ =message-blob (jam payload)
|
|
|
|
(run-message-pump bone %memo message-blob)
|
2019-06-22 00:35:07 +03:00
|
|
|
:: +on-wake: handle timer expiration
|
|
|
|
::
|
|
|
|
++ on-wake
|
|
|
|
|= [=bone error=(unit tang)]
|
|
|
|
^+ peer-core
|
2019-08-06 02:05:40 +03:00
|
|
|
:: if we previously errored out, print and try again
|
2019-06-22 00:35:07 +03:00
|
|
|
::
|
2019-08-08 07:57:04 +03:00
|
|
|
=? peer-core ?=(^ error)
|
|
|
|
(emit duct %pass /wake-fail %d %flog %crud %ames-wake u.error)
|
|
|
|
:: update and print connection state
|
|
|
|
::
|
|
|
|
=. peer-core %- update-qos
|
|
|
|
?. ?& ?=(%live -.qos.peer-state)
|
|
|
|
(gte now (add ~s30 last-contact.qos.peer-state))
|
|
|
|
==
|
|
|
|
qos.peer-state
|
|
|
|
[%dead last-contact.qos.peer-state]
|
2019-06-25 00:09:42 +03:00
|
|
|
:: expire direct route
|
|
|
|
::
|
|
|
|
:: Since a packet's timer expired, mark the .lane.route as
|
|
|
|
:: indirect. The next packets we emit will be sent to the
|
|
|
|
:: receiver's sponsorship chain in case the receiver's
|
|
|
|
:: transport address has changed and this lane is no longer
|
|
|
|
:: valid.
|
|
|
|
::
|
2019-07-30 04:03:40 +03:00
|
|
|
:: If .her is a galaxy, the lane will always remain direct.
|
|
|
|
::
|
2019-07-24 02:20:21 +03:00
|
|
|
=? route.peer-state
|
2019-07-24 02:55:35 +03:00
|
|
|
?& ?=(^ route.peer-state)
|
|
|
|
direct.u.route.peer-state
|
|
|
|
!=(%czar (clan:title her.channel))
|
|
|
|
==
|
2019-07-24 02:20:21 +03:00
|
|
|
route.peer-state(direct.u %.n)
|
2019-07-30 04:03:40 +03:00
|
|
|
:: resend comet attestation packet if first message times out
|
|
|
|
::
|
|
|
|
:: The attestation packet doesn't get acked, so if we tried to
|
|
|
|
:: send a packet but it timed out, maybe they didn't get our
|
|
|
|
:: attestation.
|
|
|
|
::
|
|
|
|
:: Only resend on timeout of packets in the first message we
|
|
|
|
:: send them, since they should remember forever.
|
|
|
|
::
|
|
|
|
=? event-core
|
|
|
|
?& ?=(%pawn (clan:title our))
|
|
|
|
=(1 current:(~(got by snd.peer-state) bone))
|
|
|
|
==
|
|
|
|
(send-blob her.channel (attestation-packet [her her-life]:channel))
|
|
|
|
:: maybe resend some timed out packets
|
2019-06-25 00:09:42 +03:00
|
|
|
::
|
2019-06-22 00:35:07 +03:00
|
|
|
(run-message-pump bone %wake ~)
|
2019-07-28 10:50:32 +03:00
|
|
|
:: +send-shut-packet: fire encrypted packet at rcvr and maybe sponsors
|
|
|
|
::
|
|
|
|
++ send-shut-packet
|
|
|
|
|= =shut-packet
|
|
|
|
^+ peer-core
|
|
|
|
:: swizzle bone just before sending; TODO document
|
|
|
|
::
|
|
|
|
=. bone.shut-packet (mix 1 bone.shut-packet)
|
|
|
|
::
|
|
|
|
=/ content (encrypt symmetric-key.channel shut-packet)
|
|
|
|
=/ =packet [[our her.channel] encrypted=%.y origin=~ content]
|
|
|
|
=/ =blob (encode-packet packet)
|
|
|
|
::
|
|
|
|
=. event-core (send-blob her.channel blob)
|
|
|
|
peer-core
|
2019-08-05 23:58:53 +03:00
|
|
|
:: +got-duct: look up $duct by .bone, asserting already bound
|
|
|
|
::
|
|
|
|
++ got-duct
|
|
|
|
|= =bone
|
|
|
|
^- ^duct
|
|
|
|
~| %dangling-bone^her.channel^bone
|
|
|
|
(~(got by by-bone.ossuary.peer-state) bone)
|
2019-06-10 19:13:11 +03:00
|
|
|
:: +run-message-pump: process $message-pump-task and its effects
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
|
|
|
++ run-message-pump
|
|
|
|
|= [=bone task=message-pump-task]
|
|
|
|
^+ peer-core
|
|
|
|
:: pass .task to the |message-pump and apply state mutations
|
|
|
|
::
|
|
|
|
=/ =message-pump-state
|
2019-06-30 15:50:00 +03:00
|
|
|
(~(gut by snd.peer-state) bone *message-pump-state)
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-09 09:26:01 +03:00
|
|
|
=/ message-pump (make-message-pump message-pump-state channel)
|
|
|
|
=^ pump-gifts message-pump-state (work:message-pump task)
|
|
|
|
=. snd.peer-state (~(put by snd.peer-state) bone message-pump-state)
|
2019-06-05 07:36:10 +03:00
|
|
|
:: process effects from |message-pump
|
|
|
|
::
|
2019-06-09 09:26:01 +03:00
|
|
|
|^ ^+ peer-core
|
|
|
|
?~ pump-gifts peer-core
|
|
|
|
=* gift i.pump-gifts
|
|
|
|
=. peer-core
|
|
|
|
?- -.gift
|
2019-06-20 11:13:54 +03:00
|
|
|
%done (on-pump-done [message-num ok]:gift)
|
|
|
|
%send (on-pump-send static-fragment.gift)
|
|
|
|
%wait (on-pump-wait date.gift)
|
|
|
|
%rest (on-pump-rest date.gift)
|
2019-06-09 09:26:01 +03:00
|
|
|
==
|
|
|
|
$(pump-gifts t.pump-gifts)
|
2019-06-20 11:13:54 +03:00
|
|
|
:: +on-pump-done: handle |message-pump's report of message (n)ack
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-20 11:13:54 +03:00
|
|
|
++ on-pump-done
|
2019-06-09 09:26:01 +03:00
|
|
|
|= [=message-num ok=?]
|
|
|
|
^+ peer-core
|
2019-06-20 03:48:29 +03:00
|
|
|
:: if odd bone, ack is on "subscription update" message; no-op
|
2019-06-19 03:52:10 +03:00
|
|
|
::
|
2019-06-20 03:48:29 +03:00
|
|
|
?: =(1 (end 0 1 bone))
|
2019-06-19 03:52:10 +03:00
|
|
|
peer-core
|
2019-06-20 03:48:29 +03:00
|
|
|
:: even bone; is this bone a nack-trace bone?
|
2019-06-19 03:38:25 +03:00
|
|
|
::
|
|
|
|
?: =(1 (end 0 1 (rsh 0 1 bone)))
|
2019-06-19 03:52:10 +03:00
|
|
|
:: nack-trace bone; assume .ok, clear nack from |message-still
|
|
|
|
::
|
|
|
|
=/ target-bone=^bone (mix 0b10 bone)
|
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
(run-message-still target-bone %drop message-num)
|
2019-06-19 03:52:10 +03:00
|
|
|
:: not a nack-trace bone; positive ack gets emitted trivially
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-09 09:26:01 +03:00
|
|
|
?: ok
|
2019-08-05 23:58:53 +03:00
|
|
|
(emit (got-duct bone) %give %done error=~)
|
2019-06-19 02:15:50 +03:00
|
|
|
:: nack; enqueue, pending nack-trace message
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
:: The pump must never emit duplicate acks. If we heard the
|
|
|
|
:: nack-trace message already, the pump should not generate a
|
|
|
|
:: duplicate %done event when we hear a message nack packet.
|
2019-06-19 02:15:50 +03:00
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
=/ nax-key [bone message-num]
|
2019-06-19 02:38:20 +03:00
|
|
|
?< (~(has in nax.peer-state) nax-key)
|
|
|
|
=. nax.peer-state (~(put in nax.peer-state) nax-key)
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-06-18 21:21:12 +03:00
|
|
|
peer-core
|
2019-07-24 02:20:21 +03:00
|
|
|
:: +on-pump-send: emit message fragment requested by |message-pump
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-06-20 11:13:54 +03:00
|
|
|
++ on-pump-send
|
2019-06-09 09:26:01 +03:00
|
|
|
|= =static-fragment
|
|
|
|
^+ peer-core
|
|
|
|
:: encrypt and encode .static-fragment to .blob bitstream
|
|
|
|
::
|
2019-06-09 09:40:30 +03:00
|
|
|
%- send-shut-packet :*
|
|
|
|
our-life.channel
|
|
|
|
her-life.channel
|
2019-06-11 23:42:32 +03:00
|
|
|
bone
|
2019-06-09 09:40:30 +03:00
|
|
|
message-num.static-fragment
|
|
|
|
%& +.static-fragment
|
|
|
|
==
|
2019-06-20 11:13:54 +03:00
|
|
|
:: +on-pump-wait: relay |message-pump's set-timer request
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-06-20 11:13:54 +03:00
|
|
|
++ on-pump-wait
|
2019-06-09 09:26:01 +03:00
|
|
|
|= date=@da
|
|
|
|
^+ peer-core
|
|
|
|
::
|
2019-06-19 02:59:25 +03:00
|
|
|
=/ =wire (make-pump-timer-wire her.channel bone)
|
2019-08-05 23:58:53 +03:00
|
|
|
(emit duct %pass wire %b %wait date)
|
2019-06-20 11:13:54 +03:00
|
|
|
:: +on-pump-rest: relay |message-pump's unset-timer request
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-06-20 11:13:54 +03:00
|
|
|
++ on-pump-rest
|
2019-06-09 09:26:01 +03:00
|
|
|
|= date=@da
|
|
|
|
^+ peer-core
|
|
|
|
::
|
2019-06-19 02:59:25 +03:00
|
|
|
=/ =wire (make-pump-timer-wire her.channel bone)
|
2019-08-05 23:58:53 +03:00
|
|
|
(emit duct %pass wire %b %rest date)
|
2019-06-09 09:26:01 +03:00
|
|
|
--
|
2019-06-10 19:13:11 +03:00
|
|
|
:: +run-message-still: process $message-still-task and its effects
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-10 19:13:11 +03:00
|
|
|
++ run-message-still
|
|
|
|
|= [=bone task=message-still-task]
|
2019-06-05 07:36:10 +03:00
|
|
|
^+ peer-core
|
2019-06-10 19:13:11 +03:00
|
|
|
:: pass .task to the |message-still and apply state mutations
|
2019-06-08 12:45:30 +03:00
|
|
|
::
|
2019-06-10 19:13:11 +03:00
|
|
|
=/ =message-still-state
|
2019-06-30 15:50:00 +03:00
|
|
|
(~(gut by rcv.peer-state) bone *message-still-state)
|
2019-06-08 12:45:30 +03:00
|
|
|
::
|
2019-06-10 19:13:11 +03:00
|
|
|
=/ message-still (make-message-still message-still-state channel)
|
|
|
|
=^ still-gifts message-still-state (work:message-still task)
|
|
|
|
=. rcv.peer-state (~(put by rcv.peer-state) bone message-still-state)
|
|
|
|
:: process effects from |message-still
|
2019-06-08 12:45:30 +03:00
|
|
|
::
|
2019-06-20 11:13:54 +03:00
|
|
|
|^ ^+ peer-core
|
|
|
|
?~ still-gifts peer-core
|
|
|
|
=* gift i.still-gifts
|
|
|
|
=. peer-core
|
|
|
|
?- -.gift
|
|
|
|
%memo (on-still-memo [message-num message]:gift)
|
2019-07-28 10:50:32 +03:00
|
|
|
%send (on-still-send [message-num ack-meat]:gift)
|
2019-06-20 11:13:54 +03:00
|
|
|
==
|
|
|
|
$(still-gifts t.still-gifts)
|
|
|
|
:: +on-still-send: emit ack packet as requested by |message-still
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-20 11:13:54 +03:00
|
|
|
++ on-still-send
|
|
|
|
|= [=message-num =ack-meat]
|
|
|
|
^+ peer-core
|
2019-06-20 10:21:37 +03:00
|
|
|
::
|
2019-06-20 11:13:54 +03:00
|
|
|
%- send-shut-packet :*
|
|
|
|
our-life.channel
|
|
|
|
her-life.channel
|
|
|
|
bone
|
|
|
|
message-num
|
|
|
|
%| ack-meat
|
|
|
|
==
|
2019-07-28 10:50:32 +03:00
|
|
|
:: +on-still-memo: dispatch message received by |message-still
|
|
|
|
::
|
|
|
|
:: odd bone: %plea request message
|
|
|
|
:: even bone, 0 second bit: %boon response message
|
|
|
|
:: even bone, 1 second bit: nack-trace %boon message
|
2019-06-20 11:13:54 +03:00
|
|
|
::
|
|
|
|
++ on-still-memo
|
2019-07-28 10:50:32 +03:00
|
|
|
?: =(1 (end 0 1 bone))
|
|
|
|
on-still-plea
|
|
|
|
?: =(0 (end 0 1 (rsh 0 1 bone)))
|
|
|
|
on-still-boon
|
|
|
|
on-still-nack-trace
|
|
|
|
:: +on-still-boon: handle response message received by |message-still
|
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
:: .bone must be mapped in .ossuary.peer-state, or we crash.
|
|
|
|
:: This means a malformed message will kill a channel. We
|
|
|
|
:: could change this to a no-op if we had some sort of security
|
|
|
|
:: reporting.
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
++ on-still-boon
|
|
|
|
|= [=message-num message=*]
|
2019-06-20 11:13:54 +03:00
|
|
|
^+ peer-core
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %ames-still-boon^our^bone=bone
|
|
|
|
:: send ack unconditionally
|
2019-06-20 11:13:54 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
=. peer-core (run-message-still bone %done ok=%.y)
|
2019-08-05 23:58:53 +03:00
|
|
|
:: give message to client vane
|
2019-06-20 11:13:54 +03:00
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
(emit (got-duct bone) %give %boon message)
|
2019-07-28 10:50:32 +03:00
|
|
|
:: +on-still-nack-trace: handle nack-trace received by |message-still
|
|
|
|
::
|
|
|
|
++ on-still-nack-trace
|
|
|
|
|= [=message-num message=*]
|
|
|
|
^+ peer-core
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %ames-still-nack-trace^our^bone=bone
|
2019-06-20 11:13:54 +03:00
|
|
|
::
|
2019-07-29 09:37:49 +03:00
|
|
|
=+ ;; [=failed=^message-num =error] message
|
2019-08-05 23:58:53 +03:00
|
|
|
:: ack nack-trace message (only applied if we don't later crash)
|
2019-07-28 10:50:32 +03:00
|
|
|
::
|
|
|
|
=. peer-core (run-message-still bone %done ok=%.y)
|
2019-08-05 23:58:53 +03:00
|
|
|
:: flip .bone's second bit to find referenced flow
|
2019-07-28 10:50:32 +03:00
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
=/ target-bone=^bone (mix 0b10 bone)
|
|
|
|
=/ nax-key [target-bone failed-message-num]
|
2019-06-20 11:13:54 +03:00
|
|
|
:: if we haven't heard a message nack, pretend we have
|
|
|
|
::
|
|
|
|
:: The nack-trace message counts as a valid message nack on
|
|
|
|
:: the original failed message.
|
|
|
|
::
|
|
|
|
:: This prevents us from having to wait for a message nack
|
|
|
|
:: packet, which would mean we couldn't immediately ack the
|
|
|
|
:: nack-trace message, which would in turn violate the
|
|
|
|
:: semantics of backward flows.
|
|
|
|
::
|
|
|
|
=? peer-core !(~(has in nax.peer-state) nax-key)
|
|
|
|
%- run-message-pump
|
2019-07-28 10:50:32 +03:00
|
|
|
[target-bone %hear failed-message-num %| ok=%.n lag=`@dr`0]
|
2019-06-20 11:13:54 +03:00
|
|
|
:: clear the nack from our state and relay to vane
|
|
|
|
::
|
|
|
|
=. nax.peer-state (~(del in nax.peer-state) nax-key)
|
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
(emit (got-duct target-bone) %give %done `error)
|
2019-07-28 10:50:32 +03:00
|
|
|
:: +on-still-plea: handle request message received by |message-still
|
2019-06-09 09:40:30 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
++ on-still-plea
|
|
|
|
|= [=message-num message=*]
|
|
|
|
^+ peer-core
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %ames-still-plea^our^bone=bone
|
2019-08-06 02:05:40 +03:00
|
|
|
:: is this the first time we're trying to process this message?
|
2019-07-28 10:50:32 +03:00
|
|
|
::
|
2019-08-06 02:05:40 +03:00
|
|
|
?. ?=([%hear * * ok=%.n] task)
|
|
|
|
:: fresh plea; pass to client vane
|
|
|
|
::
|
2019-08-08 07:57:04 +03:00
|
|
|
=+ ;; =plea message
|
|
|
|
::
|
|
|
|
=/ =wire (make-bone-wire her.channel bone)
|
|
|
|
::
|
|
|
|
?+ vane.plea ~| %ames-evil-vane^our^her.channel^vane.plea !!
|
|
|
|
%a (emit duct %pass wire %a %plea her.channel plea)
|
2019-08-06 02:05:40 +03:00
|
|
|
%c (emit duct %pass wire %c %plea her.channel plea)
|
|
|
|
%g (emit duct %pass wire %g %plea her.channel plea)
|
|
|
|
%k (emit duct %pass wire %k %plea her.channel plea)
|
|
|
|
==
|
|
|
|
:: we previously crashed on this message; send nack
|
|
|
|
::
|
|
|
|
=. peer-core (run-message-still bone %done ok=%.n)
|
|
|
|
:: also send nack-trace
|
|
|
|
::
|
|
|
|
=/ nack-trace-bone=^bone (mix 0b10 bone)
|
|
|
|
=/ =message-blob (jam [message-num ~])
|
|
|
|
::
|
|
|
|
(run-message-pump nack-trace-bone %memo message-blob)
|
2019-07-28 10:50:32 +03:00
|
|
|
--
|
2019-06-05 07:36:10 +03:00
|
|
|
--
|
2019-05-28 05:43:47 +03:00
|
|
|
--
|
2019-06-01 06:32:13 +03:00
|
|
|
:: +make-message-pump: constructor for |message-pump
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
++ make-message-pump
|
2019-06-02 01:16:41 +03:00
|
|
|
|= [state=message-pump-state =channel]
|
2019-05-29 01:05:59 +03:00
|
|
|
=| gifts=(list message-pump-gift)
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
|%
|
2019-05-29 05:56:05 +03:00
|
|
|
++ message-pump .
|
|
|
|
++ give |=(gift=message-pump-gift message-pump(gifts [gift gifts]))
|
2019-06-19 02:33:53 +03:00
|
|
|
++ packet-pump (make-packet-pump packet-pump-state.state channel)
|
2019-05-29 05:56:05 +03:00
|
|
|
:: +work: handle a $message-pump-task
|
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
++ work
|
|
|
|
|= task=message-pump-task
|
2019-06-02 01:16:41 +03:00
|
|
|
^+ [gifts state]
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-19 02:33:53 +03:00
|
|
|
=~ (dispatch-task task)
|
2019-05-29 05:56:05 +03:00
|
|
|
feed-packets
|
2019-06-20 10:21:37 +03:00
|
|
|
(run-packet-pump %halt ~)
|
2019-06-02 01:16:41 +03:00
|
|
|
[(flop gifts) state]
|
2019-05-29 05:56:05 +03:00
|
|
|
==
|
2019-06-19 02:33:53 +03:00
|
|
|
:: +dispatch-task: perform task-specific processing
|
|
|
|
::
|
|
|
|
++ dispatch-task
|
|
|
|
|= task=message-pump-task
|
|
|
|
^+ message-pump
|
|
|
|
::
|
|
|
|
?- -.task
|
2019-07-28 10:50:32 +03:00
|
|
|
%memo (on-memo message-blob.task)
|
2019-06-19 02:33:53 +03:00
|
|
|
%wake (run-packet-pump task)
|
2019-06-20 10:21:37 +03:00
|
|
|
%hear
|
2019-06-19 02:33:53 +03:00
|
|
|
?- -.ack-meat.task
|
2019-06-20 10:21:37 +03:00
|
|
|
%& (on-hear [message-num fragment-num=p.ack-meat]:task)
|
|
|
|
%| (on-done [message-num [ok lag]:p.ack-meat]:task)
|
2019-06-19 02:33:53 +03:00
|
|
|
== ==
|
2019-06-25 19:01:05 +03:00
|
|
|
:: +on-memo: handle request to send a message
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-25 19:01:05 +03:00
|
|
|
++ on-memo
|
2019-07-28 10:50:32 +03:00
|
|
|
|= =message-blob
|
2019-05-29 05:56:05 +03:00
|
|
|
^+ message-pump
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
=. unsent-messages.state (~(put to unsent-messages.state) message-blob)
|
2019-05-29 05:56:05 +03:00
|
|
|
message-pump
|
2019-06-20 10:21:37 +03:00
|
|
|
:: +on-hear: handle packet acknowledgment
|
2019-06-02 01:16:41 +03:00
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
++ on-hear
|
2019-06-02 01:16:41 +03:00
|
|
|
|= [=message-num =fragment-num]
|
|
|
|
^+ message-pump
|
|
|
|
:: pass to |packet-pump unless duplicate or future ack
|
|
|
|
::
|
|
|
|
?. (is-message-num-in-range message-num)
|
|
|
|
message-pump
|
2019-06-20 10:21:37 +03:00
|
|
|
(run-packet-pump %hear message-num fragment-num)
|
|
|
|
:: +on-done: handle message acknowledgment
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
++ on-done
|
2019-06-21 04:36:16 +03:00
|
|
|
:: check-old: loop terminator variable
|
|
|
|
::
|
|
|
|
=/ check-old=? %.y
|
2019-05-29 05:56:05 +03:00
|
|
|
|= [=message-num ok=? lag=@dr]
|
|
|
|
^+ message-pump
|
2019-06-21 04:36:16 +03:00
|
|
|
:: unsent messages from the future should never get acked
|
|
|
|
::
|
|
|
|
?> (lth message-num next.state)
|
|
|
|
:: ignore duplicate message acks
|
|
|
|
::
|
|
|
|
?: (lth message-num current.state)
|
|
|
|
message-pump
|
2019-06-20 03:08:38 +03:00
|
|
|
:: future nack implies positive ack on all earlier messages
|
|
|
|
::
|
2019-06-21 04:36:16 +03:00
|
|
|
?: &(!ok check-old)
|
2019-06-20 03:08:38 +03:00
|
|
|
|- ^+ message-pump
|
|
|
|
:: base case: current message got nacked; handle same as ack
|
|
|
|
::
|
|
|
|
?: =(message-num current.state)
|
2019-06-21 04:36:16 +03:00
|
|
|
^$(check-old %.n)
|
2019-06-20 03:08:38 +03:00
|
|
|
:: recursive case: future message got nacked
|
|
|
|
::
|
|
|
|
=. message-pump ^$(ok %.y, message-num current.state)
|
|
|
|
$
|
2019-06-02 01:16:41 +03:00
|
|
|
:: ignore duplicate and future acks
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
?. (is-message-num-in-range message-num)
|
2019-05-29 05:56:05 +03:00
|
|
|
message-pump
|
|
|
|
:: clear and print .unsent-fragments if nonempty
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=? unsent-fragments.state
|
2019-06-09 09:31:42 +03:00
|
|
|
&(=(current next) ?=(^ unsent-fragments)):state
|
2019-06-02 01:16:41 +03:00
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
~& %early-message-ack^ok^her.channel
|
|
|
|
~
|
|
|
|
:: clear all packets from this message from the packet pump
|
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
=. message-pump (run-packet-pump %done message-num lag)
|
2019-06-02 01:16:41 +03:00
|
|
|
:: enqueue this ack to be sent back to local client vane
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=. queued-message-acks.state
|
|
|
|
(~(put by queued-message-acks.state) message-num ok)
|
|
|
|
:: emit local acks from .queued-message-acks until incomplete
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
|
|
|
|- ^+ message-pump
|
2019-06-02 01:16:41 +03:00
|
|
|
:: if .current hasn't been fully acked, we're done
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
?~ ack=(~(get by queued-message-acks.state) current.state)
|
2019-05-29 05:56:05 +03:00
|
|
|
message-pump
|
2019-06-02 01:16:41 +03:00
|
|
|
:: .current is complete; pop, emit local ack, and try next message
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=. queued-message-acks.state
|
|
|
|
(~(del by queued-message-acks.state) current.state)
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
=. message-pump (give %done current.state ok.u.ack)
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
$(current.state +(current.state))
|
|
|
|
:: +is-message-num-in-range: %.y unless duplicate or future ack
|
|
|
|
::
|
|
|
|
++ is-message-num-in-range
|
|
|
|
|= =message-num
|
|
|
|
^- ?
|
|
|
|
::
|
|
|
|
?: (gte message-num next.state)
|
|
|
|
%.n
|
|
|
|
?: (lth message-num current.state)
|
|
|
|
%.n
|
|
|
|
!(~(has by queued-message-acks.state) message-num)
|
2019-06-01 06:32:13 +03:00
|
|
|
:: +feed-packets: give packets to |packet-pump until full
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
|
|
|
++ feed-packets
|
|
|
|
:: if nothing to send, no-op
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
?: &(=(~ unsent-messages) =(~ unsent-fragments)):state
|
2019-05-29 05:56:05 +03:00
|
|
|
message-pump
|
|
|
|
:: we have unsent fragments of the current message; feed them
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
?. =(~ unsent-fragments.state)
|
|
|
|
=/ res (feed:packet-pump unsent-fragments.state)
|
|
|
|
=+ [unsent packet-pump-gifts packet-pump-state]=res
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=. unsent-fragments.state unsent
|
|
|
|
=. packet-pump-state.state packet-pump-state
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
|
|
|
=. message-pump (process-packet-pump-gifts packet-pump-gifts)
|
|
|
|
:: if it sent all of them, feed it more; otherwise, we're done
|
|
|
|
::
|
|
|
|
?~ unsent
|
|
|
|
feed-packets
|
|
|
|
message-pump
|
|
|
|
:: .unsent-messages is nonempty; pop a message off and feed it
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
=^ =message-blob unsent-messages.state ~(get to unsent-messages.state)
|
2019-06-01 06:32:13 +03:00
|
|
|
:: break .message into .chunks and set as .unsent-fragments
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
=. unsent-fragments.state (split-message next.state message-blob)
|
2019-06-01 06:32:13 +03:00
|
|
|
:: try to feed packets from the next message
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=. next.state +(next.state)
|
2019-05-29 05:56:05 +03:00
|
|
|
feed-packets
|
2019-06-01 06:32:13 +03:00
|
|
|
:: +run-packet-pump: call +work:packet-pump and process results
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
|
|
|
++ run-packet-pump
|
|
|
|
|= =packet-pump-task
|
|
|
|
^+ message-pump
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=^ packet-pump-gifts packet-pump-state.state
|
2019-05-29 05:56:05 +03:00
|
|
|
(work:packet-pump packet-pump-task)
|
|
|
|
::
|
|
|
|
(process-packet-pump-gifts packet-pump-gifts)
|
2019-06-01 06:32:13 +03:00
|
|
|
:: +process-packet-pump-gifts: pass |packet-pump effects up the chain
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
|
|
|
++ process-packet-pump-gifts
|
|
|
|
|= packet-pump-gifts=(list packet-pump-gift)
|
|
|
|
^+ message-pump
|
|
|
|
::
|
|
|
|
?~ packet-pump-gifts
|
|
|
|
message-pump
|
|
|
|
=. message-pump (give i.packet-pump-gifts)
|
|
|
|
::
|
|
|
|
$(packet-pump-gifts t.packet-pump-gifts)
|
|
|
|
--
|
2019-06-01 06:32:13 +03:00
|
|
|
:: +make-packet-pump: construct |packet-pump core
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
|
|
|
++ make-packet-pump
|
2019-06-01 05:03:09 +03:00
|
|
|
|= [state=packet-pump-state =channel]
|
2019-05-29 05:56:05 +03:00
|
|
|
=| gifts=(list packet-pump-gift)
|
|
|
|
|%
|
|
|
|
++ packet-pump .
|
2019-06-01 03:50:22 +03:00
|
|
|
++ give |=(packet-pump-gift packet-pump(gifts [+< gifts]))
|
2019-06-01 06:32:13 +03:00
|
|
|
:: +packet-queue: type for all sent fragments, ordered by sequence number
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
|
|
|
++ packet-queue
|
|
|
|
%- (ordered-map live-packet-key live-packet-val)
|
|
|
|
|= [a=live-packet-key b=live-packet-key]
|
|
|
|
^- ?
|
|
|
|
::
|
|
|
|
?: (lth message-num.a message-num.b)
|
|
|
|
%.y
|
|
|
|
?: (gth message-num.a message-num.b)
|
|
|
|
%.n
|
|
|
|
(lte fragment-num.a fragment-num.b)
|
|
|
|
:: +gauge: inflate a |pump-gauge to track congestion control
|
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
++ gauge (make-pump-gauge now.channel metrics.state)
|
2019-06-01 01:35:06 +03:00
|
|
|
:: +work: handle $packet-pump-task request
|
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
++ work
|
|
|
|
|= task=packet-pump-task
|
2019-06-01 05:03:09 +03:00
|
|
|
^+ [gifts state]
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
=- [(flop gifts) state]
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
?- -.task
|
2019-06-20 10:21:37 +03:00
|
|
|
%hear (on-hear [message-num fragment-num]:task)
|
|
|
|
%done (on-done message-num.task)
|
|
|
|
%wake resend-lost(next-wake.state ~)
|
|
|
|
%halt set-wake
|
2019-05-29 01:05:59 +03:00
|
|
|
==
|
2019-06-02 01:16:41 +03:00
|
|
|
:: +resend-lost: resend as many lost packets as .gauge will allow
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
++ resend-lost
|
2019-06-01 01:35:06 +03:00
|
|
|
^+ packet-pump
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
=- =. packet-pump core.-
|
|
|
|
=. live.state live.-
|
2019-06-01 03:50:22 +03:00
|
|
|
packet-pump
|
2019-06-02 01:16:41 +03:00
|
|
|
:: acc: state to thread through traversal
|
|
|
|
::
|
|
|
|
:: num-slots: start with max retries; decrement on each resend
|
|
|
|
::
|
|
|
|
=| $= acc
|
|
|
|
$: num-slots=_num-retry-slots:gauge
|
|
|
|
core=_packet-pump
|
|
|
|
==
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
^+ [acc live=live.state]
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
2019-06-26 21:17:30 +03:00
|
|
|
%^ (traverse:packet-queue _acc) live.state acc
|
2019-06-02 01:16:41 +03:00
|
|
|
|= $: acc=_acc
|
2019-06-01 03:50:22 +03:00
|
|
|
key=live-packet-key
|
|
|
|
val=live-packet-val
|
|
|
|
==
|
2019-06-02 01:16:41 +03:00
|
|
|
^- [new-val=(unit live-packet-val) stop=? _acc]
|
2019-06-01 03:50:22 +03:00
|
|
|
:: load mutant environment
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=. packet-pump core.acc
|
2019-06-01 03:50:22 +03:00
|
|
|
:: if we can't send any more packets, we're done
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
?: =(0 num-slots.acc)
|
|
|
|
[`val stop=%.y acc]
|
2019-06-01 03:50:22 +03:00
|
|
|
:: if the packet hasn't expired, we're done
|
|
|
|
::
|
|
|
|
?: (gte expiry.val now.channel)
|
2019-06-02 01:16:41 +03:00
|
|
|
[`val stop=%.y acc]
|
|
|
|
:: packet has expired so re-send it
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
|
|
|
=/ =static-fragment
|
|
|
|
=> [key val]
|
|
|
|
[message-num num-fragments fragment-num fragment]
|
|
|
|
::
|
2019-06-01 06:05:21 +03:00
|
|
|
=. packet-pump (give %send static-fragment)
|
|
|
|
=. metrics.state (on-resent:gauge -.val)
|
2019-06-02 01:16:41 +03:00
|
|
|
:: update $sent-packet-state in .val and continue
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
2019-06-01 06:05:21 +03:00
|
|
|
=. expiry.val (next-retry-expiry:gauge -.val)
|
2019-06-01 03:50:22 +03:00
|
|
|
=. sent-date.val now.channel
|
|
|
|
=. retried.val %.y
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
[`val stop=%.n (dec num-slots.acc) packet-pump]
|
|
|
|
:: +feed: try to send a list of packets, returning unsent and effects
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
++ feed
|
2019-05-29 05:56:05 +03:00
|
|
|
|= fragments=(list static-fragment)
|
2019-06-01 05:03:09 +03:00
|
|
|
^+ [fragments gifts state]
|
2019-06-02 01:16:41 +03:00
|
|
|
:: return unsent back to caller and reverse effects to finalize
|
|
|
|
::
|
2019-07-30 08:21:35 +03:00
|
|
|
=- ::~& %alef-feed^(lent fragments)^%unsent^(lent unsent)
|
2019-07-24 02:20:21 +03:00
|
|
|
[unsent (flop gifts) state]
|
2019-06-02 01:16:41 +03:00
|
|
|
::
|
|
|
|
^+ [unsent=fragments packet-pump]
|
|
|
|
:: resend lost packets first, possibly adjusting congestion control
|
|
|
|
::
|
|
|
|
=. packet-pump resend-lost
|
2019-06-01 06:05:21 +03:00
|
|
|
:: bite off as many fragments as we can send
|
|
|
|
::
|
|
|
|
=/ num-slots num-slots:gauge
|
|
|
|
=/ sent (scag num-slots fragments)
|
|
|
|
=/ unsent (slag num-slots fragments)
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
:- unsent
|
|
|
|
^+ packet-pump
|
|
|
|
:: if nothing to send, we're done
|
|
|
|
::
|
|
|
|
?~ sent packet-pump
|
|
|
|
:: convert $static-fragment's into +ordered-set [key val] pairs
|
|
|
|
::
|
|
|
|
=/ send-list
|
2019-06-01 06:05:21 +03:00
|
|
|
%+ turn sent
|
|
|
|
|= static-fragment
|
2019-06-02 01:16:41 +03:00
|
|
|
^- [key=live-packet-key val=live-packet-val]
|
2019-06-01 06:05:21 +03:00
|
|
|
::
|
|
|
|
:- [message-num fragment-num]
|
2019-06-02 01:16:41 +03:00
|
|
|
:- :+ expiry=next-expiry:gauge
|
2019-06-01 06:05:21 +03:00
|
|
|
sent-date=now.channel
|
|
|
|
retried=%.n
|
|
|
|
[num-fragments fragment]
|
2019-06-02 01:16:41 +03:00
|
|
|
:: update .live and .metrics
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=. live.state (gas:packet-queue live.state send-list)
|
|
|
|
=. metrics.state (on-sent:gauge (lent send-list))
|
|
|
|
:: TMI
|
2019-06-01 06:05:21 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=> .(sent `(list static-fragment)`sent)
|
|
|
|
:: emit a $packet-pump-gift for each packet to send
|
|
|
|
::
|
|
|
|
|- ^+ packet-pump
|
|
|
|
?~ sent packet-pump
|
|
|
|
=. packet-pump (give %send i.sent)
|
|
|
|
$(sent t.sent)
|
2019-06-20 10:21:37 +03:00
|
|
|
:: +on-hear: handle ack on a live packet
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
:: Traverse .live from the head, marking packets as lost until we
|
|
|
|
:: find the acked packet. Then delete the acked packet and try to
|
|
|
|
:: resend lost packets.
|
|
|
|
::
|
|
|
|
:: If we don't find the acked packet, no-op: no mutations, effects,
|
|
|
|
:: or resending of lost packets.
|
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
++ on-hear
|
2019-06-01 01:35:06 +03:00
|
|
|
|= [=message-num =fragment-num]
|
|
|
|
^+ packet-pump
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=- :: if no sent packet matches the ack, don't apply mutations or effects
|
|
|
|
::
|
|
|
|
?. found.-
|
2019-07-29 09:37:49 +03:00
|
|
|
~& %alef-hear-noop
|
2019-06-02 01:16:41 +03:00
|
|
|
packet-pump
|
2019-07-30 08:21:35 +03:00
|
|
|
::~& %alef-hear-ack^message-num^fragment-num
|
2019-06-02 01:16:41 +03:00
|
|
|
::
|
|
|
|
=. metrics.state metrics.-
|
2019-06-01 05:03:09 +03:00
|
|
|
=. live.state live.-
|
2019-06-02 01:16:41 +03:00
|
|
|
::
|
|
|
|
resend-lost
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
^- $: [found=? metrics=pump-metrics]
|
|
|
|
live=(tree [live-packet-key live-packet-val])
|
|
|
|
==
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=/ acc=[found=? metrics=pump-metrics] [%.n metrics.state]
|
|
|
|
::
|
2019-06-26 21:17:30 +03:00
|
|
|
%^ (traverse:packet-queue _acc) live.state acc
|
2019-06-02 01:16:41 +03:00
|
|
|
|= $: acc=_acc
|
2019-06-01 01:35:06 +03:00
|
|
|
key=live-packet-key
|
|
|
|
val=live-packet-val
|
|
|
|
==
|
2019-06-02 01:16:41 +03:00
|
|
|
^- [new-val=(unit live-packet-val) stop=? _acc]
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=/ gauge (make-pump-gauge now.channel metrics.acc)
|
2019-06-01 01:35:06 +03:00
|
|
|
:: is this the acked packet?
|
|
|
|
::
|
|
|
|
?: =(key [message-num fragment-num])
|
|
|
|
:: delete acked packet, update metrics, and stop traversal
|
|
|
|
::
|
|
|
|
:+ new-val=~
|
|
|
|
stop=%.y
|
2019-06-02 01:16:41 +03:00
|
|
|
[found=%.y metrics=(on-ack:gauge -.val)]
|
2019-06-01 01:35:06 +03:00
|
|
|
:: ack was out of order; mark expired, tell gauge, and continue
|
|
|
|
::
|
|
|
|
:+ new-val=`val(expiry `@da`0)
|
|
|
|
stop=%.n
|
2019-06-02 01:16:41 +03:00
|
|
|
[found=%.n metrics=(on-skipped-packet:gauge -.val)]
|
2019-06-20 10:21:37 +03:00
|
|
|
:: +on-done: apply ack to all packets from .message-num
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
++ on-done
|
2019-05-29 05:56:05 +03:00
|
|
|
|= =message-num
|
|
|
|
^+ packet-pump
|
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=- =. metrics.state metrics.-
|
|
|
|
=. live.state live.-
|
|
|
|
::
|
|
|
|
resend-lost
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
^- $: metrics=pump-metrics
|
|
|
|
live=(tree [live-packet-key live-packet-val])
|
|
|
|
==
|
|
|
|
::
|
2019-06-26 21:17:30 +03:00
|
|
|
%^ (traverse:packet-queue pump-metrics) live.state acc=metrics.state
|
2019-06-02 01:16:41 +03:00
|
|
|
|= $: metrics=pump-metrics
|
|
|
|
key=live-packet-key
|
|
|
|
val=live-packet-val
|
|
|
|
==
|
|
|
|
^- [new-val=(unit live-packet-val) stop=? pump-metrics]
|
|
|
|
::
|
|
|
|
=/ gauge (make-pump-gauge now.channel metrics)
|
|
|
|
:: if ack was out of order, mark expired and continue
|
|
|
|
::
|
|
|
|
?: (lth message-num.key message-num)
|
|
|
|
:+ new-val=`val(expiry `@da`0)
|
|
|
|
stop=%.n
|
|
|
|
metrics=(on-skipped-packet:gauge -.val)
|
|
|
|
:: if packet was from acked message, delete it and continue
|
|
|
|
::
|
|
|
|
?: =(message-num.key message-num)
|
|
|
|
[new-val=~ stop=%.n metrics=(on-ack:gauge -.val)]
|
|
|
|
:: we've gone past the acked message; we're done
|
|
|
|
::
|
|
|
|
[new-val=`val stop=%.y metrics]
|
|
|
|
:: +set-wake: set, unset, or reset timer, emitting moves
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
++ set-wake
|
2019-05-29 05:56:05 +03:00
|
|
|
^+ packet-pump
|
2019-06-02 01:16:41 +03:00
|
|
|
:: if nonempty .live, peek at head to get next wake time
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-02 01:16:41 +03:00
|
|
|
=/ new-wake=(unit @da)
|
|
|
|
?~ head=(peek:packet-queue live.state)
|
|
|
|
~
|
|
|
|
`expiry.val.u.head
|
|
|
|
:: no-op if no change
|
|
|
|
::
|
|
|
|
?: =(new-wake next-wake.state) packet-pump
|
|
|
|
:: unset old timer if non-null
|
|
|
|
::
|
|
|
|
=? packet-pump !=(~ next-wake.state)
|
|
|
|
=/ old (need next-wake.state)
|
|
|
|
=. next-wake.state ~
|
|
|
|
(give %rest old)
|
|
|
|
:: set new timer if non-null
|
|
|
|
::
|
|
|
|
=? packet-pump ?=(^ new-wake)
|
|
|
|
=. next-wake.state new-wake
|
|
|
|
(give %wait u.new-wake)
|
|
|
|
::
|
|
|
|
packet-pump
|
2019-06-01 01:35:06 +03:00
|
|
|
--
|
2019-06-01 03:50:22 +03:00
|
|
|
:: +make-pump-gauge: construct |pump-gauge congestion control core
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-01 06:05:21 +03:00
|
|
|
:: TODO: actual congestion control
|
|
|
|
::
|
2019-06-01 01:35:06 +03:00
|
|
|
++ make-pump-gauge
|
2019-06-01 05:03:09 +03:00
|
|
|
|= [now=@da pump-metrics]
|
|
|
|
=* metrics +<+
|
2019-06-01 01:35:06 +03:00
|
|
|
|%
|
2019-06-01 06:05:21 +03:00
|
|
|
:: +next-expiry: when should a newly sent fresh packet time out?
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
|
|
|
++ next-expiry
|
|
|
|
^- @da
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-04 15:38:08 +03:00
|
|
|
(add now ~s5)
|
2019-06-01 06:05:21 +03:00
|
|
|
:: +next-retry-expiry: when should a resent packet time out?
|
|
|
|
::
|
|
|
|
++ next-retry-expiry
|
|
|
|
|= sent-packet-state
|
|
|
|
^- @da
|
2019-06-01 03:50:22 +03:00
|
|
|
(add now ~s10)
|
|
|
|
:: +has-slot: can we send a packet right now?
|
|
|
|
::
|
|
|
|
++ has-slot
|
|
|
|
^- ?
|
2019-06-01 06:05:21 +03:00
|
|
|
(gth num-slots 0)
|
|
|
|
:: +num-slots: how many packets can we send right now?
|
|
|
|
::
|
|
|
|
++ num-slots
|
|
|
|
^- @ud
|
|
|
|
?. (gth max-live num-live)
|
|
|
|
0
|
|
|
|
(sub max-live num-live)
|
2019-06-02 01:16:41 +03:00
|
|
|
:: +num-retry-slots: how many lost packets can we resend right now?
|
|
|
|
::
|
|
|
|
++ num-retry-slots
|
|
|
|
^- @ud
|
|
|
|
max-live
|
2019-06-01 03:50:22 +03:00
|
|
|
:: +on-skipped-packet: adjust metrics based on a misordered ack
|
|
|
|
::
|
|
|
|
:: TODO: decrease .max-live
|
|
|
|
::
|
|
|
|
++ on-skipped-packet
|
|
|
|
|= sent-packet-state
|
2019-06-01 05:03:09 +03:00
|
|
|
metrics
|
2019-06-01 03:50:22 +03:00
|
|
|
:: +on-ack: adjust metrics based on a packet getting acknowledged
|
|
|
|
::
|
|
|
|
:: TODO: adjust .rtt and .max-live
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
|
|
|
++ on-ack
|
2019-06-01 03:50:22 +03:00
|
|
|
|= sent-packet-state
|
2019-06-01 05:03:09 +03:00
|
|
|
^- pump-metrics
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
metrics(num-live (dec num-live))
|
2019-06-01 06:05:21 +03:00
|
|
|
:: +on-sent: adjust metrics based on sending .num-sent fresh packets
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
|
|
|
++ on-sent
|
2019-06-01 06:05:21 +03:00
|
|
|
|= num-sent=@ud
|
|
|
|
^- pump-metrics
|
|
|
|
::
|
|
|
|
metrics(num-live (add num-sent num-live))
|
|
|
|
:: +on-resent: adjust metrics based on retrying an expired packet
|
|
|
|
::
|
|
|
|
++ on-resent
|
2019-06-01 03:50:22 +03:00
|
|
|
|= sent-packet-state
|
2019-06-01 05:03:09 +03:00
|
|
|
^- pump-metrics
|
2019-06-04 15:38:08 +03:00
|
|
|
metrics
|
2019-05-29 01:05:59 +03:00
|
|
|
--
|
2019-08-06 02:05:40 +03:00
|
|
|
:: +make-message-still: construct |message-still message receiver core
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
++ make-message-still
|
2019-06-09 20:32:15 +03:00
|
|
|
|= [state=message-still-state =channel]
|
2019-05-29 01:05:59 +03:00
|
|
|
=| gifts=(list message-still-gift)
|
|
|
|
|%
|
2019-06-09 20:32:15 +03:00
|
|
|
++ message-still .
|
|
|
|
++ give |=(message-still-gift message-still(gifts [+< gifts]))
|
2019-05-29 01:05:59 +03:00
|
|
|
++ work
|
|
|
|
|= task=message-still-task
|
2019-06-09 20:32:15 +03:00
|
|
|
^+ [gifts state]
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-09 20:32:15 +03:00
|
|
|
=- [(flop gifts) state]
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
?- -.task
|
2019-06-20 10:21:37 +03:00
|
|
|
%done (on-done ok.task)
|
|
|
|
%drop (on-drop message-num.task)
|
2019-08-06 02:05:40 +03:00
|
|
|
%hear (on-hear [lane shut-packet ok]:task)
|
2019-05-29 01:05:59 +03:00
|
|
|
==
|
2019-06-11 23:22:24 +03:00
|
|
|
:: +on-hear: receive message fragment, possibly completing message
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
++ on-hear
|
2019-08-06 02:05:40 +03:00
|
|
|
|= [=lane =shut-packet ok=?]
|
2019-06-09 20:32:15 +03:00
|
|
|
^+ message-still
|
|
|
|
:: we know this is a fragment, not an ack; expose into namespace
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-09 20:32:15 +03:00
|
|
|
?> ?=(%& -.meat.shut-packet)
|
|
|
|
=+ [num-fragments fragment-num fragment]=+.meat.shut-packet
|
|
|
|
:: seq: message sequence number, for convenience
|
|
|
|
::
|
|
|
|
=/ seq message-num.shut-packet
|
|
|
|
:: ignore messages from far future; limit to 10 in progress
|
|
|
|
::
|
|
|
|
?: (gte seq (add 10 last-acked.state))
|
2019-08-01 07:24:54 +03:00
|
|
|
~& %ignoring-packet-from-future^seq^last-acked.state
|
2019-06-09 20:32:15 +03:00
|
|
|
message-still
|
|
|
|
::
|
|
|
|
=/ is-last-fragment=? =(+(fragment-num) num-fragments)
|
|
|
|
:: always ack a dupe!
|
|
|
|
::
|
|
|
|
?: (lte seq last-acked.state)
|
|
|
|
?. is-last-fragment
|
|
|
|
:: single packet ack
|
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %send-dupe-ack^our.channel^seq^fragment-num
|
2019-06-20 10:21:37 +03:00
|
|
|
(give %send seq %& fragment-num)
|
2019-06-19 03:38:25 +03:00
|
|
|
:: whole message (n)ack
|
2019-06-09 20:32:15 +03:00
|
|
|
::
|
2019-06-19 03:38:25 +03:00
|
|
|
=/ ok=? (~(has in nax.state) seq)
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %send-dupe-ack-whole-message^our.channel^seq
|
2019-06-20 10:21:37 +03:00
|
|
|
(give %send seq %| ok lag=`@dr`0)
|
2019-06-09 20:32:15 +03:00
|
|
|
:: last-acked<seq<=last-heard; heard message, unprocessed
|
|
|
|
::
|
|
|
|
?: (lte seq last-heard.state)
|
|
|
|
?: is-last-fragment
|
|
|
|
:: drop last packet since we don't know whether to ack or nack
|
|
|
|
::
|
2019-08-08 07:57:04 +03:00
|
|
|
~& %repeat-last-unprocessed^our.channel^her.channel^seq^last-heard.state^pending-vane-ack.state
|
2019-06-09 20:32:15 +03:00
|
|
|
message-still
|
|
|
|
:: ack all other packets
|
|
|
|
::
|
2019-08-02 02:46:36 +03:00
|
|
|
::~& %send-ack^seq^fragment-num
|
2019-06-20 10:21:37 +03:00
|
|
|
(give %send seq %& fragment-num)
|
2019-06-09 20:32:15 +03:00
|
|
|
:: last-heard<seq<10+last-heard; this is a packet in a live message
|
|
|
|
::
|
|
|
|
=/ =partial-rcv-message
|
|
|
|
:: create default if first fragment
|
|
|
|
::
|
|
|
|
?~ existing=(~(get by live-messages.state) seq)
|
|
|
|
[num-fragments num-received=0 fragments=~]
|
|
|
|
:: we have an existing partial message; check parameters match
|
|
|
|
::
|
|
|
|
?> (gth num-fragments.u.existing fragment-num)
|
|
|
|
?> =(num-fragments.u.existing num-fragments)
|
|
|
|
::
|
|
|
|
u.existing
|
|
|
|
::
|
2019-08-01 06:14:28 +03:00
|
|
|
=/ already-heard-fragment=?
|
2019-07-29 12:08:26 +03:00
|
|
|
(~(has by fragments.partial-rcv-message) fragment-num)
|
2019-06-09 20:32:15 +03:00
|
|
|
:: ack dupes except for the last fragment, in which case drop
|
|
|
|
::
|
2019-08-01 06:14:28 +03:00
|
|
|
?: already-heard-fragment
|
2019-06-09 20:32:15 +03:00
|
|
|
?: is-last-fragment
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %already-heard-last-fragment^our.channel^seq^fragment-num
|
2019-06-09 20:32:15 +03:00
|
|
|
message-still
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %send-dupe-ack-fragment^our.channel^seq^fragment-num
|
2019-06-20 10:21:37 +03:00
|
|
|
(give %send seq %& fragment-num)
|
2019-06-09 20:32:15 +03:00
|
|
|
:: new fragment; store in state and check if message is done
|
|
|
|
::
|
|
|
|
=. num-received.partial-rcv-message
|
|
|
|
+(num-received.partial-rcv-message)
|
|
|
|
::
|
|
|
|
=. fragments.partial-rcv-message
|
|
|
|
(~(put by fragments.partial-rcv-message) fragment-num fragment)
|
|
|
|
::
|
|
|
|
=. live-messages.state
|
|
|
|
(~(put by live-messages.state) seq partial-rcv-message)
|
|
|
|
:: ack any packet other than the last one, and continue either way
|
|
|
|
::
|
|
|
|
=? message-still !is-last-fragment
|
2019-08-02 02:46:36 +03:00
|
|
|
::~& %send-ack^seq^fragment-num
|
2019-06-20 10:21:37 +03:00
|
|
|
(give %send seq %& fragment-num)
|
2019-06-09 20:32:15 +03:00
|
|
|
:: enqueue all completed messages starting at +(last-heard.state)
|
|
|
|
::
|
|
|
|
|- ^+ message-still
|
|
|
|
:: if this is not the next message to ack, we're done
|
|
|
|
::
|
|
|
|
?. =(seq +(last-heard.state))
|
|
|
|
message-still
|
|
|
|
:: if we haven't heard anything from this message, we're done
|
|
|
|
::
|
|
|
|
?~ live=(~(get by live-messages.state) seq)
|
|
|
|
message-still
|
|
|
|
:: if the message isn't done yet, we're done
|
|
|
|
::
|
|
|
|
?. =(num-received num-fragments):u.live
|
|
|
|
message-still
|
|
|
|
:: we have whole message; update state, assemble, and send to vane
|
|
|
|
::
|
|
|
|
=. last-heard.state +(last-heard.state)
|
|
|
|
=. live-messages.state (~(del by live-messages.state) seq)
|
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
~& %ames-still-rcv-kb-on^our.channel^%from^her.channel^seq^num-fragments.u.live
|
2019-07-28 10:50:32 +03:00
|
|
|
=/ message=* (assemble-fragments [num-fragments fragments]:u.live)
|
2019-06-09 20:32:15 +03:00
|
|
|
=. message-still (enqueue-to-vane seq message)
|
|
|
|
::
|
|
|
|
$(seq +(seq))
|
2019-06-19 03:38:25 +03:00
|
|
|
:: +enqueue-to-vane: enqueue message to be sent to local vane
|
2019-06-09 20:32:15 +03:00
|
|
|
::
|
|
|
|
++ enqueue-to-vane
|
2019-07-28 10:50:32 +03:00
|
|
|
|= [seq=message-num message=*]
|
2019-06-09 20:32:15 +03:00
|
|
|
^+ message-still
|
|
|
|
::
|
|
|
|
=/ empty=? =(~ pending-vane-ack.state)
|
|
|
|
=. pending-vane-ack.state (~(put to pending-vane-ack.state) seq message)
|
|
|
|
?. empty
|
|
|
|
message-still
|
2019-06-20 10:21:37 +03:00
|
|
|
(give %memo seq message)
|
2019-06-11 03:31:50 +03:00
|
|
|
:: +on-done: handle confirmation of message processing from vane
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
++ on-done
|
2019-06-18 21:21:12 +03:00
|
|
|
|= ok=?
|
2019-06-09 20:32:15 +03:00
|
|
|
^+ message-still
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-11 03:31:50 +03:00
|
|
|
=^ pending pending-vane-ack.state ~(get to pending-vane-ack.state)
|
2019-06-19 03:38:25 +03:00
|
|
|
=/ =message-num message-num.p.pending
|
|
|
|
::
|
|
|
|
=. last-acked.state +(last-acked.state)
|
|
|
|
=? nax.state !ok (~(put in nax.state) message-num)
|
2019-06-11 03:31:50 +03:00
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
(give %send message-num %| ok lag=`@dr`0)
|
|
|
|
:: +on-drop: drop .message-num from our .nax state
|
2019-06-19 03:38:25 +03:00
|
|
|
::
|
2019-06-20 10:21:37 +03:00
|
|
|
++ on-drop
|
2019-06-19 03:38:25 +03:00
|
|
|
|= =message-num
|
|
|
|
^+ message-still
|
|
|
|
::
|
|
|
|
=. nax.state (~(del in nax.state) message-num)
|
|
|
|
::
|
|
|
|
message-still
|
2019-05-29 01:05:59 +03:00
|
|
|
--
|
2019-08-08 07:57:04 +03:00
|
|
|
:: +qos-update-text: notice text for if connection state changes
|
|
|
|
::
|
|
|
|
++ qos-update-text
|
|
|
|
|= [=ship old=qos new=qos]
|
|
|
|
^- (unit tape)
|
|
|
|
::
|
|
|
|
?+ [-.old -.new] ~
|
|
|
|
[%unborn %live] `"; {(scow %p ship)} is your neighbor"
|
|
|
|
[%live %dead] `"; {(scow %p ship)} not responding still trying"
|
|
|
|
[%dead %live] `"; {(scow %p ship)} is ok"
|
|
|
|
[%live %unborn] `"; {(scow %p ship)} is dead"
|
|
|
|
[%dead %unborn] `"; {(scow %p ship)} is dead"
|
|
|
|
==
|
2019-06-20 10:39:38 +03:00
|
|
|
:: +split-message: split message into kilobyte-sized fragments
|
|
|
|
::
|
|
|
|
++ split-message
|
2019-07-28 10:50:32 +03:00
|
|
|
|= [=message-num =message-blob]
|
2019-06-20 10:39:38 +03:00
|
|
|
^- (list static-fragment)
|
|
|
|
::
|
2019-07-28 10:50:32 +03:00
|
|
|
=/ fragments=(list fragment) (rip 13 message-blob)
|
2019-06-20 10:39:38 +03:00
|
|
|
=/ num-fragments=fragment-num (lent fragments)
|
|
|
|
=| counter=@
|
|
|
|
::
|
|
|
|
|- ^- (list static-fragment)
|
|
|
|
?~ fragments ~
|
|
|
|
::
|
|
|
|
:- [message-num num-fragments counter i.fragments]
|
|
|
|
::
|
|
|
|
$(fragments t.fragments, counter +(counter))
|
2019-06-09 20:32:15 +03:00
|
|
|
:: +assemble-fragments: concatenate fragments into a $message
|
|
|
|
::
|
|
|
|
++ assemble-fragments
|
|
|
|
|= [num-fragments=fragment-num fragments=(map fragment-num fragment)]
|
2019-07-29 09:37:49 +03:00
|
|
|
^- *
|
2019-06-09 20:32:15 +03:00
|
|
|
::
|
|
|
|
=| sorted=(list fragment)
|
|
|
|
=. sorted
|
|
|
|
=/ index=fragment-num 0
|
|
|
|
|- ^+ sorted
|
|
|
|
?: =(index num-fragments)
|
|
|
|
sorted
|
|
|
|
$(index +(index), sorted [(~(got by fragments) index) sorted])
|
|
|
|
::
|
|
|
|
%- cue
|
|
|
|
%+ can 13
|
|
|
|
%+ turn (flop sorted)
|
|
|
|
|=(a=@ [1 a])
|
2019-08-05 23:58:53 +03:00
|
|
|
:: +bind-duct: find or make new $bone for .duct in .ossuary
|
2019-06-09 09:26:01 +03:00
|
|
|
::
|
2019-08-05 23:58:53 +03:00
|
|
|
++ bind-duct
|
2019-06-09 09:26:01 +03:00
|
|
|
|= [=ossuary =duct]
|
|
|
|
^+ [next-bone.ossuary ossuary]
|
|
|
|
::
|
|
|
|
?^ existing=(~(get by by-duct.ossuary) duct)
|
|
|
|
[u.existing ossuary]
|
|
|
|
::
|
|
|
|
:- next-bone.ossuary
|
2019-06-19 02:42:58 +03:00
|
|
|
:+ (add 4 next-bone.ossuary)
|
2019-06-09 09:26:01 +03:00
|
|
|
(~(put by by-duct.ossuary) duct next-bone.ossuary)
|
|
|
|
(~(put by by-bone.ossuary) next-bone.ossuary duct)
|
2019-06-19 03:38:25 +03:00
|
|
|
:: +make-bone-wire: encode ship and bone in wire for sending to vane
|
|
|
|
::
|
|
|
|
++ make-bone-wire
|
|
|
|
|= [her=ship =bone]
|
|
|
|
^- wire
|
|
|
|
::
|
|
|
|
/bone/(scot %p her)/(scot %ud bone)
|
|
|
|
:: +parse-bone-wire: decode ship and bone from wire from local vane
|
|
|
|
::
|
|
|
|
++ parse-bone-wire
|
|
|
|
|= =wire
|
|
|
|
^- [her=ship =bone]
|
|
|
|
::
|
2019-08-01 00:21:07 +03:00
|
|
|
~| %ames-wire-bone^wire
|
2019-06-19 03:38:25 +03:00
|
|
|
?> ?=([%bone @ @ ~] wire)
|
|
|
|
[`@p`(slav %p i.t.wire) `@ud`(slav %ud i.t.t.wire)]
|
2019-06-19 02:59:25 +03:00
|
|
|
:: +make-pump-timer-wire: construct wire for |packet-pump timer
|
2019-06-05 07:36:10 +03:00
|
|
|
::
|
2019-06-19 02:59:25 +03:00
|
|
|
++ make-pump-timer-wire
|
2019-06-05 07:36:10 +03:00
|
|
|
|= [her=ship =bone]
|
|
|
|
^- wire
|
|
|
|
/pump/(scot %p her)/(scot %ud bone)
|
2019-06-19 02:59:25 +03:00
|
|
|
:: +parse-pump-timer-wire: parse .her and .bone from |packet-pump wire
|
|
|
|
::
|
|
|
|
++ parse-pump-timer-wire
|
|
|
|
|= =wire
|
|
|
|
^- [her=ship =bone]
|
|
|
|
::
|
2019-08-01 00:21:07 +03:00
|
|
|
~| %ames-wire-timer^wire
|
2019-06-19 02:59:25 +03:00
|
|
|
?> ?=([%pump @ @ ~] wire)
|
|
|
|
[`@p`(slav %p i.t.wire) `@ud`(slav %ud i.t.t.wire)]
|
2019-06-26 21:45:07 +03:00
|
|
|
:: +sign-open-packet: sign the contents of an $open-packet
|
|
|
|
::
|
|
|
|
++ sign-open-packet
|
|
|
|
|= [=private-key signed=_+:*open-packet]
|
|
|
|
^- signature
|
|
|
|
::
|
|
|
|
(sign:ed:crypto private-key (jam signed))
|
2019-06-18 02:23:32 +03:00
|
|
|
:: +verify-signature: use .public-key to verify .signature on .content
|
|
|
|
::
|
|
|
|
++ verify-signature
|
|
|
|
|= [content=@ =public-key =signature]
|
|
|
|
^- ?
|
|
|
|
::
|
|
|
|
(veri:ed:crypto signature content public-key)
|
2019-06-11 23:22:24 +03:00
|
|
|
:: +derive-symmetric-key: $symmetric-key from $private-key and $public-key
|
|
|
|
::
|
|
|
|
:: Assumes keys have a tag on them like the result of the |ex:crub core.
|
|
|
|
::
|
|
|
|
++ derive-symmetric-key
|
|
|
|
|= [=public-key =private-key]
|
|
|
|
^- symmetric-key
|
|
|
|
::
|
2019-07-24 02:20:21 +03:00
|
|
|
~| [public-key=public-key private-key=private-key]
|
|
|
|
::
|
2019-06-11 23:22:24 +03:00
|
|
|
?> =('b' (end 3 1 public-key))
|
|
|
|
=. public-key (rsh 8 1 (rsh 3 1 public-key))
|
|
|
|
::
|
|
|
|
?> =('B' (end 3 1 private-key))
|
|
|
|
=. private-key (rsh 8 1 (rsh 3 1 private-key))
|
|
|
|
::
|
|
|
|
`@`(shar:ed:crypto public-key private-key)
|
2019-05-28 06:59:53 +03:00
|
|
|
:: +encrypt: encrypt $shut-packet into atomic packet content
|
|
|
|
::
|
|
|
|
++ encrypt
|
|
|
|
|= [=symmetric-key plaintext=shut-packet]
|
|
|
|
^- @
|
|
|
|
::
|
|
|
|
(en:crub:crypto symmetric-key (jam plaintext))
|
|
|
|
:: +decrypt: decrypt packet content to a $shut-packet or die
|
|
|
|
::
|
|
|
|
++ decrypt
|
|
|
|
|= [=symmetric-key ciphertext=@]
|
|
|
|
^- shut-packet
|
|
|
|
::
|
|
|
|
;; shut-packet
|
|
|
|
%- cue
|
|
|
|
%- need
|
|
|
|
(de:crub:crypto symmetric-key ciphertext)
|
2019-05-25 08:53:29 +03:00
|
|
|
:: +encode-packet: serialize a packet into a bytestream
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
|
|
|
++ encode-packet
|
|
|
|
|= packet
|
2019-05-25 08:53:29 +03:00
|
|
|
^- blob
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
=/ sndr-meta (encode-ship-metadata sndr)
|
|
|
|
=/ rcvr-meta (encode-ship-metadata rcvr)
|
2019-05-25 05:03:33 +03:00
|
|
|
:: body: <<sndr rcvr (jam [origin content])>>
|
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
:: The .sndr and .rcvr ship addresses are encoded with fixed
|
|
|
|
:: lengths specified by the packet header. They live outside
|
|
|
|
:: the jammed-data section to simplify packet filtering in the
|
|
|
|
:: interpreter.
|
|
|
|
::
|
2019-05-25 05:03:33 +03:00
|
|
|
=/ body=@
|
|
|
|
;: mix
|
2019-05-28 05:43:47 +03:00
|
|
|
sndr
|
|
|
|
(lsh 3 size.sndr-meta rcvr)
|
2019-05-25 05:03:33 +03:00
|
|
|
(lsh 3 (add size.sndr-meta size.rcvr-meta) (jam [origin content]))
|
|
|
|
==
|
|
|
|
:: header: 32-bit header assembled from bitstreams of fields
|
|
|
|
::
|
|
|
|
:: <<version checksum sndr-rank rcvr-rank encryption-type unused>>
|
|
|
|
:: 4 bits at the end of the header are unused.
|
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
=/ header=@
|
2019-05-25 05:03:33 +03:00
|
|
|
%+ can 0
|
|
|
|
:~ [3 protocol-version]
|
|
|
|
[20 (mug body)]
|
|
|
|
[2 rank.sndr-meta]
|
|
|
|
[2 rank.rcvr-meta]
|
|
|
|
[5 ?:(encrypted %0 %1)]
|
|
|
|
==
|
|
|
|
:: result is <<header body>>
|
|
|
|
::
|
|
|
|
(mix header (lsh 5 1 body))
|
2019-05-25 08:53:29 +03:00
|
|
|
:: +decode-packet: deserialize packet from bytestream or crash
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
|
|
|
++ decode-packet
|
2019-05-25 08:53:29 +03:00
|
|
|
|= =blob
|
2019-05-25 05:03:33 +03:00
|
|
|
^- packet
|
|
|
|
:: first 32 (2^5) bits are header; the rest is body
|
|
|
|
::
|
|
|
|
=/ header (end 5 1 blob)
|
|
|
|
=/ body (rsh 5 1 blob)
|
|
|
|
::
|
|
|
|
=/ version (end 0 3 header)
|
|
|
|
=/ checksum (cut 0 [3 20] header)
|
|
|
|
=/ sndr-size (decode-ship-size (cut 0 [23 2] header))
|
|
|
|
=/ rcvr-size (decode-ship-size (cut 0 [25 2] header))
|
|
|
|
=/ encrypted ?+((cut 0 [27 5] header) !! %0 %.y, %1 %.n)
|
|
|
|
::
|
|
|
|
=/ =dyad
|
|
|
|
:- sndr=(end 3 sndr-size body)
|
|
|
|
rcvr=(cut 3 [sndr-size rcvr-size] body)
|
|
|
|
::
|
2019-08-01 00:21:07 +03:00
|
|
|
?. =(protocol-version version)
|
|
|
|
~| %ames-protocol^version^dyad !!
|
|
|
|
?. =(checksum (end 0 20 (mug body)))
|
|
|
|
~| %ames-checksum^dyad !!
|
|
|
|
::
|
|
|
|
=+ ~| %ames-invalid-packet
|
|
|
|
;; [origin=(unit lane) content=*]
|
|
|
|
~| %ames-invalid-noun
|
2019-05-25 05:03:33 +03:00
|
|
|
%- cue
|
|
|
|
(rsh 3 (add rcvr-size sndr-size) body)
|
|
|
|
::
|
|
|
|
[dyad encrypted origin content]
|
|
|
|
:: +decode-ship-size: decode a 2-bit ship type specifier into a byte width
|
|
|
|
::
|
|
|
|
:: Type 0: galaxy or star -- 2 bytes
|
|
|
|
:: Type 1: planet -- 4 bytes
|
|
|
|
:: Type 2: moon -- 8 bytes
|
|
|
|
:: Type 3: comet -- 16 bytes
|
|
|
|
::
|
|
|
|
++ decode-ship-size
|
|
|
|
|= rank=@
|
|
|
|
^- @
|
|
|
|
::
|
|
|
|
?+ rank !!
|
|
|
|
%0 2
|
|
|
|
%1 4
|
|
|
|
%2 8
|
|
|
|
%3 16
|
|
|
|
==
|
2019-05-25 08:53:29 +03:00
|
|
|
:: +encode-ship-metadata: produce size (in bytes) and address rank for .ship
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
|
|
|
:: 0: galaxy or star
|
|
|
|
:: 1: planet
|
|
|
|
:: 2: moon
|
|
|
|
:: 3: comet
|
|
|
|
::
|
|
|
|
++ encode-ship-metadata
|
|
|
|
|= =ship
|
|
|
|
^- [size=@ =rank]
|
|
|
|
::
|
|
|
|
=/ size=@ (met 3 ship)
|
|
|
|
::
|
|
|
|
?: (lte size 2) [2 %0]
|
|
|
|
?: (lte size 4) [4 %1]
|
|
|
|
?: (lte size 8) [8 %2]
|
|
|
|
[16 %3]
|
|
|
|
--
|