fix: drain inotify queue, poll error reporting, lazy-load synchronization

ober

a8bfe45ba44231c8b3a75f2d4f50b88a78a58272

diff --git a/jerboa_inotify_shim.c b/jerboa_inotify_shim.c
index 2c867ce..bb895ed 100644
--- a/jerboa_inotify_shim.c
+++ b/jerboa_inotify_shim.c
@@ -98,7 +98,13 @@ int jerboa_inotify_poll(int fd, int timeout_ms) {
 
     if (rc < 0) return -errno;
     if (rc == 0) return 0;
-    return (pfd.revents & POLLIN) ? 1 : 0;
+    /* POLLIN means events are ready to read. Error conditions without POLLIN
+     * (POLLERR/POLLHUP/POLLNVAL) return a distinct value so the caller can tell
+     * a hung-up/errored descriptor apart from a timeout (0) instead of silently
+     * treating it as "no events". */
+    if (pfd.revents & POLLIN) return 1;
+    if (pfd.revents & (POLLERR | POLLHUP | POLLNVAL)) return 2;
+    return 0;
 }
 
 int jerboa_inotify_close(int fd) {
diff --git a/src/jerboa-inotify.ss b/src/jerboa-inotify.ss
index 64107f4..eeb5fa0 100644
--- a/src/jerboa-inotify.ss
+++ b/src/jerboa-inotify.ss
@@ -26,7 +26,8 @@
                 native-loader-privileged?
                 native-loader-development-enabled?
                 native-loader-validate-library!
-                native-loader-validate-directory!))
+                native-loader-validate-directory!)
+          (only (std misc thread) make-mutex mutex-lock! mutex-unlock!))
 
   ;; Linux uapi values are stable. Literal constants avoid import-time native
   ;; calls and keep static-binary feature probes safe.
