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