Commit bf4ee3d4 authored by bernd's avatar bernd

Message test

parent 1be1c9c1
......@@ -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
......
......@@ -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'
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
\ 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]
\ 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]
......@@ -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]
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment