1 ;; Copyright (C) 2009 Olof-Joachim Frahm
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.
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.
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/>.
16 (in-package #:cl-inotify)
18 (defbitfield (inotify-flag :uint32)
22 (:close-write #.in-close-write)
23 (:close-nowrite #.in-close-nowrite)
26 (:moved-from #.in-moved-from)
27 (:moved-to #.in-moved-to)
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)
40 (:oneshot #.in-oneshot)
41 (:all-events #.in-all-events))
43 (deftype inotify-add/read-flag ()
44 "Shared valid flags for the WATCH-RAW and READ-EVENT functions."
47 :close-write :close-nowrite :close
48 :create :delete :delete-self
50 :move-self :moved-from :moved-to :move
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)))
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)))
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))))
68 (defun valid-watch-flag-list-p (list)
69 (every #'valid-watch-flag-p list))
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))))
80 (defcfun ("inotify_init" c-inotify-init) :int
81 "Initialises a new inotify event queue.")
83 (defcfun ("inotify_add_watch" c-inotify-add-watch) :int
84 "Watches a path on a event queue."
89 (defcfun ("inotify_rm_watch" c-inotify-rm-watch) :int
90 "Removes a watched path from a event queue."
94 (binary-types:define-signed int #.(cffi:foreign-type-size :int))
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)
107 (defstruct (inotify-instance
108 (:constructor make-inotify-instance ())
109 (:conc-name inotify-))
110 "Contains the stream and file descriptor for a inotify instance."
115 ;;;; initialisation and stuff
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*))))
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")
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?
136 ((:little-endian :big-endian) value)
137 (T (error "wrong value supplied (not :LITTLE-ENDIAN or :BIG-ENDIAN)"))))))))
139 ;; initialise the endianess
140 (eval-when (:compile-toplevel :load-toplevel :execute)
143 ;;;; basic wrapping of the API
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)))
150 (with-slots (name) event
151 (setf name (binary-types:read-binary-string stream
153 :terminators '(0)))))
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)))
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)))
172 (defun init-unregistered-inotify (inotify &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)) inotify
180 ;; file descriptor is collected with auto-close
184 (set-nonblocking fd T)
185 (setf non-block nonblocking))
187 (sb-sys:make-fd-stream
190 :element-type '(unsigned-byte 8)
191 :name (format NIL "inotify event queue ~A" fd)
193 :buffering (if nonblocking :none :full))))
194 ;; if stream is constructed, gc'ing it will cleanup the file descriptor
196 (sb-posix:close fd)))))
199 (defun make-unregistered-inotify ()
200 "Creates a new unregistered INOTIFY instance."
201 (init-unregistered-inotify (make-inotify-instance)))
203 (defun close-inotify (inotify)
204 "Closes the inotify event queue."
205 (close (inotify-stream inotify))
208 (defun perror (prefix-string)
209 #+sbcl (sb-int:simple-perror prefix-string)
210 #-(or sbcl) (error prefix-string))
212 (defun ensure-list (arg)
213 (if (listp arg) arg `(,arg)))
215 (defun translate-keyword-flags (flags)
218 (foreign-bitfield-value 'inotify-flag (ensure-list flags)))
221 (defun watch-raw (inotify 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
228 (pathname (namestring pathname))))
229 (result (c-inotify-add-watch (inotify-fd inotify)
230 path (translate-keyword-flags flags))))
231 (when (minusp result)
232 (perror "inotify_add_watch failed"))
235 (defun unwatch-raw (inotify handle)
236 "Stops watching the path associated with a HANDLE established by WATCH-RAW."
237 (let ((result (c-inotify-rm-watch (inotify-fd inotify) handle)))
238 (when (minusp result)
239 (perror "inotify_rm_watch failed")))
242 ;;;; support functions, making life easier
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."
252 (defun make-inotify (&optional (nonblocking T))
253 "Creates a new registered INOTIFY instance. In NONBLOCKING mode, the file
254 descriptor is set to non-blocking mode. The resulting object has to be
255 closed with CLOSE-INOTIFY."
256 (let ((result (make-registered-inotify-instance)))
257 (init-unregistered-inotify result nonblocking)
258 (with-slots (watched) result
259 (setf watched (make-hash-table :test 'equal)))
262 (defun watchedp (inotify pathname)
263 "Returns two values HANDLE and FLAGS if PATHNAME is being watched by INOTIFY,
264 else NIL. The match is exact."
265 (let ((it (gethash pathname (inotify-watched Inotify))))
266 (when it (values (car it) (cdr it)))))
268 (defun sane-user-flags (inotify pathname flags &key (replace-p T))
269 (check-type flags watch-flag-list)
270 ;; now, :mask-add can't be member of flags
272 (let* ((flags (ensure-list flags))
273 (rep-flags (if replace-p
274 (cons :mask-add flags)
276 (let ((it (gethash pathname (slot-value inotify 'watched))))
278 (union (cdr it) rep-flags :test #'eq)
281 (defun watch (inotify pathname flags &key (replace-p T))
282 "Adds PATHNAME (either pathname or string) to be watched and records the
283 watched paths. FLAGS (a list of keywords) determines how exactly (see
284 inotify(7) for detailed information). Returns a handle which can be used
285 with UNWATCH. If REPLACE-P is set to T (default), the flags mask is
286 replaced rather than OR-ed to the current mask (if it exists). The
287 :MASK-ADD flag is therefore removed from the FLAGS argument."
288 (let* ((flags (sane-user-flags inotify pathname flags :replace-p replace-p))
289 (handle (watch-raw inotify pathname flags)))
290 (with-slots (watched) inotify
291 (setf (gethash pathname watched) (cons handle flags)))
294 (defun unwatch (inotify &key pathname handle)
295 "Disables watching the path associated with the supplied HANDLE or PATHNAME."
296 (unless (or pathname handle)
297 (error "either PATHNAME or HANDLE has to be specified"))
299 (unwatch-raw inotify handle)
300 (let ((handle (watchedp inotify pathname)))
302 (error "PATHNAME ~S isn't being watched" pathname))
303 ;; remove even if unwatch-raw throws an error (which can happen if :oneshot is specified)
304 (remhash pathname (inotify-watched inotify))
305 (unwatch-raw inotify handle)))
308 (defun list-watched (inotify)
309 "Returns a LIST of all watched pathnames in no particular order."
311 for pathname being each hash-key in (inotify-watched inotify)
314 (defun unix-eagain-p (fd-stream)
315 "Returns T on a FD-STREAM if trying to read from the stream raised a
317 (multiple-value-bind (result error)
318 (sb-unix:unix-read (sb-sys:fd-stream-fd fd-stream) NIL 0)
319 (declare (ignore result))
320 (= error sb-unix:eagain)))
322 (defun event-available-p (inotify)
323 "Returns T if an event is available on the queue."
324 (if (inotify-nonblocking inotify)
325 (not (unix-eagain-p (inotify-stream inotify)))
326 (listen (inotify-stream inotify))))
328 (defun read-event (inotify)
329 "Reads an event from the queue. Blocks if no event is available."
330 (read-event-from-stream (inotify-stream inotify)))
332 (defun next-event (inotify)
333 "Reads an event from the queue. Returns NIL if none is available."
334 (when (event-available-p inotify)
335 (read-event inotify)))
337 (defmacro do-events ((var inotify &key blocking-p) &body body)
338 "Loops BODY with VAR bound to the next events retrieved from INOTIFY.
339 The macro uses NEXT-EVENT, so reading an event won't block and the loop
340 terminates if no events are available."
341 (check-type var symbol)
342 (let ((inotify-sym (gensym)))
344 with ,var and ,inotify-sym = ,inotify
346 `(while (event-available-p ,inotify-sym)))
348 (setf ,var (read-event ,inotify-sym))
351 (defun next-events (inotify)
352 "Reads all available events from the queue. Returns a LIST of events."
354 while (event-available-p inotify)
355 collect (read-event inotify)))