Commit 675087c8 authored by bernd's avatar bernd

Moved some useful words out of the testing stuff

parent c4deaf91
......@@ -42,20 +42,6 @@ UValue test# 0 to test#
"eve" ke-nick $! $1367B086A26B4E42. d>64 ke-first 64! 1 ke-type ! o>
;
: ins-ip ( -- net2oaddr )
net2o-host $@ net2o-port insert-ip ;
: ins-ip4 ( -- net2oaddr )
net2o-host $@ net2o-port insert-ip4 ;
: ins-ip6 ( -- net2oaddr )
net2o-host $@ net2o-port insert-ip6 ;
: c:connect ( code data nick u ret -- )
[: .time ." Connect to: " dup hex. cr ;] $err
n2o:new-context >o rdrop o to connection
dest-key \ get our destination key
n2o:connect +flow-control +resend
[: .time ." Connected, o=" o hex. cr ;] $err ;
: c:add-me ( -- ) +addme
net2o-code expect-reply get-ip cookie+request end-code| -setip ;
......@@ -75,31 +61,12 @@ UValue test# 0 to test#
endwith cookie+request
end-code| ;
also net2o-base
: fetch-id, ( id-addr u -- )
$, dht-id <req dht-host? req> endwith ;
: fetch-host, ( nick u -- )
nick-key .ke-pk $@ fetch-id, ;
previous
: c:fetch-host ( nick u -- )
net2o-code
expect-reply fetch-host,
cookie+request
end-code| ;
: c:fetch-id ( pubkey u -- )
net2o-code
expect-reply fetch-id,
cookie+request
end-code| ;
: c:addme-fetch-host ( nick u -- ) +addme
net2o-code
expect-reply get-ip fetch-host, replace-me,
cookie+request
end-code| -setip n2o:send-replace ;
\ : c:fetch-tags ( -- )
\ net2o-code
\ expect-reply
......@@ -216,35 +183,7 @@ event: ->throw dup DoError throw ;
\ lookup for other users
: c:lookup ( addr u -- id u )
$2000 $10000 "test" ins-ip c:connect
2dup c:addme-fetch-host
nick-key >o ke-pk $@
BEGIN >d#id >o 0 dht-host $[]@ o> over c@ '!' = WHILE
replace-key o> >o ke-pk $@ ." replace key: " 2dup 85type cr
o o> >r 2dup c:fetch-id r> >o
REPEAT o> 2drop do-disconnect ;
: c:insert-host ( addr u -- )
." check host: " 2dup .host cr
host>$ IF
[: check-addr1 0= IF 2drop EXIT THEN
insert-address temp-addr ins-dest
." insert host: " temp-addr $10 xtype cr
return-addr $10 0 skip nip 0= IF
temp-addr return-addr $10 move
\ temp-addr return-address $10 move
THEN ;] $>sock
ELSE 2drop THEN ;
: n2o:lookup ( addr u -- )
2dup c:lookup
0 n2o:new-context >o rdrop 2dup dest-key return-addr $10 erase
nick-key .ke-pk $@ >d#id >o dht-host ['] c:insert-host $[]map o> ;
: nat:connect ( addr u -- )
init-cache' n2o:lookup
." trying to connect to: " return-addr $10 xtype cr
$10000 $100000 n2o:connect +flow-control +resend
: nat:connect ( addr u -- ) $10000 $100000 2swap nick-connect
." Connected!" cr ;
\ some more helpers
......
......@@ -104,6 +104,7 @@ debug: resend(
debug: track(
debug: data(
debug: cmd(
debug: cmd0(
debug: send(
debug: firstack(
debug: msg(
......
......@@ -314,7 +314,7 @@ set-current previous previous
: i'm ( "name" -- ) parse-name >key ;
: dest-key ( addr u -- )
: dest-key ( addr u -- ) dup 0= IF 2drop EXIT THEN
nick-key >o o 0= !!unknown-key!!
ke-pk $@ keysize umin o> dest-pubkey $! ;
......@@ -332,6 +332,13 @@ set-current previous previous
current-key >o replace-key o> >o skc keysize ke-sk sec!
o o> ; is renew-key
also net2o-base
: fetch-id, ( id-addr u -- )
$, dht-id <req dht-host? req> endwith ;
: fetch-host, ( nick u -- )
nick-key .ke-pk $@ fetch-id, ;
previous
0 [IF]
Local Variables:
forth-local-words:
......
......@@ -55,6 +55,11 @@ User <msg-buf
previous
: send-text ( addr u -- )
net2o-code expect-reply
<msg ticks lit, msg-at $, msg-text msg>
cookie+request end-code| ;
0 [IF]
Local Variables:
forth-local-words:
......
......@@ -1778,7 +1778,7 @@ User outflag outflag off
o IF code-map @ ELSE 0 THEN outbuf-encrypt
outbuf addr 64@ 64-0= IF
return-addr
.time ." cmd0 to: " dup $10 xtype cr
cmd0( .time ." cmd0 to: " dup $10 xtype cr )
ELSE
return-address
THEN packet-to ;
......@@ -2244,7 +2244,7 @@ $10 Constant tmp-crypt-val
: tmp-crypt? ( -- flag ) validated @ tmp-crypt-val and ;
: handle-cmd0 ( -- ) \ handle packet to address 0
.time ." handle cmd0 " sockaddr alen @ .address cr
cmd0( .time ." handle cmd0 " sockaddr alen @ .address cr )
0 >o rdrop \ address 0 has no job context!
0 inbuf-decrypt 0= IF
." invalid packet to 0" drop cr EXIT THEN
......@@ -2495,6 +2495,64 @@ require net2o-dht.fs
require net2o-keys.fs \ extra cmd space
require net2o-msg.fs
\ connection setup helper
: ins-ip ( -- net2oaddr )
net2o-host $@ net2o-port insert-ip ;
: ins-ip4 ( -- net2oaddr )
net2o-host $@ net2o-port insert-ip4 ;
: ins-ip6 ( -- net2oaddr )
net2o-host $@ net2o-port insert-ip6 ;
: c:connect ( code data nick u ret -- )
[: .time ." Connect to: " dup hex. cr ;] $err
n2o:new-context >o rdrop o to connection
dest-key \ get our destination key
n2o:connect +flow-control +resend
[: .time ." Connected, o=" o hex. cr ;] $err ;
: c:fetch-id ( pubkey u -- )
net2o-code
expect-reply fetch-id,
cookie+request
end-code| ;
: c:addme-fetch-host ( nick u -- ) +addme
net2o-code
expect-reply get-ip fetch-host, replace-me,
cookie+request
end-code| -setip n2o:send-replace ;
: lookup ( addr u -- id u )
$2000 $10000 "" ins-ip c:connect
2dup c:addme-fetch-host
nick-key >o ke-pk $@
BEGIN >d#id >o 0 dht-host $[]@ o> over c@ '!' = WHILE
replace-key o> >o ke-pk $@ ." replace key: " 2dup 85type cr
o o> >r 2dup c:fetch-id r> >o
REPEAT o> 2drop do-disconnect ;
: insert-host ( addr u -- )
." check host: " 2dup .host cr
host>$ IF
[: check-addr1 0= IF 2drop EXIT THEN
insert-address temp-addr ins-dest
." insert host: " temp-addr $10 xtype cr
return-addr $10 0 skip nip 0= IF
temp-addr return-addr $10 move
\ temp-addr return-address $10 move
THEN ;] $>sock
ELSE 2drop THEN ;
: n2o:lookup ( addr u -- )
2dup lookup
0 n2o:new-context >o rdrop 2dup dest-key return-addr $10 erase
nick-key .ke-pk $@ >d#id >o dht-host ['] insert-host $[]map o> ;
: nick-connect ( cmdlen datalen addr u -- )
n2o:lookup
cmd0( ." trying to connect to: " return-addr $10 xtype cr )
n2o:connect +flow-control +resend ;
0 [IF]
Local Variables:
forth-local-words:
......
......@@ -19,12 +19,8 @@ init-client
: c:msg-test ( -- )
[: .time ." Message test" cr ;] $err
net2o-code
expect-reply
<msg ticks lit, msg-at
"This is a test message" $, msg-text msg>
cookie+request
end-code| ['] .time $err
>timing do-disconnect [: .packets profile( .times ) ;] $err ;
"This is a test message" send-text
['] .time $err
do-disconnect [: .packets profile( .times ) ;] $err ;
script? [IF] "bob" nat:connect c:msg-test 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