[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 158bb85 1/2: Fix issues regarding inotify file-noti
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] master 158bb85 1/2: Fix issues regarding inotify file-notification |
Date: |
Sun, 26 Mar 2017 03:43:09 -0400 (EDT) |
branch: master
commit 158bb8555dfefa50f6118be6794d0424cc52d291
Author: Andreas Politz <address@hidden>
Commit: Michael Albinus <address@hidden>
Fix issues regarding inotify file-notification
Remove special code handling the inotify back-end.
* lisp/filenotify.el (file-notify--watch): New struct
representing a file-watch.
(file-notify-descriptors): Use the new struct as hash-value.
(file-notify-handle-event): Check that event is a cons.
(file-notify--rm-descriptor, file-notify--event-watched-file)
(file-notify--event-file-name, file-notify--event-file1-name)
(file-notify-callback, file-notify-add-watch)
(file-notify-rm-watch, file-notify-valid-p): Use new struct.
Remove special code handling inotify descriptors. Remove code
handling multiple clients per descriptor.
(file-notify--descriptor): Remove unused function.
Let inotify-add-watch return a unique descriptor on every
call, like every other back-end does (Bug#26126). Prevent
multiple clients from interfering with each other, when
watching a shared descriptor.
* src/inotify.c (watch_list): Extend the format by including a
id and the provided mask.
(INOTIFY_DEFAULT_MASK): Default mask used for all clients.
(make_watch_descriptor): Removed.
(make_lispy_mask, lispy_mask_match_p): New functions.
(inotifyevent_to_event): Match event against the mask provided
by the client.
(add_watch, remove_descriptor, remove_watch): New functions
for managing the watch_list.
(inotify_callback): Use the new functions.
(Finotify_add_watch, Finotify_rm_watch): Remove deprecated
flags from documentation. Add check for validity of provided
descriptor. Use the new functions. Use the default mask.
(INOTIFY_DEBUG): Add new debug conditional.
(inotify-watch-list, inotify-allocated-p): New debug functions.
(symbol_to_inotifymask, syms_of_inotify): Remove deprecated symbols.
* test/lisp/filenotify-tests.el:
(file-notify-test02-rm-watch): Remove expected failure for inotify.
---
lisp/filenotify.el | 432 +++++++++++++++++++-----------------------
src/inotify.c | 374 ++++++++++++++++++++++--------------
test/lisp/filenotify-tests.el | 5 -
3 files changed, 433 insertions(+), 378 deletions(-)
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 80e9f89..0f8c945 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -40,41 +40,42 @@ The value is the name of the low-level file notification
package
to be used for local file systems. Remote file notifications
could use another implementation.")
+(cl-defstruct (file-notify--watch
+ (:constructor nil)
+ (:constructor file-notify--watch-make (directory filename
callback)))
+ ;; Watched directory
+ directory
+ ;; Watched relative filename, nil if watching the directory.
+ filename
+ ;; Function to propagate events to
+ callback)
+
+(defun file-notify--watch-absolute-filename (watch)
+ (if (file-notify--watch-filename watch)
+ (expand-file-name
+ (file-notify--watch-filename watch)
+ (file-notify--watch-directory watch))
+ (file-notify--watch-directory watch)))
+
(defvar file-notify-descriptors (make-hash-table :test 'equal)
"Hash table for registered file notification descriptors.
A key in this hash table is the descriptor as returned from
`inotify', `kqueue', `gfilenotify', `w32notify' or a file name
-handler. The value in the hash table is a list
-
- (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...)
-
-Several values for a given DIR happen only for `inotify', when
-different files from the same directory are watched.")
+handler. The value in the hash table is file-notify--watch
+struct.")
(defun file-notify--rm-descriptor (descriptor)
"Remove DESCRIPTOR from `file-notify-descriptors'.
-DESCRIPTOR should be an object returned by `file-notify-add-watch'.
-If it is registered in `file-notify-descriptors', a stopped event is sent."
- (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
- (registered (gethash desc file-notify-descriptors))
- (file (if (consp descriptor) (cdr descriptor) (cl-caadr registered)))
- (dir (car registered)))
-
- (when (consp registered)
- ;; Send `stopped' event.
- (when (consp (assoc file (cdr registered)))
+DESCRIPTOR should be an object returned by
+`file-notify-add-watch'. If it is registered in
+`file-notify-descriptors', a stopped event is sent."
+ (when-let (watch (gethash descriptor file-notify-descriptors))
+ ;; Send `stopped' event.
+ (unwind-protect
(funcall
- (cdr (assoc file (cdr registered)))
- `(,descriptor stopped ,(if file (expand-file-name file dir) dir))))
-
- ;; Modify `file-notify-descriptors'.
- (if (not file)
- (remhash desc file-notify-descriptors)
- (setcdr registered
- (delete (assoc file (cdr registered)) (cdr registered)))
- (if (null (cdr registered))
- (remhash desc file-notify-descriptors)
- (puthash desc registered file-notify-descriptors))))))
+ (file-notify--watch-callback watch)
+ `(,descriptor stopped ,(file-notify--watch-absolute-filename watch)))
+ (remhash descriptor file-notify-descriptors))))
;; This function is used by `inotify', `kqueue', `gfilenotify' and
;; `w32notify' events.
@@ -88,7 +89,8 @@ If EVENT is a filewatch event, call its callback. It has the
format
Otherwise, signal a `file-notify-error'."
(interactive "e")
;;(message "file-notify-handle-event %S" event)
- (if (and (eq (car event) 'file-notify)
+ (if (and (consp event)
+ (eq (car event) 'file-notify)
(>= (length event) 3))
(funcall (nth 2 event) (nth 1 event))
(signal 'file-notify-error
@@ -96,33 +98,33 @@ Otherwise, signal a `file-notify-error'."
;; Needed for `inotify' and `w32notify'. In the latter case, COOKIE is nil.
(defvar file-notify--pending-event nil
- "A pending file notification events for a future `renamed' action.
+ "A pending file notification event for a future `renamed' action.
It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
(defun file-notify--event-watched-file (event)
"Return file or directory being watched.
Could be different from the directory watched by the backend library."
- (let* ((desc (if (consp (car event)) (caar event) (car event)))
- (registered (gethash desc file-notify-descriptors))
- (file (if (consp (car event)) (cdar event) (cl-caadr registered)))
- (dir (car registered)))
- (if file (expand-file-name file dir) dir)))
+ (when-let (watch (gethash (car event) file-notify-descriptors))
+ (file-notify--watch-absolute-filename watch)))
(defun file-notify--event-file-name (event)
"Return file name of file notification event, or nil."
- (directory-file-name
- (expand-file-name
- (or (and (stringp (nth 2 event)) (nth 2 event)) "")
- (car (gethash (car event) file-notify-descriptors)))))
+ (when-let (watch (gethash (car event) file-notify-descriptors))
+ (directory-file-name
+ (expand-file-name
+ (or (and (stringp (nth 2 event)) (nth 2 event)) "")
+ (file-notify--watch-directory watch)))))
;; Only `gfilenotify' could return two file names.
(defun file-notify--event-file1-name (event)
"Return second file name of file notification event, or nil.
This is available in case a file has been moved."
- (and (stringp (nth 3 event))
- (directory-file-name
- (expand-file-name
- (nth 3 event) (car (gethash (car event) file-notify-descriptors))))))
+ (when-let (watch (gethash (car event) file-notify-descriptors))
+ (and (stringp (nth 3 event))
+ (directory-file-name
+ (expand-file-name
+ (nth 3 event)
+ (file-notify--watch-directory watch))))))
;; Cookies are offered by `inotify' only.
(defun file-notify--event-cookie (event)
@@ -130,21 +132,6 @@ This is available in case a file has been moved."
This is available in case a file has been moved."
(nth 3 event))
-;; `inotify' returns the same descriptor when the file (directory)
-;; uses the same inode. We want to distinguish, and apply a virtual
-;; descriptor which make the difference.
-(defun file-notify--descriptor (desc file)
- "Return the descriptor to be used in `file-notify-*-watch'.
-For `gfilenotify' and `w32notify' it is the same descriptor as
-used in the low-level file notification package."
- (if (and (natnump desc) (eq file-notify--library 'inotify))
- (cons desc
- (and (stringp file)
- (car (assoc
- (file-name-nondirectory file)
- (gethash desc file-notify-descriptors)))))
- desc))
-
;; The callback function used to map between specific flags of the
;; respective file notifications, and the ones we return.
(defun file-notify-callback (event)
@@ -152,138 +139,125 @@ used in the low-level file notification package."
EVENT is the cadr of the event in `file-notify-handle-event'
\(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])."
(let* ((desc (car event))
- (registered (gethash desc file-notify-descriptors))
+ (watch (gethash desc file-notify-descriptors))
(actions (nth 1 event))
(file (file-notify--event-file-name event))
- file1 callback pending-event stopped)
+ file1 pending-event stopped)
;; Make actions a list.
(unless (consp actions) (setq actions (cons actions nil)))
- ;; Loop over registered entries. In fact, more than one entry
- ;; happens only for `inotify'.
- (dolist (entry (cdr registered))
-
- ;; Check, that event is meant for us.
- (unless (setq callback (cdr entry))
- (setq actions nil))
-
+ (when watch
;; Loop over actions. In fact, more than one action happens only
;; for `inotify' and `kqueue'.
- (dolist (action actions)
-
- ;; Send pending event, if it doesn't match.
- (when (and file-notify--pending-event
- ;; The cookie doesn't match.
- (not (eq (file-notify--event-cookie
- (car file-notify--pending-event))
- (file-notify--event-cookie event)))
- (or
- ;; inotify.
- (and (eq (nth 1 (car file-notify--pending-event))
- 'moved-from)
- (not (eq action 'moved-to)))
- ;; w32notify.
- (and (eq (nth 1 (car file-notify--pending-event))
- 'renamed-from)
- (not (eq action 'renamed-to)))))
- (setq pending-event file-notify--pending-event
- file-notify--pending-event nil)
- (setcar (cdar pending-event) 'deleted))
-
- ;; Map action. We ignore all events which cannot be mapped.
- (setq action
- (cond
- ((memq action
- '(attribute-changed changed created deleted renamed))
- action)
- ((memq action '(moved rename))
- ;; The kqueue rename event does not return file1 in
- ;; case a file monitor is established.
- (if (setq file1 (file-notify--event-file1-name event))
- 'renamed 'deleted))
- ((eq action 'ignored)
- (setq stopped t actions nil))
- ((memq action '(attrib link)) 'attribute-changed)
- ((memq action '(create added)) 'created)
- ((memq action '(modify modified write)) 'changed)
- ((memq action '(delete delete-self move-self removed)) 'deleted)
- ;; Make the event pending.
- ((memq action '(moved-from renamed-from))
- (setq file-notify--pending-event
- `((,desc ,action ,file ,(file-notify--event-cookie
event))
- ,callback))
- nil)
- ;; Look for pending event.
- ((memq action '(moved-to renamed-to))
- (if (null file-notify--pending-event)
- 'created
- (setq file1 file
- file (file-notify--event-file-name
- (car file-notify--pending-event)))
- ;; If the source is handled by another watch, we
- ;; must fire the rename event there as well.
- (when (not (equal (file-notify--descriptor desc file1)
- (file-notify--descriptor
- (caar file-notify--pending-event)
- (file-notify--event-file-name
- file-notify--pending-event))))
- (setq pending-event
- `((,(caar file-notify--pending-event)
- renamed ,file ,file1)
- ,(cadr file-notify--pending-event))))
- (setq file-notify--pending-event nil)
- 'renamed))))
-
- ;; Apply pending callback.
- (when pending-event
- (setcar
- (car pending-event)
- (file-notify--descriptor
- (caar pending-event)
- (file-notify--event-file-name file-notify--pending-event)))
- (funcall (cadr pending-event) (car pending-event))
- (setq pending-event nil))
-
- ;; Apply callback.
- (when (and action
- (or
- ;; If there is no relative file name for that watch,
- ;; we watch the whole directory.
- (null (nth 0 entry))
- ;; File matches.
- (string-equal
- (nth 0 entry) (file-name-nondirectory file))
- ;; Directory matches.
- (string-equal
- (file-name-nondirectory file)
- (file-name-nondirectory (car registered)))
- ;; File1 matches.
- (and (stringp file1)
- (string-equal
- (nth 0 entry) (file-name-nondirectory file1)))))
- ;;(message
- ;;"file-notify-callback %S %S %S %S %S"
- ;;(file-notify--descriptor desc (car entry))
- ;;action file file1 registered)
- (if file1
- (funcall
- callback
- `(,(file-notify--descriptor desc (car entry))
- ,action ,file ,file1))
- (funcall
- callback
- `(,(file-notify--descriptor desc (car entry)) ,action ,file))))
-
- ;; Send `stopped' event.
- (when (or stopped
- (and (memq action '(deleted renamed))
- ;; Not, when a file is backed up.
- (not (and (stringp file1) (backup-file-name-p file1)))
- ;; Watched file or directory is concerned.
- (string-equal
- file (file-notify--event-watched-file event))))
- (file-notify-rm-watch (file-notify--descriptor desc (car
entry))))))))
+ (while actions
+ (let ((action (pop actions)))
+ ;; Send pending event, if it doesn't match.
+ (when (and file-notify--pending-event
+ ;; The cookie doesn't match.
+ (not (eq (file-notify--event-cookie
+ (car file-notify--pending-event))
+ (file-notify--event-cookie event)))
+ (or
+ ;; inotify.
+ (and (eq (nth 1 (car file-notify--pending-event))
+ 'moved-from)
+ (not (eq action 'moved-to)))
+ ;; w32notify.
+ (and (eq (nth 1 (car file-notify--pending-event))
+ 'renamed-from)
+ (not (eq action 'renamed-to)))))
+ (setq pending-event file-notify--pending-event
+ file-notify--pending-event nil)
+ (setcar (cdar pending-event) 'deleted))
+
+ ;; Map action. We ignore all events which cannot be mapped.
+ (setq action
+ (cond
+ ((memq action
+ '(attribute-changed changed created deleted renamed))
+ action)
+ ((memq action '(moved rename))
+ ;; The kqueue rename event does not return file1 in
+ ;; case a file monitor is established.
+ (if (setq file1 (file-notify--event-file1-name event))
+ 'renamed 'deleted))
+ ((eq action 'ignored)
+ (setq stopped t actions nil))
+ ((memq action '(attrib link)) 'attribute-changed)
+ ((memq action '(create added)) 'created)
+ ((memq action '(modify modified write)) 'changed)
+ ((memq action '(delete delete-self move-self removed))
'deleted)
+ ;; Make the event pending.
+ ((memq action '(moved-from renamed-from))
+ (setq file-notify--pending-event
+ `((,desc ,action ,file ,(file-notify--event-cookie
event))
+ ,(file-notify--watch-callback watch)))
+ nil)
+ ;; Look for pending event.
+ ((memq action '(moved-to renamed-to))
+ (if (null file-notify--pending-event)
+ 'created
+ (setq file1 file
+ file (file-notify--event-file-name
+ (car file-notify--pending-event)))
+ ;; If the source is handled by another watch, we
+ ;; must fire the rename event there as well.
+ (when (not (equal desc (caar file-notify--pending-event)))
+ (setq pending-event
+ `((,(caar file-notify--pending-event)
+ renamed ,file ,file1)
+ ,(cadr file-notify--pending-event))))
+ (setq file-notify--pending-event nil)
+ 'renamed))))
+
+ ;; Apply pending callback.
+ (when pending-event
+ (setcar
+ (car pending-event)
+ (caar pending-event))
+ (funcall (cadr pending-event) (car pending-event))
+ (setq pending-event nil))
+
+ ;; Apply callback.
+ (when (and action
+ (or
+ ;; If there is no relative file name for that watch,
+ ;; we watch the whole directory.
+ (null (file-notify--watch-filename watch))
+ ;; File matches.
+ (string-equal
+ (file-notify--watch-filename watch)
+ (file-name-nondirectory file))
+ ;; Directory matches.
+ (string-equal
+ (file-name-nondirectory file)
+ (file-name-nondirectory
+ (file-notify--watch-directory watch)))
+ ;; File1 matches.
+ (and (stringp file1)
+ (string-equal
+ (file-notify--watch-filename watch)
+ (file-name-nondirectory file1)))))
+ ;;(message
+ ;;"file-notify-callback %S %S %S %S %S"
+ ;;desc
+ ;;action file file1 watch)
+ (if file1
+ (funcall (file-notify--watch-callback watch)
+ `(,desc ,action ,file ,file1))
+ (funcall (file-notify--watch-callback watch)
+ `(,desc ,action ,file))))
+
+ ;; Send `stopped' event.
+ (when (or stopped
+ (and (memq action '(deleted renamed))
+ ;; Not, when a file is backed up.
+ (not (and (stringp file1) (backup-file-name-p file1)))
+ ;; Watched file or directory is concerned.
+ (string-equal
+ file (file-notify--event-watched-file event))))
+ (file-notify-rm-watch desc)))))))
;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor
;; for every `file-notify-add-watch', while `inotify' returns a unique
@@ -339,7 +313,7 @@ FILE is the name of the file whose event is being reported."
(if (file-directory-p file)
file
(file-name-directory file))))
- desc func l-flags registered entry)
+ desc func l-flags)
(unless (file-directory-p dir)
(signal 'file-notify-error `("Directory does not exist" ,dir)))
@@ -391,66 +365,46 @@ FILE is the name of the file whose event is being
reported."
l-flags 'file-notify-callback)))
;; Modify `file-notify-descriptors'.
- (setq file (unless (file-directory-p file) (file-name-nondirectory file))
- desc (if (consp desc) (car desc) desc)
- registered (gethash desc file-notify-descriptors)
- entry `(,file . ,callback))
- (unless (member entry (cdr registered))
- (puthash desc `(,dir ,entry . ,(cdr registered))
file-notify-descriptors))
-
+ (let ((watch (file-notify--watch-make
+ dir
+ (unless (file-directory-p file) (file-name-nondirectory
file))
+ callback)))
+ (puthash desc watch file-notify-descriptors))
;; Return descriptor.
- (file-notify--descriptor desc file)))
+ desc))
(defun file-notify-rm-watch (descriptor)
"Remove an existing watch specified by its DESCRIPTOR.
DESCRIPTOR should be an object returned by `file-notify-add-watch'."
- (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
- (file (if (consp descriptor) (cdr descriptor)))
- (registered (gethash desc file-notify-descriptors))
- (dir (car registered))
- (handler (and (stringp dir)
- (find-file-name-handler dir 'file-notify-rm-watch))))
-
- (when (stringp dir)
- ;; Call low-level function.
- (when (or (not file)
- (and (= (length (cdr registered)) 1)
- (assoc file (cdr registered))))
- (condition-case nil
- (if handler
- ;; A file name handler could exist even if there is no local
- ;; file notification support.
- (funcall handler 'file-notify-rm-watch descriptor)
-
- (funcall
- (cond
- ((eq file-notify--library 'inotify) 'inotify-rm-watch)
- ((eq file-notify--library 'kqueue) 'kqueue-rm-watch)
- ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
- ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
- desc))
- (file-notify-error nil)))
-
- ;; Modify `file-notify-descriptors'.
- (file-notify--rm-descriptor descriptor))))
+ (when-let (watch (gethash descriptor file-notify-descriptors))
+ (let ((handler (find-file-name-handler
+ (file-notify--watch-directory watch)
+ 'file-notify-rm-watch)))
+ (condition-case nil
+ (if handler
+ ;; A file name handler could exist even if there is no local
+ ;; file notification support.
+ (funcall handler 'file-notify-rm-watch descriptor)
+
+ (funcall
+ (cond
+ ((eq file-notify--library 'inotify) 'inotify-rm-watch)
+ ((eq file-notify--library 'kqueue) 'kqueue-rm-watch)
+ ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
+ ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
+ descriptor))
+ (file-notify-error nil)))
+ ;; Modify `file-notify-descriptors'.
+ (file-notify--rm-descriptor descriptor)))
(defun file-notify-valid-p (descriptor)
"Check a watch specified by its DESCRIPTOR.
DESCRIPTOR should be an object returned by `file-notify-add-watch'."
- (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
- (file (if (consp descriptor) (cdr descriptor)))
- (registered (gethash desc file-notify-descriptors))
- (dir (car registered))
- handler)
-
- (when (stringp dir)
- (setq handler (find-file-name-handler dir 'file-notify-valid-p))
-
- (and (or ;; It is a directory.
- (not file)
- ;; The file is registered.
- (assoc file (cdr registered)))
- (if handler
+ (when-let (watch (gethash descriptor file-notify-descriptors))
+ (let ((handler (find-file-name-handler
+ (file-notify--watch-directory watch)
+ 'file-notify-valid-p)))
+ (and (if handler
;; A file name handler could exist even if there is no
;; local file notification support.
(funcall handler 'file-notify-valid-p descriptor)
@@ -460,9 +414,19 @@ DESCRIPTOR should be an object returned by
`file-notify-add-watch'."
((eq file-notify--library 'kqueue) 'kqueue-valid-p)
((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
((eq file-notify--library 'w32notify) 'w32notify-valid-p))
- desc))
+ descriptor))
t))))
+
+;; TODO:
+;; * Watching a /dir/file may receive events for dir.
+;; (This may be the desired behaviour.)
+;; * Watching a file in a already watched directory
+;; If the file is created and *then* a watch is added to that file, the
+;; watch might receive events which occured prior to it being created,
+;; due to the way events are propagated during idle time. Note: This
+;; may be perfectly acceptable.
+
;; The end:
(provide 'filenotify)
diff --git a/src/inotify.c b/src/inotify.c
index 61ef615..a084552 100644
--- a/src/inotify.c
+++ b/src/inotify.c
@@ -41,23 +41,30 @@ along with GNU Emacs. If not, see
<http://www.gnu.org/licenses/>. */
#ifndef IN_ONLYDIR
# define IN_ONLYDIR 0
#endif
+#define INOTIFY_DEFAULT_MASK (IN_ALL_EVENTS|IN_EXCL_UNLINK)
/* File handle for inotify. */
static int inotifyfd = -1;
-/* Assoc list of files being watched.
- Format: (watch-descriptor name callback)
+/* Alist of files being watched. We want the returned descriptor to
+ be unique for every watch, but inotify returns the same descriptor
+ for multiple calls to inotify_add_watch with the same file. In
+ order to solve this problem, we add a ID, uniquely identifying a
+ watch/file combination.
+
+ For the same reason, we also need to store the watch's mask and we
+ can't allow the following flags to be used.
+
+ IN_EXCL_UNLINK
+ IN_MASK_ADD
+ IN_ONESHOT
+ IN_ONLYDIR
+
+ Format: (descriptor . ((id filename callback mask) ...))
*/
static Lisp_Object watch_list;
static Lisp_Object
-make_watch_descriptor (int wd)
-{
- /* TODO replace this with a Misc Object! */
- return make_number (wd);
-}
-
-static Lisp_Object
mask_to_aspects (uint32_t mask) {
Lisp_Object aspects = Qnil;
if (mask & IN_ACCESS)
@@ -95,77 +102,6 @@ mask_to_aspects (uint32_t mask) {
return aspects;
}
-static Lisp_Object
-inotifyevent_to_event (Lisp_Object watch_object, struct inotify_event const
*ev)
-{
- Lisp_Object name = Qnil;
- if (ev->len > 0)
- {
- size_t const len = strlen (ev->name);
- name = make_unibyte_string (ev->name, min (len, ev->len));
- name = DECODE_FILE (name);
- }
- else
- name = XCAR (XCDR (watch_object));
-
- return list2 (list4 (make_watch_descriptor (ev->wd),
- mask_to_aspects (ev->mask),
- name,
- make_number (ev->cookie)),
- Fnth (make_number (2), watch_object));
-}
-
-/* This callback is called when the FD is available for read. The inotify
- events are read from FD and converted into input_events. */
-static void
-inotify_callback (int fd, void *_)
-{
- struct input_event event;
- Lisp_Object watch_object;
- int to_read;
- char *buffer;
- ssize_t n;
- size_t i;
-
- to_read = 0;
- if (ioctl (fd, FIONREAD, &to_read) == -1)
- report_file_notify_error ("Error while retrieving file system events",
- Qnil);
- buffer = xmalloc (to_read);
- n = read (fd, buffer, to_read);
- if (n < 0)
- {
- xfree (buffer);
- report_file_notify_error ("Error while reading file system events",
Qnil);
- }
-
- EVENT_INIT (event);
- event.kind = FILE_NOTIFY_EVENT;
-
- i = 0;
- while (i < (size_t)n)
- {
- struct inotify_event *ev = (struct inotify_event *) &buffer[i];
-
- watch_object = Fassoc (make_watch_descriptor (ev->wd), watch_list);
- if (!NILP (watch_object))
- {
- event.arg = inotifyevent_to_event (watch_object, ev);
-
- /* If event was removed automatically: Drop it from watch list. */
- if (ev->mask & IN_IGNORED)
- watch_list = Fdelete (watch_object, watch_list);
-
- if (!NILP (event.arg))
- kbd_buffer_store_event (&event);
- }
-
- i += sizeof (*ev) + ev->len;
- }
-
- xfree (buffer);
-}
-
static uint32_t
symbol_to_inotifymask (Lisp_Object symb)
{
@@ -200,14 +136,6 @@ symbol_to_inotifymask (Lisp_Object symb)
else if (EQ (symb, Qdont_follow))
return IN_DONT_FOLLOW;
- else if (EQ (symb, Qexcl_unlink))
- return IN_EXCL_UNLINK;
- else if (EQ (symb, Qmask_add))
- return IN_MASK_ADD;
- else if (EQ (symb, Qoneshot))
- return IN_ONESHOT;
- else if (EQ (symb, Qonlydir))
- return IN_ONLYDIR;
else if (EQ (symb, Qt) || EQ (symb, Qall_events))
return IN_ALL_EVENTS;
@@ -236,6 +164,174 @@ aspect_to_inotifymask (Lisp_Object aspect)
return symbol_to_inotifymask (aspect);
}
+static Lisp_Object
+make_lispy_mask (uint32_t mask)
+{
+ return Fcons (make_number (mask & 0xffff),
+ make_number (mask >> 16));
+}
+
+static bool
+lispy_mask_match_p (Lisp_Object mask, uint32_t other)
+{
+ return (XINT (XCAR (mask)) & other)
+ || ((XINT (XCDR (mask)) << 16) & other);
+}
+
+static Lisp_Object
+inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev)
+{
+ Lisp_Object name = Qnil;
+
+ if (! lispy_mask_match_p (Fnth (make_number (3), watch), ev->mask))
+ return Qnil;
+
+ if (ev->len > 0)
+ {
+ size_t const len = strlen (ev->name);
+ name = make_unibyte_string (ev->name, min (len, ev->len));
+ name = DECODE_FILE (name);
+ }
+ else
+ name = XCAR (XCDR (watch));
+
+ return list2 (list4 (Fcons (make_number (ev->wd), XCAR (watch)),
+ mask_to_aspects (ev->mask),
+ name,
+ make_number (ev->cookie)),
+ Fnth (make_number (2), watch));
+}
+
+/* Add a new watch to watch-descriptor WD watching FILENAME and using
+ CALLBACK. Returns a cons (DESCRIPTOR . ID) uniquely identifying the
+ new watch. */
+static Lisp_Object
+add_watch (int wd, Lisp_Object filename, Lisp_Object aspect, Lisp_Object
callback)
+{
+ Lisp_Object descriptor = make_number (wd);
+ Lisp_Object elt = Fassoc (descriptor, watch_list);
+ Lisp_Object watches = Fcdr (elt);
+ Lisp_Object watch, watch_id;
+ Lisp_Object mask = make_lispy_mask (aspect_to_inotifymask (aspect));
+
+ int id = 0;
+
+ while (! NILP (watches))
+ {
+ id = max (id, 1 + XINT (XCAR (XCAR (watches))));
+ watches = XCDR (watches);
+ }
+
+ watch_id = make_number (id);
+ watch = list4 (watch_id, filename, callback, mask);
+
+ if (NILP (elt))
+ watch_list = Fcons (Fcons (descriptor, Fcons (watch, Qnil)),
+ watch_list);
+ else
+ XSETCDR (elt, Fcons (watch, XCDR (elt)));
+
+ return Fcons (descriptor, watch_id);
+}
+
+/* Remove all watches associated with descriptor. If INVALID_P is
+ true, the descriptor is already invalid, i.e. it received a
+ IN_IGNORED event. In this case skip calling inotify_rm_watch. */
+static void
+remove_descriptor (Lisp_Object descriptor, bool invalid_p)
+{
+ Lisp_Object elt = Fassoc (descriptor, watch_list);
+
+ if (! NILP (elt))
+ {
+ int wd = XINT (descriptor);
+
+ watch_list = Fdelete (elt, watch_list);
+ if (! invalid_p)
+ if (inotify_rm_watch (inotifyfd, wd) == -1)
+ report_file_notify_error ("Could not rm watch", descriptor);
+ }
+ /* Cleanup if no more files are watched. */
+ if (NILP (watch_list))
+ {
+ emacs_close (inotifyfd);
+ delete_read_fd (inotifyfd);
+ inotifyfd = -1;
+ }
+}
+
+/* Remove watch associated with (descriptor, id). */
+static void
+remove_watch (Lisp_Object descriptor, Lisp_Object id)
+{
+ Lisp_Object elt = Fassoc (descriptor, watch_list);
+
+ if (! NILP (elt))
+ {
+ Lisp_Object watch = Fassoc (id, XCDR (elt));
+
+ if (! NILP (watch))
+ XSETCDR (elt, Fdelete (watch, XCDR (elt)));
+
+ /* Remove the descriptor if noone is watching it. */
+ if (NILP (XCDR (elt)))
+ remove_descriptor (descriptor, false);
+ }
+}
+
+/* This callback is called when the FD is available for read. The inotify
+ events are read from FD and converted into input_events. */
+static void
+inotify_callback (int fd, void *_)
+{
+ struct input_event event;
+ int to_read;
+ char *buffer;
+ ssize_t n;
+ size_t i;
+
+ to_read = 0;
+ if (ioctl (fd, FIONREAD, &to_read) == -1)
+ report_file_notify_error ("Error while retrieving file system events",
+ Qnil);
+ buffer = xmalloc (to_read);
+ n = read (fd, buffer, to_read);
+ if (n < 0)
+ {
+ xfree (buffer);
+ report_file_notify_error ("Error while reading file system events",
Qnil);
+ }
+
+ EVENT_INIT (event);
+ event.kind = FILE_NOTIFY_EVENT;
+
+ i = 0;
+ while (i < (size_t)n)
+ {
+ struct inotify_event *ev = (struct inotify_event *) &buffer[i];
+ Lisp_Object descriptor = make_number (ev->wd);
+ Lisp_Object elt = Fassoc (descriptor, watch_list);
+
+ if (! NILP (elt))
+ {
+ Lisp_Object watches = XCDR (elt);
+ while (! NILP (watches))
+ {
+ event.arg = inotifyevent_to_event (XCAR (watches), ev);
+ if (!NILP (event.arg))
+ kbd_buffer_store_event (&event);
+ watches = XCDR (watches);
+ }
+ /* If event was removed automatically: Drop it from watch list. */
+ if (ev->mask & IN_IGNORED)
+ remove_descriptor (descriptor, true);
+ }
+ i += sizeof (*ev) + ev->len;
+ }
+
+ xfree (buffer);
+}
+
DEFUN ("inotify-add-watch", Finotify_add_watch, Sinotify_add_watch, 3, 3, 0,
doc: /* Add a watch for FILE-NAME to inotify.
@@ -264,10 +360,6 @@ close
The following symbols can also be added to a list of aspects:
dont-follow
-excl-unlink
-mask-add
-oneshot
-onlydir
Watching a directory is not recursive. CALLBACK is passed a single argument
EVENT which contains an event structure of the format
@@ -286,22 +378,22 @@ unmount
If a directory is watched then NAME is the name of file that caused the event.
-COOKIE is an object that can be compared using `equal' to identify two matching
+COOKIE is an object that can be compared using `equal' to identify two
matchingt
renames (moved-from and moved-to).
See inotify(7) and inotify_add_watch(2) for further information. The inotify
fd
is managed internally and there is no corresponding inotify_init. Use
`inotify-rm-watch' to remove a watch.
- */)
- (Lisp_Object file_name, Lisp_Object aspect, Lisp_Object callback)
+ */)
+ (Lisp_Object filename, Lisp_Object aspect, Lisp_Object callback)
{
- uint32_t mask;
- Lisp_Object watch_object;
Lisp_Object encoded_file_name;
- Lisp_Object watch_descriptor;
- int watchdesc = -1;
+ bool dont_follow = ! NILP (Fmemq (Qdont_follow, aspect));
+ int wd = -1;
+ uint32_t mask = (INOTIFY_DEFAULT_MASK
+ | (dont_follow ? IN_DONT_FOLLOW : 0));
- CHECK_STRING (file_name);
+ CHECK_STRING (filename);
if (inotifyfd < 0)
{
@@ -312,24 +404,12 @@ is managed internally and there is no corresponding
inotify_init. Use
add_read_fd (inotifyfd, &inotify_callback, NULL);
}
- mask = aspect_to_inotifymask (aspect);
- encoded_file_name = ENCODE_FILE (file_name);
- watchdesc = inotify_add_watch (inotifyfd, SSDATA (encoded_file_name), mask);
- if (watchdesc == -1)
- report_file_notify_error ("Could not add watch for file", file_name);
-
- watch_descriptor = make_watch_descriptor (watchdesc);
+ encoded_file_name = ENCODE_FILE (filename);
+ wd = inotify_add_watch (inotifyfd, SSDATA (encoded_file_name), mask);
+ if (wd == -1)
+ report_file_notify_error ("Could not add watch for file", filename);
- /* Delete existing watch object. */
- watch_object = Fassoc (watch_descriptor, watch_list);
- if (!NILP (watch_object))
- watch_list = Fdelete (watch_object, watch_list);
-
- /* Store watch object in watch list. */
- watch_object = list3 (watch_descriptor, encoded_file_name, callback);
- watch_list = Fcons (watch_object, watch_list);
-
- return watch_descriptor;
+ return add_watch (wd, filename, aspect, callback);
}
DEFUN ("inotify-rm-watch", Finotify_rm_watch, Sinotify_rm_watch, 1, 1, 0,
@@ -338,27 +418,20 @@ DEFUN ("inotify-rm-watch", Finotify_rm_watch,
Sinotify_rm_watch, 1, 1, 0,
WATCH-DESCRIPTOR should be an object returned by `inotify-add-watch'.
See inotify_rm_watch(2) for more information.
- */)
+ */)
(Lisp_Object watch_descriptor)
{
- Lisp_Object watch_object;
- int wd = XINT (watch_descriptor);
- if (inotify_rm_watch (inotifyfd, wd) == -1)
- report_file_notify_error ("Could not rm watch", watch_descriptor);
+ Lisp_Object descriptor, id;
- /* Remove watch descriptor from watch list. */
- watch_object = Fassoc (watch_descriptor, watch_list);
- if (!NILP (watch_object))
- watch_list = Fdelete (watch_object, watch_list);
+ if (! (CONSP (watch_descriptor)
+ && INTEGERP (XCAR (watch_descriptor))
+ && INTEGERP (XCDR (watch_descriptor))))
+ report_file_notify_error ("Invalid descriptor ", watch_descriptor);
- /* Cleanup if no more files are watched. */
- if (NILP (watch_list))
- {
- emacs_close (inotifyfd);
- delete_read_fd (inotifyfd);
- inotifyfd = -1;
- }
+ descriptor = XCAR (watch_descriptor);
+ id = XCDR (watch_descriptor);
+ remove_watch (descriptor, id);
return Qt;
}
@@ -374,10 +447,33 @@ reason. Removing the watch by calling `inotify-rm-watch'
also makes
it invalid. */)
(Lisp_Object watch_descriptor)
{
- Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list);
- return NILP (watch_object) ? Qnil : Qt;
+ Lisp_Object elt, watch;
+
+ if (! (CONSP (watch_descriptor)
+ && INTEGERP (XCAR (watch_descriptor))
+ && INTEGERP (XCDR (watch_descriptor))))
+ return Qnil;
+
+ elt = Fassoc (XCAR (watch_descriptor), watch_list);
+ watch = Fassoc (XCDR (watch_descriptor), XCDR (elt));
+
+ return ! NILP (watch) ? Qt : Qnil;
+}
+
+#ifdef INOTIFY_DEBUG
+DEFUN ("inotify-watch-list", Finotify_watch_list, Sinotify_watch_list, 0, 0, 0,
+ doc: /* Return a copy of the internal watch_list. */)
+{
+ return Fcopy_sequence (watch_list);
}
+DEFUN ("inotify-allocated-p", Finotify_allocated_p, Sinotify_allocated_p, 0,
0, 0,
+ doc: /* Return non-nil, if a inotify instance is allocated. */)
+{
+ return inotifyfd < 0 ? Qnil : Qt;
+}
+#endif
+
void
syms_of_inotify (void)
{
@@ -400,10 +496,6 @@ syms_of_inotify (void)
DEFSYM (Qclose, "close"); /* IN_CLOSE */
DEFSYM (Qdont_follow, "dont-follow"); /* IN_DONT_FOLLOW */
- DEFSYM (Qexcl_unlink, "excl-unlink"); /* IN_EXCL_UNLINK */
- DEFSYM (Qmask_add, "mask-add"); /* IN_MASK_ADD */
- DEFSYM (Qoneshot, "oneshot"); /* IN_ONESHOT */
- DEFSYM (Qonlydir, "onlydir"); /* IN_ONLYDIR */
DEFSYM (Qignored, "ignored"); /* IN_IGNORED */
DEFSYM (Qisdir, "isdir"); /* IN_ISDIR */
@@ -414,6 +506,10 @@ syms_of_inotify (void)
defsubr (&Sinotify_rm_watch);
defsubr (&Sinotify_valid_p);
+#ifdef INOTIFY_DEBUG
+ defsubr (&Sinotify_watch_list);
+ defsubr (&Sinotify_allocated_p);
+#endif
staticpro (&watch_list);
Fprovide (intern_c_string ("inotify"), Qnil);
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 329ea58..54e7ebf 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -350,11 +350,6 @@ This returns only for the local case and gfilenotify;
otherwise it is nil.
;; This test is inspired by Bug#26126 and Bug#26127.
(ert-deftest file-notify-test02-rm-watch ()
"Check `file-notify-rm-watch'."
- ;; There is a problem with inotify removing watch descriptors out of
- ;; order. Temporarily, we expect to fail this test until it is
- ;; fixed.
- :expected-result
- (if (string-equal (file-notify--test-library) "inotify") :failed :passed)
(skip-unless (file-notify--test-local-enabled))
(unwind-protect