client-tests.fs 8.58 KB
Newer Older
bernd's avatar
bernd committed
1 2 3 4
\ Test lib clients

require ./net2o.fs

bernd's avatar
bernd committed
5
UValue test#  0 to test#
bernd's avatar
bernd committed
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
1 Value total-tests

: .test# ( -- ) test# 0>= IF  test# 0 .r  THEN ;

: >timing ( -- )
    [: ." timing" .test# ;] $tmp w/o create-file throw >r
    ['] .rec-timing r@ outfile-execute r> close-file throw ;

: >cache ( addr u -- addr' u' ) [: ." .cache" .test# ." /" type ;] $tmp ;

: init-cache' ( -- )
    "" >cache 1- file-status nip #-514 = IF
	"" >cache 1- $1FF =mkdir throw
    THEN ;

: test-keys ( -- ) \ yes, use these keys *only* for testing!
22
    \ revoke: 58AB8F52F46E73EFAB068F6337F371E14DD589BF0894D2F0AF51AE7EBB858A68
23
    x" A91158F2C560ACCDFEFC05104B922E49C9DD022D0163921DAE08E6C2148A7BEBC83C71FCB345D24400D866C7FD32092C2D1EC056FD17B9537037590BD021EEBF" key:new >o
bernd's avatar
bernd committed
24
    x" B2578B8766DB3A60F1F4F36B276924FDA6E7F559F629716BC78D95DB1CD8D400" ke-sk sec! +seckey
25
    "test" ke-nick $! $1367B086A24E6B10. d>64 ke-first 64! 0 ke-type ! o>
26
    \ revoke: 5843E2DC055E1F8BE14570A37B0F81146040A2CEE1D6C01B97C3BB801CDED864
27
    x" 69D86C471E5FEED89478FB4260C898B6F69026BA4E78A9D815B53EB33CA9013A8E753EC381881FAAFFA66CD9DD47D3F2C0867E1A2B48067CA2188DF400C11074" key:new >o
bernd's avatar
bernd committed
28
    x" 5905350A6B4B5DE29C2CA4562BB105EF570713CE648E38F6FBBB6D076D141B0A" ke-sk sec! +seckey
29
    "anonymous" ke-nick $! $1367B086A255C9C2. d>64 ke-first 64! 0 ke-type ! o>
30
    \ revoke: 38A6FB42FF41A690A108DCA460CC0D15AE3C1C23FFFA9E92583FFD9FB16AD276
31
    x" 7A0FFD3D31ED822D683D685EA5689C91CB170B54A82F0E53554D34584F90DB017750513CDC1F1DC7F8F61214ED4BC801CF70C3D5FC90F716F2363038ACEE58BD" key:new >o
bernd's avatar
bernd committed
32
    x" AAB952DD5D1850F1B468EEF84F72552148070C3F499600FE362934970329FE04" ke-sk sec! +seckey
33
    "alice" ke-nick $! $1367B086A25CEF70. d>64 ke-first 64! 1 ke-type ! o>
34
    \ revoke: D82AF4AE7CD3DA7316CE6F26BC5792F4F5E6B36B4C14F7D60C49B421AE1D5468
35
    x" 1A20176C79D26402811945CFC241116BAFB52DD033492044DB5CFEECCA21E6E49F350B40A28D83B618361167D13B51A4EFCE919C7BB6BDCC570D9B7031A0428E" key:new >o
bernd's avatar
bernd committed
36
    x" 6B65577985D851753ACFFFFB00360C70C267420132204A17F4468D9CACDB010F" ke-sk sec! +seckey
37
    "bob" ke-nick $! $1367B086A26436A9. d>64 ke-first 64! 1 ke-type ! o>
38
    \ revoke: 7821DA41AFBB8F7356E2EB7059BE70321D7ADCDAD8C504998627CBB9366AB752
39
    x" 9483FBBB98A5BFE792206519FB2BAF9EE21FE863ABE981AB1C209123D40E1969EA7C68162DF5340142524D6BE3E407B065824D1E3582E6209CA03876F406EBCA" key:new >o
bernd's avatar
bernd committed
40
    x" 693D7EF6BF0E0CEFB0654EB95AB7C729B8799F850CAB24B1211116ED72EA3602" ke-sk sec! +seckey
41
    "eve" ke-nick $! $1367B086A26B4E42. d>64 ke-first 64! 1 ke-type ! o>
bernd's avatar
bernd committed
42 43
;

bernd's avatar
bernd committed
44
: ins-ip ( -- net2oaddr )
45
    net2o-host $@ net2o-port insert-ip ;
bernd's avatar
bernd committed
46
: ins-ip4 ( -- net2oaddr )
47
    net2o-host $@ net2o-port insert-ip4 ;
bernd's avatar
bernd committed
48
: ins-ip6 ( -- net2oaddr )
49 50 51
    net2o-host $@ net2o-port insert-ip6 ;

: c:connect ( code data nick u ret -- )
bernd's avatar
bernd committed
52
    [: .time ." Connect to: " dup hex. cr ;] $err
53
    n2o:new-context >o rdrop o to connection
bernd's avatar
bernd committed
54 55 56 57 58
    dest-key \ get our destination key
    n2o:connect +flow-control +resend
    [: .time ." Connected, o=" o hex. cr ;] $err ;

: c:add-me ( -- )  +addme
bernd's avatar
bernd committed
59
    net2o-code   expect-reply get-ip cookie+request  end-code| -setip ;
bernd's avatar
bernd committed
60 61 62

: c:add-tag ( -- ) +addme
    net2o-code
bernd's avatar
bernd committed
63 64 65
      expect-reply
      s" DHT test" $, type cr get-ip
      pkc keysize 2* $, dht-id
66 67
      forever "test:tag" pkc keysize 2* gen-tag-del $, dht-tags-
      forever "test:tag" pkc keysize 2* gen-tag $, dht-tags+
bernd's avatar
bernd committed
68
      endwith end-code| -setip ;
bernd's avatar
bernd committed
69 70 71

: c:fetch-tag ( nick u -- )
    net2o-code
bernd's avatar
bernd committed
72
      expect-reply
73
      nick-key .ke-pk $@ $, dht-id <req dht-host? dht-tags? req>
bernd's avatar
bernd committed
74
      endwith cookie+request
bernd's avatar
bernd committed
75
    end-code| ;
bernd's avatar
bernd committed
76

bernd's avatar
bernd committed
77
also net2o-base
bernd's avatar
bernd committed
78
: fetch-id, ( id-addr u -- )
79
    $, dht-id <req dht-host? req> endwith ;
bernd's avatar
bernd committed
80
: fetch-host, ( nick u -- )
bernd's avatar
bernd committed
81
    nick-key .ke-pk $@ fetch-id, ;
bernd's avatar
bernd committed
82 83
previous

bernd's avatar
bernd committed
84 85
: c:fetch-host ( nick u -- )
    net2o-code
bernd's avatar
bernd committed
86 87
      expect-reply  fetch-host,
      cookie+request
bernd's avatar
bernd committed
88
    end-code| ;
bernd's avatar
bernd committed
89

bernd's avatar
bernd committed
90
: c:fetch-id ( pubkey u -- )
bernd's avatar
bernd committed
91 92 93 94 95 96 97
    net2o-code
      expect-reply  fetch-id,
      cookie+request
    end-code| ;

: c:addme-fetch-host ( nick u -- ) +addme
    net2o-code
98
      expect-reply get-ip fetch-host, replace-me,
bernd's avatar
bernd committed
99 100
      cookie+request
    end-code| -setip n2o:send-replace ;
101

bernd's avatar
bernd committed
102 103
: c:fetch-tags ( -- )
    net2o-code
bernd's avatar
bernd committed
104 105 106
      expect-reply
      0 ulit, dht-open  pkc keysize 2* $, $FE ulit, 0 ulit, dht-query
      n2o:done
bernd's avatar
bernd committed
107
    end-code| ;
bernd's avatar
bernd committed
108

109
: c:dht ( n -- )  $2000 $10000 "test" ins-ip c:connect 0 ?DO
bernd's avatar
bernd committed
110
	c:add-tag "anonymous" c:fetch-tag \ c:fetch-tags
bernd's avatar
bernd committed
111
    LOOP do-disconnect ;
bernd's avatar
bernd committed
112 113 114 115

: c:download1 ( -- )
    [: .time ." Download test: 1 text file and 2 photos" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
116
      expect-reply
bernd's avatar
bernd committed
117 118
      !time .time s" Download test " $, type 1 ulit, . pi float, f. cr
      ( see-me ) get-ip 0 ulit,
bernd's avatar
bernd committed
119 120 121 122
      $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
123
      n2o:done words push' cr
bernd's avatar
bernd committed
124
    end-code| n2o:close-all ['] .time $err ;
bernd's avatar
bernd committed
125 126 127 128

: c:download2 ( -- )
    [: ." Download test 2: 7 medium photos" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
129 130 131 132 133 134 135 136 137 138 139
      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
bernd's avatar
bernd committed
140
    end-code| n2o:close-all ['] .time $err ;
bernd's avatar
bernd committed
141 142 143 144

: c:download3 ( -- )
    [: ." Download test 3: 2 big photos" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
145 146 147 148 149 150
      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
bernd's avatar
bernd committed
151
    end-code| n2o:close-all ['] .time $err ;
bernd's avatar
bernd committed
152 153 154 155

: c:download4 ( -- )
    [: ." Download test 4: 7 big photos, partial files" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
      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
bernd's avatar
bernd committed
174
    end-code| ['] .time $err ;
bernd's avatar
bernd committed
175 176 177 178

: c:download4a ( -- )
    [: ." Download test 4a: 7 big photos, rest" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
179 180 181 182 183 184 185 186 187 188
      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
bernd's avatar
bernd committed
189
    end-code| n2o:close-all ['] .time $err ;
bernd's avatar
bernd committed
190

191
: c:test-rest ( -- )
bernd's avatar
bernd committed
192 193 194 195 196 197 198 199 200 201
    c:download1
    3e @time f> IF c:download2
	waitkey( 8e )else( 6e ) @time f> IF  c:download3
	    waitkey( 16e )else( 8e ) @time f> IF
		waitkey( ." Press key to continue" key drop cr )
		c:download4
		c:download4a
	    THEN
	THEN
    THEN
bernd's avatar
bernd committed
202
    >timing do-disconnect [: .packets profile( .times ) ;] $err ;
bernd's avatar
bernd committed
203

204 205
: c:test ( -- )
    init-cache'
206
    $10000 $100000 "test" ins-ip c:connect c:test-rest ;
207

bernd's avatar
bernd committed
208 209
event: ->throw dup DoError throw ;

210 211
: c:test& ( n -- ) \ in background
    up@ 2 stacksize4 NewTask4 pass >r
bernd's avatar
bernd committed
212
    alloc-io ['] c:test catch ?dup-IF
213
	elit, ->throw drop  ELSE  elit, ->request  THEN  r> event> ;
bernd's avatar
bernd committed
214 215 216 217

#100 Value req-ms#

: c:tests ( n -- )  dup 0< IF  abs to test#  1  THEN
bernd's avatar
bernd committed
218
    dup to total-tests  1 over lshift 1- reqmask !
219
    0 ?DO  I c:test& req-ms# ms test# 1+ to test#  LOOP
bernd's avatar
bernd committed
220 221
    requests->0 ;

bernd's avatar
bernd committed
222 223
\ some more helpers

bernd's avatar
bernd committed
224
: sha-3 ( addr u -- ) c:0key
bernd's avatar
bernd committed
225
    slurp-file 2dup c:hash drop free throw pad c:key> ;
bernd's avatar
bernd committed
226

227 228
: sha-3-256 ( addr u -- )  sha-3 pad $20 85type ;
: sha-3-512 ( addr u -- )  sha-3 pad $40 85type ;
bernd's avatar
bernd committed
229 230 231

: arg-loop { xt -- }
    begin  next-arg dup while  xt execute  repeat  2drop ;
bernd's avatar
bernd committed
232 233

: sha-3-256s ( -- )
bernd's avatar
bernd committed
234
    [: 2dup sha-3-256 space type cr ;] arg-loop ;
bernd's avatar
bernd committed
235 236

: sha-3-512s ( -- )
bernd's avatar
bernd committed
237
    [: 2dup sha-3-512 space type cr ;] arg-loop ;