Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch pthread
Excluding Merge-Ins
This is equivalent to a diff from
7e6ee5e2fe
to 8a12aff164
2012-05-05
| | |
14:08 |
|
Closed-Leaf
check-in: 8a12aff164 user: bernd tags: pthread
|
13:58 |
|
check-in: b26c823a60 user: bernd tags: pthread
|
2012-05-04
| | |
23:33 |
|
check-in: 79ccbb5765 user: bernd tags: trunk
|
2012-05-03
| | |
01:06 |
|
check-in: b965d6e459 user: bernd tags: pthread
|
00:35 |
|
check-in: 938cd62b36 user: bernd tags: pthread
|
2012-05-01
| | |
23:16 |
|
check-in: 7e6ee5e2fe user: bernd tags: trunk
|
23:09 |
|
check-in: 8d58b26d2a user: bernd tags: trunk
|
| | |
Changes to net2o-client-test.fs.
︙ | | |
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
-
+
-
+
-
|
insert-ip n2o:connect
." Connected" cr
net2o-code
data-ivs
s" Download test" $, type cr
$400 blocksize! $400 blockalign!
$4000 blocksize! \ $400 blockalign!
s" net2o.fs" s" .cache/net2o.fs" n2o:copy
s" data/2011-05-13_11-26-57.jpg" s" .cache/photo000.jpg" n2o:copy
s" data/2011-05-20_17-01-12.jpg" s" .cache/photo001.jpg" n2o:copy
n2o:done
send-chunks
end-code
ticks 1 client-loop ticks - negate s>f 1e-9 f* f. ." s" cr
." IP4 packets send/received: " packet4s ? packet4r ? cr
." IP packets send/received: " packets ? packetr ? cr
." IP6 packets send/received: " packet6s ? packet6r ? cr
bye
|
Changes to net2o-cmd.fs.
︙ | | |
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
+
+
-
+
|
Variable cmd0source
Variable cmd0buf#
: cmdbuf ( -- addr ) cmd0source @ IF code-dest ELSE cmd0buf THEN ;
: cmdbuf# ( -- addr ) cmd0source @ IF j^ cmd-buf# ELSE cmd0buf# THEN ;
: cmdbuf$ ( -- addr u ) cmdbuf cmdbuf# @ ;
: endcmdbuf ( -- addr' ) cmdbuf maxdata + ;
: ?fit ( size -- ) cmdbuf# @ + maxdata u> !!commands!! and throw ;
: cmdreset cmdbuf# off ;
: cmd, ( n -- ) dup p-size ?fit
: cmd, ( n -- ) cmdbuf$ + dup >r p!+ r> - cmdbuf# +! ;
cmdbuf$ + dup >r p!+ r> - cmdbuf# +! ;
: net2o, @ cmd, ;
: net2o-code cmd0source on ['] net2o, IS net2o-do also net2o-base ;
: net2o-code0 cmd0source off ['] net2o, IS net2o-do also net2o-base ;
net2o-code0 previous
|
︙ | | |
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
|
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
|
-
+
|
\ otherwise, set only this specific bucket
r> receive-flag 0= data-ackbit @ over +bit@
r> and >r
THEN
drop r> 0= IF maxdata j^ received +! expected? THEN ;
: net2o:do-ack ( -- )
ticks j^ recv-tick ! \ time stamp of arrival
in-ticks @ j^ recv-tick ! \ time stamp of arrival
dest-addr @ j^ recv-addr ! \ last received packet
j^ recv-high @ -1 = IF
dest-addr @ j^ recv-high !
ELSE
dest-addr @ j^ recv-high umax!
THEN
inbuf 1+ c@ j^ recv-flag ! \ last receive flag
|
︙ | | |
569
570
571
572
573
574
575
|
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
|
+
+
+
+
+
+
+
+
+
+
|
: net2o:do-timeout ( -- ) resend?
resend-toggle# j^ recv-flag xor! .expected
cmdreset ticks lit, timeout false net2o:do-resend net2o:genack
cmd-send? ;
' net2o:do-timeout IS do-timeout
previous
0 [IF]
Local Variables:
forth-local-words:
(
(("net2o:") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
)
End:
[THEN]
|
Changes to net2o.fs.
︙ | | |
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
+
+
+
|
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU Affero General Public License for more details.
\ You should have received a copy of the GNU Affero General Public License
\ along with this program. If not, see <http://www.gnu.org/licenses/>.
\ :noname >in @ 0= IF loadline @ 0 .r ." : " source type .s cr THEN ; is before-word
require unix/pthread.fs
require unix/socket.fs
require string.fs
require struct0x.fs
require nacl.fs
require wurstkessel.fs
require wurstkessel-init.fs
require hash-table.fs
|
︙ | | |
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
|
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
|
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
+
+
-
+
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
+
|
\ +db msg(
\ Create udp socket
4242 Value net2o-port
0 Value net2o-sock
0 Value net2o-sock6
true Value sock46 immediate
: new-server ( -- )
sock46 [IF]
net2o-port create-udp-server46 s" w+" c-string fdopen
dup to net2o-sock to net2o-sock6
net2o-port create-udp-server46 s" w+" c-string fdopen
to net2o-sock ;
[ELSE]
net2o-port create-udp-server s" w+" c-string fdopen to net2o-sock
net2o-port create-udp-server6 s" w+" c-string fdopen to net2o-sock6
[THEN] ;
: new-client ( -- )
sock46 [IF]
new-udp-socket46 s" w+" c-string fdopen
dup to net2o-sock to net2o-sock6
new-udp-socket46 s" w+" c-string fdopen
to net2o-sock ;
[ELSE]
new-udp-socket s" w+" c-string fdopen to net2o-sock
new-udp-socket6 s" w+" c-string fdopen to net2o-sock6
[THEN] ;
$2A Constant overhead \ constant overhead
$4 Value max-size^2 \ 1k, don't fragment by default
$40 Constant min-size
$400000 Value max-data#
$10000 Value max-code#
[IFDEF] recvmmsg- 8 [ELSE] 1 [THEN] Value buffers#
8 Value buffers#
: maxdata ( -- n ) min-size max-size^2 lshift ;
maxdata overhead + Constant maxpacket
maxpacket sockaddr_in6 %size + 2 cells +
maxpacket $F + -$10 and Constant maxpacket-aligned
$F + -$10 and Constant maxpacket-aligned
: chunk-p2 ( -- n ) max-size^2 6 + ;
sockaddr_in6 %size 2 cells + allot
here 1+ -8 and 6 + here - allot
here maxpacket-aligned buffers# * allot
here maxpacket-aligned buffers# * allot
Constant outbuf' Constant inbuf'
Constant outbufs Constant inbufs
begin-structure net2o-header
2 +field flags
16 +field destination
8 +field addr
end-structure
Variable packet4r
Variable packet4s
Variable packetr
Variable packets
Variable packet6r
Variable packet6s
2Variable ptimeout
#100000000 Value poll-timeout# \ 100ms
poll-timeout# 0 ptimeout 2!
11 Constant EAGAIN
[IFDEF] recvmmsg-
iovec %size buffers# * buffer: iovecbuf
mmsghdr %size buffers# * buffer: hdr
sockaddr_in %size buffers# * buffer: sockaddrs
: setup-iov ( -- )
inbuf' iovecbuf iovec %size buffers# * bounds ?DO
dup I iov_base ! maxpacket I iov_len ! maxpacket-aligned +
iovec %size +LOOP drop ;
setup-iov
: setup-msg ( -- )
iovecbuf sockaddrs hdr mmsghdr %size buffers# * bounds ?DO
over I msg_iov !
1 I msg_iovlen !
dup I msg_name !
sockaddr_in %size I msg_namelen !
swap iovec %size + swap sockaddr_in %size +
mmsghdr %size +LOOP 2drop ;
setup-msg
: timeout-init ( -- ) poll-timeout# 0 ptimeout 2! ;
2Variable socktimeout
2Variable socktimeout
Variable read-remain
Variable read-ptr
Variable write-ptr
: rd[] ( base size -- addr ) read-ptr @ * + ;
: wr[] ( base size -- addr ) write-ptr @ * + ;
: inbuf ( -- addr ) inbuf' maxpacket-aligned rd[] ;
: outbuf ( -- addr ) outbuf' maxpacket-aligned wr[] ;
: sock@ ( -- addr u )
inbuf hdr mmsghdr %size rd[] msg_len @
sockaddrs sockaddr_in %size rd[]
sockaddr-tmp hdr mmsghdr %size rd[]
msg_namelen @ dup alen ! move ;
: sock-timeout! ( fid -- )
ptimeout 2@ >r 1000 / r> socktimeout 2!
SOL_SOCKET SO_RCVTIMEO socktimeout 2 cells setsockopt drop ;
: read-socket-quick ( socket -- addr u ) fileno
1 read-ptr +!
read-remain @ read-ptr @ u> IF drop sock@ EXIT THEN
dup sock-timeout!
hdr buffers# MSG_WAITFORONE MSG_WAITALL or ptimeout recvmmsg
dup 0< IF
errno 11 <> IF errno 512 + negate throw THEN
drop 0 0 EXIT THEN
dup read-remain ! 0 read-ptr !
0= IF 0 0 ELSE sock@ THEN ;
[ELSE]
inbuf' Constant inbuf
: sock-timeout! ( fid -- )
ptimeout 2@ >r 1000 / r> socktimeout 2!
SOL_SOCKET SO_RCVTIMEO socktimeout 2 cells setsockopt drop ;
: timeout-init ( -- ) poll-timeout# 0 ptimeout 2! ;
2Variable read-ptr
2Variable write-ptr
Variable rdfull
Variable wrfull
: rd+ ( -- flag ) 1 read-ptr +! buffers# 1- read-ptr and!
read-ptr 2@ = dup rdfull ! ;
: wr+ ( -- flag ) 1 write-ptr +! buffers# 1- write-ptr and!
write-ptr 2@ = dup wrfull ! ;
: rd- ( -- flag ) 1 read-ptr cell+ +! buffers# 1- read-ptr cell+ and!
rdfull @ rdfull off ;
: wr- ( -- flag ) 1 read-ptr cell+ +! buffers# 1- write-ptr cell+ and!
wrfull @ wrfull off ;
: rd[] ( base size -- addr ) read-ptr @ * + ;
: rd'[] ( base size -- addr ) read-ptr cell+ @ * + ;
: wr[] ( base size -- addr ) write-ptr @ * + ;
: inbuf' ( -- addr ) inbufs maxpacket-aligned rd[] ;
: inbuf'' ( -- addr ) inbufs maxpacket-aligned rd'[] ;
: outbuf ( -- addr ) outbufs maxpacket-aligned wr[] ;
User 'inbuf
: inbuf ( -- addr ) 'inbuf @ ;
: in-ticks ( -- addr ) inbuf cell - ;
: salen ( -- addr ) inbuf 2 cells - ;
: sockaddr ( -- addr ) salen sockaddr_in6 %size - ;
: sockaddr$ ( -- addr len ) sockaddr salen @ ;
: >in-ticks ( addr -- addr' ) cell - ;
: >alen ( addr -- addr' ) 2 cells - ;
: >sockaddr ( addr -- addr' ) >alen sockaddr_in6 %size - ;
outbuf' Constant outbuf
: read-socket-quick ( socket -- addr u )
fileno inbuf maxpacket MSG_WAITALL sockaddr-tmp alen recvfrom
dup 0< IF errno 512 + negate throw THEN
inbuf swap ;
: read-socket-quick ( socket -- addr u )
sockaddr_in6 %size salen !
fileno inbuf maxpacket MSG_WAITALL sockaddr salen recvfrom
dup 0< IF
errno EAGAIN <> IF errno 512 + negate throw THEN
drop 0 0 EXIT THEN
inbuf swap ;
[THEN]
: read-a-packet ( -- addr u )
net2o-sock read-socket-quick 1 packet4r +! ;
net2o-sock read-socket-quick 1 packetr +! ;
: read-a-packet6 ( -- addr u )
net2o-sock6 read-socket-quick 1 packet6r +! ;
$00000000 Value droprate#
[IFDEF] sendmmsg-
[ELSE]
: send-a-packet ( addr u -- n )
droprate# IF rng32 droprate# u< IF
\ ." dropping packet" cr
2drop 0 EXIT THEN THEN
: send-a-packet ( addr u -- n )
droprate# IF rng32 droprate# u< IF
\ ." dropping packet" cr
2drop 0 EXIT THEN THEN
sock46 [IF]
net2o-sock 1 packet4s +!
net2o-sock 1 packets +!
[ELSE]
sockaddr-tmp w@ AF_INET6 = IF
net2o-sock6 1 packet6s +!
ELSE
net2o-sock 1 packet4s +!
THEN
[THEN]
fileno -rot 0 sockaddr-tmp alen @ sendto ;
: send-flush ( -- ) ;
fileno -rot 0 sockaddr-tmp alen @ sendto ;
: send-flush ( -- ) ;
[THEN]
\ clients routing table
Variable routes
: init-route ( -- ) s" " routes hash@ $! ; \ field 0 is me, myself
: info>string ( addr -- addr u )
dup ai_addr @ swap ai_addrlen l@
sock46 [IF]
over w@ AF_INET = IF
drop >r
AF_INET6 sockaddr-tmp family w!
r@ port w@ sockaddr-tmp port w!
0 sockaddr-tmp sin6_flowinfo l!
r> sin_addr l@ sockaddr-tmp sin6_addr 12 + l!
$FFFF0000 sockaddr-tmp sin6_addr 8 + l!
0 sockaddr-tmp sin6_addr !
0 sockaddr-tmp sin6_scope_id l!
sockaddr-tmp sockaddr_in6 %size
THEN
over w@ AF_INET = IF
drop >r
AF_INET6 sockaddr-tmp family w!
r@ port w@ sockaddr-tmp port w!
0 sockaddr-tmp sin6_flowinfo l!
r> sin_addr l@ sockaddr-tmp sin6_addr 12 + l!
$FFFF0000 sockaddr-tmp sin6_addr 8 + l!
0 sockaddr-tmp sin6_addr !
0 sockaddr-tmp sin6_scope_id l!
sockaddr-tmp sockaddr_in6 %size
THEN ;
[THEN] ;
: check-address ( addr u -- net2o-addr / -1 ) routes #key ;
: insert-address ( addr u -- net2o-addr )
2dup routes #key dup -1 = IF
drop s" " 2over routes #! routes #key
ELSE
nip nip
THEN ;
: insert-ip ( addr u port -- net2o-addr )
get-info info>string insert-address ;
: address>route ( -- n/-1 )
sockaddr-tmp alen @ check-address ;
inbuf >sockaddr inbuf >alen @ check-address ;
: route>address ( n -- )
routes #.key $@ sockaddr-tmp swap dup alen ! move ;
\ route an incoming packet
Variable return-addr
|
︙ | | |
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
|
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
|
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
|
queue $@ r@ safe/string drop queue-timestamp @ 0= IF
queue r@ queue-struct $del
ELSE
r> queue-struct + >r
THEN
REPEAT rdrop ;
\ poll loop
\ reader thread
Create pollfds here pollfd %size 2 * dup allot erase
: fds!+ ( fileno flag addr -- addr' )
>r r@ events w! r@ fd l! r> pollfd %size + ;
: prep-socks ( -- ) pollfds >r
net2o-sock fileno POLLIN r> fds!+ >r
net2o-sock6 fileno POLLIN r> fds!+ drop ;
: clear-events ( -- ) pollfds
2 0 DO 0 over revents w! pollfd %size + LOOP drop ;
: timeout! ( -- )
: timeout? ( -- ns )
next-chunk-tick dup -1 <> >r ticks - dup 0>= r> or
IF 0 max 0 ptimeout 2!
ELSE drop poll-timeout# 0 ptimeout 2! THEN ;
IF 0 max
ELSE drop poll-timeout# THEN ;
: timeout! ( -- ) timeout? 0 ptimeout 2! ;
: poll-sock ( -- flag )
eval-queue clear-events timeout!
pollfds 2 postpone sock46 +
[ environment os-type s" linux" string-prefix? ] [IF]
ptimeout 0 ppoll 0>
[ELSE]
ptimeout cell+ @ #1000000 / poll 0>
[THEN]
;
: read-a-packet4/6 ( -- addr u )
sock46 [IF]
pollfds revents w@ POLLIN = IF
read-a-packet6 0 pollfds revents w! EXIT THEN
[ELSE]
pollfds revents w@ POLLIN = IF
read-a-packet 0 pollfds revents w! EXIT THEN
pollfds pollfd %size + revents w@ POLLIN = IF
read-a-packet6 0 pollfds pollfd %size + revents w! EXIT THEN
[THEN]
0 0 ;
[IFDEF] recvmmsg-
: try-read-packet ( -- addr u / 0 0 )
eval-queue timeout! read-a-packet ;
[ELSE]
: try-read-packet ( -- addr u / 0 0 )
poll-sock drop read-a-packet4/6 ;
[THEN]
: next-packet ( -- addr u )
send-anything? sendflag !
BEGIN sendflag @ 0= IF try-read-packet dup 0= ELSE 0. true THEN
WHILE 2drop send-another-chunk sendflag ! REPEAT
sockaddr-tmp alen @ insert-address inbuf ins-source
over packet-size over <> !!size!! and throw ;
: next-client-packet ( -- addr u )
try-read-packet 2dup d0= ?EXIT
sockaddr-tmp alen @ insert-address \ check-address dup -1 <> IF
inbuf ins-source
over packet-size over <> !!size!! and throw
\ ELSE hex. ." Unknown source" 0 0 THEN
;
: net2o:timeout ( ticks -- ) \ print why there is nothing to send
." timeout? " . send-anything? . chunks+ ? next-chunk-tick . cr ;
Defer queue-command ( addr u -- )
' dump IS queue-command
Defer do-ack ( -- )
' noop IS do-ack
: pow2? ( n -- n ) dup dup 1- and 0<> !!pow2!! and throw ;
0 Value server?
Variable validated
$01 Constant crypt-val
$02 Constant own-crypt-val
$04 Constant login-val
: handle-packet ( -- ) \ handle local packet
>ret-addr >dest-addr
\ inbuf .header
dest-addr @ 0= IF
0 to j^ \ address 0 has no job context!
true wurst-inbuf-decrypt 0= IF
inbuf' dup packet-size dump
inbuf dup packet-size dump
." invalid packet to 0" cr EXIT THEN
validated off \ packets to address 0 are not really validated
inbuf packet-data queue-command
ELSE
check-dest dup 0= IF drop EXIT THEN
dup 0> wurst-inbuf-decrypt 0= IF
|
︙ | | |
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
|
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
|
-
-
+
+
+
+
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
+
-
-
-
+
+
+
-
+
-
+
|
>r inbuf packet-data r@ swap dup >r move
r> r> swap queue-command
THEN
THEN ;
: route-packet ( -- ) inbuf dup packet-size send-a-packet drop ;
: server-event ( -- )
next-packet 2drop in-route
: handle-in-packet ( -- )
sockaddr$ insert-address
inbuf ins-source
server? IF in-route ELSE in-check THEN
IF ['] handle-packet catch
?dup-IF ( inbuf packet-data dump ) DoError nothrow THEN
ELSE ." route a packet" cr route-packet THEN ;
ELSE server? IF ." route a packet" cr route-packet THEN
THEN ;
0 Value received?
0 Value read-task
: client-event ( addr u -- )
2drop in-check
IF ['] handle-packet catch
?dup-IF ( inbuf packet-data dump ) DoError nothrow THEN
ELSE ( drop packet ) THEN ;
: do-packet-in ( -- ) true to received? inbuf'' 'inbuf !
handle-in-packet
rd- IF read-task wake THEN ;
\ reader thread
event: ->packet-in ( -- ) do-packet-in ;
: reader-thread ( -- )
stacksize4 newtask4 dup to read-task activate
BEGIN
inbuf' 'inbuf !
read-a-packet swap packet-size <> IF ." wrong packet size" cr
ELSE ticks in-ticks ! rd+ >r
main-task ->packet-in
r> IF stop THEN
THEN
AGAIN ;
\ loops for server and client
0 Value server?
Variable requests
Variable timeouts
: reset-timeout 20 timeouts ! ; \ 2s timeout
Defer do-timeout ' noop IS do-timeout
: server-loop ( -- ) true to server?
send-anything? sendflag !
BEGIN server-event AGAIN ;
BEGIN sendflag @ 0= IF timeout? stop-ns THEN
send-another-chunk sendflag ! AGAIN ;
: client-loop ( requests -- ) requests ! reset-timeout false to server?
BEGIN next-client-packet dup
IF client-event reset-timeout
ELSE 2drop do-timeout -1 timeouts +! THEN
BEGIN false to received? timeout? stop-ns received?
IF reset-timeout
ELSE do-timeout -1 timeouts +! THEN
timeouts @ 0<= requests @ 0= or UNTIL ;
\ client/server initializer
: init-client ( -- )
new-client init-route prep-socks ;
new-client init-route reader-thread ;
: init-server ( -- )
new-server init-route prep-socks ;
new-server init-route reader-thread ;
\ load net2o commands
include net2o-cmd.fs
|