1 /* Filesystem notifications support with kqueue API.
2
3 Copyright (C) 2015-2021 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
19
20 #include <config.h>
21
22 #include <sys/types.h>
23 #include <sys/event.h>
24 #include <sys/time.h>
25 #include <fcntl.h>
26 #include "lisp.h"
27 #include "keyboard.h"
28 #include "process.h"
29
30 #ifdef HAVE_SYS_RESOURCE_H
31 #include <sys/resource.h>
32 #endif /* HAVE_SYS_RESOURCE_H */
33
34
35 /* File handle for kqueue. */
36 static int kqueuefd = -1;
37
38 /* This is a list, elements are (DESCRIPTOR FILE FLAGS CALLBACK [DIRLIST]). */
39 static Lisp_Object watch_list;
40
41 /* Generate a list from the directory_files_internal output.
42 Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */
43 static Lisp_Object
kqueue_directory_listing(Lisp_Object directory_files)44 kqueue_directory_listing (Lisp_Object directory_files)
45 {
46 Lisp_Object dl, result = Qnil;
47
48 for (dl = directory_files; ! NILP (dl); dl = XCDR (dl)) {
49 /* We ignore "." and "..". */
50 if ((strcmp (".", SSDATA (XCAR (XCAR (dl)))) == 0) ||
51 (strcmp ("..", SSDATA (XCAR (XCAR (dl)))) == 0))
52 continue;
53
54 result = Fcons
55 (list5 (/* inode. */
56 Fnth (make_fixnum (11), XCAR (dl)),
57 /* filename. */
58 XCAR (XCAR (dl)),
59 /* last modification time. */
60 Fnth (make_fixnum (6), XCAR (dl)),
61 /* last status change time. */
62 Fnth (make_fixnum (7), XCAR (dl)),
63 /* size. */
64 Fnth (make_fixnum (8), XCAR (dl))),
65 result);
66 }
67 return result;
68 }
69
70 /* Generate a file notification event. */
71 static void
kqueue_generate_event(Lisp_Object watch_object,Lisp_Object actions,Lisp_Object file,Lisp_Object file1)72 kqueue_generate_event (Lisp_Object watch_object, Lisp_Object actions,
73 Lisp_Object file, Lisp_Object file1)
74 {
75 Lisp_Object flags, action, entry;
76 struct input_event event;
77
78 /* Check, whether all actions shall be monitored. */
79 flags = Fnth (make_fixnum (2), watch_object);
80 action = actions;
81 do {
82 if (NILP (action))
83 break;
84 entry = XCAR (action);
85 if (NILP (Fmember (entry, flags))) {
86 action = XCDR (action);
87 actions = Fdelq (entry, actions);
88 } else
89 action = XCDR (action);
90 } while (1);
91
92 /* Store it into the input event queue. */
93 if (! NILP (actions)) {
94 EVENT_INIT (event);
95 event.kind = FILE_NOTIFY_EVENT;
96 event.frame_or_window = Qnil;
97 event.arg = list2 (Fcons (XCAR (watch_object),
98 Fcons (actions,
99 NILP (file1)
100 ? list1 (file)
101 : list2 (file, file1))),
102 Fnth (make_fixnum (3), watch_object));
103 kbd_buffer_store_event (&event);
104 }
105 }
106
107 /* This compares two directory listings in case of a `write' event for
108 a directory. Generate resulting file notification events. The old
109 directory listing is retrieved from watch_object, it will be
110 replaced by the new directory listing at the end of this
111 function. */
112 static void
kqueue_compare_dir_list(Lisp_Object watch_object)113 kqueue_compare_dir_list (Lisp_Object watch_object)
114 {
115 Lisp_Object dir, pending_dl, deleted_dl;
116 Lisp_Object old_directory_files, old_dl, new_directory_files, new_dl, dl;
117
118 dir = XCAR (XCDR (watch_object));
119 pending_dl = Qnil;
120 deleted_dl = Qnil;
121
122 old_directory_files = Fnth (make_fixnum (4), watch_object);
123 old_dl = kqueue_directory_listing (old_directory_files);
124
125 /* When the directory is not accessible anymore, it has been deleted. */
126 if (NILP (Ffile_directory_p (dir))) {
127 kqueue_generate_event (watch_object, Fcons (Qdelete, Qnil), dir, Qnil);
128 return;
129 }
130 new_directory_files =
131 directory_files_internal (dir, Qnil, Qnil, Qnil, true, Qnil, Qnil);
132 new_dl = kqueue_directory_listing (new_directory_files);
133
134 /* Parse through the old list. */
135 dl = old_dl;
136 while (1) {
137 Lisp_Object old_entry, new_entry, dl1;
138 if (NILP (dl))
139 break;
140
141 /* Search for an entry with the same inode. */
142 old_entry = XCAR (dl);
143 new_entry = assq_no_quit (XCAR (old_entry), new_dl);
144 if (! NILP (Fequal (old_entry, new_entry))) {
145 /* Both entries are identical. Nothing to do. */
146 new_dl = Fdelq (new_entry, new_dl);
147 goto the_end;
148 }
149
150 /* Both entries have the same inode. */
151 if (! NILP (new_entry)) {
152 /* Both entries have the same file name. */
153 if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
154 SSDATA (XCAR (XCDR (new_entry)))) == 0) {
155 /* Modification time has been changed, the file has been written. */
156 if (NILP (Fequal (Fnth (make_fixnum (2), old_entry),
157 Fnth (make_fixnum (2), new_entry))))
158 kqueue_generate_event
159 (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (old_entry)), Qnil);
160 /* Status change time has been changed, the file attributes
161 have changed. */
162 if (NILP (Fequal (Fnth (make_fixnum (3), old_entry),
163 Fnth (make_fixnum (3), new_entry))))
164 kqueue_generate_event
165 (watch_object, Fcons (Qattrib, Qnil),
166 XCAR (XCDR (old_entry)), Qnil);
167
168 } else {
169 /* The file has been renamed. */
170 kqueue_generate_event
171 (watch_object, Fcons (Qrename, Qnil),
172 XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry)));
173 deleted_dl = Fcons (new_entry, deleted_dl);
174 }
175 new_dl = Fdelq (new_entry, new_dl);
176 goto the_end;
177 }
178
179 /* Search, whether there is a file with the same name but another
180 inode. */
181 for (dl1 = new_dl; ! NILP (dl1); dl1 = XCDR (dl1)) {
182 new_entry = XCAR (dl1);
183 if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
184 SSDATA (XCAR (XCDR (new_entry)))) == 0) {
185 pending_dl = Fcons (new_entry, pending_dl);
186 new_dl = Fdelq (new_entry, new_dl);
187 goto the_end;
188 }
189 }
190
191 /* Check, whether this a pending file. */
192 new_entry = assq_no_quit (XCAR (old_entry), pending_dl);
193
194 if (NILP (new_entry)) {
195 /* Check, whether this is an already deleted file (by rename). */
196 for (dl1 = deleted_dl; ! NILP (dl1); dl1 = XCDR (dl1)) {
197 new_entry = XCAR (dl1);
198 if (strcmp (SSDATA (XCAR (XCDR (old_entry))),
199 SSDATA (XCAR (XCDR (new_entry)))) == 0) {
200 deleted_dl = Fdelq (new_entry, deleted_dl);
201 goto the_end;
202 }
203 }
204 /* The file has been deleted. */
205 kqueue_generate_event
206 (watch_object, Fcons (Qdelete, Qnil), XCAR (XCDR (old_entry)), Qnil);
207
208 } else {
209 /* The file has been renamed. */
210 kqueue_generate_event
211 (watch_object, Fcons (Qrename, Qnil),
212 XCAR (XCDR (old_entry)), XCAR (XCDR (new_entry)));
213 pending_dl = Fdelq (new_entry, pending_dl);
214 }
215
216 the_end:
217 dl = XCDR (dl);
218 old_dl = Fdelq (old_entry, old_dl);
219 }
220
221 /* Parse through the resulting new list. */
222 dl = new_dl;
223 while (1) {
224 Lisp_Object entry;
225 if (NILP (dl))
226 break;
227
228 /* A new file has appeared. */
229 entry = XCAR (dl);
230 kqueue_generate_event
231 (watch_object, Fcons (Qcreate, Qnil), XCAR (XCDR (entry)), Qnil);
232
233 /* Check size of that file. */
234 Lisp_Object size = Fnth (make_fixnum (4), entry);
235 if (FLOATP (size) || (XFIXNUM (size) > 0))
236 kqueue_generate_event
237 (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil);
238
239 dl = XCDR (dl);
240 new_dl = Fdelq (entry, new_dl);
241 }
242
243 /* Parse through the resulting pending_dl list. */
244 dl = pending_dl;
245 while (1) {
246 Lisp_Object entry;
247 if (NILP (dl))
248 break;
249
250 /* A file is still pending. Assume it was a write. */
251 entry = XCAR (dl);
252 kqueue_generate_event
253 (watch_object, Fcons (Qwrite, Qnil), XCAR (XCDR (entry)), Qnil);
254
255 dl = XCDR (dl);
256 pending_dl = Fdelq (entry, pending_dl);
257 }
258
259 /* At this point, old_dl, new_dl and pending_dl shall be empty.
260 deleted_dl might not be empty when there was a rename to a
261 nonexistent file. Let's make a check for this (might be removed
262 once the code is stable). */
263 if (! NILP (old_dl))
264 report_file_error ("Old list not empty", old_dl);
265 if (! NILP (new_dl))
266 report_file_error ("New list not empty", new_dl);
267 if (! NILP (pending_dl))
268 report_file_error ("Pending events list not empty", pending_dl);
269
270 /* Replace old directory listing with the new one. */
271 XSETCDR (Fnthcdr (make_fixnum (3), watch_object),
272 Fcons (new_directory_files, Qnil));
273 return;
274 }
275
276 /* This is the callback function for arriving input on kqueuefd. It
277 shall create a Lisp event, and put it into the Emacs input queue. */
278 static void
kqueue_callback(int fd,void * data)279 kqueue_callback (int fd, void *data)
280 {
281 for (;;) {
282 struct kevent kev;
283 static const struct timespec nullts = { 0, 0 };
284 Lisp_Object descriptor, watch_object, file, actions;
285
286 /* Read one event. */
287 int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts);
288 if (ret < 1) {
289 /* All events read. */
290 return;
291 }
292
293 /* Determine descriptor and file name. */
294 descriptor = make_fixnum (kev.ident);
295 watch_object = assq_no_quit (descriptor, watch_list);
296 if (CONSP (watch_object))
297 file = XCAR (XCDR (watch_object));
298 else
299 continue;
300
301 /* Determine event actions. */
302 actions = Qnil;
303 if (kev.fflags & NOTE_DELETE)
304 actions = Fcons (Qdelete, actions);
305 if (kev.fflags & NOTE_WRITE) {
306 /* Check, whether this is a directory event. */
307 if (NILP (Fnth (make_fixnum (4), watch_object)))
308 actions = Fcons (Qwrite, actions);
309 else
310 kqueue_compare_dir_list (watch_object);
311 }
312 if (kev.fflags & NOTE_EXTEND)
313 actions = Fcons (Qextend, actions);
314 if (kev.fflags & NOTE_ATTRIB)
315 actions = Fcons (Qattrib, actions);
316 if (kev.fflags & NOTE_LINK)
317 actions = Fcons (Qlink, actions);
318 /* It would be useful to know the target of the rename operation.
319 At this point, it is not possible. Happens only when the upper
320 directory is monitored. */
321 if (kev.fflags & NOTE_RENAME)
322 actions = Fcons (Qrename, actions);
323
324 /* Create the event. */
325 if (! NILP (actions))
326 kqueue_generate_event (watch_object, actions, file, Qnil);
327
328 /* Cancel monitor if file or directory is deleted or renamed. */
329 if (kev.fflags & (NOTE_DELETE | NOTE_RENAME))
330 Fkqueue_rm_watch (descriptor);
331 }
332 return;
333 }
334
335 DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0,
336 doc: /* Add a watch for filesystem events pertaining to FILE.
337
338 This arranges for filesystem events pertaining to FILE to be reported
339 to Emacs. Use `kqueue-rm-watch' to cancel the watch.
340
341 Returned value is a descriptor for the added watch. If the file cannot be
342 watched for some reason, this function signals a `file-notify-error' error.
343
344 FLAGS is a list of events to be watched for. It can include the
345 following symbols:
346
347 `create' -- FILE was created
348 `delete' -- FILE was deleted
349 `write' -- FILE has changed
350 `extend' -- FILE was extended
351 `attrib' -- a FILE attribute was changed
352 `link' -- a FILE's link count was changed
353 `rename' -- FILE was moved to FILE1
354
355 When any event happens, Emacs will call the CALLBACK function passing
356 it a single argument EVENT, which is of the form
357
358 (DESCRIPTOR ACTIONS FILE [FILE1])
359
360 DESCRIPTOR is the same object as the one returned by this function.
361 ACTIONS is a list of events.
362
363 FILE is the name of the file whose event is being reported. FILE1
364 will be reported only in case of the `rename' event. This is possible
365 only when the upper directory of the renamed file is watched. */)
366 (Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
367 {
368 Lisp_Object watch_object, dir_list;
369 int maxfd, fd, oflags;
370 u_short fflags = 0;
371 struct kevent kev;
372 #ifdef HAVE_GETRLIMIT
373 struct rlimit rlim;
374 #endif /* HAVE_GETRLIMIT */
375
376 /* Check parameters. */
377 CHECK_STRING (file);
378 file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
379 if (NILP (Ffile_exists_p (file)))
380 report_file_error ("File does not exist", file);
381
382 CHECK_LIST (flags);
383
384 if (! FUNCTIONP (callback))
385 wrong_type_argument (Qinvalid_function, callback);
386
387 /* Check available file descriptors. */
388 #ifdef HAVE_GETRLIMIT
389 if (! getrlimit (RLIMIT_NOFILE, &rlim))
390 maxfd = rlim.rlim_cur;
391 else
392 #endif /* HAVE_GETRLIMIT */
393 maxfd = 256;
394
395 /* We assume 50 file descriptors are sufficient for the rest of Emacs. */
396 ptrdiff_t watch_list_len = list_length (watch_list);
397 if (maxfd - 50 < watch_list_len)
398 xsignal2
399 (Qfile_notify_error,
400 build_string ("File watching not possible, no file descriptor left"),
401 make_fixnum (watch_list_len));
402
403 if (kqueuefd < 0)
404 {
405 /* Create kqueue descriptor. */
406 kqueuefd = kqueue ();
407 if (kqueuefd < 0)
408 report_file_notify_error ("File watching is not available", Qnil);
409
410 /* Start monitoring for possible I/O. */
411 add_read_fd (kqueuefd, kqueue_callback, NULL);
412
413 watch_list = Qnil;
414 }
415
416 /* Open file. */
417 Lisp_Object encoded_file = ENCODE_FILE (file);
418 oflags = O_NONBLOCK;
419 #if O_EVTONLY
420 oflags |= O_EVTONLY;
421 #else
422 oflags |= O_RDONLY;
423 #endif
424 #if O_SYMLINK
425 oflags |= O_SYMLINK;
426 #else
427 oflags |= O_NOFOLLOW;
428 #endif
429 fd = emacs_open (SSDATA (encoded_file), oflags, 0);
430 if (fd == -1)
431 report_file_error ("File cannot be opened", file);
432
433 /* Assemble filter flags */
434 if (! NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE;
435 if (! NILP (Fmember (Qwrite, flags))) fflags |= NOTE_WRITE;
436 if (! NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND;
437 if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB;
438 if (! NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK;
439 if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME;
440
441 /* Register event. */
442 EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR,
443 fflags, 0, NULL);
444
445 if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0) {
446 emacs_close (fd);
447 report_file_error ("Cannot watch file", file);
448 }
449
450 /* Store watch object in watch list. */
451 Lisp_Object watch_descriptor = make_fixnum (fd);
452 if (NILP (Ffile_directory_p (file)))
453 watch_object = list4 (watch_descriptor, file, flags, callback);
454 else {
455 dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, true, Qnil,
456 Qnil);
457 watch_object = list5 (watch_descriptor, file, flags, callback, dir_list);
458 }
459 watch_list = Fcons (watch_object, watch_list);
460
461 return watch_descriptor;
462 }
463
464 DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0,
465 doc: /* Remove an existing WATCH-DESCRIPTOR.
466
467 WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'. */)
468 (Lisp_Object watch_descriptor)
469 {
470 Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list);
471
472 if (! CONSP (watch_object))
473 xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"),
474 watch_descriptor);
475
476 eassert (FIXNUMP (watch_descriptor));
477 int fd = XFIXNUM (watch_descriptor);
478 if ( fd >= 0)
479 emacs_close (fd);
480
481 /* Remove watch descriptor from watch list. */
482 watch_list = Fdelq (watch_object, watch_list);
483
484 if (NILP (watch_list) && (kqueuefd >= 0)) {
485 delete_read_fd (kqueuefd);
486 emacs_close (kqueuefd);
487 kqueuefd = -1;
488 }
489
490 return Qt;
491 }
492
493 DEFUN ("kqueue-valid-p", Fkqueue_valid_p, Skqueue_valid_p, 1, 1, 0,
494 doc: /* Check a watch specified by its WATCH-DESCRIPTOR.
495
496 WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'.
497
498 A watch can become invalid if the file or directory it watches is
499 deleted, or if the watcher thread exits abnormally for any other
500 reason. Removing the watch by calling `kqueue-rm-watch' also makes it
501 invalid. */)
502 (Lisp_Object watch_descriptor)
503 {
504 return NILP (assq_no_quit (watch_descriptor, watch_list)) ? Qnil : Qt;
505 }
506
507
508 void
globals_of_kqueue(void)509 globals_of_kqueue (void)
510 {
511 watch_list = Qnil;
512 }
513
514 void
syms_of_kqueue(void)515 syms_of_kqueue (void)
516 {
517 defsubr (&Skqueue_add_watch);
518 defsubr (&Skqueue_rm_watch);
519 defsubr (&Skqueue_valid_p);
520
521 /* Event types. */
522 DEFSYM (Qcreate, "create");
523 DEFSYM (Qdelete, "delete"); /* NOTE_DELETE */
524 DEFSYM (Qwrite, "write"); /* NOTE_WRITE */
525 DEFSYM (Qextend, "extend"); /* NOTE_EXTEND */
526 DEFSYM (Qattrib, "attrib"); /* NOTE_ATTRIB */
527 DEFSYM (Qlink, "link"); /* NOTE_LINK */
528 DEFSYM (Qrename, "rename"); /* NOTE_RENAME */
529
530 staticpro (&watch_list);
531
532 Fprovide (intern_c_string ("kqueue"), Qnil);
533 }
534
535 /* PROBLEMS
536 * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837
537 prevents tests on Ubuntu. */
538