[Chicken-users] EINTR with self-pipe signal trampoline

[Alan Post]

Below is a test case for a problem I'm seeing in some multi-process
code I'm writing.  I'm getting the error:

  Error: (file-read) cannot read from file - Interrupted system call

because a signal handler is going off while my main thread is in an
iowait state.  In C, I have always handled this by manually
restarting a system call when EINTR is called.  In my attached test
case, I'm trying to use SA_RESTART in sigaction(2) for the same
affect, and that isn't working for me.  Does that actually work?

I'm trying to determine which direction to head in to fix this
problem, and I was surprised that SA_RESTART didn't work.  Will one
of you with access to a linux machine try running this code?  Both
in the version as seen here and also run uncommenting the two
"foreign-code" lines.

This code might have bugs that prevent it from running as
intended--I'm not able to test past my EINTR problem.  I'm now
planning on patching file-read and file-write to restart on EINTR,
unless someone has a better idea!  Can I catch this exception at
runtime?

-Alan

PS: this code is using this trick: http://cr.yp.to/docs/selfpipe.html

<++> eintr.scm
;;;
;;; self-pipe signal trampoline.
;;;
;;; this test case should:
;;;
;;; * register SIGUSR1 and SIGCHLD as signal trampolines using the
;;;   self-pipe trick.
;;; * spawn a child process which:
;;;   - sends SIGUSR1 to the parent.
;;;   - enters an iowait state forever.  (to be killed by our
;;;     parent)
;;; * simultaneously, in the parent:
;;;   - we perform a blocking read on our self-pipe, and wait for
;;;     one of two signals:
;;;     SIGUSR1: send SIGTERM to our child process
;;;     SIGCHLD: call wait and then exit ourselves.
;;;
;;; Instead, file-read is called and enters a blocking state.  Our
;;; signal is raised, causing file-read to return EINTR.  Normally,
;;; one would restart the syscall.  I'm not sure how one does this
;;; in Chicken Scheme, or if you can.
;;;
;;; Even deferring to a C implementation of the signal trampoline
;;; which properly sets SA_RESTART does not seem to help.
;;;

(use posix)

; restart system calls on EINTR.
;
(foreign-declare #<<EOS
#include <sys/types.h>
#include <unistd.h>
#include <signal.h>
#include <errno.h>

void trampoline(int signum)
{
  char b[1];
  int saved_errno=errno;
  b[0] = (char)(unsigned)signum;
  /* hack: I know my output pipe fd in this test case. */
  write(5, &b[0], 1);
  errno=saved_errno;
}

void register_trampoline(int signum)
{
  struct sigaction new, old;
  int r;
  new.sa_handler = &trampoline;
  new.sa_flags = SA_RESTART;
  sigemptyset(&new.sa_mask);
        /* hack: ignoring the return value */
  r = sigaction(signum, &new, &old);
}
EOS
)

(call-with-values
  create-pipe
  (lambda (input-pipe output-pipe)
    ; signal handler.  write the signal received to our self-pipe.
    ;
    (define (trampoline signum)
      (file-write output-pipe (string (integer->char signum))))

    ; helper routine to read a single (unbuffered) byte and convert
    ; it to an integer (here representing a signal number).
    ;
    (define (read1 fd)
      (char->integer (string-ref (car (file-read input-pipe 1)) 0)))

    (define (child)
                        ; close our parent's self-pipe
                        (file-close input-pipe)
                        (file-close output-pipe)

                        ; and "reset" (not technically true, but another bug not
                        ; relevant to this test case) our signal handlers.
                        ;
                        (set-signal-handler! signal/usr1 #f)
                        (set-signal-handler! signal/chld #f)

      ; send our parent SIGUSR1, which should result in
      ; our parent sending us a SIGTERM.
      ;
      (process-signal (parent-process-id) signal/usr1)

      (call-with-values
        create-pipe
        (lambda (input-pipe output-pipe)
          ; pause (iowait) until we get our SIGTERM.
          ;
          (read1 input-pipe)

          ; never actually executed.
          ;
          (file-close input-pipe)
          (file-close output-pipe)
          (exit 0))))

    (define (parent pid)
      (case (read1 input-pipe)
        ((signal/usr1) (process-signal pid) (parent pid))
        ((signal/chld) (process-wait   pid))))

    ; register our signal trampoline
    ;
    (set-signal-handler! signal/usr1 trampoline)
    (set-signal-handler! signal/chld trampoline)

                ; or, register our signal trampoline.
                ;
                ; uncomment these lines to test SA_RESTART
                ;
    ;(foreign-code "register_trampoline(SIGUSR1);")
    ;(foreign-code "register_trampoline(SIGCHLD);")

    ; fork our child and do event handling.
    ;
    (let ((pid (process-fork)))
      (case pid
        ((0)  (child))
        (else (parent pid))))))
<-->
-- 
.i ma'a lo bradi cu penmi gi'e du