Commit 3fa6d349 authored by bernd's avatar bernd
Browse files

saner API for dht and keys (uses current object only) 

streaming mode is now default
parent 50d14c45

client-tests.fs

+11 −11
Original line number Diff line number Diff line
@@ -20,25 +20,25 @@ UValue test# 0 to test# 


: test-keys ( -- ) \ yes, use these keys *only* for testing!

    \ revoke: 58AB8F52F46E73EFAB068F6337F371E14DD589BF0894D2F0AF51AE7EBB858A68

    x" A91158F2C560ACCDFEFC05104B922E49C9DD022D0163921DAE08E6C2148A7BEBC83C71FCB345D24400D866C7FD32092C2D1EC056FD17B9537037590BD021EEBF" key:new

    x" A91158F2C560ACCDFEFC05104B922E49C9DD022D0163921DAE08E6C2148A7BEBC83C71FCB345D24400D866C7FD32092C2D1EC056FD17B9537037590BD021EEBF" key:new >o

    x" B2578B8766DB3A60F1F4F36B276924FDA6E7F559F629716BC78D95DB1CD8D400" ke-sk sec! +seckey

    "test" ke-nick $! $1367B086A24E6B10. d>64 ke-first 64! 0 ke-type ! n:o>

    "test" ke-nick $! $1367B086A24E6B10. d>64 ke-first 64! 0 ke-type ! o>

    \ revoke: 5843E2DC055E1F8BE14570A37B0F81146040A2CEE1D6C01B97C3BB801CDED864

    x" 69D86C471E5FEED89478FB4260C898B6F69026BA4E78A9D815B53EB33CA9013A8E753EC381881FAAFFA66CD9DD47D3F2C0867E1A2B48067CA2188DF400C11074" key:new

    x" 69D86C471E5FEED89478FB4260C898B6F69026BA4E78A9D815B53EB33CA9013A8E753EC381881FAAFFA66CD9DD47D3F2C0867E1A2B48067CA2188DF400C11074" key:new >o

    x" 5905350A6B4B5DE29C2CA4562BB105EF570713CE648E38F6FBBB6D076D141B0A" ke-sk sec! +seckey

    "anonymous" ke-nick $! $1367B086A255C9C2. d>64 ke-first 64! 0 ke-type ! n:o>

    "anonymous" ke-nick $! $1367B086A255C9C2. d>64 ke-first 64! 0 ke-type ! o>

    \ revoke: 38A6FB42FF41A690A108DCA460CC0D15AE3C1C23FFFA9E92583FFD9FB16AD276

    x" 7A0FFD3D31ED822D683D685EA5689C91CB170B54A82F0E53554D34584F90DB017750513CDC1F1DC7F8F61214ED4BC801CF70C3D5FC90F716F2363038ACEE58BD" key:new

    x" 7A0FFD3D31ED822D683D685EA5689C91CB170B54A82F0E53554D34584F90DB017750513CDC1F1DC7F8F61214ED4BC801CF70C3D5FC90F716F2363038ACEE58BD" key:new >o

    x" AAB952DD5D1850F1B468EEF84F72552148070C3F499600FE362934970329FE04" ke-sk sec! +seckey

    "alice" ke-nick $! $1367B086A25CEF70. d>64 ke-first 64! 1 ke-type ! n:o>

    "alice" ke-nick $! $1367B086A25CEF70. d>64 ke-first 64! 1 ke-type ! o>

    \ revoke: D82AF4AE7CD3DA7316CE6F26BC5792F4F5E6B36B4C14F7D60C49B421AE1D5468

    x" 1A20176C79D26402811945CFC241116BAFB52DD033492044DB5CFEECCA21E6E49F350B40A28D83B618361167D13B51A4EFCE919C7BB6BDCC570D9B7031A0428E" key:new

    x" 1A20176C79D26402811945CFC241116BAFB52DD033492044DB5CFEECCA21E6E49F350B40A28D83B618361167D13B51A4EFCE919C7BB6BDCC570D9B7031A0428E" key:new >o

    x" 6B65577985D851753ACFFFFB00360C70C267420132204A17F4468D9CACDB010F" ke-sk sec! +seckey

    "bob" ke-nick $! $1367B086A26436A9. d>64 ke-first 64! 1 ke-type ! n:o>

    "bob" ke-nick $! $1367B086A26436A9. d>64 ke-first 64! 1 ke-type ! o>

    \ revoke: 7821DA41AFBB8F7356E2EB7059BE70321D7ADCDAD8C504998627CBB9366AB752

    x" 9483FBBB98A5BFE792206519FB2BAF9EE21FE863ABE981AB1C209123D40E1969EA7C68162DF5340142524D6BE3E407B065824D1E3582E6209CA03876F406EBCA" key:new

    x" 9483FBBB98A5BFE792206519FB2BAF9EE21FE863ABE981AB1C209123D40E1969EA7C68162DF5340142524D6BE3E407B065824D1E3582E6209CA03876F406EBCA" key:new >o

    x" 693D7EF6BF0E0CEFB0654EB95AB7C729B8799F850CAB24B1211116ED72EA3602" ke-sk sec! +seckey

    "eve" ke-nick $! $1367B086A26B4E42. d>64 ke-first 64! 1 ke-type ! n:o>

    "eve" ke-nick $! $1367B086A26B4E42. d>64 ke-first 64! 1 ke-type ! o>

