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