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-inotify)
  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-RAW 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-read-flag ()
  54   "Valid flags which are returned from READ-EVENT."
  55   '(or inotify-add/read-flag
  56     (member :ignored :isdir :q-overflow :unmount)))
  57
  58 (deftype inotify-add-flag ()
  59   "Valid flags for the WATCH-RAW function."
  60   '(or inotify-add/read-flag
  61     (member :dont-follow :mask-add :oneshot :onlydir)))
  62
  63 (defun valid-watch-flag-p (x)
  64   (and (typep x 'inotify-add-flag)
  65        (not (eq :mask-add x))
  66        (not (eq :oneshot x))))
  67
  68 (defun valid-watch-flag-list-p (list)
  69   (every #'valid-watch-flag-p list))
  70
  71 (deftype watch-flag-list ()
  72   "Valid flags argument for the WATCH function, a list of keywords from
  73 INOTIFY-ADD-FLAG.  Basically only :MASK-ADD and :ONESHOT are removed.
  74 The :MASK-ADD behaviour is replicated with the REPLACE-P argument; the
  75 :ONESHOT behaviour doesn't play well with the WATCH function design (and
  76 thus should be used only with WATCH-RAW)."
  77   '(or (satisfies valid-watch-flag-p)
  78        (and list (satisfies valid-watch-flag-list-p))))
  79
  80 (defcfun ("inotify_init" c-inotify-init) :int
  81   "Initialises a new inotify event queue.")
  82
  83 (defcfun ("inotify_add_watch" c-inotify-add-watch) :int
  84   "Watches a path on a event queue."
  85   (fd :int)
  86   (pathname :string)
  87   (mask inotify-flag))
  88
  89 (defcfun ("inotify_rm_watch" c-inotify-rm-watch) :int
  90   "Removes a watched path from a event queue."
  91   (fd :int)
  92   (wd :int))
  93
  94 (binary-types:define-signed int #.(cffi:foreign-type-size :int))
  95
  96 (binary-types:define-binary-struct inotify-event ()
  97   "An inotify native event structure.
  98 WD is the watch/file descriptor,
  99 MASK is the (parsed) combination of events,
 100 COOKIE is a unique integer which connects related events,
 101 NAME optionally identifies a file relative to a watched directory."
 102   (wd 0 :binary-type int)
 103   (mask 0 :binary-type binary-types:u32)
 104   (cookie 0 :binary-type binary-types:u32)
 105   (name NIL))
 106
 107 (defstruct (inotify-instance
 108              (:constructor make-inotify-instance ())
 109              (:conc-name inotify-))
 110   "Contains the stream and file descriptor for a inotify instance."
 111   fd
 112   stream
 113   nonblocking)
 114
 115 ;;;; initialisation and stuff
 116
 117 (eval-when (:compile-toplevel :load-toplevel :execute)
 118   (defun read-new-value (&optional (stream *query-io*))
 119     "READs a value from the STREAM and returns it (wrapped in a list)."
 120     (format stream "Enter a new value: ~%")
 121     (list (read *query-io*))))
 122
 123 (eval-when (:compile-toplevel :load-toplevel :execute)
 124   (defun init-endian ()
 125     "Initialises the endianess for the BINARY-TYPES library.  Is automatically
 126 called when the library is loaded."
 127     (setf binary-types:*endian*
 128           (restart-case #+little-endian :little-endian
 129                         #+big-endian :big-endian
 130                         #-(or little-endian big-endian) (error "unknown endianess")
 131                         (use-value (value)
 132                           :report "Enter a correct value (either :LITTLE-ENDIAN or :BIG-ENDIAN)."
 133                           :interactive read-new-value
 134                           ;; TODO: better way to test for correct value/retry values?
 135                           (case value
 136                             ((:little-endian :big-endian) value)
 137                             (T (error "wrong value supplied (not :LITTLE-ENDIAN or :BIG-ENDIAN)"))))))))
 138
 139 ;; initialise the endianess
 140 (eval-when (:compile-toplevel :load-toplevel :execute)
 141   (init-endian))
 142
 143 ;;;; basic wrapping of the API
 144
 145 (defun read-raw-event-from-stream (stream)
 146   "Reads a raw event from the inotify stream."
 147   (let* ((event (binary-types:read-binary 'inotify-event stream))
 148          (len (binary-types:read-binary 'binary-types:u32 stream)))
 149     (when (plusp len)
 150       (with-slots (name) event
 151         (setf name (binary-types:read-binary-string stream
 152                                                     :size len
 153                                                     :terminators '(0)))))
 154     event))
 155
 156 (defun read-event-from-stream (stream)
 157   "Reads a event from the inotify stream and converts bitmasks on reading."
 158   (let ((event (read-raw-event-from-stream stream)))
 159     (with-slots (mask) event
 160       (setf mask (foreign-bitfield-symbols 'inotify-flag mask)))
 161     event))
 162
 163 (defun set-nonblocking (fd nonblocking)
 164   "Enables or disables NONBLOCKING mode on a file descriptor FD."
 165   (let ((flags (sb-posix:fcntl fd sb-posix:f-getfl)))
 166     ;; an error is raised if this fails, so we don't have to do it ourselves
 167     (sb-posix:fcntl fd sb-posix:f-setfl
 168                     (funcall (if nonblocking #'logior #'logxor)
 169                              flags sb-posix:o-nonblock)))
 170   (values))
 171
 172 (defun init-unregistered-notify (notify &optional (nonblocking T))
 173   "Creates a new inotify event queue.  If NONBLOCKING is set (default),
 174 the file descriptor is set to non-blocking I/O."
 175   (let ((result (c-inotify-init)))
 176     (when (minusp result)
 177       (perror "inotify_init failed"))
 178     (with-slots (fd stream (non-block nonblocking)) notify
 179       (unwind-protect
 180            ;; file descriptor is collected with auto-close
 181            (progn
 182              (setf fd result)
 183              (when nonblocking
 184                (set-nonblocking fd T)
 185                (setf non-block nonblocking))
 186              (setf stream
 187                    (sb-sys:make-fd-stream
 188                     fd
 189                     :input T
 190                     :element-type '(unsigned-byte 8)
 191                     :name (format NIL "inotify event queue ~A" fd)
 192                     :auto-close T
 193                     :buffering (if nonblocking :none :full))))
 194         ;; if stream is constructed, gc'ing it will cleanup the file descriptor
 195         (unless stream
 196           (sb-posix:close fd)))))
 197   notify)
 198
 199 (defun make-unregistered-notify ()
 200   "Creates a new unregistered NOTIFY instance."
 201   (init-unregistered-notify (make-inotify-instance)))
 202
 203 (defun close-notify (notify)
 204   "Closes the inotify event queue."
 205   (close (inotify-stream notify))
 206   (values))
 207
 208 (defun perror (prefix-string)
 209   #+sbcl (sb-int:simple-perror prefix-string)
 210   #-(or sbcl) (error prefix-string))
 211
 212 (defun ensure-list (arg)
 213   (if (listp arg) arg `(,arg)))
 214
 215 (defun translate-keyword-flags (flags)
 216   (typecase flags
 217     ((or keyword list)
 218      (foreign-bitfield-value 'inotify-flag (ensure-list flags)))
 219     (T flags)))
 220
 221 (defun watch-raw (notify pathname flags)
 222   "Adds PATHNAME (either of type PATHNAME or STRING) to be watched.  FLAGS
 223 determines how exactly (see inotify(7) for detailed information) and can
 224 be of type LIST, KEYWORD or a raw numerical value (which isn't checked
 225 for validity though).  Returns a handle which can be used with UNWATCH-RAW."
 226   (let* ((path (etypecase pathname
 227                  (string pathname)
 228                  (pathname (namestring pathname))))
 229          (result (c-inotify-add-watch (inotify-fd notify)
 230                                       path (translate-keyword-flags flags))))
 231     (when (minusp result)
 232       (perror "inotify_add_watch failed"))
 233     result))
 234
 235 (defun unwatch-raw (notify handle)
 236   "Stops watching the path associated with a HANDLE established by WATCH-RAW."
 237   (let ((result (c-inotify-rm-watch (inotify-fd notify) handle)))
 238     (when (minusp result)
 239       (perror "inotify_rm_watch failed")))
 240   (values))
 241
 242 ;;;; support functions, making life easier
 243
 244 (defstruct (registered-inotify-instance
 245              (:include inotify-instance)
 246              (:constructor make-registered-inotify-instance ())
 247              (:conc-name inotify-))
 248   "Additionally to the information in INOTIFY-INSTANCE, records watched
 249 paths in a dictionary."
 250   watched)
 251
 252 (defun make-notify (&optional (nonblocking T))
 253   "Creates a new registered NOTIFY instance.  In NONBLOCKING mode, the file
 254 descriptor is set to non-blocking mode."
 255   (let ((result (make-registered-inotify-instance)))
 256     (init-unregistered-notify result nonblocking)
 257     (with-slots (watched) result
 258       (setf watched (make-hash-table :test 'equal)))
 259     result))
 260
 261 (defun watchedp (notify pathname)
 262   "Returns two values HANDLE and FLAGS if PATHNAME is being watched by NOTIFY,
 263 else NIL."
 264   (let ((it (gethash pathname (inotify-watched notify))))
 265     (when it (values (car it) (cdr it)))))
 266
 267 (defun sane-user-flags (notify pathname flags &key (replace-p T))
 268   (check-type flags watch-flag-list)
 269   ;; now, :mask-add can't be member of flags
 270   ;; merge the flags
 271   (let* ((flags (ensure-list flags))
 272          (rep-flags (if replace-p
 273                         (cons :mask-add flags)
 274                         flags)))
 275     (let ((it (gethash pathname (slot-value notify 'watched))))
 276       (if it
 277           (union (cdr it) rep-flags :test #'eq)
 278           rep-flags))))
 279
 280 (defun watch (notify pathname flags &key (replace-p T))
 281   "Adds PATHNAME (either pathname or string) to be watched and records the
 282 watched paths.  FLAGS (a list of keywords) determines how exactly (see
 283 inotify(7) for detailed information).  Returns a handle which can be used
 284 with UNWATCH.  If REPLACE-P is set to T (default), the flags mask is
 285 replaced rather than OR-ed to the current mask (if it exists).  The
 286 :MASK-ADD flag is therefore removed from the FLAGS argument."
 287   (let* ((flags (sane-user-flags notify pathname flags :replace-p replace-p))
 288          (handle (watch-raw notify pathname flags)))
 289     (with-slots (watched) notify
 290       (setf (gethash pathname watched) (cons handle flags)))
 291     handle))
 292
 293 (defun unwatch (notify &key pathname handle)
 294   "Disables watching the path associated with the supplied HANDLE or PATHNAME."
 295   (unless (or pathname handle)
 296     (error "either PATHNAME or HANDLE has to be specified"))
 297   (if handle
 298       (unwatch-raw notify handle)
 299       (let ((handle (watchedp notify pathname)))
 300         (unless handle
 301           (error "PATHNAME ~S isn't being watched" pathname))
 302         ;; remove even if unwatch-raw throws an error (which can happen if :oneshot is specified)
 303         (remhash pathname (inotify-watched notify))
 304         (unwatch-raw notify handle)))
 305   (values))
 306
 307 (defun list-watched (notify)
 308   "Returns a list of all watched pathnames in no particular order."
 309   (loop
 310      for pathname being each hash-key in (inotify-watched notify)
 311      collect pathname))
 312
 313 (defun unix-eagain-p (fd-stream)
 314   "Returns T on a FD-STREAM if trying to read from the stream raised a
 315 EAGAIN error."
 316   (multiple-value-bind (result error)
 317       (sb-unix:unix-read (sb-sys:fd-stream-fd fd-stream) NIL 0)
 318     (declare (ignore result))
 319     (= error sb-unix:eagain)))
 320
 321 (defun event-available-p (notify)
 322   "Returns T if an event is available on the queue."
 323   (if (inotify-nonblocking notify)
 324       (not (unix-eagain-p (inotify-stream notify)))
 325       (listen (inotify-stream notify))))
 326
 327 (defun read-event (notify)
 328   "Reads an event from the queue.  Blocks if no event is available."
 329   (read-event-from-stream (inotify-stream notify)))
 330
 331 (defun next-event (notify)
 332   "Reads an event from the queue.  Returns NIL if none is available."
 333   (when (event-available-p notify)
 334     (read-event notify)))
 335
 336 (defmacro do-events ((var notify &key blocking-p) &body body)
 337   "Loops BODY with VAR bound to the next events retrieved from NOTIFY.
 338 The macro uses NEXT-EVENT, so reading an event won't block and the loop
 339 terminates if no events are available."
 340   (check-type var symbol)
 341   (let ((notify-sym (gensym)))
 342    `(loop
 343        with ,var and ,notify-sym = ,notify
 344        ,.(unless blocking-p
 345            `(while (event-available-p ,notify-sym)))
 346        do (progn
 347             (setf ,var (read-event ,notify-sym))
 348             ,.body))))
 349
 350 (defun next-events (notify)
 351   "Reads all available events from the queue.  Returns a LIST of events."
 352   (loop
 353      while (event-available-p notify)
 354      collect (read-event notify)))