;;; -*- mode: lisp; syntax: common-lisp; coding: utf-8; package: cl-inotify; -*-
-;; Copyright (c) 2011, Olof-Joachim Frahm
+;; Copyright (c) 2011-12, Olof-Joachim Frahm
;; All rights reserved.
;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are met:
-;; * Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;; * Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-;; * The name of the author may not be used to endorse or promote products
-;; derived from this software without specific prior written permission.
-
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;; ARE DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
-;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
-;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;; modification, are permitted provided that the following conditions
+;; are met:
+
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package #:cl-inotify)
(len (binary-types:read-binary 'binary-types:u32 stream)))
(when (plusp len)
(with-slots (name) event
- (setf name (binary-types:read-binary-string stream
- :size len
- :terminators '(0)))))
+ (let ((buffer (make-array len :element-type '(unsigned-byte 8))))
+ (read-sequence buffer stream :end len)
+ (setf name (trivial-utf-8:utf-8-bytes-to-string buffer :end (position 0 buffer))))))
event))
(defun read-event-from-stream (stream)
(sb-posix:close fd)))))
inotify)
-(defun make-unregistered-inotify ()
+(defun make-unregistered-inotify (&optional (nonblocking T))
"Creates a new unregistered INOTIFY instance."
- (init-unregistered-inotify (make-inotify-instance)))
+ (init-unregistered-inotify (make-inotify-instance) nonblocking))
(defun close-inotify (inotify)
"Closes the inotify event queue."
(setf watched (make-hash-table :test 'equal)))
result))
-(defun watchedp (inotify pathname)
- "Returns two values HANDLE and FLAGS if PATHNAME is being watched by INOTIFY,
-else NIL. The match is exact."
- (let ((it (gethash pathname (inotify-watched Inotify))))
- (when it (values (car it) (cdr it)))))
+(defun pathname-handle/flags (inotify pathname)
+ "Returns a CONS cell with the values HANDLE and FLAGS if PATHNAME is
+being watched by INOTIFY, else NIL. The match is exact."
+ (gethash pathname (inotify-watched inotify)))
+
+(defun event-pathname/flags (inotify event &optional (handle (slot-value event 'wd)))
+ "Returns two values PATHNAME and FLAGS for an EVENT which were used during
+registration. If HANDLE is specified EVENT is ignored."
+ (block NIL
+ (maphash (lambda (pathname entry)
+ (when (eql (car entry) handle)
+ (return (values pathname (cdr entry)))))
+ (inotify-watched inotify))))
(defun sane-user-flags (inotify pathname flags &key (replace-p T))
(check-type flags watch-flag-list)
"Adds PATHNAME (either pathname or string) to be watched and records the
watched paths. FLAGS (a list of keywords) determines how exactly (see
inotify(7) for detailed information). Returns a handle which can be used
-with UNWATCH. If REPLACE-P is set to T (default), the flags mask is
-replaced rather than OR-ed to the current mask (if it exists). The
-:MASK-ADD flag is therefore removed from the FLAGS argument."
+with UNWATCH and EVENT-PATHNAME/FLAGS. If REPLACE-P is set to T (default),
+the flags mask is replaced rather than OR-ed to the current mask (if it
+exists). The :MASK-ADD flag is therefore removed from the FLAGS argument."
(let* ((flags (sane-user-flags inotify pathname flags :replace-p replace-p))
(handle (watch-raw inotify pathname flags)))
(with-slots (watched) inotify
(setf (gethash pathname watched) (cons handle flags)))
handle))
-(defun unwatch (inotify &key pathname handle)
- "Disables watching the path associated with the supplied HANDLE or PATHNAME."
- (unless (or pathname handle)
- (error "either PATHNAME or HANDLE has to be specified"))
+(defun unwatch (inotify &key pathname event handle)
+ "Disables watching the path associated with the supplied HANDLE (which
+may be one from a given EVENT) or PATHNAME."
+ (unless (or pathname event handle)
+ (error "either PATHNAME, EVENT or HANDLE have to be specified"))
+ (when event
+ (setf handle (slot-value event 'wd)))
(if handle
(unwatch-raw inotify handle)
- (let ((handle (watchedp inotify pathname)))
+ (let ((handle (car (pathname-handle/flags inotify pathname))))
(unless handle
(error "PATHNAME ~S isn't being watched" pathname))
;; remove even if unwatch-raw throws an error (which can happen if :oneshot is specified)
(defun list-watched (inotify)
"Returns a LIST of all watched pathnames in no particular order."
(loop
- for pathname being each hash-key in (inotify-watched inotify)
- collect pathname))
+ for pathname being each hash-key in (inotify-watched inotify)
+ collect pathname))
(defun unix-eagain-p (fd-stream)
"Returns T on a FD-STREAM if trying to read from the stream raised a
(check-type var symbol)
(let ((inotify-sym (gensym)))
`(loop
- with ,var and ,inotify-sym = ,inotify
- ,.(unless blocking-p
- `(while (event-available-p ,inotify-sym)))
- do (progn
- (setf ,var (read-event ,inotify-sym))
- ,.body))))
+ with ,var and ,inotify-sym = ,inotify
+ ,.(unless blocking-p
+ `(while (event-available-p ,inotify-sym)))
+ do (progn
+ (setf ,var (read-event ,inotify-sym))
+ ,.body))))
(defun next-events (inotify)
"Reads all available events from the queue. Returns a LIST of events."
(loop
- while (event-available-p inotify)
- collect (read-event inotify)))
+ while (event-available-p inotify)
+ collect (read-event inotify)))
+
+;;; this has the longer name, because this way you actually have to read
+;;; about the differences, at least i hope so
+(defmacro with-unregistered-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
+ "Like WITH-INOTIFY, but uses MAKE-UNREGISTERED-INOTIFY and WATCH-RAW
+instead. Useful if you need to monitor just a fixed set of paths."
+ `(let* ((,inotify (make-unregistered-inotify ,nonblocking)))
+ (unwind-protect
+ (progn
+ ,.(mapcar (lambda (specifier)
+ `(watch-raw ,inotify ,.specifier))
+ rest)
+ ,.body)
+ (close-inotify ,inotify))))
+
+(defmacro with-inotify ((inotify &optional (nonblocking T) &rest rest) &body body)
+ "Executes BODY with a newly created queue bound to INOTIFY if true.
+See MAKE-INOTIFY for more information about possible arguments.
+
+The REST is a list of argument forms for the WATCH function, i.e. one or
+more forms (PATHNAME FLAGS &KEY (REPLACE-P T)).
+
+Since the QUEUE is closed on unwinding, this macro doesn't bother with
+UNWATCH calls on all WATCHed paths."
+ `(let* ((,inotify (make-inotify ,nonblocking)))
+ (unwind-protect
+ (progn
+ ,.(mapcar (lambda (specifier)
+ `(watch ,inotify ,.specifier))
+ rest)
+ ,.body)
+ (close-inotify ,inotify))))