How to abort a read from a socket after some time?

[Tomas Volf <~@wolfsden.cz>]

[-- Attachment #1: Type: text/plain, Size: 3855 bytes --]

Hello,

I am trying to figure out how to abort a read from a socket after some time
elapses.  I failed to figure out how to do so.

All code below runs after handler is set:

    (sigaction SIGALRM (lambda _ (display "Alarm!\n")))

The (time) procedure is just modified ,time from the REPL, full code at the end
of the email.

I started with the usual C way, alarm, and tested it with a sleep:

    (display "Sleep:\n")
    (alarm 1)
    (time (λ () (sleep 3)))

That does seems to work fine:

    Sleep:
    Alarm!
    ;; Result: 1
    ;; 1.000361s real time, 0.000119s run time.  0.000000s spent in GC.

However when I moved to the sockets, I quickly hit a wall:

    (display "read-char:\n")
    (let* ((ai (car (getaddrinfo "www.gnu.org" "http")))
           (s  (socket (addrinfo:fam ai)
                       (addrinfo:socktype ai)
                       (addrinfo:protocol ai))))
      (connect s (addrinfo:addr ai))
      (alarm 1)
      (time (λ () (read-char s))))

That does hang for a long time:

    read-char:
    Alarm!
    ;; Result: #<eof>
    ;; 51.742715s real time, 0.000375s run time.  0.000000s spent in GC.

The alarm was obviously triggered, but the read-char was not interrupted.  I
would have expected to receive (maybe as an exception) EINTR.

When I try non-blocking code:

    (display "read-char (non-block):\n")
    (let* ((ai (car (getaddrinfo "www.gnu.org" "http")))
           (s  (socket (addrinfo:fam ai)
                       (addrinfo:socktype ai)
                       (addrinfo:protocol ai))))
      (connect s (addrinfo:addr ai))
      (let ((flags (fcntl s F_GETFL)))
        (fcntl s F_SETFL (logior O_NONBLOCK flags)))
      (alarm 1)
      (time (λ () (read-char s))))

It still does not work:

    read-char (non-block):
    Alarm!
    ;; Result: #<eof>
    ;; 51.581392s real time, 0.000371s run time.  0.000000s spent in GC.

I would have expected to receive EWOULDBLOCK.  But let's not get distracted by
the non-blocking variant.

So, what would be a good way to do this?

Thank you for any advice on this.

Have a nice day,
Tomas Volf



Here is full script I used for playing with this:

;;; I took this code from ,time implementation.
(use-modules (ice-9 format))
(define (time thunk)
  (let* ((gc-start (gc-run-time))
         (real-start (get-internal-real-time))
         (run-start (get-internal-run-time))
         (result (thunk))
         (run-end (get-internal-run-time))
         (real-end (get-internal-real-time))
         (gc-end (gc-run-time)))
    (define (diff start end)
      (/ (- end start) 1.0 internal-time-units-per-second))
    (format #t ";; Result: ~s\n" result)
    (format #t ";; ~,6Fs real time, ~,6Fs run time.  ~,6Fs spent in GC.\n"
            (diff real-start real-end)
            (diff run-start run-end)
            (diff gc-start gc-end))
    result))

(sigaction SIGALRM (lambda _ (display "Alarm!\n")))

(display "Sleep:\n")
(alarm 1)
(time (λ () (sleep 3)))

(display "read-char:\n")
(let* ((ai (car (getaddrinfo "www.gnu.org" "http")))
       (s  (socket (addrinfo:fam ai)
                   (addrinfo:socktype ai)
                   (addrinfo:protocol ai))))
  (connect s (addrinfo:addr ai))
  (alarm 1)
  (time (λ () (read-char s))))

(display "read-char (non-block):\n")
(let* ((ai (car (getaddrinfo "www.gnu.org" "http")))
       (s  (socket (addrinfo:fam ai)
                   (addrinfo:socktype ai)
                   (addrinfo:protocol ai))))
  (connect s (addrinfo:addr ai))
  (let ((flags (fcntl s F_GETFL)))
    (fcntl s F_SETFL (logior O_NONBLOCK flags)))
  (alarm 1)
  (time (λ () (read-char s))))


--
There are only two hard things in Computer Science:
cache invalidation, naming things and off-by-one errors.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]