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