Commit ec43e68d authored by bernd's avatar bernd
Browse files

Start of message protocol

parent 812fa6de

alice-test.fs

+1 −33
Original line number Diff line number Diff line
@@ -18,38 +18,6 @@ init-client 
?nextarg [IF] net2o-host $! [THEN]

?nextarg [IF] s>number drop to net2o-port [THEN]



: 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

    ." Connected!" cr

    c:test-rest ;



\ ?nextarg [IF] s>number drop [ELSE] 1 [THEN] c:tests



script? [IF] "bob" nat:connect bye [THEN]
 
script? [IF] "bob" nat:connect c:test-rest bye [THEN]

client-tests.fs

+36 −3
Original line number Diff line number Diff line
@@ -116,12 +116,12 @@ previous 
    net2o-code

      expect-reply

      log !time .time s" Download test " $, type 1 ulit, . pi float, f. cr endwith

      get-ip 0 ulit,

      get-ip

      $400 blocksize! $400 blockalign! stat( request-stats )

      "net2o.fs" "net2o.fs" >cache n2o:copy

      "data/2011-05-13_11-26-57-small.jpg" "photo000s.jpg" >cache n2o:copy

      "data/2011-05-20_17-01-12-small.jpg" "photo001s.jpg" >cache n2o:copy

      n2o:done push' log words push' cr push' endwith

      n2o:done push' log 0 ulit, words push' cr push' endwith

    end-code| n2o:close-all ['] .time $err ;



: c:download2 ( -- )
@@ -137,7 +137,7 @@ previous 
      "data/2011-06-27_19-33-04-small.jpg" "photo006s.jpg" >cache n2o:copy

      "data/2011-06-27_19-55-48-small.jpg" "photo007s.jpg" >cache n2o:copy

      "data/2011-06-28_06-54-09-small.jpg" "photo008s.jpg" >cache n2o:copy

      n2o:done

      n2o:done push' log 55 ulit, words push' cr push' endwith

    end-code| n2o:close-all ['] .time $err ;



: c:download3 ( -- )
@@ -214,6 +214,39 @@ event: ->throw dup DoError throw ; 
    0 ?DO  I c:test& req-ms# ms test# 1+ to test#  LOOP

    requests->0 ;



\ 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

    ." Connected!" cr ;



\ some more helpers



: sha-3 ( addr u -- ) c:0key

net2o-cmd.fs

+9 −10
Original line number Diff line number Diff line
@@ -483,6 +483,8 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply 
    $> cmdnest ;

+net2o: req> ( -- ) \ end of request

    endwith ;

+net2o: request-done ( ureq -- ) 64>n \ signal request is completed

    o 0<> own-crypt? and IF  n2o:request-done  ELSE  drop  THEN ;



\ inspection
@@ -543,8 +545,6 @@ log-table >table 
+net2o: new-code ( addr addr u -- ) \ crate new code mapping

    o 0<> tmp-crypt? and own-crypt? or IF  64>n  n2o:new-code  EXIT  THEN

    64drop 64drop 64drop  un-cmd ;

+net2o: request-done ( ureq -- ) 64>n \ signal request is completed

    o 0<> own-crypt? and IF  n2o:request-done  ELSE  drop  THEN ;

+net2o: set-rtdelay ( utimestamp -- ) \ set round trip delay

    o IF  rtdelay!  EXIT  THEN

    own-crypt? IF
@@ -556,6 +556,8 @@ log-table >table 
	    ticker 64@ connect-timeout# 64- 64u< 0= ?EXIT

	THEN

    ELSE  64drop  THEN  un-cmd ;

+net2o: disconnect ( -- ) \ close connection

    o 0= ?EXIT n2o:dispose-context un-cmd ;



: n2o:create-map

    { 64: addrs ucode udata 64: addrd -- addrd ucode udata addrs }
@@ -631,6 +633,10 @@ net2o-base 


+net2o: punch? ( -- ) \ Request punch addresses

    gen-punch ;

+net2o: set-ip ( $:string -- ) \ set address information

    $> setip-xt perform ;

+net2o: get-ip ( -- ) \ request address information

    >sockaddr $, set-ip [: $, set-ip ;] n2oaddrs ;



\ create commands to send back
@@ -712,8 +718,6 @@ gen-table $freeze 
+net2o: slurp ( -- ) \ slurp in tracked files

    n2o:slurp swap ulit, flag, set-top

    ['] do-track-seek n2o:track-all-seeks net2o:send-chunks ;

+net2o: disconnect ( -- ) \ close connection

    o 0= ?EXIT n2o:dispose-context un-cmd ;



\ flow control functions
@@ -760,11 +764,6 @@ net2o' emit net2o: ack-addrtime ( utime addr -- ) \ packet at addr received at t 
gen-table $freeze

' context-table is gen-table



$60 net2o: set-ip ( $:string -- ) \ set address information

    $> setip-xt perform ;

+net2o: get-ip ( -- ) \ request address information

    >sockaddr $, set-ip [: $, set-ip ;] n2oaddrs ;



: net2o:gen-resend ( -- )

    recv-flag @ invert resend-toggle# and ulit, ack-resend ;

: net2o:ackflush ( n -- ) ulit, ack-flush ;
@@ -1103,7 +1102,7 @@ forth-local-words: 
    (

     (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)

      "[ \t\n]" t name (font-lock-function-name-face . 3))

     ("[a-z0-9]+(" immediate (font-lock-comment-face . 1)

     ("[a-z\-0-9]+(" immediate (font-lock-comment-face . 1)

      ")" nil comment (font-lock-comment-face . 1))

    )

forth-local-indent-words:

net2o-dht.fs

+1 −1
Original line number Diff line number Diff line
@@ -294,7 +294,7 @@ Variable revtoken 


get-current also net2o-base definitions



$70 net2o: dht-id ( $:string -- o:o ) $> >d#id dht( ." set dht to: " dup hex. F cr ) n:>o ;

$51 net2o: dht-id ( $:string -- o:o ) $> >d#id dht( ." set dht to: " dup hex. F cr ) n:>o ;

\g set dht id for further operations on it

dht-table >table

net2o-msg.fs

0 → 100644
+51 −0
Original line number Diff line number Diff line 
\ messages                                           06aug2014py



\ Copyright (C) 2013   Bernd Paysan



\ This program is free software: you can redistribute it and/or modify

\ it under the terms of the GNU Affero General Public License as published by

\ the Free Software Foundation, either version 3 of the License, or

\ (at your option) any later version.



\ This program is distributed in the hope that it will be useful,

\ but WITHOUT ANY WARRANTY; without even the implied warranty of

\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

\ GNU Affero General Public License for more details.



\ You should have received a copy of the GNU Affero General Public License

\ along with this program.  If not, see <http://www.gnu.org/licenses/>.



$52 net2o: msg ( -- ) \ push a message object

    msg-context @ n:>o ;



msg-table >table



reply-table $@ inherit-table msg-table



$20 net2o: msg-at ( timestamp -- ) \ specify sender time

    ." msg at: " .ticks space ;

+net2o: msg-text ( $:msg -- ) \ specify message string

    $> F type F cr ;

+net2o: msg-object ( $:hash -- ) \ specify an object, e.g. an image

    $> F ." wrapped object: " 85type F cr ;



gen-table $freeze

' context-table is gen-table



0 [IF]

Local Variables:

forth-local-words:

    (

     (("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)

      "[ \t\n]" t name (font-lock-function-name-face . 3))

     ("[a-z\-0-9]+(" immediate (font-lock-comment-face . 1)

      ")" nil comment (font-lock-comment-face . 1))

    )

forth-local-indent-words:

    (

     (("net2o:" "+net2o:") (0 . 2) (0 . 2) non-immediate)

     (("[:") (0 . 1) (0 . 1) immediate)

     ((";]") (-1 . 0) (0 . -1) immediate)

    )

End:

[THEN]
 
 No newline at end of file