Commit ec43e68d authored by bernd's avatar bernd

Start of message protocol

parent 812fa6de
......@@ -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]
......@@ -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
......
......@@ -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:
......
......@@ -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
......
\ 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
......@@ -823,6 +823,7 @@ Variable reply-table
Variable log-table
Variable setup-table
Variable ack-table
Variable msg-table
cmd-class class
64field: dest-vaddr
......@@ -871,6 +872,9 @@ cmd-class class
64field: last-time
end-class ack-class
cmd-class class
end-class msg-class
cmd-class class
field: code-map
field: code-rmap
......@@ -878,6 +882,7 @@ cmd-class class
field: data-rmap
field: log-context
field: ack-context
field: msg-context
field: codebuf#
field: context#
field: wait-task
......@@ -1091,6 +1096,8 @@ UValue connection
cmd-class new >o log-table @ token-table ! o o> ;
: n2o:new-ack ( -- o )
o ack-class new >o parent ! ack-table @ token-table ! o o> ;
: n2o:new-msg ( -- o )
o msg-class new >o parent ! msg-table @ token-table ! o o> ;
: n2o:new-context ( addr -- o )
context-class new >o timeout( ." new context: " o hex. cr )
......@@ -1107,6 +1114,7 @@ UValue connection
filestate-lock 0 pthread_mutex_init drop
n2o:new-log log-context !
n2o:new-ack ack-context !
n2o:new-msg msg-context !
o o> ;
\ insert address for punching
......@@ -2483,6 +2491,7 @@ con-cookie >osize @ buffer: cookie-adder
require net2o-cmd.fs
require net2o-dht.fs
require net2o-msg.fs
require net2o-keys.fs \ extra cmd space
0 [IF]
......
\ net2o tests - msg
require ../client-tests.fs
+db stat(
+debug
%droprate
script? [IF] debug-task [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 ." Download test: 1 text file and 2 photos" cr ;] $err
net2o-code
expect-reply
log !time .time s" Message test" $, type cr endwith
msg ticks lit, msg-at
"This is a test message" $, msg-text endwith
cookie+request
end-code| ['] .time $err
>timing 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