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 read-new-value (&optional (stream *query-io*))
 101   "READs a value from the STREAM and returns it (wrapped in a list)."
 102   (format stream "Enter a new value: ~%")
 103   (list (read *query-io*)))
 104
 105 (defun init-endian ()
 106   "Initialises the endianess for the BINARY-TYPES library.  Is automatically
 107 called when the library is loaded."
 108   (setf binary-types:*endian*
 109         (restart-case #+little-endian :little-endian
 110                       #+big-endian :big-endian
 111                       #-(or little-endian big-endian) (error "unknown endianess")
 112           (use-value (value)
 113             :report "Enter a correct value (either :LITTLE-ENDIAN or :BIG-ENDIAN)."
 114             :interactive read-new-value
 115             ;; TODO: better way to test for correct value/retry values?
 116             (case value
 117               ((:little-endian :big-endian) value)
 118               (T (error "wrong value supplied (not :LITTLE-ENDIAN or :BIG-ENDIAN)")))))))
 119
 120 ;; initialise the endianess
 121 (eval-when (:compile-toplevel :load-toplevel :execute)
 122   (init-endian))
 123
 124 ;;;; basic wrapping of the API
 125
 126 (defun read-raw-event-from-stream (stream)
 127   "Reads a raw event from the inotify stream."
 128   (let* ((event (binary-types:read-binary 'inotify-event stream))
 129          (len (binary-types:read-binary 'binary-types:u32 stream)))
 130     (when (plusp len)
 131       (with-slots (name) event
 132         (setf name (binary-types:read-binary-string stream
 133                                                     :size len
 134                                                     :terminators '(0)))))
 135     event))
 136
 137 (defun read-event-from-stream (stream)
 138   "Reads a event from the inotify stream and converts bitmasks on reading."
 139   (let ((event (read-raw-event-from-stream stream)))
 140     (with-slots (mask) event
 141       (setf mask (foreign-bitfield-symbols 'inotify-flag mask)))
 142     event))
 143
 144 (defun set-nonblocking (fd nonblocking)
 145   "Enables or disables NONBLOCKING mode on a file descriptor FD."
 146   (let ((flags (sb-posix:fcntl fd sb-posix:f-getfl)))
 147     ;; an error is raised if this fails, so we don't have to do it ourselves
 148     (sb-posix:fcntl fd sb-posix:f-setfl
 149                     (funcall (if nonblocking #'logior #'logxor)
 150                              flags sb-posix:o-nonblock)))
 151   (values))
 152
 153 (defun init-unregistered-notify (notify &optional (nonblocking T))
 154   "Creates a new inotify event queue.  If NONBLOCKING is set (default),
 155 the file descriptor is set to non-blocking I/O."
 156   (let ((result (c-inotify-init)))
 157     (when (minusp result)
 158       (error "inotify_init failed: ~A" result))
 159     (with-slots (fd stream (non-block nonblocking)) notify
 160       (unwind-protect
 161            ;; file descriptor is collected with auto-close
 162            (progn
 163              (setf fd result)
 164              (when nonblocking
 165                (set-nonblocking fd T)
 166                (setf non-block nonblocking))
 167              (setf stream
 168                    (sb-sys:make-fd-stream
 169                     fd
 170                     :input T
 171                     :element-type '(unsigned-byte 8)
 172                     :name (format NIL "inotify event queue ~A" fd)
 173                     :auto-close T
 174                     :buffering (if nonblocking :none :full))))
 175         ;; if stream is constructed, gc'ing it will cleanup the file descriptor
 176         (unless stream
 177           (sb-posix:close fd)))))
 178   notify)
 179
 180 (defun make-unregistered-notify ()
 181   "Creates a new unregistered NOTIFY instance."
 182   (init-unregistered-notify (make-inotify-instance)))
 183
 184 (defun close-notify (notify)
 185   "Closes the inotify event queue."
 186   (close (inotify-stream notify))
 187   (values))
 188
 189 (defun watch-raw (notify pathname flags)
 190   "Adds PATHNAME (either pathname or string) to be watched.  FLAGS
 191 determines how exactly (see inotify(7) for detailed information).
 192 Returns a handle which can be used with UNWATCH-RAW."
 193   (let ((path (princ-to-string pathname))
 194         result)
 195     (setf result (c-inotify-add-watch
 196                   (inotify-fd notify)
 197                   path
 198                   (typecase flags
 199                     (list (foreign-bitfield-value 'inotify-flag flags))
 200                     (keyword (foreign-bitfield-value 'inotify-flag
 201                                                      (list flags)))
 202                     (T flags))))
 203     (when (minusp result)
 204       (error "inotify_add_watch failed: ~A" result))
 205     result))
 206
 207 (defun unwatch-raw (notify handle)
 208   "Disables watching the path associated with HANDLE."
 209   (let ((result (c-inotify-rm-watch (inotify-fd notify) handle)))
 210     (when (minusp result)
 211       (error "inotify_rm_watch failed: ~A" result)))
 212   (values))
 213
 214 ;;;; support functions, making life easier
 215
 216 (defstruct (registered-inotify-instance
 217              (:include inotify-instance)
 218              (:constructor make-registered-inotify-instance ())
 219              (:conc-name inotify-))
 220   "Additionally to the information in INOTIFY-INSTANCE, records watched
 221 paths in a dictionary."
 222   watched)
 223
 224 (defun make-notify (&optional (nonblocking T))
 225   "Creates a new registered NOTIFY instance.  In NONBLOCKING mode, the file
 226 descriptor is set to non-blocking mode."
 227   (let ((result (make-registered-inotify-instance)))
 228     (init-unregistered-notify result nonblocking)
 229     (with-slots (watched) result
 230       (setf watched (make-hash-table :test 'equal)))
 231     result))
 232
 233 (defun watchedp (notify pathname)
 234   "Returns the tuple (HANDLE . FLAGS) if PATHNAME is being watched by NOTIFY,
 235 else NIL."
 236   (awhen (gethash pathname (inotify-watched notify))
 237     (values (car it) (cdr it))))
 238
 239 ;; TODO: handle additional flags, save only list of flags
 240 (defun watch (notify pathname flags)
 241   "Adds PATHNAME (either pathname or string) to be watched and records the
 242 watched paths.  FLAGS determines how exactly (see inotify(7) for detailed
 243 information).  Returns a handle which can be used with UNWATCH."
 244   (let ((handle (watch-raw notify pathname flags)))
 245     (with-slots (watched) notify
 246       (setf (gethash pathname watched) (cons handle flags)))
 247     handle))
 248
 249 (defun unwatch (notify &key pathname handle)
 250   "Disables watching the path associated with the supplied HANDLE or PATHNAME."
 251   (unless (or pathname handle)
 252     (error "either PATHNAME or HANDLE has to be specified"))
 253   (if handle
 254       (unwatch-raw notify handle)
 255       (let ((handle (watchedp notify pathname)))
 256         (unless handle
 257           (error "PATHNAME ~S isn't being watched" pathname))
 258         (unwatch-raw notify handle)
 259         (remhash pathname (inotify-watched notify))))
 260   (values))
 261
 262 (defun list-watched (notify)
 263   "Returns a list of all watched pathnames in particular order."
 264   (let (result)
 265     (maphash (lambda (k v)
 266                (declare (ignore v))
 267                (push k result))
 268              (inotify-watched notify))
 269     result))
 270
 271 (defun unix-eagainp (fd-stream)
 272   "Returns T on a FD-STREAM if trying to read from the stream raised a EAGAIN
 273 error."
 274   (multiple-value-bind (result error)
 275       (sb-unix:unix-read (sb-sys:fd-stream-fd fd-stream) NIL 0)
 276     (declare (ignore result))
 277     (= error sb-unix:eagain)))
 278
 279 (defun event-availablep (notify)
 280   "Returns T if an event is available on the queue."
 281   (if (inotify-nonblocking notify)
 282       (not (unix-eagainp (inotify-stream notify)))
 283       (listen (inotify-stream notify))))
 284
 285 (defun read-event (notify)
 286   "Reads an event from the queue.  Blocks if no event is available."
 287   (read-event-from-stream (inotify-stream notify)))
 288
 289 (defun next-event (notify)
 290   "Reads an event from the queue.  Returns NIL if none is available."
 291   (when (event-availablep notify)
 292     (read-event notify)))
 293
 294 (defmacro! do-events ((var o!notify) &body body)
 295   "Loops BODY with VAR bound to the events retrieved from NOTIFY.  The macro
 296 uses NEXT-EVENT, so that reading an event won't block."
 297   `(loop as ,var = (next-event ,g!notify)
 298       while ,var
 299       do (progn ,.body)))
 300
 301 (defun next-events (notify)
 302   "Reads all available events from the queue.  Returns a list of events."
 303   (let (result)
 304    (do-events (event notify)
 305      (push event result))
 306    (nreverse result)))