Skip to content

GitLab

net2o
net2o
Commit 2a953fd3 authored by bernd's avatar bernd
Browse files
Options

Implicit reply generation instead of explicit one

parent 1763348d
Hide whitespace changes
Inline Side-by-side
Showing with 41 additions and 32 deletions
client-tests.fs
View file @ 2a953fd3
......@@ -34,7 +34,7 @@ UValue test# 0 to test#
: c:fetch-tag ( nick u -- )
net2o-code
expect-reply
nick-key .ke-pk $@ $, dht-id <req dht-host? dht-tags? req>
nick-key .ke-pk $@ $, dht-id dht-host? dht-tags?
endwith cookie+request
end-code| ;
......@@ -81,7 +81,7 @@ UValue test# 0 to test#
"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 push' log log $20 ulit, words endwith push' cr push' endwith
n2o:done push' log log $20 ulit, words push' cr endwith
end-code| n2o:close-all ['] .time $err ;
: c:download3 ( -- )
......@@ -92,7 +92,8 @@ UValue test# 0 to test#
$10000 blocksize! $400 blockalign! stat( request-stats )
"data/2011-05-13_11-26-57.jpg" "photo000.jpg" >cache n2o:copy
"data/2011-05-20_17-01-12.jpg" "photo001.jpg" >cache n2o:copy
n2o:done push' log 0 file-id $20 ulit, words endwith push' cr push' endwith
n2o:done 0 ulit, file-id
push' endwith push' log $20 ulit, words push' cr endwith
end-code| n2o:close-all ['] .time $err ;
: c:download4 ( -- )
......@@ -115,7 +116,8 @@ UValue test# 0 to test#
$50000. 4 limit!
$60000. 5 limit!
$70000. 6 limit!
n2o:done push' log "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" $, dht-id $20 ulit, words endwith push' cr push' endwith
n2o:done "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" $, dht-id
push' endwith push' log $20 ulit, words push' cr endwith
end-code| ['] .time $err ;
: c:download4a ( -- )
......
net2o-cmd.fs
View file @ 2a953fd3
......@@ -87,7 +87,7 @@ User buf-state cell uallot drop
: o-push ( o1 o:x -- o:o1 o:x ) object-stack >stack ;
: n:>o ( o1 o:o2 -- o:o2 o:o1 )
>o r> o-push ;
>o r> o-push req? off ;
: n:o> ( o:o2 o:o1 -- o:o2 )
o-pop >r o> ;
: n:oswap ( o:o1 o:o2 -- o:o2 o:o1 )
......@@ -97,6 +97,7 @@ User buf-state cell uallot drop
: t-push ( addr -- ) t-stack >stack ;
: t-pop ( -- addr ) t-stack stack> ;
: t# ( -- n ) t-stack $[]# ;
\ float are stored big endian.
......@@ -173,9 +174,9 @@ drop
2 of ps@ s64. ." slit, " endof
3 of string@ n2o.string endof
4 of pf@ f. ." float, " endof
5 of ." endwith " cr t-pop token-table ! endof
5 of ." endwith " cr t# IF t-pop token-table ! THEN endof
6 of ." oswap " cr token-table @ t-pop token-table ! t-push endof
$15 of ." push' " p@ .net2o-name endof
$10 of ." push' " p@ .net2o-name endof
.net2o-name
0 endcase ]hex ;
......@@ -217,7 +218,8 @@ User cmdbuf#
: cmdbuf+ ( n -- )
dup maxstring u>= !!cmdfit!! cmdbuf# +! ;
: cmd, ( 64n -- ) cmdbuf$ + dup >r p!+ r> - cmdbuf+ ;
: do-<req ( -- ) o IF -1 req? !@ 0= IF start-req THEN THEN ;
: cmd, ( 64n -- ) do-<req cmdbuf$ + dup >r p!+ r> - cmdbuf+ ;
: net2o, @ n>64 cmd, ;
......@@ -245,6 +247,8 @@ Defer net2o:words
Vocabulary net2o-base
Defer do-req>
get-current also net2o-base definitions
\ Command numbers preliminary and subject to change
......@@ -268,7 +272,8 @@ comp: drop cmdsig @ IF ')' parse 2drop EXIT THEN
+net2o: flit ( #dfloat -- r ) \ double float literal
pf@ ;
+net2o: endwith ( o:object -- ) \ end scope
n:o> ;
do-req> n:o> ;
:noname o IF req? @ IF endwith req? off THEN THEN ; is do-req>
+net2o: oswap ( o:nest o:current -- o:current o:nest )
n:oswap ;
+net2o: tru ( -- f:true ) \ true flag literal
......@@ -298,7 +303,7 @@ gen-table $@ inherit-table reply-table
2r> buf-state 2! ;
: cmdreset ( -- )
cmdbuf# off ;
cmdbuf# off o IF req? off THEN ;
: cmd0! ( -- )
\g initialize a stateless command
cmd0buf cmd0source ! stateless# outflag ! ;
......@@ -467,7 +472,8 @@ dup set-current previous
\ commands to reply
also net2o-base definitions
$10 net2o: <req ( -- ) ; \ stub: push own id in reply
$10 net2o: push' ( #cmd -- ) \ push command into answer packet
p@ cmd, ;
+net2o: push-lit ( u -- ) \ push unsigned literal into answer packet
lit, ;
' push-lit alias push-char
......@@ -477,8 +483,6 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply
$> $, ;
+net2o: push-float ( r -- ) \ push floating point number
float, ;
+net2o: push' ( #cmd -- ) \ push command into answer packet
p@ cmd, ;
+net2o: ok ( utag -- ) \ tagged response
64>n net2o:ok ;
+net2o: ok? ( utag -- ) \ request tagged response
......@@ -488,8 +492,6 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply
throw ;
+net2o: nest ( $:string -- ) \ nested (self-encrypted) command
$> 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 ;
......
net2o-connected.fs
View file @ 2a953fd3
......@@ -52,7 +52,7 @@ fs-table >table
reply-table $@ inherit-table fs-table
net2o' <req net2o: <req-file ( -- ) fs-id @ ulit, file-id ;
:noname fs-id @ ulit, file-id ; fs-class to start-req
$20 net2o: open-file ( $:string mode -- ) \ open file with mode
64>n $> rot fs-open ;
+net2o: close-file ( -- ) \ close file
......@@ -86,9 +86,7 @@ ack-table >table
reply-table $@ inherit-table ack-table
net2o' <req net2o: <req-ack ( -- ) ack ;
net2o' req> net2o: ack-req> ( -- )
cmdbuf# @ 1 = IF cmdbuf# off ELSE endwith THEN ;
:noname ack ; ack-class to start-req
$20 net2o: ack-addrtime ( utime addr -- ) \ packet at addr received at time
parent @ .net2o:ack-addrtime ;
+net2o: ack-resend ( flag -- ) \ set resend toggle flag
......@@ -145,7 +143,7 @@ gen-table $freeze
set-current
: open-tracked-file ( addr u mode --)
open-file <req get-size get-stat req> ;
open-file get-size get-stat ;
: n2o:copy ( addrsrc us addrdest ud -- )
file-reg# @ ulit, file-id
......@@ -388,7 +386,7 @@ cell 8 = [IF] 6 [ELSE] 5 [THEN] Constant cell>>
: net2o:ack-code ( ackflag -- ackflag' )
false dup { slurp? stats? }
net2o-code ack <req ['] end-cmd IS expect-reply?
net2o-code ack ['] end-cmd IS expect-reply?
dup ack-receive !@ xor >r
r@ ack-toggle# and IF
net2o:gen-resend net2o:genack
......@@ -399,9 +397,9 @@ cell 8 = [IF] 6 [ELSE] 5 [THEN] Constant cell>>
?dup-IF net2o:ackflush
request-stats? to stats? true to slurp? THEN
THEN +expected slurp? or to slurp?
req> endwith cmdbuf# @ 4 = IF cmdbuf# off THEN
endwith cmdbuf# @ 2 = IF cmdbuf# off THEN
slurp? IF slurp THEN
stats? IF ack <req send-timing req> endwith THEN
stats? IF ack send-timing endwith THEN
end-code r> dup ack-toggle# and IF map-resend? THEN ;
: net2o:do-ack ( -- )
......@@ -426,10 +424,11 @@ also net2o-base
timeout( .keepalive )
rewind-transfer 0= IF .keepalive EXIT THEN
expected@ tuck u>= and IF net2o-code
ack <req +expected req> endwith IF slurp THEN end-code EXIT THEN
ack +expected endwith IF slurp THEN end-code EXIT THEN
net2o-code expect-reply
update-rtdelay ack <req net2o:genack
resend-all ticks lit, timeout rewind req> endwith slurp end-code ;
ack net2o:genack
resend-all ticks lit, timeout rewind endwith slurp update-rtdelay
end-code ;
previous
: connected-timeout ( -- ) timeout( ." connected timeout" F cr )
......
net2o-dht.fs
View file @ 2a953fd3
......@@ -295,13 +295,14 @@ Variable revtoken
get-current also net2o-base definitions
$33 net2o: dht-id ( $:string -- o:o ) $> >d#id dht( ." set dht to: " dup hex. F cr ) n:>o ;
$33 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
reply-table $@ inherit-table dht-table
net2o' <req net2o: <req-dht ( -- ) dht-hash $@ $, dht-id ; \ redefine <req
:noname dht-hash $@ $, dht-id ; dht-class to start-req
net2o' emit net2o: dht-host+ ( $:string -- ) $> d#host+ ;
+net2o: dht-host- ( $:string -- ) $> d#host- ;
+net2o: dht-tags+ ( $:string -- ) $> d#tags+ ;
......@@ -419,7 +420,7 @@ previous
also net2o-base
: replace-me, ( -- )
pkc keysize 2* $, dht-id <req dht-host? req> endwith ;
pkc keysize 2* $, dht-id dht-host? endwith ;
: remove-me, ( -- )
dht-host dup >r
......
net2o-keys.fs
View file @ 2a953fd3
......@@ -344,7 +344,7 @@ $40 buffer: nick-buf
also net2o-base
: fetch-id, ( id-addr u -- )
$, dht-id <req dht-host? req> endwith ;
$, dht-id dht-host? endwith ;
: fetch-host, ( nick u -- )
nick-key .ke-pk $@ fetch-id, ;
previous
......
net2o.fs
View file @ 2a953fd3
......@@ -796,7 +796,10 @@ current-o
object class
field: token-table
field: parent
field: req?
method start-req
end-class cmd-class \ command interpreter
' noop cmd-class to start-req
Variable cmd-table
Variable reply-table
......@@ -1151,8 +1154,10 @@ UValue connection
Variable mapstart $1 mapstart !
: server? ( -- flag ) is-server c@ negate ;
: server! ( -- ) 1 is-server c! ;
: >is-server ( -- addr )
parent @ 0= IF is-server ELSE parent @ .recurse THEN ;
: server? ( -- flag ) >is-server c@ negate ;
: server! ( -- ) 1 >is-server c! ;
: setup! ( -- ) setup-table @ token-table ! ;
: context! ( -- ) context-table @ token-table ! ;
: pow2? ( n -- n ) dup dup 1- and 0<> !!pow2!! ;
......
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