ames: WIP modernized tests pass, still haven't found signature bug

This commit is contained in:
Ted Blackman 2022-05-31 18:31:38 -05:00
parent b8ff5f42e3
commit 6a13048cf1
3 changed files with 156 additions and 65 deletions

View File

@ -288,8 +288,10 @@
%+ turn (flop hav) %+ turn (flop hav)
|= =have |= =have
dat.have dat.have
:- sig=(end 9 mes) =+ sig=(end 9 mes)
:- sig
=+ dat=(rsh 9 mes) =+ dat=(rsh 9 mes)
~& [sig=`@q`(mug sig) dat=`@q`(mug dat)]
?~ dat ~ ?~ dat ~
~| [%fine %response-not-cask] ~| [%fine %response-not-cask]
;;((cask) (cue dat)) ;;((cask) (cue dat))
@ -1119,7 +1121,7 @@
:: /ax/peers/[ship]/forward-lane (list lane) :: /ax/peers/[ship]/forward-lane (list lane)
:: /ax/bones/[ship] [snd=(set bone) rcv=(set bone)] :: /ax/bones/[ship] [snd=(set bone) rcv=(set bone)]
:: /ax/snd-bones/[ship]/[bone] vase :: /ax/snd-bones/[ship]/[bone] vase
:: /ax/fine/message/[path/...] song :: /ax/fine/hunk/[path/...] (list @ux) scry response fragments
:: ::
?. ?=(%x ren) ~ ?. ?=(%x ren) ~
=> .(tyl `(pole knot)`tyl) => .(tyl `(pole knot)`tyl)
@ -2650,7 +2652,9 @@
++ pe-keen ++ pe-keen
|= [=path =^duct] |= [=path =^duct]
?: (~(has by order.scry) path) ?: (~(has by order.scry) path)
~& %pe-keen-already
ke-abet:(ke-sub:(ke-abed:keen-core path) duct) ke-abet:(ke-sub:(ke-abed:keen-core path) duct)
~& %pe-keen-new
=^ keen-id=@ud seq.scry [seq.scry +(seq.scry)] =^ keen-id=@ud seq.scry [seq.scry +(seq.scry)]
=. order.scry (~(put by order.scry) path keen-id) =. order.scry (~(put by order.scry) path keen-id)
=. keens.scry (put:orm keens.scry keen-id *keen-state) =. keens.scry (put:orm keens.scry keen-id *keen-state)
@ -2701,6 +2705,7 @@
:: ::
++ pe-hear ++ pe-hear
|= [=lane =packet] |= [=lane =packet]
~& %pe-hear
?> =(sndr-tick.packet (mod life.peer 16)) ?> =(sndr-tick.packet (mod life.peer 16))
:: ::
=/ [=peep =purr] (decode-request-info `@ux`content.packet) =/ [=peep =purr] (decode-request-info `@ux`content.packet)
@ -2799,10 +2804,13 @@
++ ke-on-ack ++ ke-on-ack
=| marked=(list want) =| marked=(list want)
|= fra=@ud |= fra=@ud
~& %ke-on-ack
^- [? _ke-core] ^- [? _ke-core]
=; [[found=? cor=_ke-core] wan=(pha want)] =; [[found=? cor=_ke-core] wan=(pha want)]
?. found ?. found
~& %not-found
[found ke-core] [found ke-core]
~& %found
[found cor(wan.keen wan)] [found cor(wan.keen wan)]
%^ (dip-left:ke-deq ,[found=? cor=_ke-core]) wan.keen %^ (dip-left:ke-deq ,[found=? cor=_ke-core]) wan.keen
[| ke-core] [| ke-core]
@ -2875,12 +2883,14 @@
=/ max num-slots:ke-gauge =/ max num-slots:ke-gauge
|- ^+ ke-core |- ^+ ke-core
?: |(=(~ nex.keen) =(inx max)) ?: |(=(~ nex.keen) =(inx max))
~& [%ke-continue-done inx]
ke-core ke-core
=^ =want nex.keen nex.keen =^ =want nex.keen nex.keen
=. last-sent.want now =. last-sent.want now
=. tries.want +(tries.want) =. tries.want +(tries.want)
=. wan.keen (snoc:ke-deq wan.keen want) =. wan.keen (snoc:ke-deq wan.keen want)
=. metrics.keen (on-sent:ke-gauge 1) =. metrics.keen (on-sent:ke-gauge 1)
~& [%ke-continue fra.want]
=. ke-core (ke-emit hoot.want) =. ke-core (ke-emit hoot.want)
$(inx +(inx)) $(inx +(inx))
:: ::
@ -2920,6 +2930,7 @@
++ ke-rcv ++ ke-rcv
|= [fra=@ud =purr =lane:ames] |= [fra=@ud =purr =lane:ames]
^+ ke-core ^+ ke-core
~& [%ke-rcv fra]
=/ =meow (decode-response-packet purr) =/ =meow (decode-response-packet purr)
=/ og ke-core =/ og ke-core
=. pe-core (pe-update-qos %live last-contact=now) =. pe-core (pe-update-qos %live last-contact=now)
@ -2934,19 +2945,23 @@
?> =(fra 1) ?> =(fra 1)
(ke-first-rcv meow) (ke-first-rcv meow)
:: ::
~| failed-signature/fra^`@ux`sig.meow ?. %- veri-fra:keys
~| life.peer [ship life.peer ke-full-path fra [dat sig]:meow]
?> (veri-fra:keys ship life.peer ke-full-path fra [dat sig]:meow) ~| failed-signature/fra^`@ux`sig.meow
~| life.peer
!!
=^ found=? ke-core =^ found=? ke-core
(ke-on-ack fra) (ke-on-ack fra)
:: ::
?. found ?. found
~& %ke-fast-retransmit
(ke-fast-retransmit:og fra) (ke-fast-retransmit:og fra)
=/ =have [fra meow] =/ =have [fra meow]
=. hav.keen =. hav.keen
`(list ^have)`[have hav.keen] `(list ^have)`[have hav.keen]
=. num-received.keen +(num-received.keen) =. num-received.keen +(num-received.keen)
?: =(num-fragments num-received):keen ?: =(num-fragments num-received):keen
~& %ke-done
(ke-done [sig dat]:ke-decode-full) (ke-done [sig dat]:ke-decode-full)
ke-continue ke-continue
:: ::
@ -3024,6 +3039,7 @@
last-sent.u.want now last-sent.u.want now
== ==
=. wan.keen (cons:ke-deq wan.keen u.want) =. wan.keen (cons:ke-deq wan.keen u.want)
~& [%ke-take-wake-resend fra.u.want]
(ke-resend [fra hoot]:u.want) (ke-resend [fra hoot]:u.want)
-- --
-- --
@ -3076,10 +3092,12 @@
:: ::
++ on-keen ++ on-keen
|= [=ship =path] |= [=ship =path]
~& %on-keen
^+ event-core ^+ event-core
=+ ~:(spit path) :: assert length =+ ~:(spit path) :: assert length
=/ peer-core (pe-abed:fine-peer ship) =/ peer-core (pe-abed:fine-peer ship)
?^ peer-core pe-abet:(pe-keen:u.peer-core path duct) ?^ peer-core pe-abet:(pe-keen:u.peer-core path duct)
~& %on-keen-alien
%+ enqueue-alien-todo ship %+ enqueue-alien-todo ship
|= todos=alien-agenda |= todos=alien-agenda
todos(keens (~(put ju keens.todos) path duct)) todos(keens (~(put ju keens.todos) path duct))
@ -3117,6 +3135,7 @@
:: so we should only get responses from ships we know. :: so we should only get responses from ships we know.
:: below we assume sndr.packet is a known peer. :: below we assume sndr.packet is a known peer.
=* from sndr.packet =* from sndr.packet
~& %on-hear-response
=/ peer-core (need (pe-abed:fine-peer from)) =/ peer-core (need (pe-abed:fine-peer from))
pe-abet:(pe-hear:peer-core lane packet) pe-abet:(pe-hear:peer-core lane packet)
-- --
@ -3173,19 +3192,34 @@
wid^`@`pat :: namespace path wid^`@`pat :: namespace path
== ==
:: ::
++ frag-body ++ make-meow
|= [=path mes=@ num=@ud fin=?] |= [=path mes=@ num=@ud]
^- @uxmeow ^- meow
=; meow
~& :* %made-meow
sig=`@q`(mug sig.meow)
num=num.meow
siz=siz.meow
dat=`@q`(mug dat.meow)
==
meow
=/ tot (met 13 mes) =/ tot (met 13 mes)
=/ fra (cut 13 [(dec num) 1] mes) =/ dat (cut 13 [(dec num) 1] mes)
=/ wid (met 3 fra) =/ wid (met 3 dat)
=/ wod ?:(fin wid 1.024) :* sig=(sign-fra:keys path num dat) :: fragment signature
=- ~& [tot=tot wid=wid num=num fra=!=(0 fra) fin=fin] - num=tot :: number of fragments
siz=?:(=(num tot) (met 3 dat) 1.024) :: fragment byte width
dat=dat :: response data fragment
==
::
++ encode-meow
|= =meow
^- @uxmeow
%+ can 3 %+ can 3
:~ 64^(sign-fra:keys path num fra) :~ 64^sig.meow
4^tot :: number of fragments 4^num.meow
2^wod :: response data fragment size in bytes 2^siz.meow
wid^fra :: response data fragment (met 3 dat.meow)^dat.meow
== ==
:: ::
++ encode-request ++ encode-request
@ -3199,15 +3233,17 @@
(can 3 sig bod ~) (can 3 sig bod ~)
(encode-packet [our ship] req=& sam=| sic ric ~ syn) (encode-packet [our ship] req=& sam=| sic ric ~ syn)
:: ::
++ encode-hunk ::TODO unit tests ++ encode-hunk
|= [=path =hunk data=$@(~ (cask))] |= [=path =hunk data=$@(~ (cask))]
^- (list @uxmeow) ^- (list @uxmeow)
~& [hunk=hunk len=(met 3 (jam data))]
=/ mes=@ =/ mes=@
=- ~& [sig=`@q`(mug sig) dat=`@q`(mug (jam data))] -
=/ sig=@ (full:keys path data) =/ sig=@ (full:keys path data)
?~ data sig ?~ data sig
(cat 9 sig (jam data)) (mix sig (lsh 9 (jam data)))
::(cat 9 sig (jam data))
:: ::
?> (lte len.hunk 16.384)
=/ las (met 13 mes) =/ las (met 13 mes)
=/ tip (dec (add [lop len]:hunk)) =/ tip (dec (add [lop len]:hunk))
=/ top (min las tip) =/ top (min las tip)
@ -3218,25 +3254,38 @@
|- ^+ res |- ^+ res
?: =(num top) ?: =(num top)
=- (flop - res) =- (flop - res)
(frag-body path mes num =(top las)) (encode-meow (make-meow path mes num))
$(num +(num), res :_(res (frag-body path mes num |))) $(num +(num), res :_(res (encode-meow (make-meow path mes num))))
:: ::
++ keys ++ keys
|% |%
++ mess ++ mess
|=([@p life path $@(~ (cask))] (jam +<)) |= [=ship life=@ud =path dat=$@(~ (cask))]
::~& :* %mess
:: ship life path
:: ^= dat
:: ?~ dat ~
:: ?: =(%hoon -.dat)
:: [%hoon ;;(@t +.dat)]
:: [%noun `@q`(mug dat)]
:: ==
(jam +<)
:: ::
++ full ++ full
|= [=path data=$@(~ (cask))] |= [=path data=$@(~ (cask))]
(sign (mess our life.ames-state path data)) (sign (mess our life.ames-state path data))
:: ::
++ frag
|= [=path fra=@ud dat=@ux]
(jam +<)
::
++ sign-fra ++ sign-fra
|= [=path fra=@ dat=@ux] |= [=path fra=@ud dat=@ux]
(sign (jam path fra dat)) (sign (frag path fra dat))
:: ::
++ veri-fra ++ veri-fra
|= [who=ship lyf=life =path fra=@ dat=@ux sig=@] |= [who=ship lyf=life =path fra=@ud dat=@ux sig=@]
(veri who lyf sig (jam path fra dat)) (veri who lyf sig (frag path fra dat))
:: ::
++ sign ++ sign
sigh:as:crypto-core.ames-state sigh:as:crypto-core.ames-state
@ -3917,7 +3966,7 @@
++ clamp-rto ++ clamp-rto
|= rto=@dr |= rto=@dr
^+ rto ^+ rto
(min ~m2 (max ^~((div ~s1 5)) rto)) (min ~s5 (max ^~((div ~s1 5)) rto))
:: +in-slow-start: %.y iff we're in "slow-start" mode :: +in-slow-start: %.y iff we're in "slow-start" mode
:: ::
++ in-slow-start ++ in-slow-start

