inotify.lisp

   1 ;; Copyright (C) 2009 Olof-Joachim Frahm
   2
   3 ;; This program is free software; you can redistribute it and/or modify it
   4 ;; under the terms of the GNU General Public License as published by the
   5 ;; Free Software Foundation; either version 3 of the License, or (at your
   6 ;; option) any later version.
   7
   8 ;; This program is distributed in the hope that it will be useful, but
   9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
  11 ;; Public License for more details.
  12
  13 ;; You should have received a copy of the GNU General Public License along
  14 ;; with this program; if not, see <http://www.gnu.org/licenses/>.
  15
  16 (in-package #:cl-notify)
  17
  18 (defbitfield (inotify-flag :uint32)
  19   (:access #.in-access)
  20   (:modify #.in-modify)
  21   (:attrib #.in-attrib)
  22   (:close-write #.in-close-write)
  23   (:close-nowrite #.in-close-nowrite)
  24   (:close #.in-close)
  25   (:open #.in-open)
  26   (:moved-from #.in-moved-from)
  27   (:moved-to #.in-moved-to)
  28   (:move #.in-move)
  29   (:create #.in-create)
  30   (:delete #.in-delete)
  31   (:delete-self #.in-delete-self)
  32   (:move-self #.in-move-self)
  33   (:unmount #.in-unmount)
  34   (:q-overflow #.in-q-overflow)
  35   (:ignored #.in-ignored)
  36   (:onlydir #.in-onlydir)
  37   (:dont-follow #.in-dont-follow)
  38   (:mask-add #.in-mask-add)
  39   (:isdir #.in-isdir)
  40   (:oneshot #.in-oneshot)
  41   (:all-events #.in-all-events))
  42
  43 (deftype inotify-add/read-flag ()
  44   "Shared valid flags for the WATCH and READ-EVENT functions."
  45   '(member
  46     :access :attrib
  47     :close-write :close-nowrite :close
  48     :create :delete :delete-self
  49     :modify
  50     :move-self :moved-from :moved-to :move
  51     :open :all-events))
  52
  53 (deftype inotify-add-flag ()
  54   "Valid flags for the WATCH function."
  55   '(or inotify-add/read-flag
  56     (member :dont-follow :mask-add :oneshot :onlydir)))
  57
  58 (deftype inotify-read-flag ()
  59   "Valid flags which are returned from READ-EVENT."
  60   '(or inotify-add/read-flag
  61     (member :ignored :isdir :q-overflow :unmount)))
  62
  63 (defcfun ("inotify_init" c-inotify-init) :int
  64   "Initialises a new inotify event queue.")
  65
  66 (defcfun ("inotify_add_watch" c-inotify-add-watch) :int
  67   "Watches a path on a event queue."
  68   (fd :int)
  69   (pathname :string)
  70   (mask inotify-flag))
  71
  72 (defcfun ("inotify_rm_watch" c-inotify-rm-watch) :int
  73   "Removes a watched path from a event queue."
  74   (fd :int)
  75   (wd :int))
  76
  77 (binary-types:define-signed int #.(cffi:foreign-type-size :int))
  78
  79 (binary-types:define-binary-struct inotify-event ()
  80   "An inotify native event structure.
  81 WD is the watch/file descriptor,
  82 MASK is the (parsed) combination of events,
  83 COOKIE is a unique integer which connects related events,
  84 NAME optionally identifies a file relative to a watched directory."
  85   (wd 0 :binary-type int)
  86   (mask 0 :binary-type binary-types:u32)
  87   (cookie 0 :binary-type binary-types:u32)
  88   (name NIL))
  89
  90 (defstruct (inotify-instance
  91              (:constructor make-inotify-instance ())
  92              (:conc-name inotify-))
  93   "Contains the stream and file descriptor for a inotify instance."
  94   fd
  95   stream
  96   nonblocking)
  97
  98 ;;;; initialisation and stuff
  99
 100 (defun init-endian ()
 101   "Initialises endianess for the BINARY-TYPES library."
 102   (setf binary-types:*endian*
 103         #+little-endian :little-endian
 104         #+big-endian :big-endian
 105         #-(or little-endian big-endian) (error "unknown endianess")))
 106
 107 ;; um, in what evel-when should this be wrapped?
 108 (init-endian)
 109
 110 ;;;; basic wrapping of the API
 111
 112 (defun read-raw-event (stream)
 113   "Reads a raw event from the inotify stream."
 114   (let* ((event (binary-types:read-binary 'inotify-event stream))
 115          (len (binary-types:read-binary 'binary-types:u32 stream)))
 116     (when (plusp len)
 117       (with-slots (name) event
 118         (setf name (binary-types:read-binary-string stream
 119                                                     :size len
 120                                                     :terminators '(0)))))
 121     event))
 122
 123 (defun read-event-from-stream (stream)
 124   "Reads a event from the inotify stream and converts bitmasks on reading."
 125   (let ((event (read-raw-event stream)))
 126     (with-slots (mask) event
 127       (setf mask (foreign-bitfield-symbols 'inotify-flag mask)))
 128     event))
 129
 130 (defun set-nonblocking (fd nonblocking)
 131   (let ((flags (sb-posix:fcntl fd sb-posix:f-getfl)))
 132     ;; an error is raised if this fails, so we don't have to do it ourselves
 133     (sb-posix:fcntl fd sb-posix:f-setfl
 134                     (funcall (if nonblocking #'logior #'logxor)
 135                              flags sb-posix:o-nonblock))))
 136
 137 (defun init-unregistered-notify (notify &optional (nonblocking T))
 138   "Creates a new inotify event queue.  If NONBLOCKING is set (default),
 139 the file descriptor is set to non-blocking I/O."
 140   (let ((result (c-inotify-init)))
 141     (when (minusp result)
 142       (error "inotify_init failed: ~A" result))
 143     (with-slots (fd stream (non-block nonblocking)) notify
 144       (unwind-protect
 145            ;; file descriptor is collected with auto-close
 146            (progn
 147              (setf fd result)
 148              (when nonblocking
 149                (set-nonblocking fd T)
 150                (setf non-block nonblocking))
 151              (setf stream
 152                    (sb-sys:make-fd-stream
 153                     fd
 154                     :input T
 155                     :element-type '(unsigned-byte 8)
 156                     :name (format NIL "inotify event queue ~A" fd)
 157                     :auto-close T
 158                     :buffering (if nonblocking :none :full))))
 159         ;; if stream is constructed, gc'ing it will cleanup the file descriptor
 160         (unless stream
 161           (sb-posix:close fd)))))
 162   notify)
 163
 164 (defun make-unregistered-notify ()
 165   (init-unregistered-notify (make-inotify-instance)))
 166
 167 (defun close-notify (notify)
 168   "Closes the inotify event queue."
 169   (close (inotify-stream notify))
 170   (values))
 171
 172 (defun watch-raw (notify pathname flags)
 173   "Adds PATHNAME (either pathname or string) to be watched.  FLAGS
 174 determines how exactly (see inotify(7) for detailed information).
 175 Returns a handle which can be used with UNWATCH."
 176   (let ((path (princ-to-string pathname))
 177         result)
 178     (setf result (c-inotify-add-watch
 179                   (inotify-fd notify)
 180                   path
 181                   (typecase flags
 182                     (list (foreign-bitfield-value 'inotify-flag flags))
 183                     (keyword (foreign-bitfield-value 'inotify-flag
 184                                                      (list flags)))
 185                     (T flags))))
 186     (when (minusp result)
 187       (error "inotify_add_watch failed: ~A" result))
 188     result))
 189
 190 (defun unwatch-raw (notify handle)
 191   "Disables watching the path associated with HANDLE."
 192   (let ((result (c-inotify-rm-watch (inotify-fd notify) handle)))
 193     (when (minusp result)
 194       (error "inotify_rm_watch failed: ~A" result)))
 195   (values))
 196
 197 ;;;; support functions, making life easier
 198
 199 (defstruct (registered-inotify-instance
 200              (:include inotify-instance)
 201              (:constructor make-registered-inotify-instance ())
 202              (:conc-name inotify-))
 203   "Additionally to the information in INOTIFY-INSTANCE, records watched
 204 paths in a dictionary."
 205   watched)
 206
 207 (defun make-notify (&optional (nonblocking T))
 208   (let ((result (make-registered-inotify-instance)))
 209     (init-unregistered-notify result nonblocking)
 210     (with-slots (watched) result
 211       (setf watched (make-hash-table :test 'equal)))
 212     result))
 213
 214 (defun watchedp (notify pathname)
 215   "Returns the tuple (HANDLE . FLAGS) if PATHNAME is being watched by NOTIFY,
 216 else NIL."
 217   (awhen (gethash pathname (inotify-watched notify))
 218     (values (car it) (cdr it))))
 219
 220 ;; TODO: handle additional flags, save only list of flags
 221 (defun watch (notify pathname flags)
 222   (let ((handle (watch-raw notify pathname flags)))
 223     (with-slots (watched) notify
 224       (setf (gethash pathname watched) (cons handle flags)))
 225     handle))
 226
 227 (defun unwatch (notify &key pathname handle)
 228   (unless (or pathname handle)
 229     (error "either PATHNAME or HANDLE has to be specified"))
 230   (if handle
 231       (unwatch-raw notify handle)
 232       (let ((handle (watchedp notify pathname)))
 233         (unless handle
 234           (error "PATHNAME ~S isn't being watched" pathname))
 235         (unwatch-raw notify handle)
 236         (remhash pathname (inotify-watched notify))))
 237   (values))
 238
 239 (defun list-watched (notify)
 240   "Returns a list of all watched pathnames in particular order."
 241   (let (result)
 242     (maphash (lambda (k v)
 243                (declare (ignore v))
 244                (push k result))
 245              (inotify-watched notify))
 246     result))
 247
 248 (defun unix-eagainp (fd-stream)
 249   "Returns T on a FD-STREAM, if trying to read raised a EAGAIN error."
 250   (multiple-value-bind (result error)
 251       (sb-unix:unix-read (sb-sys:fd-stream-fd fd-stream) NIL 0)
 252     (declare (ignore result))
 253     (= error sb-unix:eagain)))
 254
 255 (defun event-availablep (notify)
 256   "Returns T if an event is available on the queue."
 257   (if (inotify-nonblocking notify)
 258       (not (unix-eagainp (inotify-stream notify)))
 259       (listen (inotify-stream notify))))
 260
 261 (defun read-event (notify)
 262   "Reads an event from the queue.  Blocks if no event is available."
 263   (read-event-from-stream (inotify-stream notify)))
 264
 265 (defun next-event (notify)
 266   "Reads an event from the queue.  Returns NIL if none is available."
 267   (when (event-availablep notify)
 268     (read-event notify)))
 269
 270 (defmacro! do-events ((var o!notify) &body body)
 271   "Loops BODY with VAR bound to the events retrieved from NOTIFY.  The macro
 272 uses NEXT-EVENT, so that reading an event won't block."
 273   `(loop as ,var = (next-event ,g!notify)
 274       while ,var
 275       do (progn ,.body)))
 276
 277 (defun next-events (notify)
 278   "Reads all available events from the queue.  Returns a list of events."
 279   (let (result)
 280    (do-events (event notify)
 281      (push event result))
 282    (nreverse result)))