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