code.delx.au - gnu-emacs/blob - src/kqueue.c

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