-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8; package: cl-inotify; -*-
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
;; Copyright (c) 2011-12, Olof-Joachim Frahm
;; All rights reserved.
(in-package #:cl-inotify)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (boundp 'in-cloexec)
+ (pushnew 'inotify1 *features*)))
+
+#+cl-inotify::inotify1
(defbitfield (inotify1-flag :int)
(:cloexec #.in-cloexec)
(:nonblock #.in-nonblock))
'(or (satisfies valid-watch-flag-p)
(and list (satisfies valid-watch-flag-list-p))))
-(defcfun ("inotify_init" c-inotify-init) :int
+(defsyscall inotify-init :int
"Initialises a new inotify event queue.")
-(defcfun ("inotify_add_watch" c-inotify-add-watch) :int
- "Watches a path on a event queue."
+#+cl-inotify::inotify1
+(defsyscall inotify-init1 :int
+ "Initialises a new inotify event queue and passes some flags along."
+ (flags inotify1-flag))
+
+(defsyscall inotify-add-watch :int
+ "Watches a path on an event queue."
(fd :int)
(pathname :string)
(mask inotify-flag))
-(defcfun ("inotify_rm_watch" c-inotify-rm-watch) :int
- "Removes a watched path from a event queue."
+(defsyscall inotify-rm-watch :int
+ "Removes a watched path from an event queue."
(fd :int)
(wd :int))
(defun set-nonblocking (fd nonblocking)
"Enables or disables NONBLOCKING mode on a file descriptor FD."
- (let ((flags (sb-posix:fcntl fd sb-posix:f-getfl)))
+ (let ((flags (osicat-posix:fcntl fd osicat-posix:f-getfl)))
;; an error is raised if this fails, so we don't have to do it ourselves
- (sb-posix:fcntl fd sb-posix:f-setfl
- (funcall (if nonblocking #'logior #'logxor)
- flags sb-posix:o-nonblock)))
+ (osicat-posix:fcntl fd osicat-posix:f-setfl
+ (funcall (if nonblocking #'logior #'logxor)
+ flags osicat-posix:o-nonblock)))
(values))
(defun init-unregistered-inotify (inotify &optional (nonblocking T))
"Creates a new inotify event queue. If NONBLOCKING is set (default),
the file descriptor is set to non-blocking I/O."
- (let ((result (c-inotify-init)))
- (when (minusp result)
- (perror "inotify_init failed"))
- (with-slots (fd stream (non-block nonblocking)) inotify
- (unwind-protect
- ;; file descriptor is collected with auto-close
- (progn
- (setf fd result)
- (when nonblocking
- (set-nonblocking fd T)
- (setf non-block nonblocking))
- (setf stream
- (sb-sys:make-fd-stream
- fd
- :input T
- :element-type '(unsigned-byte 8)
- :name (format NIL "inotify event queue ~A" fd)
- :auto-close T
- :buffering (if nonblocking :none :full))))
- ;; if stream is constructed, gc'ing it will cleanup the file descriptor
- (unless stream
- (sb-posix:close fd)))))
+ (with-slots (fd stream (non-block nonblocking)) inotify
+ (unwind-protect
+ ;; file descriptor is collected with auto-close
+ (progn
+ (setf non-block nonblocking)
+ #+inotify1
+ (setf fd (inotify-init1 (and non-block :nonblock)))
+ #-inotify1
+ (setf fd (inotify-init))
+ #-inotify1
+ (when non-block
+ (set-nonblocking fd T))
+ (setf stream
+ ;; TODO: what about the blocking?
+ #-(or clisp sbcl)
+ (osicat::make-fd-stream
+ fd
+ :direction :input
+ :element-type '(unsigned-byte 8))
+ #+clisp
+ (ext:make-stream
+ fd
+ :direction :input
+ :element-type '(unsigned-byte 8)
+ :buffered (not nonblocking))
+ #+sbcl
+ (sb-sys:make-fd-stream
+ fd
+ :input T
+ :element-type '(unsigned-byte 8)
+ :name (format NIL "inotify event queue ~A" fd)
+ :auto-close T
+ :buffering (if nonblocking :none :full))))
+ ;; if stream is constructed, gc'ing it will cleanup the file descriptor
+ ;; TODO: is this true for clisp? because the docs say that
+ ;; EXT:MAKE-STREAM uses dup(2)
+ (unless stream
+ (osicat-posix:close fd))))
inotify)
(defun make-unregistered-inotify (&optional (nonblocking T))
(close (inotify-stream inotify))
(values))
-(defun perror (prefix-string)
- #+sbcl (sb-int:simple-perror prefix-string)
- #-(or sbcl) (error prefix-string))
-
(defun ensure-list (arg)
(if (listp arg) arg `(,arg)))
for validity though). Returns a handle which can be used with UNWATCH-RAW."
(let* ((path (etypecase pathname
(string pathname)
- (pathname (namestring pathname))))
- (result (c-inotify-add-watch (inotify-fd inotify)
- path (translate-keyword-flags flags))))
- (when (minusp result)
- (perror "inotify_add_watch failed"))
- result))
+ (pathname (namestring pathname)))))
+ (inotify-add-watch (inotify-fd inotify)
+ path (translate-keyword-flags flags))))
(defun unwatch-raw (inotify handle)
"Stops watching the path associated with a HANDLE established by WATCH-RAW."
- (let ((result (c-inotify-rm-watch (inotify-fd inotify) handle)))
- (when (minusp result)
- (perror "inotify_rm_watch failed")))
+ (inotify-rm-watch (inotify-fd inotify) handle)
(values))
;;;; support functions, making life easier
for pathname being each hash-key in (inotify-watched inotify)
collect pathname))
-(defun unix-eagain-p (fd-stream)
- "Returns T on a FD-STREAM if trying to read from the stream raised a
-EAGAIN error."
- (multiple-value-bind (result error)
- (sb-unix:unix-read (sb-sys:fd-stream-fd fd-stream) NIL 0)
- (declare (ignore result))
- (= error sb-unix:eagain)))
+(defun unix-eagain-p (fd)
+ "Returns T on a file descriptor if trying to read raised an EAGAIN
+error."
+ (handler-case (prog1 NIL (osicat-posix:read fd (null-pointer) 0))
+ ;; we have to check for both to be portable, says read(2)
+ (osicat-posix:eagain () T)
+ (osicat-posix:ewouldblock () T)
+ ;; this is set if the kernel is newer than 2.6.21 if the buffer is
+ ;; too small to get the next event (which it certainly is)
+ (osicat-posix:einval () NIL)))
(defun event-available-p (inotify)
"Returns T if an event is available on the queue."
(if (inotify-nonblocking inotify)
- (not (unix-eagain-p (inotify-stream inotify)))
+ (not (unix-eagain-p (inotify-fd inotify)))
(listen (inotify-stream inotify))))
(defun read-event (inotify)
(defmacro do-events ((var inotify &key blocking-p) &body body)
"Loops BODY with VAR bound to the next events retrieved from INOTIFY.
The macro uses NEXT-EVENT, so reading an event won't block and the loop
-terminates if no events are available."
+terminates if no events are available. If BLOCKING-P is set, the loop
+blocks if no events are available, otherwise it exits as soon as no
+events were encountered."
(check-type var symbol)
(let ((inotify-sym (gensym)))
`(loop
(defmacro with-unregistered-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
"Like WITH-INOTIFY, but uses MAKE-UNREGISTERED-INOTIFY and WATCH-RAW
instead. Useful if you need to monitor just a fixed set of paths."
- `(let* ((,inotify (make-unregistered-inotify ,nonblocking)))
+ `(let ((,inotify (make-unregistered-inotify ,nonblocking)))
(unwind-protect
(progn
,.(mapcar (lambda (specifier)
`(watch-raw ,inotify ,@specifier))
rest)
+ (values)
,@body)
(close-inotify ,inotify))))
Since the QUEUE is closed on unwinding, this macro doesn't bother with
UNWATCH calls on all WATCHed paths."
- `(let* ((,inotify (make-inotify ,nonblocking)))
+ `(let ((,inotify (make-inotify ,nonblocking)))
(unwind-protect
(progn
,.(mapcar (lambda (specifier)
`(watch ,inotify ,@specifier))
rest)
+ (values)
,@body)
(close-inotify ,inotify))))
-
-;; TODO: what about other implementations?
-#+sbcl
-(defmacro with-inotify-event-handler ((inotify
- &optional (nonblocking T) (registered T)
- &rest rest)
- event-handler
- &body body)
- "Registers an INOTIFY queue and runs EVENT-HANDLER with it as only
-parameter whenever input happens while the BODY is executed.
-
-Other parameters are passed to WITH-(UNREGISTERED)-INOTIFY depending on the
-value of REGISTERED (default T)."
- (let ((handle (gensym "HANDLE")))
- `(,(if registered 'with-inotify 'with-unregistered-inotify)
- (,inotify ,nonblocking ,@rest)
- (sb-sys:with-fd-handler
- ((inotify-fd ,inotify)
- :input
- (lambda (,handle)
- (declare (ignore ,handle))
- (funcall ,event-handler ,inotify)))
- ,@body))))
-
-(defun run-inotify-program (program args rest directories flags
- &key function (wait T) event-handler (registered T))
- "Runs a program and records all matched events in all DIRECTORIES using
-FLAGS. If EVENT-HANDLER is set, it is instead called with every available
-event.
-
-PROGRAM, ARGS and REST are the arguments to SB-EXT:RUN-PROGRAM. REST is
-passed on verbatim except for the WAIT parameter, which is set to false.
-
-PROGRAM may also be a FUNCTION, in which case it is called with
-\(ARGS . REST) as arguments and has to return a process object like from
-SB-EXT:RUN-PROGRAM. The process also shouldn't be spawned with WAIT set.
-
-DIRECTORIES is a list of directory arguments for WATCH/-RAW.
-
-WAIT is only valid if FUNCTION is set. If it is true, after FUNCTION has
-returned, we wait until the process has quit.
-
-On supported implementations (SBCL) the FUNCTION parameter may be used to
-do some work while the program is running and watched by the inotify queue.
-It is called with the process object and the inotify queue as arguments."
- (let (events)
- (labels ((run ()
- (typecase program
- (function (apply program args rest))
- (T
- (apply #'sb-ext:run-program program args :wait NIL rest))))
- (events (inotify)
- (do-events (event inotify)
- (if event-handler
- (funcall event-handler event)
- (push event events))))
- (body (inotify)
- (unwind-protect
- (progn
- (let ((register (if registered #'watch #'watch-raw)))
- (mapcar (lambda (directory)
- (funcall register inotify directory flags))
- directories))
- (let ((process (run)))
- (if function
- (unwind-protect
- (funcall function process inotify)
- ;; wait in any case so catching the files will work
- (when wait
- (sb-ext:process-wait process)))
- (loop
- while (sb-ext:process-alive-p process)
- do (events inotify)
- finally (return (if event-handler
- process
- (values (nreverse events) process)))))))
- (close-inotify inotify))))
- (let ((inotify (if registered (make-inotify) (make-unregistered-inotify))))
- (if function
- #-sbcl
- (error "the FUNCTION parameter is only supported on SBCL for now")
- #+sbcl
- (sb-sys:with-fd-handler
- ((inotify-fd inotify)
- :input
- (lambda (handle)
- (declare (ignore handle))
- (events inotify)))
- (body inotify))
- (body inotify))))))