On Sat 03 Sep 2022 at 10:23, nature <nat...@blazebone.com> wrote:
> Then I tried something simpler like the echo server wrom
> rosettacode: https://rosettacode.org/wiki/Echo_server#Forth and this
> didn't work as well.
>
> I then tried to insert some ." at different places and I realized that
> create-server and accept-socket works, it's read-socket that
> fails/blocks indefinitely. When going deeper and trying to figure out
> where exactly in read-socket things were blocking, I found that it's the
> recv call that blocks/fails. I wasn't able to figure out more than
> that...
It seems that read-socket is trying to provide some kind of higher lever
blocking API I do not understand.
You can see the source code for read-socket with the following commands:
• (eepitch-shell)
• (eepitch-kill)
• (eepitch-shell)
gforth
require unix/socket.fs
view read-socket
view (rs)
Using read and write instead of read-socket and write-socket worked for
me, see the attached forking echo server example.
\ GOOD
\ TODO avoid pthread linking
\ gforth ./echo-server9.fs
\ (not needed anymore) GFORTHHIST=/no-history gforth ./echo-server9.fs
' noop IS bootmessage
\ ' noop IS 'cold \ still uses history file
warnings off
-status
include unix/socket.fs
\ include unix/libc.fs \ ?errno-throw
c-library wait
\c #include <sys/wait.h>
\c #define _WNOHANG() WNOHANG
c-function WNOHANG _WNOHANG -- n ( -- WNOHANG )
c-function waitpid waitpid n a n -- n ( pid_t *wstatus options -- pid_t )
\c #include <unistd.h>
c-function alarm alarm n -- void ( sec -- )
c-function (dup2) dup2 n n -- n ( oldfd newfd -- newfd )
\c #include <signal.h>
\c #define _sigchld() signal(SIGCHLD, SIG_IGN)
c-function -sigchld _sigchld -- void
end-c-library
: dup2 ( oldfd newfd -- ) (dup2) -1 = ?errno-throw ;
80 constant size
0 value %server
: echo ( -- )
BEGIN
2 alarm \ timeout after 2s inactivity
0 pad size read pad swap ( a u -- )
\ dup . errno .
dup 0>
WHILE
\ 2dup type
\ 2dup dump
>r >r 1 r> r> write \ TODO loop
REPEAT
drop drop ;
: parent ( socket -- ) close-socket ;
: child ( socket -- )
%server close-server
dup fileno dup 0 dup2 1 dup2 close-socket
['] echo catch drop bye ;
: zombies
BEGIN -1 0 WNOHANG waitpid 0> WHILE REPEAT ;
: serve
12345 create-server to %server
%server 8 listen
-sigchld
BEGIN
2 alarm \ timeout after 2s inactivity
zombies \ TODO test alarm to unblock accept-socket every 2s
%server accept-socket
0 alarm \ turn of alarm
[char] . emit
fork() dup 0< throw IF parent ELSE child THEN
AGAIN ;
:noname ['] serve catch drop bye ; is 'quit
\ history close-file drop
