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 \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
  71 (Lisp_Object watch_object, Lisp_Object actions,
  72  Lisp_Object file, Lisp_Object file1)
  73 {
  74   Lisp_Object flags, action, entry;
  75   struct input_event event;
  76
  77   /* Check, whether all actions shall be monitored.  */
  78   flags = Fnth (make_number (2), watch_object);
  79   action = actions;
  80   do {
  81     if (NILP (action))
  82       break;
  83     entry = XCAR (action);
  84     if (NILP (Fmember (entry, flags))) {
  85       action = XCDR (action);
  86       actions = Fdelq (entry, actions);
  87     } else
  88       action = XCDR (action);
  89   } while (1);
  90
  91   /* Store it into the input event queue.  */
  92   if (! NILP (actions)) {
  93     EVENT_INIT (event);
  94     event.kind = FILE_NOTIFY_EVENT;
  95     event.frame_or_window = Qnil;
  96     event.arg = list2 (Fcons (XCAR (watch_object),
  97                               Fcons (actions,
  98                                      NILP (file1)
  99                                      ? Fcons (file, Qnil)
 100                                      : list2 (file, file1))),
 101                        Fnth (make_number (3), watch_object));
 102     kbd_buffer_store_event (&event);
 103   }
 104 }
 105
 106 /* This compares two directory listings in case of a `write' event for
 107    a directory.  Generate resulting file notification events.  The old
 108    directory listing is retrieved from watch_object, it will be
 109    replaced by the new directory listing at the end of this
 110    function.  */
 111 static void
 112 kqueue_compare_dir_list
 113 (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_number (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, 1, 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_number (2), old_entry),
 157                           Fnth (make_number (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_number (3), old_entry),
 163                             Fnth (make_number (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_number (4), entry);
 235     if (FLOATP (size) || (XINT (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   //  if (! NILP (deleted_dl))
 270   //    report_file_error ("Deleted events list not empty", deleted_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 fd, oflags;
 372   u_short fflags = 0;
 373   struct kevent kev;
 374
 375   /* Check parameters.  */
 376   CHECK_STRING (file);
 377   file = Fdirectory_file_name (Fexpand_file_name (file, Qnil));
 378   if (NILP (Ffile_exists_p (file)))
 379     report_file_error ("File does not exist", file);
 380
 381   CHECK_LIST (flags);
 382
 383   if (! FUNCTIONP (callback))
 384     wrong_type_argument (Qinvalid_function, callback);
 385
 386   if (kqueuefd < 0)
 387     {
 388       /* Create kqueue descriptor.  */
 389       kqueuefd = kqueue ();
 390       if (kqueuefd < 0)
 391         report_file_notify_error ("File watching is not available", Qnil);
 392
 393       /* Start monitoring for possible I/O.  */
 394       add_read_fd (kqueuefd, kqueue_callback, NULL);
 395
 396       watch_list = Qnil;
 397     }
 398
 399   /* Open file.  */
 400   file = ENCODE_FILE (file);
 401   oflags = O_NONBLOCK;
 402 #if O_EVTONLY
 403   oflags |= O_EVTONLY;
 404 #else
 405   oflags |= O_RDONLY;
 406 #endif
 407 #if O_SYMLINK
 408     oflags |= O_SYMLINK;
 409 #else
 410     oflags |= O_NOFOLLOW;
 411 #endif
 412   fd = emacs_open (SSDATA (file), oflags, 0);
 413   if (fd == -1)
 414     report_file_error ("File cannot be opened", file);
 415
 416   /* Assemble filter flags  */
 417   if (! NILP (Fmember (Qdelete, flags))) fflags |= NOTE_DELETE;
 418   if (! NILP (Fmember (Qwrite, flags)))  fflags |= NOTE_WRITE;
 419   if (! NILP (Fmember (Qextend, flags))) fflags |= NOTE_EXTEND;
 420   if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB;
 421   if (! NILP (Fmember (Qlink, flags)))   fflags |= NOTE_LINK;
 422   if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME;
 423
 424   /* Register event.  */
 425   EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR,
 426           fflags, 0, NULL);
 427
 428   if (kevent (kqueuefd, &kev, 1, NULL, 0, NULL) < 0) {
 429     emacs_close (fd);
 430     report_file_error ("Cannot watch file", file);
 431   }
 432
 433   /* Store watch object in watch list.  */
 434   Lisp_Object watch_descriptor = make_number (fd);
 435   if (NILP (Ffile_directory_p (file)))
 436     watch_object = list4 (watch_descriptor, file, flags, callback);
 437   else {
 438     dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, 1, Qnil);
 439     watch_object = list5 (watch_descriptor, file, flags, callback, dir_list);
 440   }
 441   watch_list = Fcons (watch_object, watch_list);
 442
 443   return watch_descriptor;
 444 }
 445
 446 DEFUN ("kqueue-rm-watch", Fkqueue_rm_watch, Skqueue_rm_watch, 1, 1, 0,
 447        doc: /* Remove an existing WATCH-DESCRIPTOR.
 448
 449 WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'.  */)
 450      (Lisp_Object watch_descriptor)
 451 {
 452   Lisp_Object watch_object = assq_no_quit (watch_descriptor, watch_list);
 453
 454   if (! CONSP (watch_object))
 455     xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"),
 456               watch_descriptor);
 457
 458   eassert (INTEGERP (watch_descriptor));
 459   int fd = XINT (watch_descriptor);
 460   if ( fd >= 0)
 461     emacs_close (fd);
 462
 463   /* Remove watch descriptor from watch list.  */
 464   watch_list = Fdelq (watch_object, watch_list);
 465
 466   if (NILP (watch_list) && (kqueuefd >= 0)) {
 467     delete_read_fd (kqueuefd);
 468     emacs_close (kqueuefd);
 469     kqueuefd = -1;
 470   }
 471
 472   return Qt;
 473 }
 474
 475 DEFUN ("kqueue-valid-p", Fkqueue_valid_p, Skqueue_valid_p, 1, 1, 0,
 476        doc: /* "Check a watch specified by its WATCH-DESCRIPTOR.
 477
 478 WATCH-DESCRIPTOR should be an object returned by `kqueue-add-watch'.
 479
 480 A watch can become invalid if the file or directory it watches is
 481 deleted, or if the watcher thread exits abnormally for any other
 482 reason.  Removing the watch by calling `kqueue-rm-watch' also makes it
 483 invalid.  */)
 484      (Lisp_Object watch_descriptor)
 485 {
 486   return NILP (assq_no_quit (watch_descriptor, watch_list)) ? Qnil : Qt;
 487 }
 488
 489 \f
 490 void
 491 globals_of_kqueue (void)
 492 {
 493   watch_list = Qnil;
 494 }
 495
 496 void
 497 syms_of_kqueue (void)
 498 {
 499   defsubr (&Skqueue_add_watch);
 500   defsubr (&Skqueue_rm_watch);
 501   defsubr (&Skqueue_valid_p);
 502
 503   /* Event types.  */
 504   DEFSYM (Qcreate, "create");
 505   DEFSYM (Qdelete, "delete");   /* NOTE_DELETE  */
 506   DEFSYM (Qwrite, "write");     /* NOTE_WRITE  */
 507   DEFSYM (Qextend, "extend");   /* NOTE_EXTEND  */
 508   DEFSYM (Qattrib, "attrib");   /* NOTE_ATTRIB  */
 509   DEFSYM (Qlink, "link");       /* NOTE_LINK  */
 510   DEFSYM (Qrename, "rename");   /* NOTE_RENAME  */
 511
 512   staticpro (&watch_list);
 513
 514   Fprovide (intern_c_string ("kqueue"), Qnil);
 515 }
 516
 517 #endif /* HAVE_KQUEUE  */
 518
 519 /* PROBLEMS
 520    * https://bugs.launchpad.net/ubuntu/+source/libkqueue/+bug/1514837
 521      prevents tests on Ubuntu.  */