I.e. src and tests components, use fiveam as usual.
-CL-INOTIFY - Interface to the Linux inotify(7) API.
+CL-INOTIFY - Binding to the Linux inotify(7) API.
Copyright (C) 2011-12 Olof-Joachim Frahm
Implementations currently running on: SBCL.
Uses CFFI, binary-types (from [my Github][1] or see [CLiki][2]) and
-trivial-utf-8. Doesn't use iolib, because I don't need most of the
+trivial-utf-8. Doesn't require iolib, because I don't need most of the
functionality, although it might gain us some implementation
independence (patches which can be conditionally compiled are most
-welcome; in any case patches are welcome).
+welcome; in any case patches are welcome). The tests require fiveam.
A similar package is at [stassats Github][3].
(eval-when (:load-toplevel :execute)
(asdf:operate 'asdf:load-op 'cffi-grovel))
-(asdf:defsystem :cl-inotify
- :description "Inotify binding"
+(asdf:defsystem #:cl-inotify
+ :description "Inotify binding."
:long-description "Binding to the Linux inotify(7) API."
:author "Olof-Joachim Frahm <olof@macrolet.net>"
:license "Simplified BSD License"
#:trivial-utf-8
#:osicat)
:weakly-depends-on (#:iolib)
+ :in-order-to ((asdf:test-op (asdf:load-op #:cl-inotify-tests)))
+ :perform (asdf:test-op :after (op c)
+ (funcall (find-symbol (symbol-name '#:run!) '#:fiveam)
+ (find-symbol (symbol-name '#:cl-inotify) '#:cl-inotify-tests)))
:serial T
- :components ((:file "package")
- (cffi-grovel:grovel-file "grovel")
- (:file "inotify")))
+ :components ((:module "src"
+ :components
+ ((:file "package")
+ (cffi-grovel:grovel-file "grovel")
+ (:file "inotify")))))
+
+(asdf:defsystem #:cl-inotify-tests
+ :depends-on (#:cl-inotify #:fiveam)
+ :serial T
+ :components ((:module "src"
+ :components
+ ((:file "package")
+ (:file "suite")
+ (:file "inotify")))))
+++ /dev/null
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
-
-;; Copyright (c) 2011, Olof-Joachim Frahm
-;; All rights reserved.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package #:cl-inotify)
-
-(include "sys/inotify.h")
-
-;; since 2.6.27 according to inotify_init(2)
-(constant (in-cloexec "IN_CLOEXEC"))
-(constant (in-nonblock "IN_NONBLOCK"))
-(constant (in-access "IN_ACCESS"))
-(constant (in-modify "IN_MODIFY"))
-(constant (in-attrib "IN_ATTRIB"))
-(constant (in-close-write "IN_CLOSE_WRITE"))
-(constant (in-close-nowrite "IN_CLOSE_NOWRITE"))
-(constant (in-close "IN_CLOSE"))
-(constant (in-open "IN_OPEN"))
-(constant (in-moved-from "IN_MOVED_FROM"))
-(constant (in-moved-to "IN_MOVED_TO"))
-(constant (in-move "IN_MOVE"))
-(constant (in-create "IN_CREATE"))
-(constant (in-delete "IN_DELETE"))
-(constant (in-delete-self "IN_DELETE_SELF"))
-(constant (in-move-self "IN_MOVE_SELF"))
-(constant (in-unmount "IN_UNMOUNT"))
-(constant (in-q-overflow "IN_Q_OVERFLOW"))
-(constant (in-ignored "IN_IGNORED"))
-(constant (in-onlydir "IN_ONLYDIR"))
-(constant (in-dont-follow "IN_DONT_FOLLOW"))
-(constant (in-mask-add "IN_MASK_ADD"))
-(constant (in-isdir "IN_ISDIR"))
-(constant (in-oneshot "IN_ONESHOT"))
-(constant (in-all-events "IN_ALL_EVENTS"))
+++ /dev/null
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
-
-;; Copyright (c) 2011-12, Olof-Joachim Frahm
-;; All rights reserved.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(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))
-
-(defbitfield (inotify-flag :uint32)
- (:access #.in-access)
- (:modify #.in-modify)
- (:attrib #.in-attrib)
- (:close-write #.in-close-write)
- (:close-nowrite #.in-close-nowrite)
- (:close #.in-close)
- (:open #.in-open)
- (:moved-from #.in-moved-from)
- (:moved-to #.in-moved-to)
- (:move #.in-move)
- (:create #.in-create)
- (:delete #.in-delete)
- (:delete-self #.in-delete-self)
- (:move-self #.in-move-self)
- (:unmount #.in-unmount)
- (:q-overflow #.in-q-overflow)
- (:ignored #.in-ignored)
- (:onlydir #.in-onlydir)
- (:dont-follow #.in-dont-follow)
- (:mask-add #.in-mask-add)
- (:isdir #.in-isdir)
- (:oneshot #.in-oneshot)
- (:all-events #.in-all-events))
-
-(deftype inotify-add/read-flag ()
- "Shared valid flags for the WATCH-RAW and READ-EVENT functions."
- '(member
- :access :attrib
- :close-write :close-nowrite :close
- :create :delete :delete-self
- :modify
- :move-self :moved-from :moved-to :move
- :open :all-events))
-
-(deftype inotify-read-flag ()
- "Valid flags which are returned from READ-EVENT."
- '(or inotify-add/read-flag
- (member :ignored :isdir :q-overflow :unmount)))
-
-(deftype inotify-add-flag ()
- "Valid flags for the WATCH-RAW function."
- '(or inotify-add/read-flag
- (member :dont-follow :mask-add :oneshot :onlydir)))
-
-(defun valid-watch-flag-p (x)
- (and (typep x 'inotify-add-flag)
- (not (eq :mask-add x))
- (not (eq :oneshot x))))
-
-(defun valid-watch-flag-list-p (list)
- (every #'valid-watch-flag-p list))
-
-(deftype watch-flag-list ()
- "Valid flags argument for the WATCH function, a list of keywords from
-INOTIFY-ADD-FLAG. Basically only :MASK-ADD and :ONESHOT are removed.
-The :MASK-ADD behaviour is replicated with the REPLACE-P argument; the
-:ONESHOT behaviour doesn't play well with the WATCH function design (and
-thus should be used only with WATCH-RAW)."
- '(or (satisfies valid-watch-flag-p)
- (and list (satisfies valid-watch-flag-list-p))))
-
-(defsyscall inotify-init :int
- "Initialises a new inotify 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))
-
-(defsyscall inotify-rm-watch :int
- "Removes a watched path from an event queue."
- (fd :int)
- (wd :int))
-
-(binary-types:define-signed int #.(cffi:foreign-type-size :int))
-
-(binary-types:define-binary-struct inotify-event ()
- "An inotify native event structure.
-WD is the watch/file descriptor,
-MASK is the (parsed) combination of events,
-COOKIE is a unique integer which connects related events,
-NAME optionally identifies a file relative to a watched directory."
- (wd 0 :binary-type int)
- (mask 0 :binary-type binary-types:u32)
- (cookie 0 :binary-type binary-types:u32)
- (name NIL))
-
-(defstruct (inotify-instance
- (:constructor make-inotify-instance ())
- (:conc-name inotify-))
- "Contains the stream and file descriptor for a inotify instance."
- fd
- stream
- nonblocking)
-
-;;;; initialisation and stuff
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun read-new-value (&optional (stream *query-io*))
- "READs a value from the STREAM and returns it (wrapped in a list)."
- (format stream "~&Enter a new value (unevaluated): ")
- (force-output stream)
- (list (read stream))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun init-endian ()
- "Initialises the endianess for the BINARY-TYPES library. Is automatically
-called when the library is loaded."
- (setf binary-types:*endian*
- (restart-case #+little-endian :little-endian
- #+big-endian :big-endian
- #-(or little-endian big-endian) (error "unknown endianess")
- (use-value (value)
- :report "Enter a correct value (either :LITTLE-ENDIAN or :BIG-ENDIAN)."
- :interactive read-new-value
- ;; TODO: better way to test for correct value/retry values?
- (case value
- ((:little-endian :big-endian) value)
- (T (error "wrong value supplied (not :LITTLE-ENDIAN or :BIG-ENDIAN)"))))))))
-
-;; initialise the endianess
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (init-endian))
-
-;;;; basic wrapping of the API
-
-(defun read-raw-event-from-stream (stream)
- "Reads a raw event from the inotify stream."
- (let* ((event (binary-types:read-binary 'inotify-event stream))
- (len (binary-types:read-binary 'binary-types:u32 stream)))
- (when (plusp len)
- (with-slots (name) event
- (let ((buffer (make-array len :element-type '(unsigned-byte 8))))
- (read-sequence buffer stream :end len)
- (setf name (trivial-utf-8:utf-8-bytes-to-string buffer :end (position 0 buffer))))))
- event))
-
-(defun read-event-from-stream (stream)
- "Reads a event from the inotify stream and converts bitmasks on reading."
- (let ((event (read-raw-event-from-stream stream)))
- (with-slots (mask) event
- (setf mask (foreign-bitfield-symbols 'inotify-flag mask)))
- event))
-
-(defun set-nonblocking (fd nonblocking)
- "Enables or disables NONBLOCKING mode on a file descriptor FD."
- (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
- (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."
- (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))
- "Creates a new unregistered INOTIFY instance."
- (init-unregistered-inotify (make-inotify-instance) nonblocking))
-
-(defun close-inotify (inotify)
- "Closes the inotify event queue."
- (close (inotify-stream inotify))
- (values))
-
-(defun ensure-list (arg)
- (if (listp arg) arg `(,arg)))
-
-(defun translate-keyword-flags (flags)
- (typecase flags
- ((or keyword list)
- (foreign-bitfield-value 'inotify-flag (ensure-list flags)))
- (T flags)))
-
-(defun watch-raw (inotify pathname flags)
- "Adds PATHNAME (either of type PATHNAME or STRING) to be watched. FLAGS
-determines how exactly (see inotify(7) for detailed information) and can
-be of type LIST, KEYWORD or a raw numerical value (which isn't checked
-for validity though). Returns a handle which can be used with UNWATCH-RAW."
- (let* ((path (etypecase pathname
- (string pathname)
- (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."
- (inotify-rm-watch (inotify-fd inotify) handle)
- (values))
-
-;;;; support functions, making life easier
-
-(defstruct (registered-inotify-instance
- (:include inotify-instance)
- (:constructor make-registered-inotify-instance ())
- (:conc-name inotify-))
- "Additionally to the information in INOTIFY-INSTANCE, records watched
-paths in a dictionary."
- watched)
-
-(defun make-inotify (&optional (nonblocking T))
- "Creates a new registered INOTIFY instance. In NONBLOCKING mode, the file
-descriptor is set to non-blocking mode. The resulting object has to be
-closed with CLOSE-INOTIFY."
- (let ((result (make-registered-inotify-instance)))
- (init-unregistered-inotify result nonblocking)
- (with-slots (watched) result
- (setf watched (make-hash-table :test 'equal)))
- result))
-
-(defun pathname-handle/flags (inotify pathname)
- "Returns a CONS cell with the values HANDLE and FLAGS if PATHNAME is
-being watched by INOTIFY, else NIL. The match is exact."
- (gethash pathname (inotify-watched inotify)))
-
-(defun event-pathname/flags (inotify event &optional (handle (slot-value event 'wd)))
- "Returns two values PATHNAME and FLAGS for an EVENT which were used during
-registration. If HANDLE is specified EVENT is ignored."
- (block NIL
- (maphash (lambda (pathname entry)
- (when (eql (car entry) handle)
- (return (values pathname (cdr entry)))))
- (inotify-watched inotify))))
-
-(defun sane-user-flags (inotify pathname flags &key (replace-p T))
- (check-type flags watch-flag-list)
- ;; now, :mask-add can't be member of flags
- ;; merge the flags
- (let* ((flags (ensure-list flags))
- (rep-flags (if replace-p
- (cons :mask-add flags)
- flags)))
- (let ((it (gethash pathname (slot-value inotify 'watched))))
- (if it
- (union (cdr it) rep-flags :test #'eq)
- rep-flags))))
-
-(defun watch (inotify pathname flags &key (replace-p T))
- "Adds PATHNAME (either pathname or string) to be watched and records the
-watched paths. FLAGS (a list of keywords) determines how exactly (see
-inotify(7) for detailed information). Returns a handle which can be used
-with UNWATCH and EVENT-PATHNAME/FLAGS. If REPLACE-P is set to T (default),
-the flags mask is replaced rather than OR-ed to the current mask (if it
-exists). The :MASK-ADD flag is therefore removed from the FLAGS argument."
- (let* ((flags (sane-user-flags inotify pathname flags :replace-p replace-p))
- (handle (watch-raw inotify pathname flags)))
- (with-slots (watched) inotify
- (setf (gethash pathname watched) (cons handle flags)))
- handle))
-
-(defun unwatch (inotify &key pathname event handle)
- "Disables watching the path associated with the supplied HANDLE (which
-may be one from a given EVENT) or PATHNAME."
- (unless (or pathname event handle)
- (error "either PATHNAME, EVENT or HANDLE have to be specified"))
- (when event
- (setf handle (slot-value event 'wd)))
- (if handle
- (unwatch-raw inotify handle)
- (let ((handle (car (pathname-handle/flags inotify pathname))))
- (unless handle
- (error "PATHNAME ~S isn't being watched" pathname))
- ;; remove even if unwatch-raw throws an error (which can happen if :oneshot is specified)
- (remhash pathname (inotify-watched inotify))
- (unwatch-raw inotify handle)))
- (values))
-
-(defun list-watched (inotify)
- "Returns a LIST of all watched pathnames in no particular order."
- (loop
- for pathname being each hash-key in (inotify-watched inotify)
- collect pathname))
-
-(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-fd inotify)))
- (listen (inotify-stream inotify))))
-
-(defun read-event (inotify)
- "Reads an event from the queue. Blocks if no event is available."
- (read-event-from-stream (inotify-stream inotify)))
-
-(defun next-event (inotify)
- "Reads an event from the queue. Returns NIL if none is available."
- (when (event-available-p inotify)
- (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. 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
- with ,var and ,inotify-sym = ,inotify
- ,.(unless blocking-p
- `(while (event-available-p ,inotify-sym)))
- do (progn
- (setf ,var (read-event ,inotify-sym))
- ,@body))))
-
-(defun next-events (inotify)
- "Reads all available events from the queue. Returns a LIST of events."
- (loop
- while (event-available-p inotify)
- collect (read-event inotify)))
-
-;;; this has the longer name, because this way you actually have to read
-;;; about the differences, at least i hope so
-(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)))
- (unwind-protect
- (progn
- ,.(mapcar (lambda (specifier)
- `(watch-raw ,inotify ,@specifier))
- rest)
- (values)
- ,@body)
- (close-inotify ,inotify))))
-
-(defmacro with-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
- "Executes BODY with a newly created queue bound to INOTIFY if true.
-See MAKE-INOTIFY for more information about possible arguments.
-
-The REST is a list of argument forms for the WATCH function, i.e. one or
-more forms (PATHNAME FLAGS &KEY (REPLACE-P T)).
-
-Since the QUEUE is closed on unwinding, this macro doesn't bother with
-UNWATCH calls on all WATCHed paths."
- `(let ((,inotify (make-inotify ,nonblocking)))
- (unwind-protect
- (progn
- ,.(mapcar (lambda (specifier)
- `(watch ,inotify ,@specifier))
- rest)
- (values)
- ,@body)
- (close-inotify ,inotify))))
+++ /dev/null
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
-
-;; Copyright (c) 2011-12, Olof-Joachim Frahm
-;; All rights reserved.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package #:cl-inotify)
-
-(defun run-inotify-event-handler (watch event-handler &key (nonblocking T) (registered T))
- "Registers an INOTIFY queue and runs EVENT-HANDLER with it as only
-parameter whenever input happens."
- (let ((inotify (funcall (if registered #'make-inotify #'make-unregistered-inotify) nonblocking)))
- (unwind-protect
- (iolib:with-event-base (event-base)
- (dolist (watch watch)
- (apply #'watch inotify watch))
- (flet ((events (&rest args)
- (declare (ignore args))
- (do-events (event inotify :blocking-p NIL)
- (funcall event-handler inotify event))))
- (iolib:set-io-handler event-base (inotify-fd inotify) :read #'events)
- (iolib:event-dispatch event-base)))
- (close-inotify inotify))))
-
-(defun run-inotify-program (program args rest directories flags
- &key 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.
-
-Returns the process structure and if EVENT-HANDLER wasn't set, a LIST of
-recorded events as second value."
- (let (events)
- (flet ((events (inotify)
- (do-events (event inotify)
- (if event-handler
- (funcall event-handler event)
- (push event events)))))
- (let ((inotify (if registered (make-inotify) (make-unregistered-inotify))))
- (unwind-protect
- (progn
- (let ((register (if registered #'watch #'watch-raw)))
- (mapcar (lambda (directory)
- (funcall register inotify directory flags))
- directories))
- (let ((process (etypecase program
- (string
- (apply #'sb-ext:run-program program args :wait NIL rest))
- (function
- (apply program args rest)))))
- (loop
- while (sb-ext:process-alive-p process)
- do (events inotify))
- (events inotify)
- (if event-handler
- process
- (values process (nreverse events)))))
- (close-inotify inotify))))))
+++ /dev/null
-;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
-
-;; Copyright (c) 2011-12, Olof-Joachim Frahm
-;; All rights reserved.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package #:cl-user)
-
-(defpackage cl-inotify
- (:use #:cl #:cffi)
- (:import-from #:osicat-posix #:defsyscall)
- (:export ;;; used types for documentation
- #:inotify-add/read-flag
- #:inotify-read-flag
- #:inotify-add-flag
-
- ;;; very raw
- #:read-raw-event-from-stream
-
- ;;; basic stuff
- #:close-inotify
-
- ;;; inotify accessors
- #:inotify-fd
- #:inotify-stream
- #:inotify-nonblocking
-
- ;;; event parsing functions
- #:make-unregistered-inotify
- #:read-event-from-stream
- #:watch-raw
- #:unwatch-raw
-
- ;;; event accessors
- #:inotify-event-wd
- #:inotify-event-mask
- #:inotify-event-cookie
- #:inotify-event-name
-
- ;;; enhanced functionality
- #:make-inotify
- #:pathname-handle/flags
- #:event-pathname/flags
- #:watch
- #:unwatch
- #:event-availablep
- #:read-event
- #:next-event
-
- ;;; convenience functions
- #:list-watched
- #:do-events
- #:next-events
-
- ;;; macros
- #:with-inotify
- #:with-unregistered-inotify)
- (:documentation "A binding (not only?) for the LINUX inotify(7) API."))
--- /dev/null
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
+
+;; Copyright (c) 2011, Olof-Joachim Frahm
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-inotify)
+
+(include "sys/inotify.h")
+
+;; since 2.6.27 according to inotify_init(2)
+(constant (in-cloexec "IN_CLOEXEC"))
+(constant (in-nonblock "IN_NONBLOCK"))
+(constant (in-access "IN_ACCESS"))
+(constant (in-modify "IN_MODIFY"))
+(constant (in-attrib "IN_ATTRIB"))
+(constant (in-close-write "IN_CLOSE_WRITE"))
+(constant (in-close-nowrite "IN_CLOSE_NOWRITE"))
+(constant (in-close "IN_CLOSE"))
+(constant (in-open "IN_OPEN"))
+(constant (in-moved-from "IN_MOVED_FROM"))
+(constant (in-moved-to "IN_MOVED_TO"))
+(constant (in-move "IN_MOVE"))
+(constant (in-create "IN_CREATE"))
+(constant (in-delete "IN_DELETE"))
+(constant (in-delete-self "IN_DELETE_SELF"))
+(constant (in-move-self "IN_MOVE_SELF"))
+(constant (in-unmount "IN_UNMOUNT"))
+(constant (in-q-overflow "IN_Q_OVERFLOW"))
+(constant (in-ignored "IN_IGNORED"))
+(constant (in-onlydir "IN_ONLYDIR"))
+(constant (in-dont-follow "IN_DONT_FOLLOW"))
+(constant (in-mask-add "IN_MASK_ADD"))
+(constant (in-isdir "IN_ISDIR"))
+(constant (in-oneshot "IN_ONESHOT"))
+(constant (in-all-events "IN_ALL_EVENTS"))
--- /dev/null
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
+
+;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(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))
+
+(defbitfield (inotify-flag :uint32)
+ (:access #.in-access)
+ (:modify #.in-modify)
+ (:attrib #.in-attrib)
+ (:close-write #.in-close-write)
+ (:close-nowrite #.in-close-nowrite)
+ (:close #.in-close)
+ (:open #.in-open)
+ (:moved-from #.in-moved-from)
+ (:moved-to #.in-moved-to)
+ (:move #.in-move)
+ (:create #.in-create)
+ (:delete #.in-delete)
+ (:delete-self #.in-delete-self)
+ (:move-self #.in-move-self)
+ (:unmount #.in-unmount)
+ (:q-overflow #.in-q-overflow)
+ (:ignored #.in-ignored)
+ (:onlydir #.in-onlydir)
+ (:dont-follow #.in-dont-follow)
+ (:mask-add #.in-mask-add)
+ (:isdir #.in-isdir)
+ (:oneshot #.in-oneshot)
+ (:all-events #.in-all-events))
+
+(deftype inotify-add/read-flag ()
+ "Shared valid flags for the WATCH-RAW and READ-EVENT functions."
+ '(member
+ :access :attrib
+ :close-write :close-nowrite :close
+ :create :delete :delete-self
+ :modify
+ :move-self :moved-from :moved-to :move
+ :open :all-events))
+
+(deftype inotify-read-flag ()
+ "Valid flags which are returned from READ-EVENT."
+ '(or inotify-add/read-flag
+ (member :ignored :isdir :q-overflow :unmount)))
+
+(deftype inotify-add-flag ()
+ "Valid flags for the WATCH-RAW function."
+ '(or inotify-add/read-flag
+ (member :dont-follow :mask-add :oneshot :onlydir)))
+
+(defun valid-watch-flag-p (x)
+ (and (typep x 'inotify-add-flag)
+ (not (eq :mask-add x))
+ (not (eq :oneshot x))))
+
+(defun valid-watch-flag-list-p (list)
+ (every #'valid-watch-flag-p list))
+
+(deftype watch-flag-list ()
+ "Valid flags argument for the WATCH function, a list of keywords from
+INOTIFY-ADD-FLAG. Basically only :MASK-ADD and :ONESHOT are removed.
+The :MASK-ADD behaviour is replicated with the REPLACE-P argument; the
+:ONESHOT behaviour doesn't play well with the WATCH function design (and
+thus should be used only with WATCH-RAW)."
+ '(or (satisfies valid-watch-flag-p)
+ (and list (satisfies valid-watch-flag-list-p))))
+
+(defsyscall inotify-init :int
+ "Initialises a new inotify 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))
+
+(defsyscall inotify-rm-watch :int
+ "Removes a watched path from an event queue."
+ (fd :int)
+ (wd :int))
+
+(binary-types:define-signed int #.(cffi:foreign-type-size :int))
+
+(binary-types:define-binary-struct inotify-event ()
+ "An inotify native event structure.
+WD is the watch/file descriptor,
+MASK is the (parsed) combination of events,
+COOKIE is a unique integer which connects related events,
+NAME optionally identifies a file relative to a watched directory."
+ (wd 0 :binary-type int)
+ (mask 0 :binary-type binary-types:u32)
+ (cookie 0 :binary-type binary-types:u32)
+ (name NIL))
+
+(defstruct (inotify-instance
+ (:constructor make-inotify-instance ())
+ (:conc-name inotify-))
+ "Contains the stream and file descriptor for a inotify instance."
+ fd
+ stream
+ nonblocking)
+
+;;;; initialisation and stuff
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun read-new-value (&optional (stream *query-io*))
+ "READs a value from the STREAM and returns it (wrapped in a list)."
+ (format stream "~&Enter a new value (unevaluated): ")
+ (force-output stream)
+ (list (read stream))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun init-endian ()
+ "Initialises the endianess for the BINARY-TYPES library. Is automatically
+called when the library is loaded."
+ (setf binary-types:*endian*
+ (restart-case #+little-endian :little-endian
+ #+big-endian :big-endian
+ #-(or little-endian big-endian) (error "unknown endianess")
+ (use-value (value)
+ :report "Enter a correct value (either :LITTLE-ENDIAN or :BIG-ENDIAN)."
+ :interactive read-new-value
+ ;; TODO: better way to test for correct value/retry values?
+ (case value
+ ((:little-endian :big-endian) value)
+ (T (error "wrong value supplied (not :LITTLE-ENDIAN or :BIG-ENDIAN)"))))))))
+
+;; initialise the endianess
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (init-endian))
+
+;;;; basic wrapping of the API
+
+(defun read-raw-event-from-stream (stream)
+ "Reads a raw event from the inotify stream."
+ (let* ((event (binary-types:read-binary 'inotify-event stream))
+ (len (binary-types:read-binary 'binary-types:u32 stream)))
+ (when (plusp len)
+ (with-slots (name) event
+ (let ((buffer (make-array len :element-type '(unsigned-byte 8))))
+ (read-sequence buffer stream :end len)
+ (setf name (trivial-utf-8:utf-8-bytes-to-string buffer :end (position 0 buffer))))))
+ event))
+
+(defun read-event-from-stream (stream)
+ "Reads a event from the inotify stream and converts bitmasks on reading."
+ (let ((event (read-raw-event-from-stream stream)))
+ (with-slots (mask) event
+ (setf mask (foreign-bitfield-symbols 'inotify-flag mask)))
+ event))
+
+(defun set-nonblocking (fd nonblocking)
+ "Enables or disables NONBLOCKING mode on a file descriptor FD."
+ (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
+ (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."
+ (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))
+ "Creates a new unregistered INOTIFY instance."
+ (init-unregistered-inotify (make-inotify-instance) nonblocking))
+
+(defun close-inotify (inotify)
+ "Closes the inotify event queue."
+ (close (inotify-stream inotify))
+ (values))
+
+(defun ensure-list (arg)
+ (if (listp arg) arg `(,arg)))
+
+(defun translate-keyword-flags (flags)
+ (typecase flags
+ ((or keyword list)
+ (foreign-bitfield-value 'inotify-flag (ensure-list flags)))
+ (T flags)))
+
+(defun watch-raw (inotify pathname flags)
+ "Adds PATHNAME (either of type PATHNAME or STRING) to be watched. FLAGS
+determines how exactly (see inotify(7) for detailed information) and can
+be of type LIST, KEYWORD or a raw numerical value (which isn't checked
+for validity though). Returns a handle which can be used with UNWATCH-RAW."
+ (let* ((path (etypecase pathname
+ (string pathname)
+ (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."
+ (inotify-rm-watch (inotify-fd inotify) handle)
+ (values))
+
+;;;; support functions, making life easier
+
+(defstruct (registered-inotify-instance
+ (:include inotify-instance)
+ (:constructor make-registered-inotify-instance ())
+ (:conc-name inotify-))
+ "Additionally to the information in INOTIFY-INSTANCE, records watched
+paths in a dictionary."
+ watched)
+
+(defun make-inotify (&optional (nonblocking T))
+ "Creates a new registered INOTIFY instance. In NONBLOCKING mode, the file
+descriptor is set to non-blocking mode. The resulting object has to be
+closed with CLOSE-INOTIFY."
+ (let ((result (make-registered-inotify-instance)))
+ (init-unregistered-inotify result nonblocking)
+ (with-slots (watched) result
+ (setf watched (make-hash-table :test 'equal)))
+ result))
+
+(defun pathname-handle/flags (inotify pathname)
+ "Returns a CONS cell with the values HANDLE and FLAGS if PATHNAME is
+being watched by INOTIFY, else NIL. The match is exact."
+ (gethash pathname (inotify-watched inotify)))
+
+(defun event-pathname/flags (inotify event &optional (handle (slot-value event 'wd)))
+ "Returns two values PATHNAME and FLAGS for an EVENT which were used during
+registration. If HANDLE is specified EVENT is ignored."
+ (block NIL
+ (maphash (lambda (pathname entry)
+ (when (eql (car entry) handle)
+ (return (values pathname (cdr entry)))))
+ (inotify-watched inotify))))
+
+(defun sane-user-flags (inotify pathname flags &key (replace-p T))
+ (check-type flags watch-flag-list)
+ ;; now, :mask-add can't be member of flags
+ ;; merge the flags
+ (let* ((flags (ensure-list flags))
+ (rep-flags (if replace-p
+ (cons :mask-add flags)
+ flags)))
+ (let ((it (gethash pathname (slot-value inotify 'watched))))
+ (if it
+ (union (cdr it) rep-flags :test #'eq)
+ rep-flags))))
+
+(defun watch (inotify pathname flags &key (replace-p T))
+ "Adds PATHNAME (either pathname or string) to be watched and records the
+watched paths. FLAGS (a list of keywords) determines how exactly (see
+inotify(7) for detailed information). Returns a handle which can be used
+with UNWATCH and EVENT-PATHNAME/FLAGS. If REPLACE-P is set to T (default),
+the flags mask is replaced rather than OR-ed to the current mask (if it
+exists). The :MASK-ADD flag is therefore removed from the FLAGS argument."
+ (let* ((flags (sane-user-flags inotify pathname flags :replace-p replace-p))
+ (handle (watch-raw inotify pathname flags)))
+ (with-slots (watched) inotify
+ (setf (gethash pathname watched) (cons handle flags)))
+ handle))
+
+(defun unwatch (inotify &key pathname event handle)
+ "Disables watching the path associated with the supplied HANDLE (which
+may be one from a given EVENT) or PATHNAME."
+ (unless (or pathname event handle)
+ (error "either PATHNAME, EVENT or HANDLE have to be specified"))
+ (when event
+ (setf handle (slot-value event 'wd)))
+ (if handle
+ (unwatch-raw inotify handle)
+ (let ((handle (car (pathname-handle/flags inotify pathname))))
+ (unless handle
+ (error "PATHNAME ~S isn't being watched" pathname))
+ ;; remove even if unwatch-raw throws an error (which can happen if :oneshot is specified)
+ (remhash pathname (inotify-watched inotify))
+ (unwatch-raw inotify handle)))
+ (values))
+
+(defun list-watched (inotify)
+ "Returns a LIST of all watched pathnames in no particular order."
+ (loop
+ for pathname being each hash-key in (inotify-watched inotify)
+ collect pathname))
+
+(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-fd inotify)))
+ (listen (inotify-stream inotify))))
+
+(defun read-event (inotify)
+ "Reads an event from the queue. Blocks if no event is available."
+ (read-event-from-stream (inotify-stream inotify)))
+
+(defun next-event (inotify)
+ "Reads an event from the queue. Returns NIL if none is available."
+ (when (event-available-p inotify)
+ (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. 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
+ with ,var and ,inotify-sym = ,inotify
+ ,.(unless blocking-p
+ `(while (event-available-p ,inotify-sym)))
+ do (progn
+ (setf ,var (read-event ,inotify-sym))
+ ,@body))))
+
+(defun next-events (inotify)
+ "Reads all available events from the queue. Returns a LIST of events."
+ (loop
+ while (event-available-p inotify)
+ collect (read-event inotify)))
+
+;;; this has the longer name, because this way you actually have to read
+;;; about the differences, at least i hope so
+(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)))
+ (unwind-protect
+ (progn
+ ,.(mapcar (lambda (specifier)
+ `(watch-raw ,inotify ,@specifier))
+ rest)
+ (values)
+ ,@body)
+ (close-inotify ,inotify))))
+
+(defmacro with-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
+ "Executes BODY with a newly created queue bound to INOTIFY if true.
+See MAKE-INOTIFY for more information about possible arguments.
+
+The REST is a list of argument forms for the WATCH function, i.e. one or
+more forms (PATHNAME FLAGS &KEY (REPLACE-P T)).
+
+Since the QUEUE is closed on unwinding, this macro doesn't bother with
+UNWATCH calls on all WATCHed paths."
+ `(let ((,inotify (make-inotify ,nonblocking)))
+ (unwind-protect
+ (progn
+ ,.(mapcar (lambda (specifier)
+ `(watch ,inotify ,@specifier))
+ rest)
+ (values)
+ ,@body)
+ (close-inotify ,inotify))))
--- /dev/null
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify; -*-
+
+;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-inotify)
+
+(defun run-inotify-event-handler (watch event-handler &key (nonblocking T) (registered T))
+ "Registers an INOTIFY queue and runs EVENT-HANDLER with it as only
+parameter whenever input happens."
+ (let ((inotify (funcall (if registered #'make-inotify #'make-unregistered-inotify) nonblocking)))
+ (unwind-protect
+ (iolib:with-event-base (event-base)
+ (dolist (watch watch)
+ (apply #'watch inotify watch))
+ (flet ((events (&rest args)
+ (declare (ignore args))
+ (do-events (event inotify :blocking-p NIL)
+ (funcall event-handler inotify event))))
+ (iolib:set-io-handler event-base (inotify-fd inotify) :read #'events)
+ (iolib:event-dispatch event-base)))
+ (close-inotify inotify))))
+
+(defun run-inotify-program (program args rest directories flags
+ &key 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.
+
+Returns the process structure and if EVENT-HANDLER wasn't set, a LIST of
+recorded events as second value."
+ (let (events)
+ (flet ((events (inotify)
+ (do-events (event inotify)
+ (if event-handler
+ (funcall event-handler event)
+ (push event events)))))
+ (let ((inotify (if registered (make-inotify) (make-unregistered-inotify))))
+ (unwind-protect
+ (progn
+ (let ((register (if registered #'watch #'watch-raw)))
+ (mapcar (lambda (directory)
+ (funcall register inotify directory flags))
+ directories))
+ (let ((process (etypecase program
+ (string
+ (apply #'sb-ext:run-program program args :wait NIL rest))
+ (function
+ (apply program args rest)))))
+ (loop
+ while (sb-ext:process-alive-p process)
+ do (events inotify))
+ (events inotify)
+ (if event-handler
+ process
+ (values process (nreverse events)))))
+ (close-inotify inotify))))))
--- /dev/null
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
+
+;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-user)
+
+(defpackage #:cl-inotify
+ (:use #:cl #:cffi)
+ (:import-from #:osicat-posix #:defsyscall)
+ (:export ;;; used types for documentation
+ #:inotify-add/read-flag
+ #:inotify-read-flag
+ #:inotify-add-flag
+
+ ;;; very raw
+ #:read-raw-event-from-stream
+
+ ;;; basic stuff
+ #:close-inotify
+
+ ;;; inotify accessors
+ #:inotify-fd
+ #:inotify-stream
+ #:inotify-nonblocking
+
+ ;;; event parsing functions
+ #:make-unregistered-inotify
+ #:read-event-from-stream
+ #:watch-raw
+ #:unwatch-raw
+
+ ;;; event accessors
+ #:inotify-event-wd
+ #:inotify-event-mask
+ #:inotify-event-cookie
+ #:inotify-event-name
+
+ ;;; enhanced functionality
+ #:make-inotify
+ #:pathname-handle/flags
+ #:event-pathname/flags
+ #:watch
+ #:unwatch
+ #:event-availablep
+ #:read-event
+ #:next-event
+
+ ;;; convenience functions
+ #:list-watched
+ #:do-events
+ #:next-events
+
+ ;;; macros
+ #:with-inotify
+ #:with-unregistered-inotify)
+ (:documentation "Binding to the Linux inotify(7) API."))
--- /dev/null
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify-tests; -*-
+
+;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-inotify-tests)
+
+(in-suite cl-inotify)
--- /dev/null
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-user; -*-
+
+;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-user)
+
+(defpackage #:cl-inotify-tests
+ (:use #:cl #:cl-inotify #:fiveam))
--- /dev/null
+;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8-unix; package: cl-inotify-tests; -*-
+
+;; Copyright (c) 2011-12, Olof-Joachim Frahm
+;; All rights reserved.
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package #:cl-inotify-tests)
+
+(defsuite cl-inotify)
projects / cl-inotify.git / commitdiff