Message test

bob-test.fs

@@ -31,6 +31,7 @@ init-client
     ." Bob replaced: " pkc $20 85type  cr
     do-disconnect ;
 
+strict-keys off
 c:bob server-loop
 \ ?nextarg [IF] s>number drop [ELSE] 1 [THEN] c:tests
 

client-tests.fs

@@ -150,6 +150,9 @@ UValue test#  0 to test#
       n2o:done
     end-code| n2o:close-all ['] .time $err ;
 
+: c:disconnect ( -- )
+    do-disconnect [: .packets profile( .times ) ;] $err ;
+
 : c:test-rest ( -- )
     c:download1
     3e @time f> IF c:download2
@@ -161,7 +164,7 @@ UValue test#  0 to test#
 	    THEN
 	THEN
     THEN
-    >timing do-disconnect [: .packets profile( .times ) ;] $err ;
+    >timing c:disconnect ;
 
 : c:test ( -- )
     init-cache'

debugging.fs

@@ -150,7 +150,9 @@ debug: regen( \ regenerate keys
 
 : toggle ( addr -- )  dup @ 0= swap ! ;
 
-: debug-task ( -- )  stacksize4 NewTask4 activate
+0 Value debug-task
+: new-debug-task ( -- ) debug-task ?EXIT
+    stacksize4 NewTask4 dup to debug-task activate
     BEGIN  case key
 	    'c' of  ['] cmd( >body toggle  endof
 	    'm' of  ['] msg( >body toggle  endof

net2o-keys.fs

@@ -39,7 +39,7 @@ require mkdir.fs
 
 $100 Constant keypack#
 
-0 Value pw-level# \ pw-level# 0 is lowest
+2 Value pw-level# \ pw-level# 0 is lowest
 \ !!TODO!! we need a way to tell how much we can trust keys
 \ passwords need a pw-level (because they are guessable)
 \ secrets don't, they aren't. We can quickly decrypt all

net2o.fs

@@ -566,7 +566,8 @@ Defer init-reply
 alloc-io
 
 : net2o-pass ( params xt n task )  pass
-    b-out init-reply prep-socks alloc-io catch free-io
+    b-out op-vector @ debug-vector ! ." Created net2o task" cr
+    init-reply prep-socks alloc-io catch free-io
     ?dup-IF  DoError  THEN ;
 : net2o-task ( params xt n -- task )
     stacksize4 NewTask4 dup >r net2o-pass r> ;
@@ -2523,6 +2524,9 @@ require net2o-msg.fs
       cookie+request
     end-code| -setip n2o:send-replace ;
 
+: c:announce-me ( -- )
+    $2000 $10000 "" ins-ip dup add-beacon c:connect replace-me do-disconnect ;
+
 : nick-lookup ( addr u -- id u )
     $2000 $10000 "" ins-ip c:connect
     2dup c:addme-fetch-host

tests/alice-msg.fs

+\ net2o tests - msg
+
+require ../client-tests.fs
+
++db stat(
+script? [IF] +debug %droprate [THEN]
+test-keys \ we want the test keys - never use this in production!
+
+i'm alice
+
+init-client
+
+!time
+
+?nextarg [IF] net2o-host $! [THEN]
+?nextarg [IF] s>number drop to net2o-port [THEN]
+
+: c:msg-test ( -- )
+    [: .time ." Message test" cr ;] $err
+    "Hi Bob!" send-text o-timeout
+    BEGIN  pad 100 accept cr dup WHILE  pad swap send-text  REPEAT
+    drop ['] .time $err ;
+
+script? [IF] c:announce-me ." connect bob?" key drop
+    "bob" nat:connect c:msg-test c:disconnect bye [THEN]

tests/bob-msg.fs

+\ net2o tests - msg
+
+require ../client-tests.fs
+
++db stat(
+script? [IF] +debug %droprate [THEN]
+test-keys \ we want the test keys - never use this in production!
+
+i'm bob
+
+init-client
+
+!time
+
+?nextarg [IF] net2o-host $! [THEN]
+?nextarg [IF] s>number drop to net2o-port [THEN]
+
+: c:msg-test ( -- )
+    [: .time ." Message test" cr ;] $err
+    "Hi Alice!" send-text o-timeout
+    BEGIN  pad 100 accept cr dup WHILE  pad swap send-text  REPEAT
+    drop ['] .time $err ;
+
+script? [IF] c:announce-me ." connect alice?" key drop
+    "alice" nat:connect c:msg-test c:disconnect bye [THEN]

tests/msg.fs

@@ -3,9 +3,7 @@
 require ../client-tests.fs
 
 +db stat(
-+debug
-%droprate
-script? [IF] debug-task [THEN]
+script? [IF] +debug %droprate [THEN]
 test-keys \ we want the test keys - never use this in production!
 
 i'm alice
@@ -20,7 +18,8 @@ init-client
 : c:msg-test ( -- )
     [: .time ." Message test" cr ;] $err
     "This is a test message" send-text
-    ['] .time $err
-    do-disconnect [: .packets profile( .times ) ;] $err ;
+    "This is a second test message" send-text
+    pad 100 accept pad swap send-text
+    ['] .time $err ;
 
-script? [IF] "bob" nat:connect c:msg-test bye [THEN]
+script? [IF] "bob" nat:connect c:msg-test c:disconnect bye [THEN]