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