Commit bbfaaa30 authored by bernd's avatar bernd

start preparing moving flow control to separate class

parent 0418f2cf
......@@ -99,12 +99,12 @@ previous
cookie+request
end-code| -setip n2o:send-replace ;
: c:fetch-tags ( -- )
net2o-code
expect-reply
0 ulit, dht-open pkc keysize 2* $, $FE ulit, 0 ulit, dht-query
n2o:done
end-code| ;
\ : c:fetch-tags ( -- )
\ net2o-code
\ expect-reply
\ 0 ulit, dht-open pkc keysize 2* $, $FE ulit, 0 ulit, dht-query
\ n2o:done
\ end-code| ;
: c:dht ( n -- ) $2000 $10000 "test" ins-ip c:connect 0 ?DO
c:add-tag "anonymous" c:fetch-tag \ c:fetch-tags
......@@ -114,20 +114,21 @@ previous
[: .time ." Download test: 1 text file and 2 photos" cr ;] $err
net2o-code
expect-reply
!time .time s" Download test " $, type 1 ulit, . pi float, f. cr
( see-me ) get-ip 0 ulit,
!time
log .time s" Download test " $, type 1 ulit, . pi float, f. cr endwith
get-ip 0 ulit,
$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 words push' cr
n2o:done push' log words push' cr push' endwith
end-code| n2o:close-all ['] .time $err ;
: c:download2 ( -- )
[: ." Download test 2: 7 medium photos" cr ;] $err
net2o-code
expect-reply close-all \ rewind-total
.time s" Download test 2" $, type cr ( see-me )
log .time s" Download test 2" $, type cr endwith
$10000 blocksize! $400 blockalign! stat( request-stats )
"data/2011-06-02_15-02-38-small.jpg" "photo002s.jpg" >cache n2o:copy
"data/2011-06-03_10-26-49-small.jpg" "photo003s.jpg" >cache n2o:copy
......@@ -143,7 +144,7 @@ previous
[: ." Download test 3: 2 big photos" cr ;] $err
net2o-code
expect-reply close-all \ rewind-total
.time s" Download test 3" $, type cr ( see-me )
log .time s" Download test 3" $, type cr endwith
$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
......@@ -154,7 +155,7 @@ previous
[: ." Download test 4: 7 big photos, partial files" cr ;] $err
net2o-code
expect-reply close-all \ rewind-total
.time s" Download test 4" $, type cr ( see-me )
log .time s" Download test 4" $, type cr endwith
$10000 blocksize! $400 blockalign! stat( request-stats )
"data/2011-06-02_15-02-38.jpg" "photo002.jpg" >cache n2o:copy
"data/2011-06-03_10-26-49.jpg" "photo003.jpg" >cache n2o:copy
......@@ -177,7 +178,7 @@ previous
[: ." Download test 4a: 7 big photos, rest" cr ;] $err
net2o-code
expect-reply
.time s" Download test 4a" $, type cr ( see-me )
log .time s" Download test 4a" $, type cr endwith
-1. 0 limit!
-1. 1 limit!
-1. 2 limit!
......
......@@ -256,6 +256,9 @@ User cmdbuf#
Defer net2o:words
: inherit-table ( addr u "name" -- )
' dup IS gen-table execute $! ;
Vocabulary net2o-base
get-current also net2o-base definitions previous
......@@ -286,8 +289,7 @@ get-current also net2o-base definitions previous
dup set-current
gen-table $freeze
gen-table $@ reply-table $!
' reply-table is gen-table
gen-table $@ inherit-table reply-table
\ net2o assembler
......@@ -459,7 +461,6 @@ dup set-current previous
also net2o-base definitions
$10 net2o: <req ( -- ) ; \ stub: push own id in reply
+net2o: req> ( -- ) endwith ; \ generic: pop own id in reply
+net2o: push-lit ( u -- ) \ push unsigned literal into answer packet
lit, ;
' push-lit alias push-char
......@@ -478,11 +479,14 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply
\ Use ko instead of throw for not acknowledge (kudos to Heinz Schnitter)
+net2o: ko ( uerror -- ) \ receive error message
throw ;
+net2o: nest ( $:string -- ) \ nested (self-encrypted) command
$> cmdnest ;
: req> ( -- ) push' endwith ;
\ inspection
+net2o: token ( $:token n -- )
64>n 0 .r ." :" $> type space ; \ stub
+net2o: token ( $:token n -- ) 64drop $> 2drop ; \ stub
:noname ( start -- )
token-table $@ 2 pick cells safe/string bounds U+DO
......@@ -493,11 +497,14 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply
THEN 1+
cell +LOOP drop ; IS net2o:words
\ setup connection class
gen-table $freeze
gen-table $@ setup-table $!
' setup-table is gen-table
\ log dump class
gen-table $@ inherit-table log-table
net2o' token net2o: log-token ( $:token n -- )
64>n 0 .r ." :" $> F type space ;
$20 net2o: emit ( xc -- ) \ emit character on server log
64>n xemit ;
......@@ -509,11 +516,18 @@ $20 net2o: emit ( xc -- ) \ emit character on server log
F f. ;
+net2o: cr ( -- ) \ newline on server log
F cr ;
+net2o: see-me ( -- ) \ see received commands on server log
n2o:see-me ;
+net2o: .time ( -- ) \ print timer to server log
F .time .packets profile( .times ) ;
gen-table $freeze
\ setup connection class
reply-table $@ inherit-table setup-table
$20 net2o: log ( -- o:log ) log-context @ n:>o ;
log-table >table
+net2o: nest ( $:string -- ) \ nested (self-encrypted) command
$> cmdnest ;
+net2o: tmpnest ( $:string -- ) \ nested (temporary encrypted) command
$> cmdtmpnest ;
......@@ -565,8 +579,6 @@ $20 net2o: emit ( xc -- ) \ emit character on server log
]nest n2o:create-map neststack @ IF ]tmpnest THEN
64drop 2drop 64drop ;
+net2o: disconnect ( -- ) \ close connection
o 0= ?EXIT n2o:dispose-context un-cmd ;
+net2o: set-tick ( uticks -- ) \ adjust time
adjust-ticks ;
+net2o: get-tick ( -- ) \ request time adjust
......@@ -640,8 +652,7 @@ net2o-base
\ everything that follows here can assume to have a connection context
gen-table $freeze
gen-table $@ context-table $!
' context-table is gen-table
gen-table $@ inherit-table context-table
\ file functions
......@@ -649,8 +660,7 @@ $40 net2o: file-id ( uid -- o:file )
64>n state-addr n:>o ;
fs-table >table
reply-table $@ fs-table $!
' fs-table is gen-table
reply-table $@ inherit-table fs-table
net2o' <req net2o: <req-file ( -- ) fs-id @ ulit, file-id ;
net2o' emit net2o: open-file ( $:string mode -- ) \ open file with mode
......@@ -693,6 +703,8 @@ 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
......@@ -731,8 +743,6 @@ $50 net2o: ack-addrtime ( utime addr -- ) \ packet at addr received at time
$60 net2o: !time ( -- ) \ start timer
F !time init-timer ;
+net2o: .time ( -- ) \ print timer to server log
F .time .packets profile( .times ) ;
+net2o: set-ip ( $:string -- ) \ set address information
$> setip-xt perform ;
......@@ -754,7 +764,7 @@ net2o-base
: lit< lit, push-lit ;
: slit< slit, push-slit ;
:noname ( throwcode -- )
server? IF
connection @ .server? IF
dup IF dup nlit, ko end-cmd
['] end-cmd IS expect-reply? (end-code) THEN
THEN throw ; IS >throw
......
......@@ -298,8 +298,7 @@ $70 net2o: dht-id ( $:string -- o:o ) $> >d#id dht( ." set dht to: " dup hex. F
\g set dht id for further operations on it
dht-table >table
reply-table $@ dht-table $!
' dht-table is gen-table
reply-table $@ inherit-table dht-table
net2o' <req net2o: <req-dht ( -- ) dht-hash $@ $, dht-id ; \ redefine <req
net2o' emit net2o: dht-host+ ( $:string -- ) $> d#host+ ;
......@@ -353,8 +352,8 @@ get-current definitions
+net2o: dht-host? ( -- ) d#host? ;
+net2o: dht-tags? ( -- ) d#tags? ;
+net2o: dht-open ( fid -- ) 64>n d#open ;
+net2o: dht-query ( addr u mask fid -- ) 2*64>n d#query ;
\ +net2o: dht-open ( fid -- ) 64>n d#open ;
\ +net2o: dht-query ( addr u mask fid -- ) 2*64>n d#query ;
previous set-current
......@@ -465,7 +464,7 @@ Defer renew-key
-setip n2o:send-revoke ;
: do-disconnect ( -- )
net2o-code .time s" Disconnect" $, type cr
net2o-code log .time s" Disconnect" $, type cr endwith
close-all disconnect end-code msg( ." disconnected" F cr )
n2o:dispose-context msg( ." Disposed context" F cr ) ;
......
......@@ -188,8 +188,7 @@ Variable keys
get-current also net2o-base definitions
cmd-table $@ key-entry-table $!
' key-entry-table is gen-table
cmd-table $@ inherit-table key-entry-table
$10 net2o: newkey ( $:string -- o:key ) $> key:new n:>o ;
key-entry-table >table
......
......@@ -865,6 +865,11 @@ end-class reply-class \ command interpreter with replies
Variable reply-table
reply-class class
end-class log-class
Variable log-table
reply-class class
end-class setup-class \ setup connections
......@@ -877,6 +882,7 @@ setup-class class
field: data-rmap
field: codebuf#
field: context#
field: log-context
field: wait-task
field: resend0
field: punch-load
......@@ -901,7 +907,7 @@ setup-class class
field: filereq#
1 pthread-mutexes +field filestate-lock
1 pthread-mutexes +field code-lock
field: data-resend
field: data-b2b
......@@ -914,21 +920,22 @@ setup-class class
field: req-codesize
field: req-datasize
\ flow control, sender part
field: window-size \ packets in flight
field: timeouts
field: flyburst
field: flybursts
64field: min-slack
64field: max-slack
64field: ns/burst
64field: last-ns/burst
64field: extra-ns
field: window-size \ packets in flight
64field: bandwidth-tick \ ns
64field: next-tick \ ns
64field: next-timeout \ ns
field: timeouts
64field: rtdelay \ ns
64field: lastack \ ns
64field: resend-all-to \ ns
field: flyburst
field: flybursts
64field: lastslack
64field: lastdeltat
64field: slackgrow
......@@ -1086,6 +1093,9 @@ resend-size# buffer: resend-init
UValue connection
: n2o:new-log ( -- o )
log-class new >o log-table @ token-table ! o o> ;
: n2o:new-context ( addr -- o )
context-class new >o timeout( ." new context: " o hex. cr )
o to connection \ current connection
......@@ -1098,7 +1108,9 @@ UValue connection
-1 blocksize !
1 blockalign !
code-lock 0 pthread_mutex_init drop
filestate-lock 0 pthread_mutex_init drop o o> ;
filestate-lock 0 pthread_mutex_init drop
n2o:new-log log-context !
o o> ;
\ insert address for punching
......@@ -1797,11 +1809,6 @@ Defer punch-reply
\ send chunk
: net2o:get-dest ( -- taddr )
data-dest ;
: net2o:get-resend ( -- taddr )
resend-dest ;
\ branchless version using floating point
User <size-lb> 1 floats cell- uallot drop
......@@ -1833,10 +1840,10 @@ User <size-lb> 1 floats cell- uallot drop
resend$@ nip 0> data-tail? or ;
: net2o:resend ( -- addr n )
resend$@ net2o:get-resend net2o:prep-send /resend ;
resend$@ resend-dest net2o:prep-send /resend ;
: net2o:send ( -- addr n )
data-tail@ net2o:get-dest net2o:prep-send /tail ;
data-tail@ data-dest net2o:prep-send /tail ;
: ?toggle-ack ( -- )
data-to-send 0= IF
......@@ -2289,6 +2296,7 @@ $10 Constant tmp-crypt-val
crypto-key sec-off
data-resend $off timing-stat $off
dest-pubkey $off
log-context @ .dispose
dispose
cmd( ." disposed" cr ) ;] file-sema c-section ;
......
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