src/kqueue.c

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