Changes On Branch pthread
Not logged in
Home Timeline Files Branches Tags Tickets Wiki Login Impressum Datenschutzerklärung
Hide Diff Patch Unified Diff

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
Removed sock46 option Closed-Leaf check-in: 8a12aff164 user: bernd tags: pthread
13:58
Moved code around to remove forward reference check-in: b26c823a60 user: bernd tags: pthread
2012-05-04
23:33
Initialize alen for recvfrom check-in: 79ccbb5765 user: bernd tags: trunk
2012-05-03
01:06
Started pthread based reader loop check-in: b965d6e459 user: bernd tags: pthread
00:35
Create new branch named "pthread" check-in: 938cd62b36 user: bernd tags: pthread
2012-05-01
23:16
Disabled recvmmsg - does not work check-in: 7e6ee5e2fe user: bernd tags: trunk
23:09
Allow handover on clients, too 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

insert-ip n2o:connect

." Connected" cr

net2o-code
data-ivs
s" Download test" $, type cr
$400 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
." IP6 packets send/received: " packet6s ? packet6r ? cr

bye








|








|
<



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
$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
." IP packets send/received: " packets ? packetr ? 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

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 + ;


: cmdreset  cmdbuf# off ;


: cmd, ( n -- )  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









>



>
|








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
    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

	\ 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
    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








|








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 ( -- )
    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











: 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


















>
>
>
>
>
>
>
>
>
>

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

\ 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/>.




require unix/socket.fs
require string.fs
require struct0x.fs
require nacl.fs
require wurstkessel.fs
require wurstkessel-init.fs
require hash-table.fs








>
>
>








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

\ +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
    [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
    [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#
: maxdata ( -- n ) min-size max-size^2 lshift ;
maxdata overhead + Constant maxpacket

maxpacket $F + -$10 and Constant maxpacket-aligned
: chunk-p2 ( -- n )  max-size^2 6 + ;


here 1+ -8 and 6 + here - allot
here maxpacket-aligned buffers# * allot
here maxpacket-aligned buffers# * allot
Constant outbuf' Constant inbuf'

begin-structure net2o-header
    2 +field flags
   16 +field destination
    8 +field addr
end-structure

Variable packet4r
Variable packet4s
Variable packet6r
Variable packet6s

2Variable ptimeout
#100000000 Value poll-timeout# \ 100ms
poll-timeout# 0 ptimeout 2!

[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

    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
    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 ;
[THEN]

: read-a-packet ( -- addr u )
    net2o-sock read-socket-quick  1 packet4r +! ;

: 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
	sock46 [IF]
	    net2o-sock  1 packet4s +!
	[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 ( -- ) ;
[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
    [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 ;
: route>address ( n -- )
    routes #.key $@ sockaddr-tmp swap dup alen ! move ;

\ route an incoming packet

Variable return-addr









<

<
<

<
|
|
<
<
<
<


<
|
|
<
<
<
<






|


>
|


>



|







|
|
<
<




|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<

|
|
|
|
>
|
|
>
>
>
|
>
|
|
|
>
>
>
>
|
>
>
>
>
>
>
|
>
>
|
>
>
>
|
|
>
>
>
|
<
|
>
|
>
|
>
|
<


|

<
<
<


<
<
|
|
|
|
<
|
<
<
<
<
<
<
<
|
|
<









<
|
|
|
|
|
|
|
|
|
|
|
<













|








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




: new-server ( -- )

    net2o-port create-udp-server46 s" w+" c-string fdopen
    to net2o-sock ;





: new-client ( -- )

    new-udp-socket46 s" w+" c-string fdopen
    to net2o-sock ;





$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#
8 Value buffers#
: maxdata ( -- n ) min-size max-size^2 lshift ;
maxdata overhead + Constant maxpacket
maxpacket sockaddr_in6 %size + 2 cells +
$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 outbufs Constant inbufs

begin-structure net2o-header
    2 +field flags
   16 +field destination
    8 +field addr
end-structure

Variable packetr
Variable packets



2Variable ptimeout
#100000000 Value poll-timeout# \ 100ms
poll-timeout# 0 ptimeout 2!
11 Constant EAGAIN






















2Variable socktimeout















: 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 - ;


: 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 ;


: read-a-packet ( -- addr u )
    net2o-sock read-socket-quick  1 packetr +! ;




$00000000 Value droprate#



: send-a-packet ( addr u -- n )
    droprate# IF  rng32 droprate# u< IF
	    \ ." dropping packet" cr
	    2drop 0  EXIT  THEN  THEN

    net2o-sock  1 packets +!







    fileno -rot 0 sockaddr-tmp alen @ sendto ;
: send-flush ( -- ) ;


\ 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@

    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 ;


: 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 )
    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

	    queue $@ r@ safe/string drop queue-timestamp @ 0= IF
		queue r@ queue-struct $del
	    ELSE
		r> queue-struct + >r
	    THEN
    REPEAT  rdrop ;

\ poll loop

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! ( -- )
    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 ;

: 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 ;



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








<
|
<

<
<
<
<
<
<
<
<
<
<
|

|
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<










>
>













<








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 ;


\ reader thread












: timeout? ( -- ns )
    next-chunk-tick dup -1 <> >r ticks - dup 0>= r> or
    IF    0 max
    ELSE  drop poll-timeout#  THEN ;
: timeout! ( -- )  timeout?  0 ptimeout 2! ;














































: 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
	    ." 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

	    >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
    IF  ['] handle-packet catch
	?dup-IF  ( inbuf packet-data dump ) DoError nothrow  THEN
    ELSE  ." route a packet" cr route-packet  THEN ;




: client-event ( addr u -- )



    2drop in-check

    IF  ['] handle-packet catch

	?dup-IF  ( inbuf packet-data dump ) DoError nothrow  THEN








    ELSE  ( drop packet )  THEN ;


\ 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?

    BEGIN  server-event  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
     timeouts @ 0<=  requests @ 0= or  UNTIL ;

\ client/server initializer

: init-client ( -- )
    new-client init-route prep-socks ;

: init-server ( -- )
    new-server init-route prep-socks ;

\ load net2o commands

include net2o-cmd.fs








|
>
>
|


|
>

>
>
|
>
>
>
|
>
|
>
|
>
>
>
>
>
>
>
>
|
>



<







>
|
>


|
|
|





|


|





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 ;

: 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  server? IF  ." route a packet" cr route-packet  THEN
    THEN ;

0 Value received?
0 Value read-task

: 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


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  sendflag @ 0= IF  timeout? stop-ns  THEN
	send-another-chunk sendflag !  AGAIN ;

: client-loop ( requests -- )  requests !  reset-timeout  false to server?
    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 reader-thread ;

: init-server ( -- )
    new-server init-route reader-thread ;

\ load net2o commands

include net2o-cmd.fs

Fossil 2.23 [ffad4043e5] 2023-11-01 21:50:12