Commit 50d14c45 authored by bernd's avatar bernd

Alice-test still doesn't work

parent d79511b3
......@@ -18,12 +18,13 @@ init-client
?nextarg [IF] net2o-host $! [THEN]
?nextarg [IF] s>number drop to net2o-port [THEN]
: c:lookup ( addr u -- )
$2000 $10000 "test" ins-ip c:connect
BEGIN 2dup ~~ c:addme-fetch-host ~~ o >o
nick-key ke-pk $@ o> ~~ >d#id
0 dht-host $[]@ over c@ '!' = WHILE
~~ replace-key ~~ ke-nick $@ ~~ n:o>
: c:lookup ( addr u -- id u )
$2000 $10000 "test" ins-ip c:connect
2dup c:addme-fetch-host
nick-key .ke-pk $@
BEGIN >d#id 0 dht-host $[]@ over c@ '!' = WHILE
replace-key ke-pk $@ ." replace key: " 2dup 85type cr
n:o> 2dup c:fetch-id
REPEAT n:o> 2drop do-disconnect ;
: c:insert-host ( addr u -- )
host>$ IF
......@@ -39,7 +40,7 @@ init-client
: n2o:lookup ( addr u -- )
2dup c:lookup
0 n2o:new-context dest-key return-addr $10 erase
d#id @ k#host cells + ['] c:insert-host $[]map ;
d#id @ .dht-host ['] c:insert-host $[]map ;
: nat:connect ( addr u -- )
init-cache' n2o:lookup
......
......@@ -60,44 +60,51 @@ UValue test# 0 to test#
: c:add-tag ( -- ) +addme
net2o-code
expect-reply
s" DHT test" $, type cr get-ip
pkc keysize 2* $, dht-id
forever "test:tag" pkc keysize 2* gen-tag-del $, k#tags ulit, dht-value-
forever "test:tag" pkc keysize 2* gen-tag $, k#tags ulit, dht-value+
endwith end-code| -setip ;
expect-reply
s" DHT test" $, type cr get-ip
pkc keysize 2* $, dht-id
forever "test:tag" pkc keysize 2* gen-tag-del $, k#tags ulit, dht-value-
forever "test:tag" pkc keysize 2* gen-tag $, k#tags ulit, dht-value+
endwith end-code| -setip ;
: c:fetch-tag ( nick u -- )
net2o-code
expect-reply
0 >o nick-key ke-pk $@ o> $, dht-id <req
k#host ulit, dht-value? k#tags ulit, dht-value? req>
endwith cookie+request
expect-reply
nick-key .ke-pk $@ $, dht-id <req
k#host ulit, dht-value? k#tags ulit, dht-value? req>
endwith cookie+request
end-code| ;
also net2o-base
: fetch-id, ( id-addr u -- )
$, dht-id <req k#host ulit, dht-value? req> endwith ;
: fetch-host, ( nick u -- )
0 >o nick-key ke-pk $@ o> $, dht-id
<req k#host ulit, dht-value? req> endwith ;
nick-key .ke-pk $@ fetch-id, ;
previous
: c:fetch-host ( nick u -- )
net2o-code
expect-reply fetch-host,
cookie+request
expect-reply fetch-host,
cookie+request
end-code| ;
: c:addme-fetch-host ( nick u -- ) +addme connection @ o ~~ 2drop
net2o-code ~~
expect-reply get-ip fetch-host, replaceme,
~~ cookie+request
end-code| ~~ -setip ~~ n2o:send-replace ~~ ;
: c:fetch-id ( nick u -- )
net2o-code
expect-reply fetch-id,
cookie+request
end-code| ;
: c:addme-fetch-host ( nick u -- ) +addme
net2o-code
expect-reply get-ip fetch-host, replaceme,
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
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
......@@ -107,78 +114,78 @@ previous
: c:download1 ( -- )
[: .time ." Download test: 1 text file and 2 photos" cr ;] $err
net2o-code
expect-reply
!time .time s" Download test" $, type cr ( see-me ) get-ip
$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
expect-reply
!time .time s" Download test" $, type cr ( see-me ) get-ip
$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
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 )
$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
"data/2011-06-15_12-27-03-small.jpg" "photo004s.jpg" >cache n2o:copy
"data/2011-06-24_11-26-36-small.jpg" "photo005s.jpg" >cache n2o:copy
"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
expect-reply close-all \ rewind-total
.time s" Download test 2" $, type cr ( see-me )
$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
"data/2011-06-15_12-27-03-small.jpg" "photo004s.jpg" >cache n2o:copy
"data/2011-06-24_11-26-36-small.jpg" "photo005s.jpg" >cache n2o:copy
"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
end-code| n2o:close-all ['] .time $err ;
: c:download3 ( -- )
[: ." 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 )
$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
expect-reply close-all \ rewind-total
.time s" Download test 3" $, type cr ( see-me )
$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
end-code| n2o:close-all ['] .time $err ;
: c:download4 ( -- )
[: ." 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 )
$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
"data/2011-06-15_12-27-03.jpg" "photo004.jpg" >cache n2o:copy
"data/2011-06-24_11-26-36.jpg" "photo005.jpg" >cache n2o:copy
"data/2011-06-27_19-33-04.jpg" "photo006.jpg" >cache n2o:copy
"data/2011-06-27_19-55-48.jpg" "photo007.jpg" >cache n2o:copy
"data/2011-06-28_06-54-09.jpg" "photo008.jpg" >cache n2o:copy
$10000. 0 limit!
$20000. 1 limit!
$30000. 2 limit!
$40000. 3 limit!
$50000. 4 limit!
$60000. 5 limit!
$70000. 6 limit!
n2o:done
expect-reply close-all \ rewind-total
.time s" Download test 4" $, type cr ( see-me )
$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
"data/2011-06-15_12-27-03.jpg" "photo004.jpg" >cache n2o:copy
"data/2011-06-24_11-26-36.jpg" "photo005.jpg" >cache n2o:copy
"data/2011-06-27_19-33-04.jpg" "photo006.jpg" >cache n2o:copy
"data/2011-06-27_19-55-48.jpg" "photo007.jpg" >cache n2o:copy
"data/2011-06-28_06-54-09.jpg" "photo008.jpg" >cache n2o:copy
$10000. 0 limit!
$20000. 1 limit!
$30000. 2 limit!
$40000. 3 limit!
$50000. 4 limit!
$60000. 5 limit!
$70000. 6 limit!
n2o:done
end-code| ['] .time $err ;
: c:download4a ( -- )
[: ." Download test 4a: 7 big photos, rest" cr ;] $err
net2o-code
expect-reply
.time s" Download test 4a" $, type cr ( see-me )
-1. 0 limit!
-1. 1 limit!
-1. 2 limit!
-1. 3 limit!
-1. 4 limit!
-1. 5 limit!
-1. 6 limit!
n2o:done
expect-reply
.time s" Download test 4a" $, type cr ( see-me )
-1. 0 limit!
-1. 1 limit!
-1. 2 limit!
-1. 3 limit!
-1. 4 limit!
-1. 5 limit!
-1. 6 limit!
n2o:done
end-code| n2o:close-all ['] .time $err ;
: c:test-rest ( -- )
......
......@@ -444,17 +444,19 @@ also net2o-base
d#id @ .dht-host dup >r
[: sigsize# - 2dup + sigdate datesize# move
gen-host-del $, k#host ulit, dht-value- ;] $[]map
r> $[]off ;
r@ $@ dump r> $[]off ;
previous
: me>d#id ( -- ) pkc keysize 2* >d#id ?d#id ;
: n2o:send-replace ( -- )
me>d#id d#id @ IF
net2o-code expect-reply
pkc keysize 2* $, dht-id remove-me, endwith
cookie+request
end-code|
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> ;
: set-revocation ( addr u -- )
......
......@@ -95,11 +95,11 @@ Variable this-keyid
\ search for keys - not optimized
: nick-key ( addr u -- ) \ search for key nickname and make current
key-table
[: dup >r cell+ $@ drop cell+ .ke-nick $@ 2over str= IF
r@ make-thiskey
THEN rdrop ;] #map 2drop ;
: nick-key ( addr u -- o ) \ search for key nickname
0 -rot key-table
[: cell+ $@ drop cell+ >o ke-nick $@ 2over str= IF
rot drop o -rot
THEN o> ;] #map 2drop ;
: key-exist? ( addr u -- flag )
key-table #@ d0<> ;
......@@ -304,14 +304,14 @@ set-current previous previous
: >key ( addr u -- )
key-table @ 0= IF read-keys THEN
nick-key this-keyid @ 0= ?EXIT
this-key @ .ke-pk $@ pkc swap keysize 2* umin move
ke-sk @ skc keysize move ;
nick-key >o o 0= IF EXIT THEN
ke-pk $@ pkc swap keysize 2* umin move
ke-sk @ skc keysize move o> ;
: i'm ( "name" -- ) parse-name >key ;
: dest-key ( addr u -- )
0 >o nick-key this-keyid @ 0= !!unknown-key!!
nick-key >o o 0= !!unknown-key!!
ke-pk $@ keysize umin o> dest-pubkey $! ;
: replace-key 1 /string { rev-addr u -- } \ revocation ticket
......@@ -320,7 +320,6 @@ set-current previous previous
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 $!
keysize key-table #off
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> ;
......
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