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