From db5ab2a9e4bad6125673b1c5cdb2d86c11841977 Mon Sep 17 00:00:00 2001 From: Olof-Joachim Frahm Date: Fri, 18 Dec 2009 21:07:23 +0100 Subject: [PATCH] Enhanced functionality and more convenience. Changed dependency on utils-frahm, non-blocking reading, registration of watched directories. --- cl-notify.asd | 3 +- inotify.lisp | 289 ++++++++++++++++++++++++++++++++++++++++++++------------- package.lisp | 35 +++++-- 3 files changed, 251 insertions(+), 76 deletions(-) diff --git a/cl-notify.asd b/cl-notify.asd index 08c4d68..1350e36 100644 --- a/cl-notify.asd +++ b/cl-notify.asd @@ -4,7 +4,8 @@ (asdf:operate 'asdf:load-op 'cffi-grovel)) (asdf:defsystem cl-notify - :depends-on (#:cffi #:binary-types) + :depends-on (#:cffi #:binary-types #:utils-frahm-common) + :serial T :components ((:file "package") (cffi-grovel:grovel-file "grovel") (:file "inotify"))) diff --git a/inotify.lisp b/inotify.lisp index 427ff73..b7ddfc2 100644 --- a/inotify.lisp +++ b/inotify.lisp @@ -1,108 +1,267 @@ (in-package #:cl-notify) -(defbitfield (inotify-flags :uint32) - (:in-access #.in-access) - (:in-modify #.in-modify) - (:in-attrib #.in-attrib) - (:in-close-write #.in-close-write) - (:in-close-nowrite #.in-close-nowrite) - (:in-close #.in-close) - (:in-open #.in-open) - (:in-moved-from #.in-moved-from) - (:in-moved-to #.in-moved-to) - (:in-move #.in-move) - (:in-create #.in-create) - (:in-delete #.in-delete) - (:in-delete-self #.in-delete-self) - (:in-move-self #.in-move-self) - (:in-unmount #.in-unmount) - (:in-q-overflow #.in-q-overflow) - (:in-ignored #.in-ignored) - (:in-onlydir #.in-onlydir) - (:in-dont-follow #.in-dont-follow) - (:in-mask-add #.in-mask-add) - (:in-isdir #.in-isdir) - (:in-oneshot #.in-oneshot) - (:in-all-events #.in-all-events)) - -(defcfun "inotify_init" :int) - -(defcfun "inotify_add_watch" :int +(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 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-add-flag () + "Valid flags for the WATCH function." + '(or inotify-add/read-flag + (member :dont-follow :mask-add :oneshot :onlydir))) + +(deftype inotify-read-flag () + "Valid flags which are returned from READ-EVENT." + '(or inotify-add/read-flag + (member :ignored :isdir :q-overflow :unmount))) + +(defcfun ("inotify_init" c-inotify-init) :int + "Initialises a new inotify event queue.") + +(defcfun ("inotify_add_watch" c-inotify-add-watch) :int + "Watches a path on a event queue." (fd :int) (pathname :string) - (mask inotify-flags)) + (mask inotify-flag)) -(defcfun "inotify_rm_watch" :int +(defcfun ("inotify_rm_watch" c-inotify-rm-watch) :int + "Removes a watched path from a 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 (fd stream))) +(defstruct (inotify-instance + (:constructor make-inotify-instance ()) + (:conc-name inotify-)) + "Contains the stream and file descriptor for a inotify instance." fd - stream) + stream + nonblocking) + +;;;; initialisation and stuff (defun init-endian () + "Initialises endianess for the BINARY-TYPES library." (setf binary-types:*endian* #+little-endian :little-endian #+big-endian :big-endian #-(or little-endian big-endian) (error "unknown endianess"))) +;; um, in what evel-when should this be wrapped? (init-endian) -(defun inotify-read-raw-event (stream) +;;;; basic wrapping of the API + +(defun read-raw-event (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 (> len 0) + (when (plusp len) (with-slots (name) event - (setf name - (binary-types:read-binary-string stream :size len :terminators '(0))))) + (setf name (binary-types:read-binary-string stream + :size len + :terminators '(0))))) event)) -(defun inotify-read-event (stream) - (let ((event (inotify-read-raw-event stream))) +(defun read-event-from-stream (stream) + "Reads a event from the inotify stream and converts bitmasks on reading." + (let ((event (read-raw-event stream))) (with-slots (mask) event - (setf mask (foreign-bitfield-symbols 'inotify-flags mask))) + (setf mask (foreign-bitfield-symbols 'inotify-flag mask))) event)) -(defun make-notify () - (let* ((fd (inotify-init))) - (when (< fd 0) - (error "inotify_init failed: ~A" fd)) - ;; file descriptor is collected with auto-close - (make-inotify-instance - fd - (sb-sys:make-fd-stream fd - :input T - :element-type '(unsigned-byte 8) - :name (format NIL "inotify event queue ~A" fd) - :auto-close T)))) +(defun set-nonblocking (fd nonblocking) + (let ((flags (sb-posix:fcntl fd sb-posix:f-getfl))) + ;; an error is raised if this fails, so we don't have to do it ourselves + (sb-posix:fcntl fd sb-posix:f-setfl + (funcall (if nonblocking #'logior #'logxor) + flags sb-posix:o-nonblock)))) + +(defun init-unregistered-notify (notify &optional (nonblocking T)) + "Creates a new inotify event queue. If NONBLOCKING is set (default), +the file descriptor is set to non-blocking I/O." + (let ((result (c-inotify-init))) + (when (minusp result) + (error "inotify_init failed: ~A" result)) + (with-slots (fd stream (non-block nonblocking)) notify + (unwind-protect + ;; file descriptor is collected with auto-close + (progn + (setf fd result) + (when nonblocking + (set-nonblocking fd T) + (setf non-block nonblocking)) + (setf stream + (sb-sys:make-fd-stream + fd + :input T + :element-type '(unsigned-byte 8) + :name (format NIL "inotify event queue ~A" fd) + :auto-close T + :buffering (if nonblocking :none :full)))) + ;; if stream is constructed, gc'ing it will cleanup the file descriptor + (unless stream + (sb-posix:close fd))))) + notify) + +(defun make-unregistered-notify () + (init-unregistered-notify (make-inotify-instance))) (defun close-notify (notify) - (close (inotify-instance-stream notify)) + "Closes the inotify event queue." + (close (inotify-stream notify)) (values)) -(defun watch (notify pathname flags) +(defun watch-raw (notify pathname flags) + "Adds PATHNAME (either pathname or string) to be watched. FLAGS +determines how exactly (see inotify(7) for detailed information). +Returns a handle which can be used with UNWATCH." (let ((path (princ-to-string pathname)) result) - (setf result - (inotify-add-watch (inotify-instance-fd notify) - path - (if (listp flags) - (foreign-bitfield-value 'inotify-flags flags) - flags))) - (when (< result 0) + (setf result (c-inotify-add-watch + (inotify-fd notify) + path + (typecase flags + (list (foreign-bitfield-value 'inotify-flag flags)) + (keyword (foreign-bitfield-value 'inotify-flag + (list flags))) + (T flags)))) + (when (minusp result) (error "inotify_add_watch failed: ~A" result)) result)) -(defun unwatch (notify handle) - (let ((result (inotify-rm-watch (inotify-instance-fd notify) handle))) - (when (< result 0) - (error "inotify_rm_watch failed: ~A" result)) - (values))) +(defun unwatch-raw (notify handle) + "Disables watching the path associated with HANDLE." + (let ((result (c-inotify-rm-watch (inotify-fd notify) handle))) + (when (minusp result) + (error "inotify_rm_watch failed: ~A" result))) + (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-notify (&optional (nonblocking T)) + (let ((result (make-registered-inotify-instance))) + (init-unregistered-notify result nonblocking) + (with-slots (watched) result + (setf watched (make-hash-table :test 'equal))) + result)) + +(defun watchedp (notify pathname) + "Returns the tuple (HANDLE . FLAGS) if PATHNAME is being watched by NOTIFY, +else NIL." + (awhen (gethash pathname (inotify-watched notify)) + (values (car it) (cdr it)))) + +;; TODO: handle additional flags, save only list of flags +(defun watch (notify pathname flags) + (let ((handle (watch-raw notify pathname flags))) + (with-slots (watched) notify + (setf (gethash pathname watched) (cons handle flags))) + handle)) + +(defun unwatch (notify &key pathname handle) + (unless (or pathname handle) + (error "either PATHNAME or HANDLE has to be specified")) + (if handle + (unwatch-raw notify handle) + (let ((handle (watchedp notify pathname))) + (unless handle + (error "PATHNAME ~S isn't being watched" pathname)) + (unwatch-raw notify handle) + (remhash pathname (inotify-watched notify)))) + (values)) + +(defun list-watched (notify) + "Returns a list of all watched pathnames in particular order." + (let (result) + (maphash (lambda (k v) + (declare (ignore v)) + (push k result)) + (inotify-watched notify)) + result)) + +(defun unix-eagainp (fd-stream) + "Returns T on a FD-STREAM, if trying to read raised a EAGAIN error." + (multiple-value-bind (result error) + (sb-unix:unix-read (sb-sys:fd-stream-fd fd-stream) NIL 0) + (declare (ignore result)) + (= error sb-unix:eagain))) + +(defun event-availablep (notify) + "Returns T if an event is available on the queue." + (if (inotify-nonblocking notify) + (not (unix-eagainp (inotify-stream notify))) + (listen (inotify-stream notify)))) + +(defun read-event (notify) + "Reads an event from the queue. Blocks if no event is available." + (read-event-from-stream (inotify-stream notify))) + +(defun next-event (notify) + "Reads an event from the queue. Returns NIL if none is available." + (when (event-availablep notify) + (read-event notify))) + +(defmacro! do-events ((var o!notify) &body body) + "Loops BODY with VAR bound to the events retrieved from NOTIFY. The macro +uses NEXT-EVENT, so that reading an event won't block." + `(loop as ,var = (next-event ,g!notify) + while ,var + do (progn ,.body))) + +(defun next-events (notify) + "Reads all available events from the queue. Returns a list of events." + (let (result) + (do-events (event notify) + (push event result)) + (nreverse result))) diff --git a/package.lisp b/package.lisp index 4ec662d..0f7b202 100644 --- a/package.lisp +++ b/package.lisp @@ -1,17 +1,32 @@ (in-package #:cl-user) (defpackage cl-notify - (:use #:cl #:cffi) - (:export #:inotify-event - #:inotify-event-wd - #:inotify-event-mask - #:inotify-event-cookie - #:inotify-event-name + (:use #:cl #:cffi #:utils-frahm #:anaphora) + (:export ;;; used types for documentation + #:inotify-add/read-flag + #:inotify-read-flag + #:inotify-add-flag - #:inotify-read-raw-event - #:inotify-read-event - #:make-inotify #:close-notify + + ;;; event parsing functions + #:make-unregistered-notify + #:read-raw-event + #:watch-raw + #:unwatch-raw + + ;;; enhanced functionality + #:make-notify + #:watchedp #:watch #:unwatch - )) + #:event-availablep + #:read-event + #:next-event + + ;;; convenience functions + #:list-watched + #:do-events + #:read-events + ) + (:documentation "A binding for the LINUX inotify(7) API.")) -- 1.7.10.4