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);
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     watch_object = list5 (watch_descriptor, file, flags, callback, dir_list);
457   }
458   watch_list = Fcons (watch_object, watch_list);
459 
460   return watch_descriptor;
461 }
462 
463 DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0,
464        doc: /* Remove an existing WATCH-DESCRIPTOR.
465 
466 WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'.  */)
467      (Lisp_Object watch_descriptor)
468 {
469   Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list);
470 
471   if (! CONSP (watch_object))
472     xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"),
473 	      watch_descriptor);
474 
475   eassert (FIXNUMP (watch_descriptor));
476   int fd = XFIXNUM (watch_descriptor);
477   if ( fd >= 0)
478     emacs_close (fd);
479 
480   /* Remove watch descriptor from watch list.  */
481   watch_list = Fdelq (watch_object, watch_list);
482 
483   if (NILP (watch_list) && (kqueuefd >= 0)) {
484     delete_read_fd (kqueuefd);
485     emacs_close (kqueuefd);
486     kqueuefd = -1;
487   }
488 
489   return Qt;
490 }
491 
492 DEFUN ("kqueue-valid-p", Fkqueue_valid_p, Skqueue_valid_p, 1, 1, 0,
493        doc: /* Check a watch specified by its WATCH-DESCRIPTOR.
494 
495 WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'.
496 
497 A watch can become invalid if the file or directory it watches is
498 deleted, or if the watcher thread exits abnormally for any other
499 reason.  Removing the watch by calling `kqueue-rm-watch' also makes it
500 invalid.  */)
501      (Lisp_Object watch_descriptor)
502 {
503   return NILP (assq_no_quit (watch_descriptor, watch_list)) ? Qnil : Qt;
504 }
505 
506 
507 void
globals_of_kqueue(void)508 globals_of_kqueue (void)
509 {
510   watch_list = Qnil;
511 }
512 
513 void
syms_of_kqueue(void)514 syms_of_kqueue (void)
515 {
516   defsubr (&Skqueue_add_watch);
517   defsubr (&Skqueue_rm_watch);
518   defsubr (&Skqueue_valid_p);
519 
520   /* Event types.  */
521   DEFSYM (Qcreate, "create");
522   DEFSYM (Qdelete, "delete");	/* NOTE_DELETE  */
523   DEFSYM (Qwrite, "write");	/* NOTE_WRITE  */
524   DEFSYM (Qextend, "extend");	/* NOTE_EXTEND  */
525   DEFSYM (Qattrib, "attrib");	/* NOTE_ATTRIB  */
526   DEFSYM (Qlink, "link");	/* NOTE_LINK  */
527   DEFSYM (Qrename, "rename");	/* NOTE_RENAME  */
528 
529   staticpro (&watch_list);
530 
531   Fprovide (intern_c_string ("kqueue"), Qnil);
532 }
533 
534 /* PROBLEMS
535    * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837
536      prevents tests on Ubuntu.  */
537