From: Olof-Joachim Frahm Date: Mon, 10 Jun 2013 22:39:13 +0000 (+0200) Subject: Restructure paths, add tests package. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7c56d5c60449ae124a1c748b2939f31f38956358;p=cl-inotify.git Restructure paths, add tests package. I.e. src and tests components, use fiveam as usual. --- diff --git a/README.md b/README.md index 389c40e..316c3ac 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -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 @@ -9,10 +9,10 @@ Working, but unfinished. 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]. diff --git a/cl-inotify.asd b/cl-inotify.asd index 354b85c..dfc010d 100644 --- a/cl-inotify.asd +++ b/cl-inotify.asd @@ -31,8 +31,8 @@ (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 " :license "Simplified BSD License" @@ -41,7 +41,22 @@ #: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"))))) diff --git a/grovel.lisp b/grovel.lisp deleted file mode 100644 index fbe9a1e..0000000 --- a/grovel.lisp +++ /dev/null @@ -1,58 +0,0 @@ -;;; -*- 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")) diff --git a/inotify.lisp b/inotify.lisp deleted file mode 100644 index 8c97386..0000000 --- a/inotify.lisp +++ /dev/null @@ -1,440 +0,0 @@ -;;; -*- 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)))) diff --git a/iolib.lisp b/iolib.lisp deleted file mode 100644 index 948aba6..0000000 --- a/iolib.lisp +++ /dev/null @@ -1,89 +0,0 @@ -;;; -*- 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)))))) diff --git a/package.lisp b/package.lisp deleted file mode 100644 index 743ee14..0000000 --- a/package.lisp +++ /dev/null @@ -1,80 +0,0 @@ -;;; -*- 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.")) diff --git a/src/grovel.lisp b/src/grovel.lisp new file mode 100644 index 0000000..fbe9a1e --- /dev/null +++ b/src/grovel.lisp @@ -0,0 +1,58 @@ +;;; -*- 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")) diff --git a/src/inotify.lisp b/src/inotify.lisp new file mode 100644 index 0000000..8c97386 --- /dev/null +++ b/src/inotify.lisp @@ -0,0 +1,440 @@ +;;; -*- 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)))) diff --git a/src/iolib.lisp b/src/iolib.lisp new file mode 100644 index 0000000..948aba6 --- /dev/null +++ b/src/iolib.lisp @@ -0,0 +1,89 @@ +;;; -*- 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)))))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..b9d334f --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,80 @@ +;;; -*- 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.")) diff --git a/tests/inotify.lisp b/tests/inotify.lisp new file mode 100644 index 0000000..c9bde3e --- /dev/null +++ b/tests/inotify.lisp @@ -0,0 +1,31 @@ +;;; -*- 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) diff --git a/tests/package.lisp b/tests/package.lisp new file mode 100644 index 0000000..253134c --- /dev/null +++ b/tests/package.lisp @@ -0,0 +1,32 @@ +;;; -*- 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)) diff --git a/tests/suite.lisp b/tests/suite.lisp new file mode 100644 index 0000000..adaac10 --- /dev/null +++ b/tests/suite.lisp @@ -0,0 +1,31 @@ +;;; -*- 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)