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.
This commit is contained in:
Andreas Politz 2017-03-26 09:21:56 +02:00 committed by Michael Albinus
parent 9278d904af
commit 158bb8555d
3 changed files with 428 additions and 373 deletions

View file

@ -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)
(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))
;; 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))))
;; 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)
(caar pending-event))
(funcall (cadr pending-event) (car pending-event))
(setq pending-event nil))
;; 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 (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))))
;; 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))))))))
;; 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-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)
(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))))
(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)

View file

@ -41,22 +41,29 @@ 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;
@ -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);
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);
watch_descriptor = make_watch_descriptor (watchdesc);
/* 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);

View file

@ -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