Commit d0ed6411 authored by bernd's avatar bernd

Removed all the setup stuff from the actual active connection words

parent cfd3e35b
......@@ -104,7 +104,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 55 ulit, words push' cr push' endwith
n2o:done
end-code| n2o:close-all ['] .time $err ;
: c:download3 ( -- )
......
......@@ -501,38 +501,11 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply
gen-table $freeze
\ 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 ;
+net2o: type ( $:string -- ) \ type string on server log
$> F type ;
+net2o: . ( u -- ) \ print number on server log
64. ;
+net2o: f. ( -- ) \ print fp number on server log
F f. ;
+net2o: cr ( -- ) \ newline on server log
F cr ;
+net2o: .time ( -- ) \ print timer to server log
F .time .packets profile( .times ) ;
+net2o: !time ( -- ) \ start timer
F !time init-timer ;
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: tmpnest ( $:string -- ) \ nested (temporary encrypted) command
$20 net2o: tmpnest ( $:string -- ) \ nested (temporary encrypted) command
$> cmdtmpnest ;
: ]nest$ ( -- ) end-cmd cmd>nest $, ;
......@@ -556,8 +529,6 @@ 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 }
......@@ -633,10 +604,6 @@ 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
......@@ -645,7 +612,10 @@ net2o-base
+net2o: >time-offset ( n -- ) \ set time offset
o IF time-offset 64! ELSE 64drop THEN ;
: time-offset! ( -- ) ticks 64dup lit, >time-offset time-offset 64! ;
+net2o: context ( -- ) \ make context active
o IF context! THEN ;
: time-offset! ( -- ) ticks 64dup lit, >time-offset time-offset 64! context ;
: reply-key, ( -- )
nest[ pkc keysize $, dest-pubkey @ IF
dest-pubkey $@ $, keypair
......@@ -658,27 +628,50 @@ net2o-base
[: crypt( ." Reply key: " tmpkey@ .nnb F cr )
reply-key, cookie+request time-offset! ]tmpnest
push-cmd ;] IS expect-reply? ;
+net2o: gen-punch-reply ( -- ) o? \ generate a key request reply reply
[: crypt( ." Reply key: " tmpkey@ .nnb F cr )
reply-key, gen-punchload gen-punch time-offset! ]tmpnest
push-cmd ;] IS expect-reply? ;
gen-table $freeze
\ everything that follows here can assume to have a connection context
gen-table $freeze
gen-table $@ inherit-table context-table
reply-table $@ inherit-table context-table
\ generic functions
$20 net2o: disconnect ( -- ) \ close connection
o 0= ?EXIT n2o:dispose-context un-cmd ;
+net2o: set-ip ( $:string -- ) \ set address information
$> setip-xt perform ;
+net2o: get-ip ( -- ) \ request address information
>sockaddr $, set-ip [: $, set-ip ;] n2oaddrs ;
\ file functions
+net2o: set-blocksize ( n -- ) \ set blocksize
64>n blocksize! ;
+net2o: set-blockalign ( n -- ) \ set block alignment
64>n pow2? blockalign ! ;
+net2o: close-all ( -- ) \ close all files
n2o:close-all ;
\ better slurping
$40 net2o: file-id ( uid -- o:file )
+net2o: set-top ( utop flag -- ) \ set top, flag is true when all data is sent
>r 64>n r> data-rmap @ >o over dest-top @ <> and dest-end or! dest-top! o> ;
+net2o: slurp ( -- ) \ slurp in tracked files
n2o:slurp swap ulit, flag, set-top
['] do-track-seek n2o:track-all-seeks net2o:send-chunks ;
\ object handles
$30 net2o: file-id ( uid -- o:file )
64>n state-addr n:>o ;
fs-table >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
$20 net2o: open-file ( $:string mode -- ) \ open file with mode
64>n $> rot fs-open ;
+net2o: close-file ( -- ) \ close file
fs-close ;
......@@ -698,30 +691,15 @@ net2o' emit net2o: open-file ( $:string mode -- ) \ open file with mode
gen-table $freeze
' context-table is gen-table
+net2o: set-blocksize ( n -- ) \ set blocksize
64>n blocksize! ;
+net2o: set-blockalign ( n -- ) \ set block alignment
64>n pow2? blockalign ! ;
+net2o: close-all ( -- ) \ close all files
n2o:close-all ;
: blocksize! ( n -- ) dup ulit, set-blocksize blocksize! ;
: blockalign! ( n -- ) pow2? dup ulit, set-blockalign blockalign ! ;
\ better slurping
:noname ( uid useek -- ) 64>r ulit, file-id
64r> lit, set-seek endwith ; is do-track-seek
+net2o: set-top ( utop flag -- ) \ set top, flag is true when all data is sent
>r 64>n r> data-rmap @ >o over dest-top @ <> and dest-end or! dest-top! o> ;
+net2o: slurp ( -- ) \ slurp in tracked files
n2o:slurp swap ulit, flag, set-top
['] do-track-seek n2o:track-all-seeks net2o:send-chunks ;
\ flow control functions
$50 net2o: ack ( -- ) ack-context @ n:>o ;
$31 net2o: ack ( -- ) ack-context @ n:>o ;
ack-table >table
reply-table $@ inherit-table ack-table
......@@ -729,7 +707,7 @@ 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 ;
net2o' emit net2o: ack-addrtime ( utime addr -- ) \ packet at addr received at time
$20 net2o: ack-addrtime ( utime addr -- ) \ packet at addr received at time
parent @ .net2o:ack-addrtime ;
+net2o: ack-resend ( flag -- ) \ set resend toggle flag
64>n parent @ .net2o:ack-resend ;
......@@ -764,6 +742,34 @@ net2o' emit net2o: ack-addrtime ( utime addr -- ) \ packet at addr received at t
gen-table $freeze
' context-table is gen-table
\ log dump class
reply-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 ;
+net2o: type ( $:string -- ) \ type string on server log
$> F type ;
+net2o: . ( u -- ) \ print number on server log
64. ;
+net2o: f. ( -- ) \ print fp number on server log
F f. ;
+net2o: cr ( -- ) \ newline on server log
F cr ;
+net2o: .time ( -- ) \ print timer to server log
F .time .packets profile( .times ) ;
+net2o: !time ( -- ) \ start timer
F !time init-timer ;
gen-table $freeze
' context-table is gen-table
$32 net2o: log ( -- o:log ) log-context @ n:>o ;
log-table >table
: net2o:gen-resend ( -- )
recv-flag @ invert resend-toggle# and ulit, ack-resend ;
: net2o:ackflush ( n -- ) ulit, ack-flush ;
......@@ -977,7 +983,7 @@ cell 8 = [IF] 6 [ELSE] 5 [THEN] Constant cell>>
2dup + n2o:new-map lit, swap ulit, ulit,
map-request ;
: gen-request ( -- )
: gen-request ( -- ) o IF setup! THEN
cmd( ind-addr @ IF ." in" THEN ." direct connect" F cr )
net2o-code0
['] end-cmd IS expect-reply?
......@@ -1087,7 +1093,7 @@ previous
: reqsize! ( ucode udata -- ) req-datasize ! req-codesize ! ;
: tail-connect ( -- ) +resend client-loop
-timeout tskc KEYBYTES erase resend0 $off ;
-timeout tskc KEYBYTES erase resend0 $off context! ;
: n2o:connect ( ucode udata -- )
reqsize! gen-request tail-connect ;
......
......@@ -303,7 +303,7 @@ Defer search-key \ search if that is one of our pubkeys
o 0= IF 2drop EXIT THEN skc key-rest ;
: net2o:keypair ( pkc uc pk u -- )
o 0= IF 2drop EXIT THEN
?keysize search-key key-rest ;
2dup mpubkey $! ?keysize search-key key-rest ;
: net2o:receive-tmpkey ( addr u -- ) ?keysize \ dup keysize .nnb cr
o 0= IF gen-stkeys stskc ELSE tskc THEN \ dup keysize .nnb cr
swap keypad ed-dh
......
......@@ -294,7 +294,7 @@ Variable revtoken
get-current also net2o-base definitions
$51 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
......
......@@ -17,7 +17,7 @@
get-current also net2o-base definitions
$52 net2o: msg ( -- ) \ push a message object
$34 net2o: msg ( -- ) \ push a message object
msg-context @ n:>o buf-state 2@ msg-buf 2! ;
msg-table >table
......
......@@ -903,7 +903,8 @@ cmd-class class
field: blocksize
field: blockalign
field: crypto-key
field: pubkey
field: pubkey \ other side official pubkey
field: mpubkey \ our side official pubkey
field: timeout-xt \ callback for timeout
field: setip-xt \ callback for set-ip
field: ack-xt
......@@ -1173,6 +1174,8 @@ Variable mapstart $1 mapstart !
: 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!! ;
: n2o:new-map ( u -- addr )
......@@ -1181,7 +1184,7 @@ Variable mapstart $1 mapstart !
: n2o:new-data pow2? { 64: addrs 64: addrd u -- }
o 0= IF
addrd >dest-map @ ?EXIT
return-addr be@ n2o:new-context >o rdrop server! THEN
return-addr be@ n2o:new-context >o rdrop server! setup! THEN
msg( ." data map: " addrs $64. addrd $64. u hex. cr )
>code-flag off
addrd u data-rmap map-data-dest
......@@ -1189,7 +1192,7 @@ Variable mapstart $1 mapstart !
: n2o:new-code pow2? { 64: addrs 64: addrd u -- }
o 0= IF
addrd >dest-map @ ?EXIT
return-addr be@ n2o:new-context >o rdrop server! THEN
return-addr be@ n2o:new-context >o rdrop server! setup! THEN
msg( ." code map: " addrs $64. addrd $64. u hex. cr )
>code-flag on
addrd u code-rmap map-code-dest
......@@ -2507,9 +2510,10 @@ require net2o-msg.fs
: c:connect ( code data nick u ret -- )
[: .time ." Connect to: " dup hex. cr ;] $err
n2o:new-context >o rdrop o to connection
n2o:new-context >o rdrop o to connection setup!
dest-key \ get our destination key
n2o:connect +flow-control +resend
n2o:connect
+flow-control +resend
[: .time ." Connected, o=" o hex. cr ;] $err ;
: c:fetch-id ( pubkey u -- )
......
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