root/src/kqueue.c

DEFINITIONS

1. kqueue_directory_listing
2. kqueue_generate_event
3. kqueue_compare_dir_list
4. kqueue_callback
5. DEFUN
6. DEFUN
7. globals_of_kqueue
8. syms_of_kqueue

     1 /* Filesystem notifications support with kqueue API.
     2 
     3 Copyright (C) 2015-2023 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
    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
    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
   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
   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
   509 globals_of_kqueue (void)
   510 {
   511   watch_list = Qnil;
   512 }
   513 
   514 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.  */