Re: [Chicken-users] replace signal with sigaction

[Alan Post]

Thank you for this.

I notice, right away, that your io_needs_restart handles EAGAIN in
the same way it handles EINTR.  I have always introduced a timeout
when I get an EAGAIN, and I give up after say 3 tries.

My use case here:

Let's say fork() returns EAGAIN.  This could happen because ulimit
has reached the maximum number of processes permitted by the user.
This is in some sense a transient problem, but on a different
timescale than an EINTR.  Continuing to bang away at the process
limit is likely to keep the machine overcommitted.

It's more complex, of course, to wait for a few seconds to put a
file descriptor back in the event queue, but unlike EINTR, EAGAIN
can be a total tease: you might never get what you ask for.

At any rate, I'll be slowly testing up toward my own problem, thank
you for the code dumps you've been sending today.

-Alan

On Fri, Sep 30, 2011 at 08:22:22PM +0200, Jörg F. Wittenberger wrote:
> Alan,
> 
> I figured that you did almost have you for the process-io-ports code
> I cited the other day.
> 
> It might make your live easier, if I just post the code as I'm using
> it right now.
> 
> Be warned: it does one thing NOT.  When there is a bad fd encountered
> while reading/writing to a fd, the read/write will be aborted by
> exception.  But the port will *not* be closed.
> 
> 
> 
> (declare
> (foreign-declare #<<EOF
> 
> #include <errno.h>
> #include <sys/wait.h>
> static int io_needs_restart()
> {
>  switch(errno) {
>   case EAGAIN:
>   case EINTR:
>    return 1;
>   default: return 0;
> }
> }
> 
> EOF
> ))
> 
> (define process-io-ports
>  (let ([make-input-port make-input-port]
>       [make-output-port make-output-port]     [make-string make-string]
>       [substring substring]
>       [file-close-fd! (foreign-lambda* int ((int fd)) "return(close(fd));")]
>       )
>    (lambda (pid fdr fdw)
>      (##sys#file-nonblocking! fdw)
>      (##sys#file-nonblocking! fdr)    ; should not be required
>      (let* ([buf (make-string buffer-size)]
>            [buflen 0]
>            [bufindex 0]
>            [iclosed #f]
>            [oclosed #f]
>            [in
>             (make-input-port
>              (let-location
>               ((again bool #f))
>               (lambda ()
>                 (when (fx>= bufindex buflen)
>                       (let loop ()
>                         (and (not iclosed)
>                              (let ([n ((foreign-lambda*
>                                         int
>                                         ((int fd) (scheme-pointer buf) (int 
> s) ((c-pointer bool) again))
>                                           "int r = read(fd, buf, s);
> *again=(r==-1)&&io_needs_restart(); return(r);")
>                                        fdr buf buffer-size (location again))])
>                                (cond
>                                 (again
>                                  (guard
>                                   (ex (else (format (current-error-port) 
> "read error ~a\n" ex)
>                                             (raise ex)))
>                                   (thread-wait-for-i/o! fdr #:input))
>                                  (loop))
>                                 ((eq? -1 n)
>                                  ;; (##sys#update-errno)
>                                    ;; (##sys#signal-hook
> #:process-error 'process-io-read "can not read from fd" fdr
> strerror)
>                                  (set! iclosed #t)
>                                  #;(when (eq? -1 (file-close-fd! fdr))
>                                  (##sys#update-errno)
>                                  (##sys#signal-hook #:process-error 
> 'process-io-read
>                                  "can not close fd input port" fdr) )
>                                  (file-close-fd! fdr))
>                                 (else
>                                  ;; (print "[rd: " n "]")
>                                  (set! buflen n)
>                                  (set! bufindex 0))) ))) )
>                 (if (or iclosed (fx>= bufindex buflen))
>                     (end-of-file)
>                     (let ([c (##core#inline "C_subchar" buf bufindex)])
>                       (set! bufindex (fx+ bufindex 1))
>                       c) ) ))
>              (lambda ()
>                 (when iclosed
>                   (##sys#signal-hook #:process-error "input port is
> closed" fdr))
>                #t )
>              (lambda ()
>                (unless iclosed
>                  (set! iclosed #t)
>                  (when (eq? -1 (file-close-fd! fdr))
>                    (##sys#update-errno)
>                    (##sys#signal-hook #:process-error 'process-io-close
>                                        "can not close fd input port" fdr) )
>                   (if oclosed
>                      (receive (p f s) (process-wait-for-pid pid) s)
>                      (receive (p f s) (process-test-pid pid)
>                         (when (eqv? p pid)
>                           (set! oclosed #t)
>                           (when (eq? -1 (file-close-fd! fdw))
>                              (##sys#update-errno)
>                              (##sys#signal-hook #:process-error 
> 'process-io-close
>                                                 "can not close fd output 
> port" fdw) ) s)))
>                   ) ) ) ]
>            [out
>             (let-location
>              ((again bool #f))
>              (make-output-port
>               (lambda (s)
>                 (define start-time (current-milliseconds))
>                 (let loop ([len (##sys#size s)]
>                            [off 0])
>                   (if oclosed
>                       (##sys#signal-hook
>                        #:process-error 'process-io-write "fd output port is 
> closed" fdw)
>                       (let ([n ((foreign-lambda*
>                                  int
>                                    ((int fd) (scheme-pointer buf)
> (int off) (int count) ((c-pointer bool) again))
>                                    "int r = write(fd,
> ((char*)buf)+off, count); *again=(r==-1)&&io_needs_restart();
> return(r);")
>                                 fdw s off len (location again))])
>                         (cond [again
>                                (guard
>                                 (ex (else (format (current-error-port) "write 
> error ~s\n" ex)
>                                           (raise ex)))
>                                 (thread-wait-for-i/o! fdw #:output))
>                                (loop len off)]
>                               [(eq? -1 n)
>                                (##sys#update-errno)
>                                (##sys#signal-hook
>                                 #:process-error 'process-io-write
>                                 "can not write to fd" fdw len strerror) ]
>                               [(fx< n len)
>                                (loop (fx- len n) (fx+ off n)) ] )
>                         (process-io-update-bandwith! (##sys#size s) 
> start-time) ))))
>               (lambda ()
>                 (unless oclosed
>                         (set! oclosed #t)
>                         (when (eq? -1 (file-close-fd! fdw))
>                               (##sys#update-errno)
>                               (##sys#signal-hook #:process-error 
> 'process-io-close
>                                                  "can not close fd output 
> port" fdw) )
>                         (if iclosed
>                             (receive (p f s) (process-wait-for-pid pid) s)
>                             (receive (p f s) (process-test-pid pid)
>                                      (when (eqv? p pid)
>                                            (set! iclosed #t)
>                                            (when (eq? -1 (file-close-fd! fdr))
>                                                  (##sys#update-errno)
>                                                  (##sys#signal-hook 
> #:process-error 'process-io-close
>                                                                     "can not 
> close fd input port" fdr) ) s)))) ))) ] )
>       (values in out) ) ) ) )
> 
> 
> _______________________________________________
> Chicken-users mailing list
> address@hidden
> https://lists.nongnu.org/mailman/listinfo/chicken-users

-- 
.i ma'a lo bradi cu penmi gi'e du