Index: net2o-client-test.fs ================================================================== --- net2o-client-test.fs +++ net2o-client-test.fs @@ -13,18 +13,17 @@ ." 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 -." IP6 packets send/received: " packet6s ? packet6r ? cr +." IP packets send/received: " packets ? packetr ? cr bye Index: net2o-cmd.fs ================================================================== --- net2o-cmd.fs +++ net2o-cmd.fs @@ -148,14 +148,16 @@ : 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 -- ) cmdbuf$ + dup >r p!+ r> - cmdbuf# +! ; +: 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 ; @@ -518,11 +520,11 @@ 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! @@ -571,5 +573,15 @@ 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] Index: net2o.fs ================================================================== --- net2o.fs +++ net2o.fs @@ -13,10 +13,13 @@ \ 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 . +\ :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 @@ -156,172 +159,131 @@ \ 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] ; + net2o-port create-udp-server46 s" w+" c-string fdopen + to net2o-sock ; : 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] ; + 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# -[IFDEF] recvmmsg- 8 [ELSE] 1 [THEN] Value buffers# +8 Value buffers# : maxdata ( -- n ) min-size max-size^2 lshift ; maxdata overhead + Constant maxpacket -maxpacket $F + -$10 and Constant maxpacket-aligned +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 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 packet6r -Variable packet6s +Variable packetr +Variable packets 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] +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 packet4r +! ; - -: read-a-packet6 ( -- addr u ) - net2o-sock6 read-socket-quick 1 packet6r +! ; + net2o-sock read-socket-quick 1 packetr +! ; $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] +: 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@ - 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] ; + 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 @@ -331,11 +293,11 @@ : 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 @@ -1142,74 +1104,17 @@ 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! ( -- ) +\ reader thread + +: 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 ; - -: 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 -; + 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 -- ) @@ -1216,10 +1121,12 @@ ' 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 @@ -1229,11 +1136,10 @@ >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 @@ -1253,46 +1159,66 @@ 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 + +: 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 ; -: client-event ( addr u -- ) - 2drop in-check - IF ['] handle-packet catch - ?dup-IF ( inbuf packet-data dump ) DoError nothrow THEN - ELSE ( drop packet ) THEN ; +: 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? - BEGIN server-event AGAIN ; + 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 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