View File

@ -1,6 +1,7 @@
/+ *test /+ *test
/= ames /sys/vane/ames /= ames /sys/vane/ames
/= jael /sys/vane/jael /= jael /sys/vane/jael
/* dojo %hoon /app/dojo/hoon
:: construct some test fixtures :: construct some test fixtures
:: ::
=/ nec ^$:((ames ~nec)) =/ nec ^$:((ames ~nec))
@ -183,6 +184,16 @@
%+ snag index %+ snag index
(skim moves is-move-send) (skim moves is-move-send)
:: ::
++ n-frags
|= n=@
^- @ux
:: 6 chosen randomly to get some trailing zeros
::
%+ rsh 10
%+ rep 13
%+ turn (gulf 1 n)
|=(x=@ (fil 3 1.024 (dis 0xff x)))
::
++ scry ++ scry
|= [vane=_nec car=term bem=beam] |= [vane=_nec car=term bem=beam]
=/ =roof =/ =roof
@ -198,7 +209,12 @@
``noun+!>([black black]) ``noun+!>([black black])
:: ::
%cz %cz
``noun+!>(`@ux`(fil 5 32 0xdead.beef)) ?+ -.r.bem !!
%ud ``noun+!>((n-frags p.r.bem))
==
::
%cx
``hoon+!>(dojo)
== ==
=/ vane-core (vane(rof roof)) =/ vane-core (vane(rof roof))
(scry:vane-core ~ car bem) (scry:vane-core ~ car bem)
@ -226,34 +242,36 @@
:: ::
=/ =packet:ames =/ =packet:ames
:* [sndr=~nec rcvr=~bud] :* [sndr=~nec rcvr=~bud]
req=& sam=&
sndr-tick=0b10 sndr-tick=0b10
rcvr-tick=0b11 rcvr-tick=0b11
origin=~ origin=~
content=0xdead.beef content=0xdead.beef
== ==
:: ::
=/ encoded (encode-packet:ames & packet) =/ encoded (encode-packet:ames packet)
=/ decoded (decode-packet:ames encoded) =/ decoded (decode-packet:ames encoded)
:: ::
%+ expect-eq %+ expect-eq
!> [& packet] !> packet
!> decoded !> decoded
:: ::
++ test-origin-encoding ^- tang ++ test-origin-encoding ^- tang
:: ::
=/ =packet:ames =/ =packet:ames
:* [sndr=~nec rcvr=~bud] :* [sndr=~nec rcvr=~bud]
req=& sam=&
sndr-tick=0b10 sndr-tick=0b10
rcvr-tick=0b11 rcvr-tick=0b11
origin=`0xbeef.cafe.beef origin=`0xbeef.cafe.beef
content=0xdead.beef content=0xdead.beef
== ==
:: ::
=/ encoded (encode-packet:ames & packet) =/ encoded (encode-packet:ames packet)
=/ decoded (decode-packet:ames encoded) =/ decoded (decode-packet:ames encoded)
:: ::
%+ expect-eq %+ expect-eq
!> [& packet] !> packet
!> decoded !> decoded
:: ::
++ test-shut-packet-encoding ^- tang ++ test-shut-packet-encoding ^- tang
@ -305,7 +323,7 @@
rcvr-life=3 rcvr-life=3
== ==
:: ::
=/ =blob:ames (encode-packet:ames & packet) =/ =blob:ames (encode-packet:ames packet)
=^ moves1 bud (call bud ~[//unix] %hear lane-foo blob) =^ moves1 bud (call bud ~[//unix] %hear lane-foo blob)
=^ moves2 bud =^ moves2 bud
=/ =point:ames =/ =point:ames
@ -478,55 +496,79 @@
?. ?=(%give -.card.move) ~ ?. ?=(%give -.card.move) ~
?. ?=(%send -.p.card.move) ~ ?. ?=(%send -.p.card.move) ~
`;;(@uxhoot blob.p.card.move) `;;(@uxhoot blob.p.card.move)
=/ [is-ames=? =packet:ames] (decode-packet:ames `@ux`req) =/ =packet:ames (decode-packet:ames `@ux`req)
?> ?=(%| is-ames) ?< sam.packet
?> req.packet
=/ twit =/ twit
(decode-request:ames `@ux`content.packet) (decode-request:ames `@ux`content.packet)
~& twit ~& twit
(expect-eq !>(1) !>(1)) (expect-eq !>(1) !>(1))
:: ::
++ test-fine-hunk
^- tang
%- zing
%+ turn (gulf 1 10)
|= siz=@
=/ want=path /~bud/0/1/c/z/(scot %ud siz)/kids/sys
::
=/ =beam [[~bud %$ da+now:bud] (welp /fine/hunk/1/16.384 want)]
=/ [=mark =vase] (need (need (scry bud %x beam)))
=+ !<(song=(list @uxmeow) vase)
%+ expect-eq
!>(siz)
!>((lent song))
::
++ test-fine-response ++ test-fine-response
^- tang ^- tang
=/ datum=@ux (fil 5 32 0xdead.beef) ::%- zing
=/ want=path /~bud/0/1/c/z/1/kids/sys ::%+ turn (gulf 1 50)
=. rof.bud ::|= siz=@
|=(* ``noun+!>(datum)) ::=/ want=path /~bud/0/1/c/z/(scot %ud siz)/kids/sys
=/ =beam [[~bud %$ da+now:bud] (welp /fine/message want)] =/ want=path /~bud/0/1/c/x/1/kids/app/dojo/hoon
=/ dit (jam %hoon dojo)
=/ exp (cat 9 (fil 3 64 0xff) dit)
=/ siz=@ud (met 13 exp)
^- tang
::
=/ =beam [[~bud %$ da+now:bud] (welp /fine/hunk/1/16.384 want)]
=/ [=mark =vase] (need (need (scry bud %x beam))) =/ [=mark =vase] (need (need (scry bud %x beam)))
=+ !<(=song:ames vase) =+ !<(song=(list @uxmeow) vase)
=/ partial=(list have:ames) =/ paz=(list have:ames)
%- head %+ spun song
%^ spin song 1 |= [blob=@ux num=_1]
|= [blob=@ux num=@ud]
^- [have:ames _num] ^- [have:ames _num]
:_ +(num) :_ +(num)
=/ [is-ames=? =packet:ames] (decode-packet:ames `@ux`blob) =/ =meow:ames (decode-response-packet:ames blob)
?> ?=(%| is-ames) [num meow]
=/ [=peep:ames =purr:ames] (decode-request-info:ames `@ux`content.packet)
=/ rawr (decode-response-packet:ames `@ux`purr)
~& rawr-sig/`@ux`sig.rawr
~& rawr-siz/`@ux`siz.rawr
~& rawr-wid/`@ux`wid.rawr
~& rawr-dat/`@ux`dat.rawr
[num rawr]
:: ::
=/ num-frag=@ud (lent partial) =/ num-frag=@ud (lent paz)
~& num-frag=num-frag
=/ =roar:ames =/ =roar:ames
(decode-response-msg:ames num-frag (flop partial)) (decode-response-msg:ames num-frag (flop paz))
%+ welp %+ welp
=/ dat =/ dat
?> ?=(^ dat.roar) ?> ?=(^ dat.roar)
;;(@ux q.dat.roar) ;;(@ux q.dat.roar)
(expect-eq !>(dat) !>(datum)) (expect-eq !>(`@`dat) !>(`@`dojo))
=/ event-core =/ event-core
~! nec ~! nec
=/ foo [*@da *@ rof.nec] =/ foo [*@da *@ rof.nec]
(per-event:(nec foo) [*@da *@ rof.nec] *duct ames-state.nec) (per-event:(nec foo) [*@da *@ rof.nec] *duct ames-state.nec)
%- zing %+ welp
%+ turn partial ^- tang
|= [fra=@ud sig=@ siz=@ud byts] %- zing
%+ expect-eq !>(%.y) %+ turn paz
!>((veri-fra:keys:fine:event-core ~bud life.ames-state.bud want fra dat sig)) |= [fra=@ud sig=@ siz=@ud byts]
%+ expect-eq !>(%.y)
!>
%- veri-fra:keys:fine:event-core
[~bud life.ames-state.bud want fra dat sig]
~& %verifying-sig
%+ expect-eq
!>(&)
!>
%- meri:keys:fine:event-core
[~bud life.ames-state.bud want roar]
:: ::
++ test-old-ames-wire ^- tang ++ test-old-ames-wire ^- tang
=^ moves0 bud (call bud ~[/g/hood] %spew [%odd]~) =^ moves0 bud (call bud ~[/g/hood] %spew [%odd]~)

View File

@ -5,7 +5,7 @@
#include "vere/vere.h" #include "vere/vere.h"
#include "ur/serial.h" #include "ur/serial.h"
#define FINE_PAGE 16384 // packets per page #define FINE_PAGE 8 // packets per page TODO: 16384
#define FINE_FRAG 1024 // bytes per fragment packet #define FINE_FRAG 1024 // bytes per fragment packet
#define FINE_PATH_MAX 384 // longest allowed scry path #define FINE_PATH_MAX 384 // longest allowed scry path
#define HEAD_SIZE 4 // header size in bytes #define HEAD_SIZE 4 // header size in bytes
@ -1682,7 +1682,6 @@ _ames_hear_ames(u3_pact* pac_u, c3_w cur_w)
} }
_ames_pact_free(pac_u); _ames_pact_free(pac_u);
return;
} }
// otherwise, inject the packet as an event // otherwise, inject the packet as an event
@ -1788,8 +1787,9 @@ _ames_hear(u3_ames* sam_u,
// check contents match mug in header // check contents match mug in header
// //
if ( c3n == _ames_check_mug(pac_u) ) { if ( c3n == _ames_check_mug(pac_u) ) {
_log_head(&pac_u->hed_u);
sam_u->sat_u.mut_d++; sam_u->sat_u.mut_d++;
// TODO: reinstate filter after debugging is over // TODO: reinstate filter after debugging is over
// if ( 0 == (sam_u->sat_u.mut_d % 100000) ) { // if ( 0 == (sam_u->sat_u.mut_d % 100000) ) {