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