Migrate chez-inotify to jerboa-inotify
ober
28dcf7d31abbedb7c3a167f22b8896222721440e
new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +lib/ +*.so +*.dylib +*.wpo +*.o +.jerbuild-hashes --- a/Makefile +++ b/Makefile @@ -1,16 +1,40 @@ -CC = gcc -CFLAGS = -shared -fPIC -O2 -SCHEME = scheme +JERBOA_HOME ?= $(HOME)/mine/jerboa +SCHEME ?= $(JERBOA_HOME)/.chez/bin/scheme +JERBUILD ?= $(JERBOA_HOME)/jerbuild +LIBDIRS = lib:$(JERBOA_HOME)/lib -.PHONY: all clean test +CC ?= cc +CFLAGS ?= -shared -fPIC -O2 +LIBS ?= +SHIM = jerboa_inotify_shim.so -all: chez_inotify_shim.so +UNAME_S := $(shell uname -s) -chez_inotify_shim.so: chez_inotify_shim.c - $(CC) $(CFLAGS) -o $@ $< +.PHONY: all build transpile test clean shim platform-check -test: chez_inotify_shim.so - LD_LIBRARY_PATH=. $(SCHEME) --libdirs src --script tests/inotify-test.ss +all: build + +platform-check: + @if [ "$(UNAME_S)" != "Linux" ]; then \ + echo "inotify is a Linux kernel API; shim build + tests require Linux ($(UNAME_S) detected)."; \ + exit 1; \ + fi + +shim: platform-check $(SHIM) + +$(SHIM): jerboa_inotify_shim.c + $(CC) $(CFLAGS) -o $@ $< $(LIBS) + +transpile: + $(JERBUILD) transpile src lib --force + +build: transpile shim + +test: build + JERBOA_INOTIFY_LIB=$(CURDIR) \ + LD_LIBRARY_PATH=$(CURDIR) \ + $(SCHEME) --libdirs "$(LIBDIRS)" --script tests/inotify-test.ss clean: - rm -f chez_inotify_shim.so + rm -f $(SHIM) chez_inotify_shim.so + rm -rf lib deleted file mode 100644 --- a/chez_inotify_shim.c +++ /dev/null @@ -1,122 +0,0 @@ -/* 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; } new file mode 100644 --- /dev/null +++ b/jerboa_inotify_shim.c @@ -0,0 +1,122 @@ +/* jerboa_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 jerboa_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 jerboa_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 jerboa_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 jerboa_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 jerboa_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 jerboa_inotify_close(int fd) { + return close(fd); +} + +/* --- Event parsing helpers --- */ + +/* Get the size of struct inotify_event (without name). */ +int jerboa_inotify_event_base_size(void) { + return sizeof(struct inotify_event); +} + +/* Extract wd from event at offset in buffer. */ +int jerboa_inotify_event_wd(unsigned char *buf, int offset) { + return ((struct inotify_event *)(buf + offset))->wd; +} + +/* Extract mask from event at offset. */ +unsigned int jerboa_inotify_event_mask(unsigned char *buf, int offset) { + return ((struct inotify_event *)(buf + offset))->mask; +} + +/* Extract cookie from event at offset. */ +unsigned int jerboa_inotify_event_cookie(unsigned char *buf, int offset) { + return ((struct inotify_event *)(buf + offset))->cookie; +} + +/* Extract name length from event at offset. */ +unsigned int jerboa_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 *jerboa_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 jerboa_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 jerboa_IN_ACCESS(void) { return IN_ACCESS; } +unsigned int jerboa_IN_ATTRIB(void) { return IN_ATTRIB; } +unsigned int jerboa_IN_CLOSE_WRITE(void) { return IN_CLOSE_WRITE; } +unsigned int jerboa_IN_CLOSE_NOWRITE(void) { return IN_CLOSE_NOWRITE; } +unsigned int jerboa_IN_CREATE(void) { return IN_CREATE; } +unsigned int jerboa_IN_DELETE(void) { return IN_DELETE; } +unsigned int jerboa_IN_DELETE_SELF(void) { return IN_DELETE_SELF; } +unsigned int jerboa_IN_MODIFY(void) { return IN_MODIFY; } +unsigned int jerboa_IN_MOVE_SELF(void) { return IN_MOVE_SELF; } +unsigned int jerboa_IN_MOVED_FROM(void) { return IN_MOVED_FROM; } +unsigned int jerboa_IN_MOVED_TO(void) { return IN_MOVED_TO; } +unsigned int jerboa_IN_OPEN(void) { return IN_OPEN; } +unsigned int jerboa_IN_ALL_EVENTS(void) { return IN_ALL_EVENTS; } +unsigned int jerboa_IN_MOVE(void) { return IN_MOVE; } +unsigned int jerboa_IN_CLOSE(void) { return IN_CLOSE; } +unsigned int jerboa_IN_DONT_FOLLOW(void) { return IN_DONT_FOLLOW; } +unsigned int jerboa_IN_EXCL_UNLINK(void) { return IN_EXCL_UNLINK; } +unsigned int jerboa_IN_MASK_ADD(void) { return IN_MASK_ADD; } +unsigned int jerboa_IN_ONESHOT(void) { return IN_ONESHOT; } +unsigned int jerboa_IN_ONLYDIR(void) { return IN_ONLYDIR; } +unsigned int jerboa_IN_IGNORED(void) { return IN_IGNORED; } +unsigned int jerboa_IN_ISDIR(void) { return IN_ISDIR; } +unsigned int jerboa_IN_Q_OVERFLOW(void) { return IN_Q_OVERFLOW; } +unsigned int jerboa_IN_UNMOUNT(void) { return IN_UNMOUNT; } deleted file mode 100644 --- a/src/chez-inotify.sls +++ /dev/null @@ -1,125 +0,0 @@ -#!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 new file mode 100644 --- /dev/null +++ b/src/jerboa-inotify.ss @@ -0,0 +1,124 @@ +#!chezscheme +;;; chez-inotify — Linux inotify for Chez Scheme + + (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 (jerboa prelude)) + + ;; Load the C shim + (def _loaded (load-shared-object "jerboa_inotify_shim.so")) + + ;; ---- FFI bindings ---- + (def c-init (foreign-procedure "jerboa_inotify_init" () int)) + (def c-add-watch (foreign-procedure "jerboa_inotify_add_watch" (int string unsigned-int) int)) + (def c-rm-watch (foreign-procedure "jerboa_inotify_rm_watch" (int int) int)) + (def c-read (foreign-procedure "jerboa_inotify_read" (int u8* int) int)) + (def c-poll (foreign-procedure "jerboa_inotify_poll" (int int) int)) + (def c-close (foreign-procedure "jerboa_inotify_close" (int) int)) + (def c-event-wd (foreign-procedure "jerboa_inotify_event_wd" (u8* int) int)) + (def c-event-mask (foreign-procedure "jerboa_inotify_event_mask" (u8* int) unsigned-int)) + (def c-event-cookie (foreign-procedure "jerboa_inotify_event_cookie" (u8* int) unsigned-int)) + (def c-event-name (foreign-procedure "jerboa_inotify_event_name" (u8* int) string)) + (def c-event-size (foreign-procedure "jerboa_inotify_event_size" (u8* int) int)) + + ;; ---- Constants ---- + (def IN_ACCESS ((foreign-procedure "jerboa_IN_ACCESS" () unsigned-int))) + (def IN_ATTRIB ((foreign-procedure "jerboa_IN_ATTRIB" () unsigned-int))) + (def IN_CLOSE_WRITE ((foreign-procedure "jerboa_IN_CLOSE_WRITE" () unsigned-int))) + (def IN_CLOSE_NOWRITE ((foreign-procedure "jerboa_IN_CLOSE_NOWRITE" () unsigned-int))) + (def IN_CREATE ((foreign-procedure "jerboa_IN_CREATE" () unsigned-int))) + (def IN_DELETE ((foreign-procedure "jerboa_IN_DELETE" () unsigned-int))) + (def IN_DELETE_SELF ((foreign-procedure "jerboa_IN_DELETE_SELF" () unsigned-int))) + (def IN_MODIFY ((foreign-procedure "jerboa_IN_MODIFY" () unsigned-int))) + (def IN_MOVE_SELF ((foreign-procedure "jerboa_IN_MOVE_SELF" () unsigned-int))) + (def IN_MOVED_FROM ((foreign-procedure "jerboa_IN_MOVED_FROM" () unsigned-int))) + (def IN_MOVED_TO ((foreign-procedure "jerboa_IN_MOVED_TO" () unsigned-int))) + (def IN_OPEN ((foreign-procedure "jerboa_IN_OPEN" () unsigned-int))) + (def IN_ALL_EVENTS ((foreign-procedure "jerboa_IN_ALL_EVENTS" () unsigned-int))) + (def IN_MOVE ((foreign-procedure "jerboa_IN_MOVE" () unsigned-int))) + (def IN_CLOSE ((foreign-procedure "jerboa_IN_CLOSE" () unsigned-int))) + (def IN_DONT_FOLLOW ((foreign-procedure "jerboa_IN_DONT_FOLLOW" () unsigned-int))) + (def IN_EXCL_UNLINK ((foreign-procedure "jerboa_IN_EXCL_UNLINK" () unsigned-int))) + (def IN_MASK_ADD ((foreign-procedure "jerboa_IN_MASK_ADD" () unsigned-int))) + (def IN_ONESHOT ((foreign-procedure "jerboa_IN_ONESHOT" () unsigned-int))) + (def IN_ONLYDIR ((foreign-procedure "jerboa_IN_ONLYDIR" () unsigned-int))) + (def IN_IGNORED ((foreign-procedure "jerboa_IN_IGNORED" () unsigned-int))) + (def IN_ISDIR ((foreign-procedure "jerboa_IN_ISDIR" () unsigned-int))) + (def IN_Q_OVERFLOW ((foreign-procedure "jerboa_IN_Q_OVERFLOW" () unsigned-int))) + (def IN_UNMOUNT ((foreign-procedure "jerboa_IN_UNMOUNT" () unsigned-int))) + + ;; ---- Error handling ---- + (def (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. + (def (inotify-init) + (let ([rc (c-init)]) + (check-rc 'inotify-init rc) + rc)) + + ;; Close an inotify fd. + (def (inotify-close fd) + (c-close fd)) + + ;; Add a watch on path with event mask. Returns watch descriptor. + (def (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. + (def (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. + (def (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 '(). + (def (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))))))))) + + --- a/tests/inotify-test.ss +++ b/tests/inotify-test.ss @@ -1,7 +1,7 @@ #!chezscheme ;;; inotify-test.ss — Tests for chez-inotify -(import (chezscheme) (chez-inotify)) +(import (chezscheme) (jerboa-inotify)) (define pass-count 0) (define fail-count 0)