inotify.lisp

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