@@ -60,6 +61,7 @@
 
   (def *native-loaded?* #f)
   (def *bindings-ready?* #f)
+  (def *load-lock* (make-mutex))
 
   (def (try-load-one! path)
     (guard (e [(condition? e) #f])
@@ -102,25 +104,34 @@
   (def c-event-size #f)
 
   (def (ensure-bindings!)
-    (when (and (try-load-native!) (not *bindings-ready?*))
-      (set! c-init (c-lambda () int "jerboa_inotify_init"))
-      (set! c-add-watch
-            (foreign-procedure __collect_safe "jerboa_inotify_add_watch_bv"
-              (int u8* int unsigned-int) int))
-      (set! c-rm-watch (c-lambda (int int) int "jerboa_inotify_rm_watch"))
-      (set! c-read
-            (foreign-procedure __collect_safe "jerboa_inotify_read"
-              (int u8* int) int))
-      (set! c-poll
-            (foreign-procedure __collect_safe "jerboa_inotify_poll"
-              (int int) int))
-      (set! c-close (c-lambda (int) int "jerboa_inotify_close"))
-      (set! c-event-wd (c-lambda (u8* int int) int "jerboa_inotify_event_wd"))
-      (set! c-event-mask (c-lambda (u8* int int) unsigned-int "jerboa_inotify_event_mask"))
-      (set! c-event-cookie (c-lambda (u8* int int) unsigned-int "jerboa_inotify_event_cookie"))
-      (set! c-event-name (c-lambda (u8* int int) string "jerboa_inotify_event_name"))
-      (set! c-event-size (c-lambda (u8* int int) int "jerboa_inotify_event_size"))
-      (set! *bindings-ready?* #t))
+    ;; Double-checked locking: the fast path skips the lock once bindings are
+    ;; ready; the lock serializes the one-time load so concurrent callers cannot
+    ;; race the check-then-set of *native-loaded?*/*bindings-ready?*.
+    (when (not *bindings-ready?*)
+      (mutex-lock! *load-lock*)
+      (guard (e [(condition? e)
+                 (mutex-unlock! *load-lock*)
+                 (raise e)])
+        (when (and (try-load-native!) (not *bindings-ready?*))
+          (set! c-init (c-lambda () int "jerboa_inotify_init"))
+          (set! c-add-watch
+                (foreign-procedure __collect_safe "jerboa_inotify_add_watch_bv"
+                  (int u8* int unsigned-int) int))
+          (set! c-rm-watch (c-lambda (int int) int "jerboa_inotify_rm_watch"))
+          (set! c-read
+                (foreign-procedure __collect_safe "jerboa_inotify_read"
+                  (int u8* int) int))
+          (set! c-poll
+                (foreign-procedure __collect_safe "jerboa_inotify_poll"
+                  (int int) int))
+          (set! c-close (c-lambda (int) int "jerboa_inotify_close"))
+          (set! c-event-wd (c-lambda (u8* int int) int "jerboa_inotify_event_wd"))
+          (set! c-event-mask (c-lambda (u8* int int) unsigned-int "jerboa_inotify_event_mask"))
+          (set! c-event-cookie (c-lambda (u8* int int) unsigned-int "jerboa_inotify_event_cookie"))
+          (set! c-event-name (c-lambda (u8* int int) string "jerboa_inotify_event_name"))
+          (set! c-event-size (c-lambda (u8* int int) int "jerboa_inotify_event_size"))
+          (set! *bindings-ready?* #t))
+        (mutex-unlock! *load-lock*)))
     *bindings-ready?*)
 
   (def (need-native who)
@@ -218,22 +229,28 @@
 
   (def (inotify-read-events fd)
     (need-native 'inotify-read-events)
-    (let ([buf (make-bytevector event-buffer-size 0)])
-      (let ([n (check-rc 'inotify-read-events
-                         (c-read (ensure-fd 'inotify-read-events fd)
-                                 buf event-buffer-size))])
-        (if (= n 0)
-            '()
-            (let loop ([offset 0] [events '()])
-              (if (>= offset n)
-                  (reverse events)
-                  (let ([sz (c-event-size buf n offset)])
-                    (unless (and (integer? sz) (> sz 0) (<= (+ offset sz) n))
-                      (error 'inotify-read-events "invalid native event size" sz offset n))
-                    (let ([ev (make-inotify-event
-                                (c-event-wd buf n offset)
-                                (c-event-mask buf n offset)
-                                (c-event-cookie buf n offset)
-                                (let ([name (c-event-name buf n offset)])
-                                  (if (string=? name "") #f name)))])
-                      (loop (+ offset sz) (cons ev events))))))))))
+    (let ([fd (ensure-fd 'inotify-read-events fd)]
+          [buf (make-bytevector event-buffer-size 0)])
+      ;; The inotify fd is created with IN_NONBLOCK (see jerboa_inotify_init),
+      ;; so jerboa_inotify_read returns 0 once the queue is drained (EAGAIN).
+      ;; Keep reading until then so a burst of events larger than one 64KiB
+      ;; buffer is fully drained instead of leaving events pending in the
+      ;; kernel queue for a later call.
+      (let read-loop ([all '()])
+        (let ([n (check-rc 'inotify-read-events
+                           (c-read fd buf event-buffer-size))])
+          (if (= n 0)
+              (reverse all)
+              (let parse-loop ([offset 0] [events all])
+                (if (>= offset n)
+                    (read-loop events)
+                    (let ([sz (c-event-size buf n offset)])
+                      (unless (and (integer? sz) (> sz 0) (<= (+ offset sz) n))
+                        (error 'inotify-read-events "invalid native event size" sz offset n))
+                      (let ([ev (make-inotify-event
+                                  (c-event-wd buf n offset)
+                                  (c-event-mask buf n offset)
+                                  (c-event-cookie buf n offset)
+                                  (let ([name (c-event-name buf n offset)])
+                                    (if (string=? name "") #f name)))])
+                        (parse-loop (+ offset sz) (cons ev events)))))))))))