;



: ins-ip ( -- net2oaddr )
@@ -96,7 +96,7 @@ previous 


: c:addme-fetch-host ( nick u -- ) +addme

    net2o-code

      expect-reply get-ip fetch-host, replaceme,

      expect-reply get-ip fetch-host, replace-me,

      cookie+request

    end-code| -setip n2o:send-replace ;

debugging.fs

+1 −1
Original line number Diff line number Diff line
@@ -131,7 +131,7 @@ debug: sender( \ extra sender task 
debug: dht( \ debugging for dht functions

debug: hash( \ dht hasing function debug

debug: file( \ file read/write debugging

debug: save( \ separate save task

debug: save( \ save once per round

debug: bg( \ started in background mode

debug: nat( \ NAT traversal stuff

debug: route( \ do routing

net2o-cmd.fs

+5 −6
Original line number Diff line number Diff line
@@ -696,7 +696,7 @@ reply-table $@ fs-table $! 
    data-rmap @ >o dest-back @ do-slurp @ umax o> net2o:ackflush ;



: rewind ( -- )

    save( rewind-flush )else( rewind-total ) ;

    save( rewind-total )else( rewind-flush ) ;



\ ids 90..100 reserved for DHT
@@ -796,8 +796,7 @@ also net2o-base 
    data-rmap @ >o

    data-ack# @ bytes>addr dest-top 2@ umin umin

    dest-tail @ umax dup dest-tail !@ o>

    save( \ 2dup u> IF  ." tail: " dup hex. over hex. F cr  THEN

    u> IF  net2o:save& 64#0 burst-ticks 64!  THEN )else( 2drop ) ;

    save( 2drop )else( u> IF  net2o:save& 64#0 burst-ticks 64!  THEN ) ;

: receive-flag ( -- flag )  recv-flag @ resend-toggle# and 0<> ;



8 Value max-resend#
@@ -855,7 +854,7 @@ also net2o-base 
: rewind-transfer ( -- )

    rewind data-end? IF  filereq# @ n2o:request-done

    ELSE  restart-transfer  THEN

    save( )else( request-stats? IF  send-timing  THEN ) ;

    save( request-stats? IF  send-timing  THEN ) ;



: request-stats   F true to request-stats?  track-timing ;
@@ -870,7 +869,7 @@ also net2o-base 
	msg( ." check: " data-rmap @ >o dest-back @ hex. dest-tail @ hex. dest-head @ hex.

	data-ackbits @ data-ack# @ dup hex. + l@ hex.

	o> F cr ." Block transfer done: " expected@ hex. hex. F cr )

	net2o:ack-cookies  save( )else( n2o:spit ) rewind-transfer

	net2o:ack-cookies  save( n2o:spit ) rewind-transfer

	64#0 burst-ticks 64!

    THEN ;
@@ -986,7 +985,7 @@ also net2o-base 
    expected@ tuck u>= and IF  net2o-code  +expected  end-code  EXIT  THEN

    net2o-code  expect-reply

    update-rtdelay  ticks lit, timeout  net2o:genack

    resend-all save( rewind-flush slurp ) end-code ;

    resend-all save( )else( rewind-flush slurp ) end-code ;

previous



: connected-timeout ( -- ) timeout( ." connected timeout" F cr )

net2o-dht.fs

+25 −30
Original line number Diff line number Diff line
@@ -90,7 +90,6 @@ s" invalid signature" throwcode !!wrong-sig!! 


\ Hash state variables



UValue d#id

$41 Constant sigonlysize#

$51 Constant sigsize#

$71 Constant sigpksize#
@@ -258,19 +257,18 @@ Variable revtoken 


dht-table ' new static-a with-allocater constant dht-stub



: >d#id ( addr u -- )

    2dup d#public d# to d#id

    d#id @ ?dup-IF  nip nip

    ELSE  dht-stub >o dht-table @ token-table ! dht-hash $! o o>  THEN

    o swap n:>o connection ! ;

: >d#id ( addr u -- o ) connection @ { conn }

    2dup d#public d# @ >o

    o 0= IF  dht-stub >o rdrop dht-table @ token-table ! dht-hash $!  THEN

    conn connection ! o o> ;

: ?d#id ( -- )

    d#id @ 0= IF \ want to allocate it? check first!

    o dht-stub = IF \ want to allocate it? check first!

	dht-hash $@ connection @

	dht-class new >o rdrop connection ! dht-hash $!

	dht-table @ token-table ! o d#id !

    ELSE  connection @ d#id @ >o rdrop connection !  THEN ;

	dht-table @ token-table ! o dht-hash $@ d#public d# !

    THEN ;

: (d#value+) ( addr u key -- ) \ without sanity checks

    cells dup k#size u>= !!no-dht-key!!

    cells dup k#size u>= !!no-dht-key!!  ?d#id

    dht-hash + dht( ." ins into: " dup hex. dup $[]# F . F cr ) $ins[]sig ;



: .tag ( addr u -- ) 2dup 2>r
@@ -302,7 +300,6 @@ dht-table ' new static-a with-allocater constant dht-stub 
	ELSE  2drop rdrop  THEN  rdrop EXIT  THEN

    rdrop drop 2drop ;

: d#value+ ( addr u key -- ) \ with sanity checks

    ?d#id

    dup >r k#peers u<= !!dht-permission!! \ can't change hash+peers

    r@ k#host = IF  check-host  THEN

    r@ k#tags = IF  check-tag   THEN
@@ -312,7 +309,7 @@ dht-table ' new static-a with-allocater constant dht-stub 


get-current also net2o-base definitions



100 net2o: dht-id ( $:string -- ) $> >d#id ;

100 net2o: dht-id ( $:string -- o:o ) $> >d#id n:>o ;

\g set dht id for further operations on it

dht-table >table
@@ -356,8 +353,8 @@ end-class dht-file-class 
:noname $FFFFFFFF n>64 64dup fs-limit 64! fs-size 64! ; dht-file-class to fs-open

:noname ( addr u -- n )  dup >r

    dht-queries $@ bounds ?DO

	I 1+ I c@ 2dup >d#id + c@ >r

	d#id, r> d#values,

	I 1+ I c@ 2dup >d#id >o + c@ >r

	d#id, r> d#values, o>

    I c@ 2 + +LOOP  nip r> swap - ; dht-file-class to fs-read



: new>dht ( -- )
@@ -437,50 +434,48 @@ previous 
\ replace me stuff



also net2o-base

: replaceme, ( -- )

: replace-me, ( -- )

    pkc keysize 2* $, dht-id <req k#host ulit, dht-value? req> endwith ;



: remove-me, ( -- )

    d#id @ .dht-host dup >r

    dht-host dup >r

    [: sigsize# - 2dup + sigdate datesize# move

      gen-host-del $, k#host ulit, dht-value- ;] $[]map

    r@ $@ dump r> $[]off ;

previous



: me>d#id ( -- ) pkc keysize 2* >d#id ?d#id ;

: me>d#id ( -- ) pkc keysize 2* >d#id >o ?d#id o o> ;



: n2o:send-replace ( -- )

    me>d#id d#id @ IF

	d#id @ .dht-host $[]# IF

    me>d#id >o dht-host $[]# IF

	net2o-code   expect-reply

	  pkc keysize 2* $, dht-id remove-me, endwith

	  cookie+request

	end-code|

	THEN

    THEN n:o> ;

    THEN o> ;



: set-revocation ( addr u -- )

    d#id @ .dht-host $+[]! ;

    dht-host $+[]! ;



Defer renew-key



: n2o:send-revoke ( addr u -- )

    net2o-code  expect-reply

      d#id @ .dht-hash $@ $, dht-id remove-me,

      dht-hash $@ $, dht-id remove-me,

      keysize <> !!keysize!! >revoke revoke-key 2dup set-revocation

      2dup $, k#host ulit, dht-value+ endwith

      cookie+request end-code| \ send revocation upstrem

    d#id @ .dht-hash $@ renew-key ; \ replace key in key storage

    dht-hash $@ renew-key ; \ replace key in key storage



: replace-me ( -- )  +addme

    net2o-code   expect-reply get-ip replaceme, cookie+request

    net2o-code   expect-reply get-ip replace-me, cookie+request

    end-code| -setip

    n2o:send-replace ;



: revoke-me ( addr u -- )

    \G give it your revocation secret

    +addme

    net2o-code   expect-reply replaceme, cookie+request  end-code|

    net2o-code   expect-reply replace-me, cookie+request  end-code|

    -setip n2o:send-revoke ;



: do-disconnect ( -- )

net2o-keys.fs

+21 −25
Original line number Diff line number Diff line
@@ -64,6 +64,7 @@ cmd-class class 
    64field: ke-first

    64field: ke-last

    64field: ke-offset \ offset in key file

    0 +field ke-end

end-class key-entry



Variable key-entry-table
@@ -75,23 +76,21 @@ Variable key-entry-table 
0 Value sample-key



Variable key-table

Variable this-key

Variable this-keyid

2Variable addsig



64Variable key-read-offset



: current-key ( addr u -- )

    2dup keysize umin key-table #@ drop cell+ dup this-key ! n:>o ke-pk $! ;

: make-thiskey ( addr -- )

    dup $@ drop this-keyid !  cell+ $@ drop cell+ dup this-key ! >o rdrop ;

: current-key ( addr u -- o )

    2dup keysize umin key-table #@ drop cell+ >o ke-pk $! o o> ;



: key:new ( addr u -- )

    \ addr u is the public key

    sample-key dup cell- @ >osize @ 2dup cell /string erase

    over >o 64#-1 ke-last 64! key-read-offset 64@ ke-offset 64!

    key-entry-table @ token-table ! o>

    -1 cells /string  keypack-all# n>64 key-read-offset 64+!

    2over keysize umin key-table #! current-key ;

    sample-key >o ke-sk ke-end over - erase

    64#-1 ke-last 64!

    key-entry-table @ token-table !

    key-read-offset 64@ ke-offset 64!

    keypack-all# n>64 key-read-offset 64+! o cell- ke-end over -

    2over keysize umin key-table #! o>

    current-key ;



\ search for keys - not optimized
@@ -191,14 +190,13 @@ get-current also net2o-base definitions 
cmd-table $@ key-entry-table $!

' key-entry-table is gen-table



10 net2o: newkey ( $:string -- ) $> key:new ;

10 net2o: newkey ( $:string -- o:key ) $> key:new n:>o ;

key-entry-table >table

+net2o: privkey ( $:string -- ) $> ke-sk sec! +seckey ;

+net2o: keytype ( n -- )  64>n ke-type ! ; \ default: anonymous

+net2o: keynick ( $:string -- )    $> ke-nick $! ;

+net2o: keyprofile ( $:string -- ) $> ke-prof $! ;

+net2o: newkeysig ( $:string -- )  $> save-mem addsig 2!

    addsig 2 cells ke-sigs $+! ;

+net2o: newkeysig ( $:string -- )  $> ke-sigs $+[]! ;

+net2o: keymask ( x -- )  64drop ;

+net2o: keyfirst ( date-ns -- )  ke-first 64! ;

+net2o: keylast  ( date-ns -- )  ke-last 64! ;
@@ -207,7 +205,6 @@ dup set-current previous 
' context-table is gen-table



key-entry ' new static-a with-allocater to sample-key

sample-key this-key ! \ dummy

sample-key >o key-entry-table @ token-table ! o>



: key:code ( -- )
@@ -314,20 +311,19 @@ set-current previous previous 
    nick-key >o o 0= !!unknown-key!!

    ke-pk $@ keysize umin o> dest-pubkey $! ;



: replace-key 1 /string { rev-addr u -- } \ revocation ticket

: replace-key 1 /string { rev-addr u -- o } \ revocation ticket

    key( ." Replace:" cr o cell- 0 .key )

    s" #revoked" dup >r ke-nick $+!

    this-keyid @ ke-nick $@ r> - ke-prof $@ ke-sigs $@ ke-type @ ke-key @ 

    rev-addr keysize 2* key:new

    ke-key ! ke-type ! ke-sigs $! ke-prof $! ke-nick $!

    ke-nick $@ r> - ke-prof $@ ke-sigs ke-type @ ke-key @ 

    rev-addr keysize 2* key:new >o

    ke-key ! ke-type ! [: ke-sigs $+[]! ;] $[]map ke-prof $! ke-nick $!

    rev-addr keysize 2* ke-pk $!

    rev-addr u + 1- dup c@ 2* - $10 - dup 64@ ke-first 64! 64'+ 64@ ke-last 64!

    key( ." with:" cr o cell- 0 .key ) n:oswap n:o> ;

    key( ." with:" cr o cell- 0 .key ) o o> ;



:noname ( revaddr u1 keyaddr u2 -- )

    current-key

    replace-key skc keysize ke-sk sec! o this-key !

    n:o> ; is renew-key

:noname ( revaddr u1 keyaddr u2 -- o )

    current-key >o replace-key o> >o skc keysize ke-sk sec!

    o o> ; is renew-key



0 [IF]

Local Variables: