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 (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   //  if (! NILP (deleted_dl))
 272   //    report_file_error ("Deleted events list not empty", deleted_dl);
 273
 274   /* Replace old directory listing with the new one.  */
 275   XSETCDR (Fnthcdr (make_number (3), watch_object),
 276            Fcons (new_directory_files, Qnil));
 277   return;
 278 }
 279
 280 /* This is the callback function for arriving input on kqueuefd.  It
 281    shall create a Lisp event, and put it into the Emacs input queue.  */
 282 static void
 283 kqueue_callback (int fd, void *data)
 284 {
 285   for (;;) {
 286     struct kevent kev;
 287     static const struct timespec nullts = { 0, 0 };
 288     Lisp_Object descriptor, watch_object, file, actions;
 289
 290     /* Read one event.  */
 291     int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts);
 292     if (ret < 1) {
 293       /* All events read.  */
 294       return;
 295     }
 296
 297     /* Determine descriptor and file name.  */
 298     descriptor = make_number (kev.ident);
 299     watch_object = assq_no_quit (descriptor, watch_list);
 300     if (CONSP (watch_object))
 301       file = XCAR (XCDR (watch_object));
 302     else
 303       continue;
 304
 305     /* Determine event actions.  */
 306     actions = Qnil;
 307     if (kev.fflags & NOTE_DELETE)
 308       actions = Fcons (Qdelete, actions);
 309     if (kev.fflags & NOTE_WRITE) {
 310       /* Check, whether this is a directory event.  */
 311       if (NILP (Fnth (make_number (4), watch_object)))
 312         actions = Fcons (Qwrite, actions);
 313       else
 314         kqueue_compare_dir_list (watch_object);
 315     }
 316     if (kev.fflags & NOTE_EXTEND)
 317       actions = Fcons (Qextend, actions);
 318     if (kev.fflags & NOTE_ATTRIB)
 319       actions = Fcons (Qattrib, actions);
 320     if (kev.fflags & NOTE_LINK)
 321       actions = Fcons (Qlink, actions);
 322     /* It would be useful to know the target of the rename operation.
 323        At this point, it is not possible.  Happens only when the upper
 324        directory is monitored.  */
 325     if (kev.fflags & NOTE_RENAME)
 326       actions = Fcons (Qrename, actions);
 327
 328     /* Create the event.  */
 329     if (! NILP (actions))
 330       kqueue_generate_event (watch_object, actions, file, Qnil);
 331
 332     /* Cancel monitor if file or directory is deleted or renamed.  */
 333     if (kev.fflags & (NOTE_DELETE | NOTE_RENAME))
 334       Fkqueue_rm_watch (descriptor);
 335   }
 336   return;
 337 }
 338
 339 DEFUN ("kqueue-add-watch", Fkqueue_add_watch, Skqueue_add_watch, 3, 3, 0,
 340        doc: /* Add a watch for filesystem events pertaining to FILE.
 341
 342 This arranges for filesystem events pertaining to FILE to be reported
 343 to Emacs.  Use `kqueue-rm-watch' to cancel the watch.
 344
 345 Returned value is a descriptor for the added watch.  If the file cannot be
 346 watched for some reason, this function signals a `file-notify-error' error.
 347
 348 FLAGS is a list of events to be watched for.  It can include the
 349 following symbols:
 350
 351   `create' -- FILE was created
 352   `delete' -- FILE was deleted
 353   `write'  -- FILE has changed
 354   `extend' -- FILE was extended
 355   `attrib' -- a FILE attribute was changed
 356   `link'   -- a FILE's link count was changed
 357   `rename' -- FILE was moved to FILE1
 358
 359 When any event happens, Emacs will call the CALLBACK function passing
 360 it a single argument EVENT, which is of the form
 361
 362   (DESCRIPTOR ACTIONS FILE [FILE1])
 363
 364 DESCRIPTOR is the same object as the one returned by this function.
 365 ACTIONS is a list of events.
 366
 367 FILE is the name of the file whose event is being reported.  FILE1
 368 will be reported only in case of the `rename' event.  This is possible
 369 only when the upper directory of the renamed file is watched.  */)
 370   (Lisp_Object file, Lisp_Object flags, Lisp_Object callback)
 371 {
 372   Lisp_Object watch_object, dir_list;
 373   int maxfd, fd, oflags;
 374   u_short fflags = 0;
 375   struct kevent kev;
 376 #ifdef HAVE_GETRLIMIT
 377   struct rlimit rlim;
 378 #endif /* HAVE_GETRLIMIT  */
 379
 380   /* Check parameters.  */
 381   CHECK_STRING (file);
 382   file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
 383   if (NILP (Ffile_exists_p (file)))
 384     report_file_error ("File does not exist", file);
 385
 386   CHECK_LIST (flags);
 387
 388   if (! FUNCTIONP (callback))
 389     wrong_type_argument (Qinvalid_function, callback);
 390
 391   /* Check available file descriptors.  */
 392 #ifdef HAVE_GETRLIMIT
 393   if (! getrlimit (RLIMIT_NOFILE, &rlim))
 394     maxfd = rlim.rlim_cur;
 395   else
 396 #endif /* HAVE_GETRLIMIT  */
 397     maxfd = 256;
 398
 399   /* We assume 50 file descriptors are sufficient for the rest of Emacs.  */
 400   if ((maxfd - 50) < XINT (Flength (watch_list)))
 401     xsignal2
 402       (Qfile_notify_error,
 403        build_string ("File watching not possible, no file descriptor left"),
 404        Flength (watch_list));
 405
 406   if (kqueuefd < 0)
 407     {
 408       /* Create kqueue descriptor.  */
 409       kqueuefd = kqueue ();
 410       if (kqueuefd < 0)
 411         report_file_notify_error ("File watching is not available", Qnil);
 412
 413       /* Start monitoring for possible I/O.  */
 414       add_read_fd (kqueuefd, kqueue_callback, NULL);
 415
 416       watch_list = Qnil;
 417     }
 418
 419   /* Open file.  */
 420   file = ENCODE_FILE (file);
 421   oflags = O_NONBLOCK;
 422 #if O_EVTONLY
 423   oflags |= O_EVTONLY;
 424 #else
 425   oflags |= O_RDONLY;
 426 #endif
 427 #if O_SYMLINK
 428     oflags |= O_SYMLINK;
 429 #else
 430     oflags |= O_NOFOLLOW;
 431 #endif
 432   fd = emacs_open (SSDATA (file), oflags, 0);
 433   if (fd == -1)
 434     report_file_error ("File cannot be opened", file);
 435
 436   /* Assemble filter flags  */
 437   if (! NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE;
 438   if (! NILP (Fmember (Qwrite, flags)))  fflags |= NOTE_WRITE;
 439   if (! NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND;
 440   if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB;
 441   if (! NILP (Fmember (Qlink, flags)))   fflags |= NOTE_LINK;
 442   if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME;
 443
 444   /* Register event.  */
 445   EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR,
 446           fflags, 0, NULL);
 447
 448   if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0) {
 449     emacs_close (fd);
 450     report_file_error ("Cannot watch file", file);
 451   }
 452
 453   /* Store watch object in watch list.  */
 454   Lisp_Object watch_descriptor = make_number (fd);
 455   if (NILP (Ffile_directory_p (file)))
 456     watch_object = list4 (watch_descriptor, file, flags, callback);
 457   else {
 458     dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, 1, Qnil);
 459     watch_object = list5 (watch_descriptor, file, flags, callback, dir_list);
 460   }
 461   watch_list = Fcons (watch_object, watch_list);
 462
 463   return watch_descriptor;
 464 }
 465
 466 DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0,
 467        doc: /* Remove an existing WATCH-DESCRIPTOR.
 468
 469 WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'.  */)
 470      (Lisp_Object watch_descriptor)
 471 {
 472   Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list);
 473
 474   if (! CONSP (watch_object))
 475     xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"),
 476               watch_descriptor);
 477
 478   eassert (INTEGERP (watch_descriptor));
 479   int fd = XINT (watch_descriptor);
 480   if ( fd >= 0)
 481     emacs_close (fd);
 482
 483   /* Remove watch descriptor from watch list.  */
 484   watch_list = Fdelq (watch_object, watch_list);
 485
 486   if (NILP (watch_list) && (kqueuefd >= 0)) {
 487     delete_read_fd (kqueuefd);
 488     emacs_close (kqueuefd);
 489     kqueuefd = -1;
 490   }
 491
 492   return Qt;
 493 }
 494
 495 DEFUN ("kqueue-valid-p", Fkqueue_valid_p, Skqueue_valid_p, 1, 1, 0,
 496        doc: /* "Check a watch specified by its WATCH-DESCRIPTOR.
 497
 498 WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'.
 499
 500 A watch can become invalid if the file or directory it watches is
 501 deleted, or if the watcher thread exits abnormally for any other
 502 reason.  Removing the watch by calling `kqueue-rm-watch' also makes it
 503 invalid.  */)
 504      (Lisp_Object watch_descriptor)
 505 {
 506   return NILP (assq_no_quit (watch_descriptor, watch_list)) ? Qnil : Qt;
 507 }
 508
 509 \f
 510 void
 511 globals_of_kqueue (void)
 512 {
 513   watch_list = Qnil;
 514 }
 515
 516 void
 517 syms_of_kqueue (void)
 518 {
 519   defsubr (&Skqueue_add_watch);
 520   defsubr (&Skqueue_rm_watch);
 521   defsubr (&Skqueue_valid_p);
 522
 523   /* Event types.  */
 524   DEFSYM (Qcreate, "create");
 525   DEFSYM (Qdelete, "delete");   /* NOTE_DELETE  */
 526   DEFSYM (Qwrite, "write");     /* NOTE_WRITE  */
 527   DEFSYM (Qextend, "extend");   /* NOTE_EXTEND  */
 528   DEFSYM (Qattrib, "attrib");   /* NOTE_ATTRIB  */
 529   DEFSYM (Qlink, "link");       /* NOTE_LINK  */
 530   DEFSYM (Qrename, "rename");   /* NOTE_RENAME  */
 531
 532   staticpro (&watch_list);
 533
 534   Fprovide (intern_c_string ("kqueue"), Qnil);
 535 }
 536
 537 #endif /* HAVE_KQUEUE  */
 538
 539 /* PROBLEMS
 540    * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837
 541      prevents tests on Ubuntu.  */