Re: Issues with socket.fs on OpenBSD

Tomas Hlavaty <[email protected]> Sun, 04 Sep 2022 08:51:52 +0200

Newsgroups	gmane.comp.lang.forth.gforth
Message-ID	<[email protected]>

On Sat 03 Sep 2022 at 10:23, nature <[email protected]> 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.

echo-server9.fs (text/plain, 1.6 KB)

\ 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