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

3
require ../net2o.fs
bernd's avatar
bernd committed
4

bernd's avatar
bernd committed
5
UValue test#  0 to test#
bernd's avatar
bernd committed
6 7 8 9 10 11
1 Value total-tests

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

: >timing ( -- )
    [: ." timing" .test# ;] $tmp w/o create-file throw >r
bernd's avatar
bernd committed
12 13
    ['] .rec-timing r@ outfile-execute
    r> close-file throw ;
bernd's avatar
bernd committed
14 15 16 17

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

: init-cache' ( -- )
18
    "" >cache 1- file-status nip no-file# = IF
bernd's avatar
bernd committed
19 20 21 22
	"" >cache 1- $1FF =mkdir throw
    THEN ;

: c:add-me ( -- )  +addme
bernd's avatar
bernd committed
23
    net2o-code   expect-reply get-ip cookie+request  end-code| -setip ;
bernd's avatar
bernd committed
24 25 26

: c:add-tag ( -- ) +addme
    net2o-code
bernd's avatar
bernd committed
27
      expect-reply
28
      log s" DHT test" $, type cr endwith get-ip
bernd's avatar
bernd committed
29
      pkc keysize 2* $, dht-id
30 31
      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
32
      endwith end-code| -setip ;
bernd's avatar
bernd committed
33 34 35

: c:fetch-tag ( nick u -- )
    net2o-code
bernd's avatar
bernd committed
36
      expect-reply
37
      nick-key .ke-pk $@ $, dht-id dht-host? dht-tags?
bernd's avatar
bernd committed
38
      endwith cookie+request
bernd's avatar
bernd committed
39
    end-code| ;
bernd's avatar
bernd committed
40 41 42

: c:fetch-host ( nick u -- )
    net2o-code
bernd's avatar
bernd committed
43 44
      expect-reply  fetch-host,
      cookie+request
bernd's avatar
bernd committed
45
    end-code| ;
bernd's avatar
bernd committed
46

47 48 49 50 51 52
\ : c:fetch-tags ( -- )
\     net2o-code
\       expect-reply
\       0 ulit, dht-open  pkc keysize 2* $, $FE ulit, 0 ulit, dht-query
\       n2o:done
\     end-code| ;
bernd's avatar
bernd committed
53

bernd's avatar
bernd committed
54 55
Variable connect-nick  "test" connect-nick $!

56
: c:dht ( n -- )  $8 $8 connect-nick $@ nick>pk ins-ip pk:connect 0 ?DO
bernd's avatar
bernd committed
57
	c:add-tag "anonymous" c:fetch-tag \ c:fetch-tags
58
    LOOP  disconnect-me ;
bernd's avatar
bernd committed
59

60 61
: std-block ( -- ) $10 blocksize! $A blockalign! ;

bernd's avatar
bernd committed
62 63 64
: c:download1 ( -- )
    [: .time ." Download test: 1 text file and 2 photos" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
65
      expect-reply
bernd's avatar
bernd committed
66
      log !time .time s" Download test " $, type 1 ulit, . pi float, f. cr endwith
bernd's avatar
bernd committed
67
      get-ip
68
      std-block stat( request-stats )
bernd's avatar
bernd committed
69 70 71
      "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
bernd's avatar
bernd committed
72
      n2o:done push' log 0 ulit, words push' cr push' endwith
bernd's avatar
bernd committed
73
    end-code| n2o:close-all ['] .time $err ;
bernd's avatar
bernd committed
74 75 76 77

: c:download2 ( -- )
    [: ." Download test 2: 7 medium photos" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
78
      expect-reply close-all \ rewind-total
79
      log .time s" Download test 2" $, type cr endwith
80
      std-block stat( request-stats )
bernd's avatar
bernd committed
81 82 83 84 85 86 87
      "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
88
      n2o:done push' log log $20 ulit, words push' cr endwith
bernd's avatar
bernd committed
89
    end-code| n2o:close-all ['] .time $err ;
bernd's avatar
bernd committed
90 91 92 93

: c:download3 ( -- )
    [: ." Download test 3: 2 big photos" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
94
      expect-reply close-all \ rewind-total
95
      log .time s" Download test 3" $, type cr endwith
96
      std-block stat( request-stats )
bernd's avatar
bernd committed
97 98
      "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
99 100
      n2o:done 0 ulit, file-id
      push' endwith push' log $20 ulit, words push' cr endwith
bernd's avatar
bernd committed
101
    end-code| n2o:close-all ['] .time $err ;
bernd's avatar
bernd committed
102 103 104 105

: c:download4 ( -- )
    [: ." Download test 4: 7 big photos, partial files" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
106
      expect-reply close-all \ rewind-total
107
      log .time s" Download test 4" $, type cr endwith
108
      std-block stat( request-stats )
bernd's avatar
bernd committed
109 110 111 112 113 114 115 116 117 118 119 120 121 122
      "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!
123 124
      n2o:done "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" $, dht-id
      push' endwith push' log $20 ulit, words push' cr endwith
bernd's avatar
bernd committed
125
    end-code| ['] .time $err ;
bernd's avatar
bernd committed
126 127 128 129

: c:download4a ( -- )
    [: ." Download test 4a: 7 big photos, rest" cr ;] $err
    net2o-code
bernd's avatar
bernd committed
130
      expect-reply
131
      log .time s" Download test 4a" $, type cr endwith
132
      7 0 DO  -1. I limit!  LOOP
bernd's avatar
bernd committed
133
      n2o:done
bernd's avatar
bernd committed
134
    end-code| ['] .time $err n2o:close-all ;
bernd's avatar
bernd committed
135

136
: c:test-rest ( -- )
bernd's avatar
bernd committed
137
    c:download1
138 139 140
    7e @time f> IF c:download2
	waitkey( 8e )else( 15e ) @time f> IF  c:download3
	    waitkey( 16e )else( 20e ) @time f> IF
bernd's avatar
bernd committed
141 142 143 144 145 146
		waitkey( ." Press key to continue" key drop cr )
		c:download4
		c:download4a
	    THEN
	THEN
    THEN
bernd's avatar
bernd committed
147
    >timing c:disconnect ;
bernd's avatar
bernd committed
148

149 150
: c:test ( -- )
    init-cache'
151
    $a $e connect-nick $@ nick>pk ins-ip pk:connect c:test-rest ;
152

153 154 155
Variable reqdone#
event: ->reqdone -1 reqdone# +! ;

156 157
: c:test& ( n -- ) \ in background
    up@ 2 stacksize4 NewTask4 pass >r
bernd's avatar
bernd committed
158
    alloc-io ['] c:test catch ?dup-IF
bernd's avatar
bernd committed
159
	elit, ->throw drop
160
    ELSE  drop ->reqdone  THEN  r> event> ;
bernd's avatar
bernd committed
161 162 163 164

#100 Value req-ms#

: c:tests ( n -- )  dup 0< IF  abs to test#  1  THEN
165
    dup to total-tests  dup reqdone# !
166
    0 ?DO  I c:test& req-ms# ms test# 1+ to test#  LOOP
167
    BEGIN  stop reqdone# @ 0= UNTIL ;
bernd's avatar
bernd committed
168

bernd's avatar
bernd committed
169 170
\ lookup for other users

bernd's avatar
bernd committed
171
: nat:connect ( addr u -- )  $A $E nick-connect
bernd's avatar
bernd committed
172 173
    ." Connected!" cr ;

bernd's avatar
bernd committed
174 175
\ some more helpers

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

179 180
: 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
181

bernd's avatar
bernd committed
182
: sha-3-256s ( -- )
bernd's avatar
bernd committed
183
    [: 2dup sha-3-256 space type cr ;] arg-loop ;
bernd's avatar
bernd committed
184 185

: sha-3-512s ( -- )
bernd's avatar
bernd committed
186
    [: 2dup sha-3-512 space type cr ;] arg-loop ;
bernd's avatar
bernd committed
187 188 189 190

\ terminal connection

: c:terminal ( -- )
191
    $a $e connect-nick $@ nick>pk ins-ip pk:connect
bernd's avatar
bernd committed
192 193 194 195 196
    [: .time ." Terminal test: connect to server" cr ;] $err
    tc-permit# fs-class-permit or to fs-class-permit
    net2o-code
    expect-reply
      log .time "Terminal test" $, type cr endwith
197
      std-block stat( request-stats )
bernd's avatar
bernd committed
198 199 200
      [: 3 ulit, file-type  "" $, 0 ulit, open-file
	state-addr >o 2 fs-class! o> ;] n2o>file
    end-code| ['] .time $err ;