Implicit reply generation instead of explicit one

: 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| ;

      "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 ( -- )

      $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 ( -- )

      $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 ( -- )

: 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 )

: t-push ( addr -- )  t-stack >stack ;

: t-pop ( -- addr )   t-stack stack> ;

: t# ( -- n ) t-stack $[]# ;

\ float are stored big endian.

	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 ;

: 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, ;

Vocabulary net2o-base

Defer do-req>

get-current also net2o-base definitions

\ Command numbers preliminary and subject to change

+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

    2r> buf-state 2! ;

: cmdreset ( -- )

    cmdbuf# off ;

    cmdbuf# off  o IF  req? off  THEN ;

: cmd0! ( -- )

    \g initialize a stateless command

    cmd0buf cmd0source !  stateless# outflag ! ;

\ 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

    $> $, ;

+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

    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 ;

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

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

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

: 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

	?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 ( -- )

    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 )

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+ ;

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

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