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 (defun init-endian ()
101 "Initialises endianess for the BINARY-TYPES library."
102 (setf binary-types:*endian*
103 #+little-endian :little-endian
104 #+big-endian :big-endian
105 #-(or little-endian big-endian) (error "unknown endianess")))
107 ;; um, in what evel-when should this be wrapped?
110 ;;;; basic wrapping of the API
112 (defun read-raw-event-from-stream (stream)
113 "Reads a raw event from the inotify stream."
114 (let* ((event (binary-types:read-binary 'inotify-event stream))
115 (len (binary-types:read-binary 'binary-types:u32 stream)))
117 (with-slots (name) event
118 (setf name (binary-types:read-binary-string stream
120 :terminators '(0)))))
123 (defun read-event-from-stream (stream)
124 "Reads a event from the inotify stream and converts bitmasks on reading."
125 (let ((event (read-raw-event-from-stream stream)))
126 (with-slots (mask) event
127 (setf mask (foreign-bitfield-symbols 'inotify-flag mask)))
130 (defun set-nonblocking (fd nonblocking)
131 (let ((flags (sb-posix:fcntl fd sb-posix:f-getfl)))
132 ;; an error is raised if this fails, so we don't have to do it ourselves
133 (sb-posix:fcntl fd sb-posix:f-setfl
134 (funcall (if nonblocking #'logior #'logxor)
135 flags sb-posix:o-nonblock))))
137 (defun init-unregistered-notify (notify &optional (nonblocking T))
138 "Creates a new inotify event queue. If NONBLOCKING is set (default),
139 the file descriptor is set to non-blocking I/O."
140 (let ((result (c-inotify-init)))
141 (when (minusp result)
142 (error "inotify_init failed: ~A" result))
143 (with-slots (fd stream (non-block nonblocking)) notify
145 ;; file descriptor is collected with auto-close
149 (set-nonblocking fd T)
150 (setf non-block nonblocking))
152 (sb-sys:make-fd-stream
155 :element-type '(unsigned-byte 8)
156 :name (format NIL "inotify event queue ~A" fd)
158 :buffering (if nonblocking :none :full))))
159 ;; if stream is constructed, gc'ing it will cleanup the file descriptor
161 (sb-posix:close fd)))))
164 (defun make-unregistered-notify ()
165 (init-unregistered-notify (make-inotify-instance)))
167 (defun close-notify (notify)
168 "Closes the inotify event queue."
169 (close (inotify-stream notify))
172 (defun watch-raw (notify pathname flags)
173 "Adds PATHNAME (either pathname or string) to be watched. FLAGS
174 determines how exactly (see inotify(7) for detailed information).
175 Returns a handle which can be used with UNWATCH."
176 (let ((path (princ-to-string pathname))
178 (setf result (c-inotify-add-watch
182 (list (foreign-bitfield-value 'inotify-flag flags))
183 (keyword (foreign-bitfield-value 'inotify-flag
186 (when (minusp result)
187 (error "inotify_add_watch failed: ~A" result))
190 (defun unwatch-raw (notify handle)
191 "Disables watching the path associated with HANDLE."
192 (let ((result (c-inotify-rm-watch (inotify-fd notify) handle)))
193 (when (minusp result)
194 (error "inotify_rm_watch failed: ~A" result)))
197 ;;;; support functions, making life easier
199 (defstruct (registered-inotify-instance
200 (:include inotify-instance)
201 (:constructor make-registered-inotify-instance ())
202 (:conc-name inotify-))
203 "Additionally to the information in INOTIFY-INSTANCE, records watched
204 paths in a dictionary."
207 (defun make-notify (&optional (nonblocking T))
208 (let ((result (make-registered-inotify-instance)))
209 (init-unregistered-notify result nonblocking)
210 (with-slots (watched) result
211 (setf watched (make-hash-table :test 'equal)))
214 (defun watchedp (notify pathname)
215 "Returns the tuple (HANDLE . FLAGS) if PATHNAME is being watched by NOTIFY,
217 (awhen (gethash pathname (inotify-watched notify))
218 (values (car it) (cdr it))))
220 ;; TODO: handle additional flags, save only list of flags
221 (defun watch (notify pathname flags)
222 (let ((handle (watch-raw notify pathname flags)))
223 (with-slots (watched) notify
224 (setf (gethash pathname watched) (cons handle flags)))
227 (defun unwatch (notify &key pathname handle)
228 (unless (or pathname handle)
229 (error "either PATHNAME or HANDLE has to be specified"))
231 (unwatch-raw notify handle)
232 (let ((handle (watchedp notify pathname)))
234 (error "PATHNAME ~S isn't being watched" pathname))
235 (unwatch-raw notify handle)
236 (remhash pathname (inotify-watched notify))))
239 (defun list-watched (notify)
240 "Returns a list of all watched pathnames in particular order."
242 (maphash (lambda (k v)
245 (inotify-watched notify))
248 (defun unix-eagainp (fd-stream)
249 "Returns T on a FD-STREAM, if trying to read raised a EAGAIN error."
250 (multiple-value-bind (result error)
251 (sb-unix:unix-read (sb-sys:fd-stream-fd fd-stream) NIL 0)
252 (declare (ignore result))
253 (= error sb-unix:eagain)))
255 (defun event-availablep (notify)
256 "Returns T if an event is available on the queue."
257 (if (inotify-nonblocking notify)
258 (not (unix-eagainp (inotify-stream notify)))
259 (listen (inotify-stream notify))))
261 (defun read-event (notify)
262 "Reads an event from the queue. Blocks if no event is available."
263 (read-event-from-stream (inotify-stream notify)))
265 (defun next-event (notify)
266 "Reads an event from the queue. Returns NIL if none is available."
267 (when (event-availablep notify)
268 (read-event notify)))
270 (defmacro! do-events ((var o!notify) &body body)
271 "Loops BODY with VAR bound to the events retrieved from NOTIFY. The macro
272 uses NEXT-EVENT, so that reading an event won't block."
273 `(loop as ,var = (next-event ,g!notify)
277 (defun next-events (notify)
278 "Reads all available events from the queue. Returns a list of events."
280 (do-events (event notify)