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-notify)
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 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-add-flag ()
54 "Valid flags for the WATCH function."
55 '(or inotify-add/read-flag
56 (member :dont-follow :mask-add :oneshot :onlydir)))
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)))
63 (defcfun ("inotify_init" c-inotify-init) :int
64 "Initialises a new inotify event queue.")
66 (defcfun ("inotify_add_watch" c-inotify-add-watch) :int
67 "Watches a path on a event queue."
72 (defcfun ("inotify_rm_watch" c-inotify-rm-watch) :int
73 "Removes a watched path from a event queue."
77 (binary-types:define-signed int #.(cffi:foreign-type-size :int))
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)
90 (defstruct (inotify-instance
91 (:constructor make-inotify-instance ())
92 (:conc-name inotify-))
93 "Contains the stream and file descriptor for a inotify instance."
98 ;;;; initialisation and stuff
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*))))
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")
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?
119 ((:little-endian :big-endian) value)
120 (T (error "wrong value supplied (not :LITTLE-ENDIAN or :BIG-ENDIAN)"))))))))
122 ;; initialise the endianess
123 (eval-when (:compile-toplevel :load-toplevel :execute)
126 ;;;; basic wrapping of the API
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)))
133 (with-slots (name) event
134 (setf name (binary-types:read-binary-string stream
136 :terminators '(0)))))
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)))
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)))
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
163 ;; file descriptor is collected with auto-close
167 (set-nonblocking fd T)
168 (setf non-block nonblocking))
170 (sb-sys:make-fd-stream
173 :element-type '(unsigned-byte 8)
174 :name (format NIL "inotify event queue ~A" fd)
176 :buffering (if nonblocking :none :full))))
177 ;; if stream is constructed, gc'ing it will cleanup the file descriptor
179 (sb-posix:close fd)))))
182 (defun make-unregistered-notify ()
183 "Creates a new unregistered NOTIFY instance."
184 (init-unregistered-notify (make-inotify-instance)))
186 (defun close-notify (notify)
187 "Closes the inotify event queue."
188 (close (inotify-stream notify))
191 (defun perror (prefix-string)
192 #+sbcl (sb-int:simple-perror prefix-string)
193 #-(or sbcl) (error prefix-string))
195 (defun ensure-list (arg)
196 (if (listp arg) arg `(,arg)))
198 (defun translate-keyword-flags (flags)
201 (foreign-bitfield-value 'inotify-flag (ensure-list flags)))
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
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"))
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")))
225 ;;;; support functions, making life easier
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."
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)))
244 (defun watchedp (notify pathname)
245 "Returns the tuple (HANDLE . FLAGS) if PATHNAME is being watched by NOTIFY,
247 (awhen (gethash pathname (inotify-watched notify))
248 (values (car it) (cdr it))))
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)))
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"))
265 (unwatch-raw notify handle)
266 (let ((handle (watchedp notify pathname)))
268 (error "PATHNAME ~S isn't being watched" pathname))
269 (unwatch-raw notify handle)
270 (remhash pathname (inotify-watched notify))))
273 (defun list-watched (notify)
274 "Returns a list of all watched pathnames in particular order."
276 for pathname being each hash-key in (inotify-watched notify)
279 (defun unix-eagain-p (fd-stream)
280 "Returns T on a FD-STREAM if trying to read from the stream raised a
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)))
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))))
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)))
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)))
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."
308 while (event-available-p ,g!notify)
310 (setf ,var (read-event ,g!notify))
313 (defun next-events (notify)
314 "Reads all available events from the queue. Returns a LIST of events."
316 while (event-available-p notify)
317 collect (read-event notify)))