lisp/filenotify.el

   1 ;;; filenotify.el --- watch files for changes on disk  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary
  23
  24 ;; This package is an abstraction layer from the different low-level
  25 ;; file notification packages `inotify', `kqueue', `gfilenotify' and
  26 ;; `w32notify'.
  27
  28 ;;; Code:
  29
  30 (require 'cl-lib)
  31 (eval-when-compile (require 'subr-x))
  32
  33 (defconst file-notify--library
  34   (cond
  35    ((featurep 'inotify) 'inotify)
  36    ((featurep 'kqueue) 'kqueue)
  37    ((featurep 'gfilenotify) 'gfilenotify)
  38    ((featurep 'w32notify) 'w32notify))
  39   "Non-nil when Emacs has been compiled with file notification support.
  40 The value is the name of the low-level file notification package
  41 to be used for local file systems.  Remote file notifications
  42 could use another implementation.")
  43
  44 (cl-defstruct (file-notify--watch
  45                (:constructor nil)
  46                (:constructor
  47                 file-notify--watch-make (directory filename callback)))
  48   ;; Watched directory
  49   directory
  50   ;; Watched relative filename, nil if watching the directory.
  51   filename
  52   ;; Function to propagate events to
  53   callback)
  54
  55 (defun file-notify--watch-absolute-filename (watch)
  56   "Return the absolute filename observed by WATCH."
  57   (if (file-notify--watch-filename watch)
  58       (expand-file-name
  59        (file-notify--watch-filename watch)
  60        (file-notify--watch-directory watch))
  61     (file-notify--watch-directory watch)))
  62
  63 (defvar file-notify-descriptors (make-hash-table :test 'equal)
  64   "Hash table for registered file notification descriptors.
  65 A key in this hash table is the descriptor as returned from
  66 `inotify', `kqueue', `gfilenotify', `w32notify' or a file name
  67 handler.  The value in the hash table is `file-notify--watch'
  68 struct.")
  69
  70 (defun file-notify--rm-descriptor (descriptor)
  71   "Remove DESCRIPTOR from `file-notify-descriptors'.
  72 DESCRIPTOR should be an object returned by `file-notify-add-watch'.
  73 If it is registered in `file-notify-descriptors', a stopped event is sent."
  74   (when-let (watch (gethash descriptor file-notify-descriptors))
  75     ;; Send `stopped' event.
  76     (unwind-protect
  77         (funcall
  78          (file-notify--watch-callback watch)
  79          `(,descriptor stopped ,(file-notify--watch-absolute-filename watch)))
  80       (remhash descriptor file-notify-descriptors))))
  81
  82 ;; This function is used by `inotify', `kqueue', `gfilenotify' and
  83 ;; `w32notify' events.
  84 ;;;###autoload
  85 (defun file-notify-handle-event (event)
  86   "Handle file system monitoring event.
  87 If EVENT is a filewatch event, call its callback.  It has the format
  88
  89   (file-notify (DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE]) CALLBACK)
  90
  91 Otherwise, signal a `file-notify-error'."
  92   (interactive "e")
  93   ;;(message "file-notify-handle-event %S" event)
  94   (if (and (consp event)
  95            (eq (car event) 'file-notify)
  96            (>= (length event) 3))
  97       (funcall (nth 2 event) (nth 1 event))
  98     (signal 'file-notify-error
  99             (cons "Not a valid file-notify event" event))))
 100
 101 ;; Needed for `inotify' and `w32notify'.  In the latter case, COOKIE is nil.
 102 (defvar file-notify--pending-event nil
 103   "A pending file notification event for a future `renamed' action.
 104 It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
 105
 106 (defun file-notify--event-watched-file (event)
 107   "Return file or directory being watched.
 108 Could be different from the directory watched by the backend library."
 109   (when-let (watch (gethash (car event) file-notify-descriptors))
 110     (file-notify--watch-absolute-filename watch)))
 111
 112 (defun file-notify--event-file-name (event)
 113   "Return file name of file notification event, or nil."
 114   (when-let (watch (gethash (car event) file-notify-descriptors))
 115     (directory-file-name
 116      (expand-file-name
 117       (or  (and (stringp (nth 2 event)) (nth 2 event)) "")
 118       (file-notify--watch-directory watch)))))
 119
 120 ;; Only `gfilenotify' could return two file names.
 121 (defun file-notify--event-file1-name (event)
 122   "Return second file name of file notification event, or nil.
 123 This is available in case a file has been moved."
 124   (when-let (watch (gethash (car event) file-notify-descriptors))
 125     (and (stringp (nth 3 event))
 126          (directory-file-name
 127           (expand-file-name
 128            (nth 3 event) (file-notify--watch-directory watch))))))
 129
 130 ;; Cookies are offered by `inotify' only.
 131 (defun file-notify--event-cookie (event)
 132   "Return cookie of file notification event, or nil.
 133 This is available in case a file has been moved."
 134   (nth 3 event))
 135
 136 ;; The callback function used to map between specific flags of the
 137 ;; respective file notifications, and the ones we return.
 138 (defun file-notify-callback (event)
 139   "Handle an EVENT returned from file notification.
 140 EVENT is the cadr of the event in `file-notify-handle-event'
 141 \(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])."
 142   (let* ((desc (car event))
 143          (watch (gethash desc file-notify-descriptors))
 144          (actions (nth 1 event))
 145          (file (file-notify--event-file-name event))
 146          file1 pending-event stopped)
 147
 148     ;; Make actions a list.
 149     (unless (consp actions) (setq actions (cons actions nil)))
 150
 151     (when watch
 152       ;; Loop over actions.  In fact, more than one action happens only
 153       ;; for `inotify' and `kqueue'.
 154       (while actions
 155         (let ((action (pop actions)))
 156           ;; Send pending event, if it doesn't match.
 157           (when (and file-notify--pending-event
 158                      ;; The cookie doesn't match.
 159                      (not (equal (file-notify--event-cookie
 160                                   (car file-notify--pending-event))
 161                                  (file-notify--event-cookie event)))
 162                      (or
 163                       ;; inotify.
 164                       (and (eq (nth 1 (car file-notify--pending-event))
 165                                'moved-from)
 166                            (not (eq action 'moved-to)))
 167                       ;; w32notify.
 168                       (and (eq (nth 1 (car file-notify--pending-event))
 169                                'renamed-from)
 170                            (not (eq action 'renamed-to)))))
 171             (setq pending-event file-notify--pending-event
 172                   file-notify--pending-event nil)
 173             (setcar (cdar pending-event) 'deleted))
 174
 175           ;; Map action.  We ignore all events which cannot be mapped.
 176           (setq action
 177                 (cond
 178                  ((memq action
 179                         '(attribute-changed changed created deleted renamed))
 180                   action)
 181                  ((memq action '(moved rename))
 182                   ;; The kqueue rename event does not return file1 in
 183                   ;; case a file monitor is established.
 184                   (if (setq file1 (file-notify--event-file1-name event))
 185                       'renamed 'deleted))
 186                  ((eq action 'ignored)
 187                   (setq stopped t actions nil))
 188                  ((memq action '(attrib link)) 'attribute-changed)
 189                  ((memq action '(create added)) 'created)
 190                  ((memq action '(modify modified write)) 'changed)
 191                  ((memq action '(delete delete-self move-self removed))
 192                   'deleted)
 193                  ;; Make the event pending.
 194                  ((memq action '(moved-from renamed-from))
 195                   (setq file-notify--pending-event
 196                         `((,desc ,action ,file
 197                            ,(file-notify--event-cookie event))
 198                           ,(file-notify--watch-callback watch)))
 199                   nil)
 200                  ;; Look for pending event.
 201                  ((memq action '(moved-to renamed-to))
 202                   (if (null file-notify--pending-event)
 203                       'created
 204                     (setq file1 file
 205                           file (file-notify--event-file-name
 206                                 (car file-notify--pending-event)))
 207                     ;; If the source is handled by another watch, we
 208                     ;; must fire the rename event there as well.
 209                     (unless (equal desc (caar file-notify--pending-event))
 210                       (setq pending-event
 211                             `((,(caar file-notify--pending-event)
 212                                renamed ,file ,file1)
 213                               ,(cadr file-notify--pending-event))))
 214                     (setq file-notify--pending-event nil)
 215                     'renamed))))
 216
 217           ;; Apply pending callback.
 218           (when pending-event
 219             (funcall (cadr pending-event) (car pending-event))
 220             (setq pending-event nil))
 221
 222           ;; Apply callback.
 223           (when (and action
 224                      (or
 225                       ;; If there is no relative file name for that
 226                       ;; watch, we watch the whole directory.
 227                       (null (file-notify--watch-filename watch))
 228                       ;; File matches.
 229                       (string-equal
 230                        (file-notify--watch-filename watch)
 231                        (file-name-nondirectory file))
 232                       ;; Directory matches.
 233                       (string-equal
 234                        (file-name-nondirectory file)
 235                        (file-name-nondirectory
 236                         (file-notify--watch-directory watch)))
 237                       ;; File1 matches.
 238                       (and (stringp file1)
 239                            (string-equal
 240                             (file-notify--watch-filename watch)
 241                             (file-name-nondirectory file1)))))
 242             ;;(message
 243             ;;"file-notify-callback %S %S %S %S %S"
 244             ;;desc action file file1 watch)
 245             (if file1
 246                 (funcall (file-notify--watch-callback watch)
 247                          `(,desc ,action ,file ,file1))
 248               (funcall (file-notify--watch-callback watch)
 249                        `(,desc  ,action ,file))))
 250
 251           ;; Send `stopped' event.
 252           (when (or stopped
 253                     (and (memq action '(deleted renamed))
 254                          ;; Not, when a file is backed up.
 255                          (not (and (stringp file1) (backup-file-name-p file1)))
 256                          ;; Watched file or directory is concerned.
 257                          (string-equal
 258                           file (file-notify--event-watched-file event))))
 259             (file-notify-rm-watch desc)))))))
 260
 261 ;; `kqueue', `gfilenotify' and `w32notify' return a unique descriptor
 262 ;; for every `file-notify-add-watch', while `inotify' returns a unique
 263 ;; descriptor per inode only.
 264 (defun file-notify-add-watch (file flags callback)
 265   "Add a watch for filesystem events pertaining to FILE.
 266 This arranges for filesystem events pertaining to FILE to be reported
 267 to Emacs.  Use `file-notify-rm-watch' to cancel the watch.
 268
 269 The returned value is a descriptor for the added watch.  If the
 270 file cannot be watched for some reason, this function signals a
 271 `file-notify-error' error.
 272
 273 FLAGS is a list of conditions to set what will be watched for.  It can
 274 include the following symbols:
 275
 276   `change'           -- watch for file changes
 277   `attribute-change' -- watch for file attributes changes, like
 278                         permissions or modification time
 279
 280 If FILE is a directory, `change' watches for file creation or
 281 deletion in that directory.  This does not work recursively.
 282
 283 When any event happens, Emacs will call the CALLBACK function passing
 284 it a single argument EVENT, which is of the form
 285
 286   (DESCRIPTOR ACTION FILE [FILE1])
 287
 288 DESCRIPTOR is the same object as the one returned by this function.
 289 ACTION is the description of the event.  It could be any one of the
 290 following:
 291
 292   `created'           -- FILE was created
 293   `deleted'           -- FILE was deleted
 294   `changed'           -- FILE has changed
 295   `renamed'           -- FILE has been renamed to FILE1
 296   `attribute-changed' -- a FILE attribute was changed
 297   `stopped'           -- watching FILE has been stopped
 298
 299 FILE is the name of the file whose event is being reported."
 300   ;; Check arguments.
 301   (unless (stringp file)
 302     (signal 'wrong-type-argument `(,file)))
 303   (setq file (expand-file-name file))
 304   (unless (and (consp flags)
 305                (null (delq 'change (delq 'attribute-change (copy-tree flags)))))
 306     (signal 'wrong-type-argument `(,flags)))
 307   (unless (functionp callback)
 308     (signal 'wrong-type-argument `(,callback)))
 309
 310   (let* ((handler (find-file-name-handler file 'file-notify-add-watch))
 311          (dir (directory-file-name
 312                (if (file-directory-p file)
 313                    file
 314                  (file-name-directory file))))
 315          desc func l-flags)
 316
 317     (unless (file-directory-p dir)
 318       (signal 'file-notify-error `("Directory does not exist" ,dir)))
 319
 320     (if handler
 321         ;; A file name handler could exist even if there is no local
 322         ;; file notification support.
 323         (setq desc (funcall handler 'file-notify-add-watch dir flags callback))
 324
 325       ;; Check, whether Emacs has been compiled with file notification
 326       ;; support.
 327       (unless file-notify--library
 328         (signal 'file-notify-error
 329                 '("No file notification package available")))
 330
 331       ;; Determine low-level function to be called.
 332       (setq func
 333             (cond
 334              ((eq file-notify--library 'inotify) 'inotify-add-watch)
 335              ((eq file-notify--library 'kqueue) 'kqueue-add-watch)
 336              ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
 337              ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
 338
 339       ;; Determine respective flags.
 340       (if (eq file-notify--library 'gfilenotify)
 341           (setq l-flags (append '(watch-mounts send-moved) flags))
 342         (when (memq 'change flags)
 343           (setq
 344            l-flags
 345            (cond
 346             ((eq file-notify--library 'inotify)
 347              '(create delete delete-self modify move-self move))
 348             ((eq file-notify--library 'kqueue)
 349              '(create delete write extend rename))
 350             ((eq file-notify--library 'w32notify)
 351              '(file-name directory-name size last-write-time)))))
 352         (when (memq 'attribute-change flags)
 353           (push (cond
 354                  ((eq file-notify--library 'inotify) 'attrib)
 355                  ((eq file-notify--library 'kqueue) 'attrib)
 356                  ((eq file-notify--library 'w32notify) 'attributes))
 357                 l-flags)))
 358
 359       ;; Call low-level function.
 360       (setq desc (funcall
 361                   ;; kqueue does not report file changes in directory
 362                   ;; monitor.  So we must watch the file itself.
 363                   func (if (eq file-notify--library 'kqueue) file dir)
 364                   l-flags 'file-notify-callback)))
 365
 366     ;; Modify `file-notify-descriptors'.
 367     (let ((watch (file-notify--watch-make
 368                   dir
 369                   (unless (file-directory-p file) (file-name-nondirectory file))
 370                   callback)))
 371       (puthash desc watch file-notify-descriptors))
 372     ;; Return descriptor.
 373     desc))
 374
 375 (defun file-notify-rm-watch (descriptor)
 376   "Remove an existing watch specified by its DESCRIPTOR.
 377 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
 378   (when-let (watch (gethash descriptor file-notify-descriptors))
 379     (let ((handler (find-file-name-handler
 380                     (file-notify--watch-directory watch)
 381                     'file-notify-rm-watch)))
 382       (condition-case nil
 383           (if handler
 384               ;; A file name handler could exist even if there is no
 385               ;; local file notification support.
 386               (funcall handler 'file-notify-rm-watch descriptor)
 387
 388             (funcall
 389              (cond
 390               ((eq file-notify--library 'inotify) 'inotify-rm-watch)
 391               ((eq file-notify--library 'kqueue) 'kqueue-rm-watch)
 392               ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
 393               ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
 394              descriptor))
 395         (file-notify-error nil)))
 396     ;; Modify `file-notify-descriptors'.
 397     (file-notify--rm-descriptor descriptor)))
 398
 399 (defun file-notify-valid-p (descriptor)
 400   "Check a watch specified by its DESCRIPTOR.
 401 DESCRIPTOR should be an object returned by `file-notify-add-watch'."
 402   (when-let (watch (gethash descriptor file-notify-descriptors))
 403     (let ((handler (find-file-name-handler
 404                     (file-notify--watch-directory watch)
 405                     'file-notify-valid-p)))
 406       (and (if handler
 407                ;; A file name handler could exist even if there is no
 408                ;; local file notification support.
 409                (funcall handler 'file-notify-valid-p descriptor)
 410              (funcall
 411               (cond
 412                ((eq file-notify--library 'inotify) 'inotify-valid-p)
 413                ((eq file-notify--library 'kqueue) 'kqueue-valid-p)
 414                ((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
 415                ((eq file-notify--library 'w32notify) 'w32notify-valid-p))
 416               descriptor))
 417            t))))
 418
 419
 420 ;; TODO:
 421 ;; * Watching a /dir/file may receive events for dir.
 422 ;;   (This may be the desired behaviour.)
 423 ;; * Watching a file in a already watched directory
 424 ;;   If the file is created and *then* a watch is added to that file, the
 425 ;;   watch might receive events which occurred prior to it being created,
 426 ;;   due to the way events are propagated during idle time.  Note: This
 427 ;;   may be perfectly acceptable.
 428
 429 ;; The end:
 430 (provide 'filenotify)
 431
 432 ;;; filenotify.el ends here