Commit 7fed1158 authored by bernd's avatar bernd

Debugging: Path->IP address+remaining path

parent d3d9583d
......@@ -93,6 +93,8 @@ cell 8 = [IF]
' umin! Alias 64umin!
' umax! Alias 64umax!
' !@ Alias 64!@
' be-ux@ Alias be@
' be-x! Alias be!
[ELSE]
' 2swap alias 64rot
' 2swap alias -64rot
......@@ -199,6 +201,8 @@ cell 8 = [IF]
: 64max! ( d addr -- ) >r r@ 64@ dmax r> 64! ;
: 64umin! ( n addr -- ) >r r@ 64@ dumin r> 64! ;
: 64umax! ( n addr -- ) >r r@ 64@ dumin r> 64! ;
' be-ul@ alias be@
' be-l! alias be!
[THEN]
\ independent of cell size, using dfloats:
' dfloats Alias 64s
......
......@@ -145,7 +145,9 @@ previous
my-addr$ $[]off ;
: !my-addr$ ( -- )
my-addr[] [: o>addr gen-host my-addr$ $ins[] ;] $[]o-map ;
my-addr[] [:
nat( ." insert into my-addr$: " dup .addr forth:cr )
o>addr gen-host my-addr$ $ins[]sig ;] $[]o-map ;
:noname addrs-off !my-addrs !my-addr$ ; is !my-addr
......
......@@ -501,7 +501,7 @@ previous
o 0= IF drop EXIT THEN
request( ." request acked: " dup . cr )
resend0 $off
nat( ." ok from: " ret-addr $10 xtype space dup .
nat( ." ok from: " ret-addr .addr-path space dup .
dup reply[] 2@ d0= IF ." acked" THEN cr )
0. 2 pick reply[] dup >r 2!
['] drop r> reply-xt !@ execute ; \ clear request
......
......@@ -110,6 +110,7 @@ net2o-base
+net2o: punch-done ( -- ) \g punch received
o 0<> own-crypt? and IF
return-addr return-address $10 move resend0 $off
nat( ." punch done: " return-address .addr-path forth:cr )
THEN ;
: cookie, ( -- ) add-cookie lit, set-cookie ;
......@@ -117,7 +118,7 @@ net2o-base
: request, ( -- ) next-request #request, ;
: gen-punch ( -- )
my-addr$ [: -sig nat( ." punch: " 2dup .addr$ forth:cr ) $, punch ;] $[]map ;
my-addr$ [: -sig nat( ." gen punch: " 2dup .addr$ forth:cr ) $, punch ;] $[]map ;
: cookie+request ( -- ) request( ." gen cookie" forth:cr )
nest[ cookie, request, ]nest ;
......
......@@ -28,13 +28,6 @@ KEYBYTES 2* Constant keysize2 \ pubkey+revkey=64 bytes
\ specify strength (in bytes), not length! length is 2*strength
32 Constant hash#128 \ 128 bit hash strength is enough!
64 Constant hash#256 \ 256 bit hash strength is more than enough!
\ Hash state variables
$41 Constant sigonlysize#
$51 Constant sigsize#
$71 Constant sigpksize#
$91 Constant sigpk2size#
$10 Constant datesize#
\ key storage stuff
$1E0 Constant keypack#
......@@ -410,9 +403,6 @@ Defer search-key \ search if that is one of our pubkeys
: forever ( -- ) 64#0 sigdate 64! 64#-1 sigdate 64'+ 64! ;
: now+delta ( delta64 -- ) ticks 64dup sigdate 64! 64+ sigdate 64'+ 64! ;
: startdate@ ( addr u -- date ) + sigsize# - 64@ ;
: enddate@ ( addr u -- date ) + sigsize# - 64'+ 64@ ;
: .check ( flag -- ) '' '' rot select xemit ;
: .sigdate ( tick -- )
64dup 64#0 64= IF 64drop ." forever" EXIT THEN
......
......@@ -117,31 +117,6 @@ Variable dht-table
I c@ $100 + cells hash dht@ + to hash
LOOP true !!dht-full!! ;
: $ins[]sig ( addr u $array -- )
\G insert O(log(n)) into pre-sorted array
{ $arr } 0 $arr $[]#
BEGIN 2dup < WHILE 2dup + 2/ { left right $# }
2dup sigsize# - $# $arr $[]@ sigsize# - compare dup 0= IF
drop
2dup startdate@
$# $arr $[]@ startdate@ 64u>=
IF $# $arr $[]!
ELSE 2drop THEN EXIT THEN
0< IF left $# ELSE $# 1+ right THEN
REPEAT drop >r
0 { w^ ins$0 } ins$0 cell $arr r@ cells $ins r> $arr $[]! ;
: $del[]sig ( addr u $arrrray -- )
\G delete O(log(n)) from pre-sorted array, check sigs
{ $arr } 0 $arr $[]#
BEGIN 2dup < WHILE 2dup + 2/ { left right $# }
2dup sigonlysize# - $# $arr $[]@ sigonlysize# -
compare dup 0= IF
$# $arr $[] $off
$arr $# cells cell $del
2drop EXIT THEN
0< IF left $# ELSE $# 1+ right THEN
REPEAT 2drop 2drop ; \ not found
: >d#id ( addr u -- o )
[: 2dup d#public d#
dup @ 0= IF dht-class new >o
......@@ -297,11 +272,11 @@ false Value add-myip
addr .host-route $@len 0= IF
addr my-addr-merge IF addr >o n2o:dispose-addr o>
nat( ." merged" forth:cr ) EXIT THEN
addr o>addr gen-host my-addr$ $ins[]
addr o>addr gen-host my-addr$ $ins[]sig
addr >o n2o:dispose-addr o>
nat( ." public" forth:cr ) EXIT THEN
addr my-addr? 0= IF
addr o>addr gen-host my-addr$ $ins[]
addr o>addr gen-host my-addr$ $ins[]sig
nat( ." routed" ) THEN
nat( forth:cr )
what's expect-reply? ['] addme-end <> IF
......
......@@ -268,6 +268,14 @@ Defer !my-addr
nat( ." ping: " 2dup .address cr )
2>r net2o-sock "" 0 2r> sendto drop ;
: p+ ( addr u -- addr' u' )
BEGIN dup WHILE over c@ $80 < >r 1 /string r> UNTIL THEN ;
: .addr-path ( addr -- )
dup be@ routes #.key dup 0= IF drop $10 xtype ELSE
$@ .address
$10 p+ 0 -skip dup IF '|' emit THEN xtype THEN ;
0 [IF]
Local Variables:
forth-local-words:
......
......@@ -85,6 +85,8 @@ cmd-args
tuck 2>r over swap - 0 max /string 2r> str= ;
[THEN]
: -skip ( addr u char -- ) >r
BEGIN 1- dup 0>= WHILE 2dup + c@ r@ <> UNTIL THEN 1+ rdrop ;
: -scan ( addr u char -- addr u' ) >r
BEGIN dup WHILE 1- 2dup + c@ r@ = UNTIL 1+ THEN rdrop ;
......@@ -281,6 +283,42 @@ Create reverse-table $100 0 [DO] [I] bitreverse8 c, [LOOP]
0< IF left $# ELSE $# 1+ right THEN
REPEAT 2drop 2drop ; \ not found
\ same with signatures; newest signature replaces older
$41 Constant sigonlysize#
$51 Constant sigsize#
$71 Constant sigpksize#
$91 Constant sigpk2size#
$10 Constant datesize#
: startdate@ ( addr u -- date ) + sigsize# - 64@ ;
: enddate@ ( addr u -- date ) + sigsize# - 64'+ 64@ ;
: $ins[]sig ( addr u $array -- )
\G insert O(log(n)) into pre-sorted array
{ $arr } 0 $arr $[]#
BEGIN 2dup < WHILE 2dup + 2/ { left right $# }
2dup sigsize# - $# $arr $[]@ sigsize# - compare dup 0= IF
drop
2dup startdate@
$# $arr $[]@ startdate@ 64u>=
IF $# $arr $[]!
ELSE 2drop THEN EXIT THEN
0< IF left $# ELSE $# 1+ right THEN
REPEAT drop >r
0 { w^ ins$0 } ins$0 cell $arr r@ cells $ins r> $arr $[]! ;
: $del[]sig ( addr u $arrrray -- )
\G delete O(log(n)) from pre-sorted array, check sigs
{ $arr } 0 $arr $[]#
BEGIN 2dup < WHILE 2dup + 2/ { left right $# }
2dup sigonlysize# - $# $arr $[]@ sigonlysize# -
compare dup 0= IF
$# $arr $[] $off
$arr $# cells cell $del
2drop EXIT THEN
0< IF left $# ELSE $# 1+ right THEN
REPEAT 2drop 2drop ; \ not found
\ filter entries out of a string array
: $[]filter { addr xt -- }
......
......@@ -114,6 +114,8 @@ object class
cell uvar code-key^
end-class io-buffers
Variable routes
\ add IP addresses
require net2o-ip.fs
......@@ -327,8 +329,6 @@ $00000000 Value droprate#
\ clients routing table
Variable routes
: init-route ( -- ) s" " routes hash@ $! ; \ field 0 is me, myself
: ipv4>ipv6 ( addr u -- addr' u' )
......@@ -375,9 +375,6 @@ Variable lastn2oaddr
\ route an incoming packet
[IFDEF] 64bit ' be-ux@ [ELSE] ' be-ul@ [THEN] alias be@
[IFDEF] 64bit ' be-x! [ELSE] ' be-l! [THEN] alias be!
: >rpath-len ( rpath -- rpath len )
dup $100 u< IF 1 EXIT THEN
dup $10000 u< IF 2 EXIT THEN
......@@ -1082,8 +1079,6 @@ require net2o-file.fs
Defer >sockaddr
Defer sockaddr+return
: -skip ( addr u char -- ) >r
BEGIN 1- dup 0>= WHILE 2dup + c@ r@ <> UNTIL THEN 1+ rdrop ;
: -sig ( addr u -- addr u' ) 2dup + 1- c@ 2* $11 + - ;
: n2oaddrs ( xt -- )
my-addr$ [: -sig sockaddr+return rot dup >r execute r> ;] $[]map drop ;
......@@ -1119,7 +1114,7 @@ User outflag outflag off
header( ." send code " outbuf .header )
outbuf flags 1+ c@ stateless# and IF
outbuf0-encrypt return-addr
cmd0( .time ." cmd0 to: " dup $10 xtype cr )
cmd0( .time ." cmd0 to: " dup .addr-path cr )
ELSE
code-map @ outbuf-encrypt return-address
THEN packet-to ;
......@@ -1183,7 +1178,7 @@ Defer new-addr
check-addr1 0= IF 2drop EXIT THEN
insert-address temp-addr ins-dest
temp-addr return-addr $10 move
nat( ." send punch to: " return-addr $10 xtype cr )
nat( ." send punch to: " return-addr .addr-path cr )
punch-load $@ punch-reply ;
: net2o:punch ( addr u -- )
......@@ -1684,7 +1679,7 @@ $20 Constant signed-val
: route-packet ( -- )
inbuf >r r@ get-dest route>address
route( ." route to: " sockaddr alen @ .address space
inbuf destination $10 xtype cr )
inbuf destination .addr-path cr )
r> dup packet-size send-a-packet 0< ?ior ;
\ dispose context
......@@ -2004,7 +1999,7 @@ User host$ \ check for this hostname
." check addr: " dup .addr cr dup >r
[: check-addr1 0= IF 2drop EXIT THEN
insert-address temp-addr ins-dest
." insert host: " temp-addr $10 xtype cr
." insert host: " temp-addr .addr-path cr
return-addr $10 0 skip nip 0= IF
temp-addr return-addr $10 move
THEN ;] addr>sock r>
......@@ -2025,7 +2020,7 @@ User host$ \ check for this hostname
:noname ( addr u cmdlen datalen -- )
2>r n2o:pklookup 2r>
cmd0( ." attempt to connect to: " return-addr $10 xtype cr )
cmd0( ." attempt to connect to: " return-addr .addr-path cr )
n2o:connect +flow-control +resend ; is pk-connect
: nick-connect ( addr u cmdlen datalen -- )
......
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