client-tests.fs 6.53 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
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 18 19 20 21 22

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

: init-cache' ( -- )
    "" >cache 1- file-status nip #-514 = IF
	"" >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

54
: c:dht ( n -- )  $2000 $10000 "test" ins-ip c:connect 0 ?DO
bernd's avatar
bernd committed
55
	c:add-tag "anonymous" c:fetch-tag \ c:fetch-tags
bernd's avatar
bernd committed
56
    LOOP do-disconnect ;
bernd's avatar
bernd committed
57 58 59 60

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

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

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

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

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

bernd's avatar
bernd committed
132
: c:disconnect ( -- ) [: ." Disconnecting..." cr ;] $err
bernd's avatar
bernd committed
133 134
    do-disconnect [: .packets profile( .times ) ;] $err ;

135
: c:test-rest ( -- )
bernd's avatar
bernd committed
136
    c:download1
137 138 139
    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
140 141 142 143 144 145
		waitkey( ." Press key to continue" key drop cr )
		c:download4
		c:download4a
	    THEN
	THEN
    THEN
bernd's avatar
bernd committed
146
    >timing c:disconnect ;
bernd's avatar
bernd committed
147

148 149
: c:test ( -- )
    init-cache'
150
    $10000 $100000 "test" ins-ip c:connect c:test-rest ;
151

bernd's avatar
bernd committed
152 153
event: ->throw dup DoError throw ;

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

#100 Value req-ms#

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

bernd's avatar
bernd committed
166 167
\ lookup for other users

168
: nat:connect ( addr u -- )  $10000 $100000  2swap nick-connect
bernd's avatar
bernd committed
169 170
    ." Connected!" cr ;

bernd's avatar
bernd committed
171 172
\ some more helpers

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

176 177
: 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
178 179 180

: arg-loop { xt -- }
    begin  next-arg dup while  xt execute  repeat  2drop ;
bernd's avatar
bernd committed
181 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 191 192 193 194 195 196 197 198 199 200

\ terminal connection

: c:terminal ( -- )
    $10000 $100000 "test" ins-ip c:connect
    [: .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
      $10000 blocksize! $400 blockalign! stat( request-stats )
      [: 3 ulit, file-type  "" $, 0 ulit, open-file
	state-addr >o 2 fs-class! o> ;] n2o>file
    end-code| ['] .time $err ;