Add inotify bindings: C shim, R6RS library, and tests

ober

6a6fd0e1e6285d8f0b55217caf8952c608ca306f

diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..74cfe15
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,16 @@
+CC = gcc
+CFLAGS = -shared -fPIC -O2
+SCHEME = scheme
+
+.PHONY: all clean test
+
+all: chez_inotify_shim.so
+
+chez_inotify_shim.so: chez_inotify_shim.c
+	$(CC) $(CFLAGS) -o $@ $<
+
+test: chez_inotify_shim.so
+	LD_LIBRARY_PATH=. $(SCHEME) --libdirs src --script tests/inotify-test.ss
+
+clean:
+	rm -f chez_inotify_shim.so
diff --git a/chez_inotify_shim.c b/chez_inotify_shim.c
new file mode 100644
index 0000000..ae0bae0
--- /dev/null
+++ b/chez_inotify_shim.c
@@ -0,0 +1,122 @@
+/* chez_inotify_shim.c — Linux inotify wrapper for Chez Scheme FFI */
+
+#include <sys/inotify.h>
+#include <unistd.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+#include <poll.h>
+
+/* Create an inotify instance with NONBLOCK and CLOEXEC flags.
+   Returns fd or -errno. */
+int chez_inotify_init(void) {
+    int fd = inotify_init1(IN_NONBLOCK | IN_CLOEXEC);
+    if (fd < 0) return -errno;
+    return fd;
+}
+
+/* Add a watch. Returns watch descriptor or -errno. */
+int chez_inotify_add_watch(int fd, const char *path, unsigned int mask) {
+    int wd = inotify_add_watch(fd, path, mask);
+    if (wd < 0) return -errno;
+    return wd;
+}
+
+/* Remove a watch. Returns 0 or -errno. */
+int chez_inotify_rm_watch(int fd, int wd) {
+    if (inotify_rm_watch(fd, wd) < 0) return -errno;
+    return 0;
+}
+
+/* Read events into buffer. Returns bytes read, 0 if nothing available,
+   or -errno on error. */
+int chez_inotify_read(int fd, unsigned char *buf, int buflen) {
+    int n = read(fd, buf, buflen);
+    if (n < 0) {
+        if (errno == EAGAIN || errno == EWOULDBLOCK) return 0;
+        return -errno;
+    }
+    return n;
+}
+
+/* Poll for readability with timeout_ms (-1 = block, 0 = poll).
+   Returns 1 if readable, 0 if timeout, -errno on error. */
+int chez_inotify_poll(int fd, int timeout_ms) {
+    struct pollfd pfd;
+    pfd.fd = fd;
+    pfd.events = POLLIN;
+    int rc = poll(&pfd, 1, timeout_ms);
+    if (rc < 0) return -errno;
+    return rc;
+}
+
+/* Close an inotify fd. */
+int chez_inotify_close(int fd) {
+    return close(fd);
+}
+
+/* --- Event parsing helpers --- */
+
+/* Get the size of struct inotify_event (without name). */
+int chez_inotify_event_base_size(void) {
+    return sizeof(struct inotify_event);
+}
+
+/* Extract wd from event at offset in buffer. */
+int chez_inotify_event_wd(unsigned char *buf, int offset) {
+    return ((struct inotify_event *)(buf + offset))->wd;
+}
+
+/* Extract mask from event at offset. */
+unsigned int chez_inotify_event_mask(unsigned char *buf, int offset) {
+    return ((struct inotify_event *)(buf + offset))->mask;
+}
+
+/* Extract cookie from event at offset. */
+unsigned int chez_inotify_event_cookie(unsigned char *buf, int offset) {
+    return ((struct inotify_event *)(buf + offset))->cookie;
+}
+
+/* Extract name length from event at offset. */
+unsigned int chez_inotify_event_len(unsigned char *buf, int offset) {
+    return ((struct inotify_event *)(buf + offset))->len;
+}
+
+/* Get pointer to name string (may be empty). */
+const char *chez_inotify_event_name(unsigned char *buf, int offset) {
+    struct inotify_event *ev = (struct inotify_event *)(buf + offset);
+    if (ev->len == 0) return "";
+    return ev->name;
+}
+
+/* Get total size of event at offset (header + name). */
+int chez_inotify_event_size(unsigned char *buf, int offset) {
+    struct inotify_event *ev = (struct inotify_event *)(buf + offset);
+    return sizeof(struct inotify_event) + ev->len;
+}
+
+/* Constants */
+unsigned int chez_IN_ACCESS(void)        { return IN_ACCESS; }
+unsigned int chez_IN_ATTRIB(void)        { return IN_ATTRIB; }
+unsigned int chez_IN_CLOSE_WRITE(void)   { return IN_CLOSE_WRITE; }
+unsigned int chez_IN_CLOSE_NOWRITE(void) { return IN_CLOSE_NOWRITE; }
+unsigned int chez_IN_CREATE(void)        { return IN_CREATE; }
+unsigned int chez_IN_DELETE(void)        { return IN_DELETE; }
+unsigned int chez_IN_DELETE_SELF(void)   { return IN_DELETE_SELF; }
+unsigned int chez_IN_MODIFY(void)        { return IN_MODIFY; }
+unsigned int chez_IN_MOVE_SELF(void)     { return IN_MOVE_SELF; }
+unsigned int chez_IN_MOVED_FROM(void)    { return IN_MOVED_FROM; }
+unsigned int chez_IN_MOVED_TO(void)      { return IN_MOVED_TO; }
+unsigned int chez_IN_OPEN(void)          { return IN_OPEN; }
+unsigned int chez_IN_ALL_EVENTS(void)    { return IN_ALL_EVENTS; }
+unsigned int chez_IN_MOVE(void)          { return IN_MOVE; }
+unsigned int chez_IN_CLOSE(void)         { return IN_CLOSE; }
+unsigned int chez_IN_DONT_FOLLOW(void)   { return IN_DONT_FOLLOW; }
+unsigned int chez_IN_EXCL_UNLINK(void)   { return IN_EXCL_UNLINK; }
+unsigned int chez_IN_MASK_ADD(void)      { return IN_MASK_ADD; }
+unsigned int chez_IN_ONESHOT(void)       { return IN_ONESHOT; }
+unsigned int chez_IN_ONLYDIR(void)       { return IN_ONLYDIR; }
+unsigned int chez_IN_IGNORED(void)       { return IN_IGNORED; }
+unsigned int chez_IN_ISDIR(void)         { return IN_ISDIR; }
+unsigned int chez_IN_Q_OVERFLOW(void)    { return IN_Q_OVERFLOW; }
+unsigned int chez_IN_UNMOUNT(void)       { return IN_UNMOUNT; }
diff --git a/src/chez-inotify.sls b/src/chez-inotify.sls
new file mode 100644
index 0000000..297e03b
--- /dev/null
+++ b/src/chez-inotify.sls
@@ -0,0 +1,125 @@
+#!chezscheme
+;;; chez-inotify — Linux inotify for Chez Scheme
+
+(library (chez-inotify)
+  (export
+    ;; Core API
+    inotify-init inotify-close
+    inotify-add-watch inotify-rm-watch
+    inotify-read-events inotify-poll
+    ;; Event record
+    make-inotify-event inotify-event?
+    inotify-event-wd inotify-event-mask
+    inotify-event-cookie inotify-event-name
+    ;; Constants — watch masks
+    IN_ACCESS IN_ATTRIB IN_CLOSE_WRITE IN_CLOSE_NOWRITE
+    IN_CREATE IN_DELETE IN_DELETE_SELF IN_MODIFY
+    IN_MOVE_SELF IN_MOVED_FROM IN_MOVED_TO IN_OPEN
+    IN_ALL_EVENTS IN_MOVE IN_CLOSE
+    ;; Constants — watch flags
+    IN_DONT_FOLLOW IN_EXCL_UNLINK IN_MASK_ADD IN_ONESHOT IN_ONLYDIR
+    ;; Constants — event flags
+    IN_IGNORED IN_ISDIR IN_Q_OVERFLOW IN_UNMOUNT)
+
+  (import (chezscheme))
+
+  ;; Load the C shim
+  (define _loaded (load-shared-object "chez_inotify_shim.so"))
+
+  ;; ---- FFI bindings ----
+  (define c-init       (foreign-procedure "chez_inotify_init" () int))
+  (define c-add-watch  (foreign-procedure "chez_inotify_add_watch" (int string unsigned-int) int))
+  (define c-rm-watch   (foreign-procedure "chez_inotify_rm_watch" (int int) int))
+  (define c-read       (foreign-procedure "chez_inotify_read" (int u8* int) int))
+  (define c-poll       (foreign-procedure "chez_inotify_poll" (int int) int))
+  (define c-close      (foreign-procedure "chez_inotify_close" (int) int))
+  (define c-event-wd     (foreign-procedure "chez_inotify_event_wd" (u8* int) int))
+  (define c-event-mask   (foreign-procedure "chez_inotify_event_mask" (u8* int) unsigned-int))
+  (define c-event-cookie (foreign-procedure "chez_inotify_event_cookie" (u8* int) unsigned-int))
+  (define c-event-name   (foreign-procedure "chez_inotify_event_name" (u8* int) string))
+  (define c-event-size   (foreign-procedure "chez_inotify_event_size" (u8* int) int))
+
+  ;; ---- Constants ----
+  (define IN_ACCESS        ((foreign-procedure "chez_IN_ACCESS" () unsigned-int)))
+  (define IN_ATTRIB        ((foreign-procedure "chez_IN_ATTRIB" () unsigned-int)))
+  (define IN_CLOSE_WRITE   ((foreign-procedure "chez_IN_CLOSE_WRITE" () unsigned-int)))
+  (define IN_CLOSE_NOWRITE ((foreign-procedure "chez_IN_CLOSE_NOWRITE" () unsigned-int)))
+  (define IN_CREATE        ((foreign-procedure "chez_IN_CREATE" () unsigned-int)))
+  (define IN_DELETE        ((foreign-procedure "chez_IN_DELETE" () unsigned-int)))
+  (define IN_DELETE_SELF   ((foreign-procedure "chez_IN_DELETE_SELF" () unsigned-int)))
+  (define IN_MODIFY        ((foreign-procedure "chez_IN_MODIFY" () unsigned-int)))
+  (define IN_MOVE_SELF     ((foreign-procedure "chez_IN_MOVE_SELF" () unsigned-int)))
+  (define IN_MOVED_FROM    ((foreign-procedure "chez_IN_MOVED_FROM" () unsigned-int)))
+  (define IN_MOVED_TO      ((foreign-procedure "chez_IN_MOVED_TO" () unsigned-int)))
+  (define IN_OPEN          ((foreign-procedure "chez_IN_OPEN" () unsigned-int)))
+  (define IN_ALL_EVENTS    ((foreign-procedure "chez_IN_ALL_EVENTS" () unsigned-int)))
+  (define IN_MOVE          ((foreign-procedure "chez_IN_MOVE" () unsigned-int)))
+  (define IN_CLOSE         ((foreign-procedure "chez_IN_CLOSE" () unsigned-int)))
+  (define IN_DONT_FOLLOW   ((foreign-procedure "chez_IN_DONT_FOLLOW" () unsigned-int)))
+  (define IN_EXCL_UNLINK   ((foreign-procedure "chez_IN_EXCL_UNLINK" () unsigned-int)))
+  (define IN_MASK_ADD      ((foreign-procedure "chez_IN_MASK_ADD" () unsigned-int)))
+  (define IN_ONESHOT       ((foreign-procedure "chez_IN_ONESHOT" () unsigned-int)))
+  (define IN_ONLYDIR       ((foreign-procedure "chez_IN_ONLYDIR" () unsigned-int)))
+  (define IN_IGNORED       ((foreign-procedure "chez_IN_IGNORED" () unsigned-int)))
+  (define IN_ISDIR         ((foreign-procedure "chez_IN_ISDIR" () unsigned-int)))
+  (define IN_Q_OVERFLOW    ((foreign-procedure "chez_IN_Q_OVERFLOW" () unsigned-int)))
+  (define IN_UNMOUNT       ((foreign-procedure "chez_IN_UNMOUNT" () unsigned-int)))
+
+  ;; ---- Error handling ----
+  (define (check-rc who rc)
+    (when (< rc 0)
+      (error who (format "errno ~a" (- rc)))))
+
+  ;; ---- Event record ----
+  (define-record-type inotify-event
+    (fields wd mask cookie name))
+
+  ;; ---- Public API ----
+
+  ;; Create an inotify instance. Returns fd.
+  (define (inotify-init)
+    (let ([rc (c-init)])
+      (check-rc 'inotify-init rc)
+      rc))
+
+  ;; Close an inotify fd.
+  (define (inotify-close fd)
+    (c-close fd))
+
+  ;; Add a watch on path with event mask. Returns watch descriptor.
+  (define (inotify-add-watch fd path mask)
+    (let ([rc (c-add-watch fd path mask)])
+      (check-rc 'inotify-add-watch rc)
+      rc))
+
+  ;; Remove a watch by descriptor.
+  (define (inotify-rm-watch fd wd)
+    (let ([rc (c-rm-watch fd wd)])
+      (check-rc 'inotify-rm-watch rc)))
+
+  ;; Poll for readability. timeout-ms: -1 = block, 0 = poll, >0 = ms.
+  ;; Returns #t if data available, #f if timeout.
+  (define (inotify-poll fd timeout-ms)
+    (let ([rc (c-poll fd timeout-ms)])
+      (check-rc 'inotify-poll rc)
+      (> rc 0)))
+
+  ;; Read all pending events. Returns list of inotify-event records.
+  ;; If no events available, returns '().
+  (define (inotify-read-events fd)
+    (let ([buf (make-bytevector 4096 0)])
+      (let ([n (c-read fd buf 4096)])
+        (check-rc 'inotify-read-events n)
+        (if (= n 0) '()
+          (let loop ([offset 0] [events '()])
+            (if (>= offset n) (reverse events)
+              (let ([ev (make-inotify-event
+                          (c-event-wd buf offset)
+                          (c-event-mask buf offset)
+                          (c-event-cookie buf offset)
+                          (let ([name (c-event-name buf offset)])
+                            (if (string=? name "") #f name)))]
+                    [sz (c-event-size buf offset)])
+                (loop (+ offset sz) (cons ev events)))))))))
+
+  ) ;; end library
diff --git a/tests/inotify-test.ss b/tests/inotify-test.ss
new file mode 100644
index 0000000..08127c0
--- /dev/null
+++ b/tests/inotify-test.ss
@@ -0,0 +1,87 @@
+#!chezscheme
+;;; inotify-test.ss — Tests for chez-inotify
+
+(import (chezscheme) (chez-inotify))
+
+(define pass-count 0)
+(define fail-count 0)
+
+(define-syntax chk
+  (syntax-rules (=>)
+    [(_ expr => expected)
+     (let ([result expr] [exp expected])
+       (if (equal? result exp)
+         (set! pass-count (+ pass-count 1))
+         (begin (set! fail-count (+ fail-count 1))
+                (display "FAIL: ") (write 'expr)
+                (display " => ") (write result)
+                (display " expected ") (write exp) (newline))))]))
+
+;;; Constants
+(chk (> IN_CREATE 0) => #t)
+(chk (> IN_DELETE 0) => #t)
+(chk (> IN_MODIFY 0) => #t)
+(chk (> IN_ALL_EVENTS 0) => #t)
+(chk (> IN_ISDIR 0) => #t)
+
+;;; Create and close
+(let ([fd (inotify-init)])
+  (chk (> fd 0) => #t)
+  (inotify-close fd))
+
+;;; Watch a temp directory, create a file, read events
+(let ([dir (format "/tmp/chez-inotify-test-~a" (random 1000000))])
+  (mkdir dir)
+  (let ([fd (inotify-init)])
+    (let ([wd (inotify-add-watch fd dir (bitwise-ior IN_CREATE IN_DELETE))])
+      (chk (>= wd 0) => #t)
+
+      ;; Create a file in the watched directory
+      (let ([test-file (format "~a/testfile.txt" dir)])
+        (call-with-output-file test-file
+          (lambda (p) (display "hello" p)))
+
+        ;; Poll for events (should be ready)
+        (chk (inotify-poll fd 100) => #t)
+
+        ;; Read events
+        (let ([events (inotify-read-events fd)])
+          (chk (> (length events) 0) => #t)
+          (let ([ev (car events)])
+            (chk (= (inotify-event-wd ev) wd) => #t)
+            (chk (> (bitwise-and (inotify-event-mask ev) IN_CREATE) 0) => #t)
+            (chk (equal? (inotify-event-name ev) "testfile.txt") => #t)))
+
+        ;; Delete the file
+        (delete-file test-file)
+
+        ;; Read delete event
+        (when (inotify-poll fd 100)
+          (let ([events (inotify-read-events fd)])
+            (chk (> (length events) 0) => #t)
+            (let ([ev (car events)])
+              (chk (> (bitwise-and (inotify-event-mask ev) IN_DELETE) 0) => #t)))))
+
+      ;; Remove watch and close
+      (inotify-rm-watch fd wd))
+    (inotify-close fd))
+  ;; Cleanup
+  (delete-directory dir #f))
+
+;;; No events available — returns empty list
+(let ([dir (format "/tmp/chez-inotify-test2-~a" (random 1000000))])
+  (mkdir dir)
+  (let ([fd (inotify-init)])
+    (inotify-add-watch fd dir IN_CREATE)
+    (chk (inotify-poll fd 0) => #f)  ;; no events
+    (chk (null? (inotify-read-events fd)) => #t)
+    (inotify-close fd))
+  (delete-directory dir #f))
+
+;;; Summary
+(newline)
+(display "inotify tests: ")
+(display pass-count) (display " passed, ")
+(display fail-count) (display " failed")
+(newline)
+(when (> fail-count 0) (exit 1))