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

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