Commit 675087c8 authored by bernd's avatar bernd
Browse files

Moved some useful words out of the testing stuff

parent c4deaf91

client-tests.fs

+1 −62
Original line number Diff line number Diff line
@@ -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

debugging.fs

+1 −0
Original line number Diff line number Diff line
@@ -104,6 +104,7 @@ debug: resend( 
debug: track(

debug: data(

debug: cmd(

debug: cmd0(

debug: send(

debug: firstack(

debug: msg(

net2o-keys.fs

+8 −1
Original line number Diff line number Diff line
@@ -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:

net2o-msg.fs

+5 −0
Original line number Diff line number Diff line
@@ -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:

net2o.fs

+60 −2
Original line number Diff line number Diff line
@@ -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: