Commit 3fa6d349 authored by bernd's avatar bernd

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

streaming mode is now default
parent 50d14c45
......@@ -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 ;
......
......@@ -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
......
......@@ -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 )
......
......@@ -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
net2o-code expect-reply
pkc keysize 2* $, dht-id remove-me, endwith
cookie+request
end-code|
THEN
THEN n:o> ;
me>d#id >o dht-host $[]# IF
net2o-code expect-reply
pkc keysize 2* $, dht-id remove-me, endwith
cookie+request
end-code|
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 ( -- )
......
......@@ -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:
......
......@@ -1563,7 +1563,6 @@ Variable fs-table
: dest-top! ( addr -- )
\ dest-tail @ dest-size @ + umin
\ save( ." dest-top: " dup hex. dest-top @ hex. cr )
dup dup dest-top @ U+DO
data-ackbits @ I I' fix-size dup { len }
chunk-p2 rshift swap chunk-p2 rshift swap bit-erase
......@@ -2008,7 +2007,7 @@ rdata-class to rewind-timestamps-partial
: net2o:save ( -- )
data-rmap @ .dest-back @ >r n2o:spit
r> data-rmap @ >o dest-back !@ \ save( ." back: " dest-back @ hex. dup hex. cr )
r> data-rmap @ >o dest-back !@
flush( ." rewind partial " dup hex. cr )
dup rewind-partial dup dest-back! do-slurp !@ drop o> ;
......
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