emacs-config/elisp/trusted-dirs.el

;;; trusted-dirs.el --- Simplistic security for Eglot and auto-complete. -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
(require 'cl-lib)
(eval-and-compile
  (defconst trusted-dirs-generated-function-name-prefix "trusted-dirs--"
    "Prefix to append to generated functions.
This is used by `trusted-dirs-add-hook-if-safe' and
`trusted-dirs-mark-function-unsafe'.  Note that these two functions are actually
macros, so if you change this (which you probably shouldn't do), code that uses
these will need to be recompiled.")

  (defconst trusted-dirs-hook-function-name-suffix "@trusted-dirs-hook-if-safe"
    "Suffix to append to function names in `trusted-dirs-add-hook-if-safe'.
Note that `trusted-dirs-add-hook-if-safe' is a macro, so if this value is
changed (which you probably shouldn't do), code that calls
`trusted-dirs-add-hook-if-safe' will need to be recompiled.")

  (defconst trusted-dirs-advice-function-name-suffix
    "@trusted-dirs-advice-if-safe"
    "Suffix to append to function names in `trusted-dirs-mark-function-unsafe'.
Note that `trusted-dirs-mark-function-unsafe' is a macro, so if this value is
changed (which you probably shouldn't do), code that calls
`trusted-dirs-mark-function-unsafe' will need to be recompiled. "))

(defgroup trusted-dirs nil
  "Simplistic security for Eglot, auto-complete, etc."
  :group 'files
  :prefix "trusted-dirs-")

(defun trusted-dirs--validate-only-allow-absolute-paths (widget)
  "Custom validation function to only allow WIDGET to contain absolute paths."
  (let ((path (widget-value widget)))
    (unless (and (stringp path) (file-name-absolute-p path))
      (widget-put widget :error "Path must be absolute")
      widget)))

(defcustom trusted-dirs-list ()
  "List of directories that should be considered safe."
  :group 'trusted-dirs
  :tag "Trusted Directories"
  :type '(repeat
          (cons :tag "Entry"
                (directory
                 :tag "Directory"
                 :validate trusted-dirs--validate-only-allow-absolute-paths)
                (boolean :tag "Also trust subdirectories" :value t)))
  :risky t)

(defcustom trusted-dirs-truename-trusted-directories t
  "If non-nil, use the `file-truename' of for entries in `trusted-dirs-list'.
Note that this does not affect `default-directory', see
`trusted-dirs-truename-current-directory' for that."
  :group 'trusted-dirs
  :tag "Resolve Symbolic Links for Trusted Directories"
  :type 'boolean
  :risky t)

(defcustom trusted-dirs-truename-current-directory t
  "If non-nil, use the `file-truename' of `default-directory' when checking safety.
If this is nil, each link to a directory must individually be in
`trusted-dirs-list' to be considered safe.  Note that this does _NOT_ effect the
entries in `trusted-dirs-list', only `default-directory'."
  :group 'trusted-dirs
  :tag "Resolve Symbolic Links for the Current Directory"
  :type 'boolean
  :risky t)

(defcustom trusted-dirs-show-in-modeline 'dynamic-temporary-untrusted
  "How to show the current buffer's trusted status in the mode line.
There are three possible values:
  - t: always show the status
  - \\='untrusted: show the status if `default-directory' is untrusted
  - \\='dynamic: as above, but only if a protected function tried to run
  - \\='dynamic-untrusted: as above, but only if the function failed
  - \\='dynamic-temporary: save as \\='dynamic, but also show when the buffer is
                        temporarily trusted
  - \\='dynamic-temporary-untrusted: as above, but only if a function failed

To completely disabled display of the trusted status, disable
`trusted-dirs-modeline-mode'."
  :group 'tusted-dirs
  :tag "Show Trusted State in Modeline"
  :type '(choice (const :tag "Always" t)
                 (const :tag "If Untrusted" untrusted)
                 (const :tag "Dynamic" dynamic)
                 (const :tag "Dynamic if Untrusted" dynamic-untrusted)
                 (const :tag "Dynamic (or Temporary)" dynamic-temporary)
                 (const :tag "Dynamic if Untrusted (or Temporary)"
                        dynamic-temporary-untrusted))
  :set (lambda (sym val)
         (set-default-toplevel-value sym val)
         (force-mode-line-update t)))

(defface trusted-dirs-trusted-modeline-face
  '((t))
  "Face for the trusted notification string in the mode line."
  :group 'trusted-dirs
  :tag "Mode Line Trusted Notification Face")

(defface trusted-dirs-temporary-modeline-face
  '((t . (:inherit warning)))
  "Face for the temporarily trusted notification string in the mode line."
  :group 'trusted-dirs
  :tag "Mode Line Temporarily Trusted Notification Face")

(defface trusted-dirs-untrusted-modeline-face
  '((t . (:inherit error)))
  "Face for the untrusted notification string in the mode line."
  :group 'trusted-dirs
  :tag "Mode Line Untrusted Notification Face")

(defvar-local trusted-dirs--did-protected-function-run nil
  "Non-nil if a protected function tried to run in the current buffer.")
;;;###autoload (put 'trusted-dirs--did-protected-function-run 'risky-local-variable t)

(defvar-local trusted-dirs--did-protected-function-fail nil
  "Non-nil if a protected function failed to run in the current buffer.")
;;;###autoload (put 'trusted-dirs--did-protected-function-fail 'risky-local-variable t)

(defvar trusted-dirs--temporarily-trusted-cache (make-hash-table :test 'equal)
  "Hash table of temporarily trusted directories and buffers.
Each key is a directory or buffer.  In the case of a buffer, any non-nil values
means that the buffer is trusted.  In the case of a directory, the key is one of
the following:
  - t: this directory is trusted
  - \\='subdir: this directory and its subdirectories are trusted

Entries are removed from this list by
`trusted-dirs--cleanup-temporary-trusted-cache', which is called from
`kill-buffer-hook'.")
;;;###autoload (put 'trusted-dirs--temporarily-trusted-cache 'risky-local-variable t)

(defun trusted-dirs--modeline-string ()
  "Return the trusted-dirs mode line string for the current buffer.
To change when this is shown, customize `trusted-dirs-show-in-modeline'."
  (let* ((safe (car (trusted-dirs-safe-p nil t)))
         (temporary (car (memq safe
                               '(temp-buffer temp-dir temp-subdir)))))
    (and (or (eq trusted-dirs-show-in-modeline t)
             (and temporary
                  (memq trusted-dirs-show-in-modeline
                        '(dynamic-temporary dynamic-temporary-untrusted)))
             (and (not safe) (eq trusted-dirs-show-in-modeline 'untrusted))
             (and trusted-dirs--did-protected-function-run
                  (memq trusted-dirs-show-in-modeline
                        '(dynamic dynamic-temporary)))
             (and trusted-dirs--did-protected-function-fail
                  (memq trusted-dirs-show-in-modeline
                        '(dynamic-untrusted dynamic-temporary-untrusted))))
         (list
          (cond
           (temporary
            `(:propertize ,(format "Temp. Trusted %s"
                                   (cl-case temporary
                                     (temp-buffer "(B)")
                                     (temp-dir "(D)")
                                     (temp-subdir "(S)")))
              face trusted-dirs-temporary-modeline-face
              mouse-face mode-line-highlight
              help-echo
              ,(cl-case temporary
                 (temp-buffer
                  "This buffer is temp. trusted. Click to untrust.")
                 (temp-dir
                  "This directory is temp. trusted. Click to untrust it.")
                 (temp-subdir
                  "A parent directory is temp. trusted. Click to untrust it."))
              keymap
              (mode-line keymap
                         (mouse-1 . trusted-dirs-remove-temporary-current-buffer))))
           (safe '(:propertize "Trusted"
                   face trusted-dirs-trusted-modeline-face
                   help-echo
                   (cl-case safe
                     (dir "This buffer's directory (not a parent) is trusted.")
                     (subdir "A parent directory of this buffer is trusted."))))
           (t '(:propertize "Untrusted"
                face trusted-dirs-untrusted-modeline-face
                help-echo "This buffer is untrusted.")))
          " "))))

;;;###autoload
(define-minor-mode trusted-dirs-modeline-mode
  "Minor mode for showing current buffer's trusted status in the mode line."
  :group 'trusted-dirs
  :global t
  :lighter nil
  (let ((item '(:eval (trusted-dirs--modeline-string))))
    (if trusted-dirs-modeline-mode
        (add-to-list 'global-mode-string item)
      (setq global-mode-string (remove item global-mode-string))))
  (force-mode-line-update))

(defun trusted-dirs--remove-extra-path-parts (path)
  "Remove extra path parts from PATH.
This removes \".\" and \"..\" components.  This always returns a path without a
trailing slash.  The difference between this and `expand-file-name' is that this
will not return things like \"/..\"."
  (let ((expanded (expand-file-name path)))
    (while (string-prefix-p "/.." expanded)
      (setq expanded (substring expanded 3))
      (unless (string-prefix-p "/" expanded)
        (setq expanded (concat "/" expanded))))
    (directory-file-name expanded)))

(defun trusted-dirs--resolve-trusted-directory (path)
  "Resolve PATH, which is resolved according to user settings.
If `trusted-dirs-truename-trusted-directories' is set, return the
`file-truename' of PATH.  In any case, remove \".\" and \"..\" components from
PATH.  Also make PATH absolute and remove any trailing slash."
  (if trusted-dirs-truename-trusted-directories
      (directory-file-name (file-truename path))
    (trusted-dirs--remove-extra-path-parts path)))

(defun trusted-dirs-resolved-list ()
  "Return `trusted-dirs-list' as a hash table, removing invalid entries.
Also, take the `file-truename' of each entry if
`trusted-dirs-truename-trusted-directories' is set."
  (let ((ht (make-hash-table :test 'equal)))
    (dolist (entry trusted-dirs-list ht)
      (when (file-name-absolute-p (car entry))
        (let* ((resolved (trusted-dirs--resolve-trusted-directory (car entry)))
               (cur-val (gethash resolved ht)))
          ;; Prioritize the most specific rule.  If the output is already set to
          ;; t (more specific than 'subdir), don't touch it.  Otherwise, set the
          ;; output to whatever the current entry is
          (unless (eq cur-val t)
            (puthash resolved (cdr entry) ht)))))))

(defsubst trusted-dirs--resolve-current-directory (path)
  "Resolve PATH, which is resolved according to user settings.
If `trusted-dirs-truename-current-directory' is set, return the `file-truename'
of PATH.  In any case, remove \".\" and \"..\" components from PATH.  Also make
PATH absolute and remove any trailing slash."
  (if trusted-dirs-truename-current-directory
      (directory-file-name (file-truename path))
    (trusted-dirs--remove-extra-path-parts path)))

(defun trusted-dirs--path-equal-p (path1 path2)
  "Return non-nil if PATH1 and PATH2 are the same path.
This is the same as `equal' except that it calls `directory-file-name' on PATH1
and PATH2 before comparing them."
  (and (equal (directory-file-name path1)
              (directory-file-name path2))))

(defun trusted-dirs--normal-buffer-p (&optional buffer)
  "Return non-nil if BUFFER (or the current buffer) is a normal buffer.
A buffer is normal if it visits a file, is not hidden, and it's name does not
start and end with asterisks."
  (unless buffer (setq buffer (current-buffer)))
  (and (buffer-file-name buffer)
       (not (string-prefix-p " " (buffer-name buffer)))
       (not (string-match-p "\\`\\*.*\\*\\'" (buffer-name buffer)))))

(defun trusted-dirs--subdirectory-p (parent child &optional resolved)
  "Return non-nil if CHILD is a subdirectory of PARENT.
This will resolve both PARENT and CHILD with
`trusted-dirs--resolve-current-directory', unless RESOLVED is non-nil."
  (unless resolved
    (setq parent (trusted-dirs--resolve-current-directory parent)
          child (trusted-dirs--resolve-current-directory child)))
  (or (equal parent "/")
      (string-match-p (concat "\\`" (regexp-quote parent) "\\(\\'\\|/\\)") child)))

(defun trusted-dirs--find-buffers-in-dir
    (dir &optional subdir-too resolved special-too)
  "Return a list of buffers that have a `default-directory' of DIR.
If SUBDIR-TOO is set, also search for subdirectories of DIR.  If SPECIAL-TOO is
set, also consider buffers that are special.  Otherwise, only consider regular,
visible, file-visiting buffers.

Unless RESOLVED is set, resolve DIR with
`trusted-dirs--resolve-current-directory'."
  (unless resolved (setq dir (trusted-dirs--resolve-current-directory dir)))
  (let (out)
    (dolist (buffer (buffer-list) out)
      (when (or special-too (trusted-dirs--normal-buffer-p buffer))
        (let ((target-dir (trusted-dirs--resolve-current-directory
                           (buffer-local-value 'default-directory
                                               buffer))))
          (when (or (and subdir-too (trusted-dirs--subdirectory-p
                                     dir target-dir))
                    (equal dir target-dir))
            (push buffer out)))))))

(defun trusted-dirs--cleanup-temporary-trusted-cache ()
  "Cleanup `trusted-dirs--temporarily-trusted-cache'."
  (remhash (current-buffer) trusted-dirs--temporarily-trusted-cache)
  (cl-loop with resolved = (trusted-dirs--resolve-current-directory
                            default-directory)
           for prev = nil then cur
           for cur = resolved then (directory-file-name
                                    (file-name-directory cur))
           until (equal prev cur)
           for rule = (gethash cur trusted-dirs--temporarily-trusted-cache)
           when (and rule (null (delq (current-buffer)
                                      (trusted-dirs--find-buffers-in-dir
                                       cur (eq rule 'subdir)))))
           collect cur into steps
           and do (remhash cur trusted-dirs--temporarily-trusted-cache)
           finally do
           (message "Untrusted %s" (trusted-dirs--pprint-list steps))))

(add-hook 'kill-buffer-hook #'trusted-dirs--cleanup-temporary-trusted-cache)

(defun trusted-dirs--buffer-temporarily-trusted-p (buffer)
  "Return non-nil if BUFFER is temprarily trusted.
This checks both BUFFER and BUFFER's `default-directory'.

Return a cons.  For the car if the BUFFER is trusted, return \\='temp-buffer.
If `default-directory' is exactly trusted, return \\='temp-dir.  If a parent
directory of it is trusted, return \\='temp-subdir.  For the cdr, return the
directory that matched, or the BUFFER it itself matched."
  (or
   (and (gethash buffer trusted-dirs--temporarily-trusted-cache)
        (cons 'temp-buffer buffer))
   (cl-loop with dir = (trusted-dirs--resolve-current-directory
                        (buffer-local-value 'default-directory buffer))
            for prev = nil then cur
            for cur = dir then (directory-file-name
                                (file-name-directory cur))
            until (equal prev cur)
            for result = (gethash cur trusted-dirs--temporarily-trusted-cache)
            ;; if we find an exact match, return t
            when (and result (equal dir cur)) return (cons 'temp-dir cur)
            ;; otherwise, return t if the entry allows subdirectories
            when (eq result 'subdir) return (cons 'temp-subdir cur))))

(defun trusted-dirs--permanently-trusted-p (path &optional resolved)
  "Return non-nil if PATH is in `trusted-dirs-list'.
This will resolve PATH with `trusted-dirs--resolve-trusted-directory' unless
RESOLVED is non-nil.

Return a cons.  For the car if PATH (not a parent directory) is trusted, return
\\='dir.  If a parent directory of PATH is trusted, return \\='subdir.  For the
cdr, return the directory that matched."
  (unless resolved (setq path (trusted-dirs--resolve-current-directory path)))
  (cl-loop with trusted-list = (trusted-dirs-resolved-list)
           for prev = nil then cur
           for cur = path then (directory-file-name
                                (file-name-directory cur))
           until (equal prev cur)
           for result = (gethash cur trusted-list)
           ;; if we find an exact match, return t
           when (and result (equal path cur)) return (cons 'dir cur)
           ;; otherwise, return t if the entry allows subdirectories
           when (eq result 'subdir) return (cons 'subdir cur)))

(defun trusted-dirs-safe-p (&optional dir no-modify)
  "Return non-nil if DIR is considered safe.
DIR defaults to `default-directory' if it is nil.  Also, if DIR is unsafe, set
`trusted-dirs--did-protected-function-fail' to t unless NO-MODIFY is non-nil.
In any case, set `trusted-dirs--did-protected-function-run' to t unless
NO-MODIFY is non-nil.

This can return a few different things depending on how DIR is trusted.  See
`trusted-dirs--permanently-trusted-p' and
`trusted-dirs--buffer-temporarily-trusted-p' for a list of possible return
values."
  (unless dir (setq dir default-directory))
  (setq dir (trusted-dirs--resolve-current-directory dir))
  (unless no-modify
    (setq trusted-dirs--did-protected-function-run t))
  (let ((result (or (trusted-dirs--permanently-trusted-p dir)
                    (trusted-dirs--buffer-temporarily-trusted-p
                     (current-buffer)))))
    (unless (or no-modify result)
      (setq trusted-dirs--did-protected-function-fail t))
    (unless no-modify
      (force-mode-line-update))
    result))

(defun trusted-dirs--visible-buffer-list ()
  "Return a list of all visible buffers.
A buffer is coincided visible if it's name does not start with a space."
  (cl-delete-if (lambda (buf)
                  (string-prefix-p " " (buffer-name buf)))
                (buffer-list)))

(defun trusted-dirs--pprint-buffer-name (buffer)
  "Return a string which can represent BUFFER when prompting the user."
  (if-let ((path (buffer-file-name buffer))
           (file (file-name-nondirectory path)))
      (if (equal file (buffer-name buffer))
          file
        (format "%s (buffer %s)" file (buffer-name buffer)))
    (buffer-name buffer)))

(defun trusted-dirs-outdated-trust-information-p (&optional buffer)
  "Return non-nil if BUFFER has outdated trust information.
See `trusted-dirs-reload-newly-trusted-buffers' for an explanation of when a
buffer might have outdated trust information.

If BUFFER is nil, default to the current buffer;"
  (with-current-buffer (or buffer (current-buffer))
    (let ((safe (trusted-dirs-safe-p nil t)))
      (or (and safe trusted-dirs--did-protected-function-fail)
          (and (not safe) trusted-dirs--did-protected-function-run
               (not trusted-dirs--did-protected-function-fail))))))

(cl-defun trusted-dirs--outdated-buffer-list (&optional (buffers (buffer-list)))
  "Return a list of buffers that have outdated trust information.
See `trusted-dirs-reload-newly-trusted-buffers' for an explanation of when a
buffer might have outdated trust information.

If BUFFERS is passed, only consider buffers in that list.  Otherwise, consider
all live buffers (even special and hidden ones)."
  (cl-remove-if-not #'trusted-dirs-outdated-trust-information-p buffers))

(defun trusted-dirs--princ-to-string (object)
  "Return the output resulting from calling `princ' on OBJECT."
  (with-output-to-string
    (princ object standard-output)))

(defun trusted-dirs--pprint-list (items &optional formatter no-oxford-comma)
  "Pretty print ITEMS, a list of things.
Each item will be converted to a string, using FORMATTER, before being printed.
If FORMATTER is nil, use `trusted-dirs--princ-to-string'.  The FORMATTER must
take a single argument, the item to format, and return a string.

With NO-OXFORD-COMMA, don't insert an Oxford comma."
  (unless formatter (setq formatter #'trusted-dirs--princ-to-string))
  (let ((len (length items)))
    (cl-case len
      (0 "")
      (1 (funcall formatter (car items)))
      (2 (concat (funcall formatter (cl-first items))
                 " and "
                 (funcall formatter (cl-second items))))
      (t (cl-loop for i upfrom 1
                  for item in items
                  when (/= len i)
                  concat (funcall formatter item)
                  and concat (if (and no-oxford-comma
                                      (= i (1- len)))
                                 " "
                               ", ")
                  else
                  concat "and "
                  and concat (funcall formatter item))))))

;;;###autoload
(cl-defun trusted-dirs-revert-newly-trusted-buffers
    (&optional force silent (buffers (trusted-dirs--visible-buffer-list)))
  "Revert all buffers that have outdated trust information.
A buffer is considered to have outdated trust information if:
 - it is marked as having a had a function fail, even though it is trusted
 - it is marked as having had no function fail, even though it is untrusted

By default this prompts the user to save any buffers before reverting them.  If
the user says no to saving a buffer, skip it.  With FORCE, don't ask the user
anything and (possibly destructively) revert all buffers.

Unless SILENT is non-nil, `message' the user with a list of each revered buffer.

By default, revert all live buffers.  To only check some buffers, pass a list of
buffers in BUFFERS."
  (interactive)
  (let (reverted)
    (dolist (buffer (trusted-dirs--outdated-buffer-list buffers))
      (with-current-buffer buffer
        (when (and (not force)
                   (buffer-modified-p)
                   (y-or-n-p (format "Save and revert %s?"
                                     (trusted-dirs--pprint-buffer-name buffer))))
          (save-buffer))
        (when (or force (not (buffer-modified-p)))
          (revert-buffer nil t)
          (push buffer reverted))))
    (when (and (not silent) reverted)
      (message
       "Reverted buffer%s %s"
       (if (length= reverted 1) "" "s")
       (trusted-dirs--pprint-list reverted
                                  #'trusted-dirs--pprint-buffer-name)))))

(cl-defun trusted-dirs--maybe-prompt-revert-newly-trusted-buffers
    (&optional (buffers (trusted-dirs--outdated-buffer-list
                         (trusted-dirs--visible-buffer-list))))
  "If there are buffers with outdated trust, prompt the user to revert them.
For a definition of what qualifies as a buffer with outdated trust, see
`trusted-dirs-revert-newly-trusted-buffers'.

With BUFFERS, only consider those buffers."
  (and buffers (y-or-n-p "Buffers with outdated trust detected! Revert?")
       (trusted-dirs-revert-newly-trusted-buffers nil nil buffers)))

;;;###autoload
(defun trusted-dirs-add (path &optional no-recursive no-revert)
  "Mark PATH as a trusted directory.
If NO-RECURSIVE is non-nil, don't trust any subdirectories of PATH.
Interactively, prompt for PATH.  With a prefix argument, set NO-RECURSIVE.

By default, this calls asks the user if they want to run
`trusted-dirs-revert-newly-trusted-buffers'.  If NO-REVERT is set, don't ask or
call it.

PATH is processed according to `trusted-dirs-truename-trusted-directories'."
  (interactive "DTrust Directory: \nP")
  (cl-loop with resolved = (trusted-dirs--resolve-trusted-directory path)
           with set-val = (if no-recursive t 'subdir)
           with did-set = nil
           for entry in trusted-dirs-list
           for entry-dir = (trusted-dirs--resolve-trusted-directory
                            (car entry))
           when (trusted-dirs--path-equal-p entry-dir resolved) do
           (setcdr entry set-val)
           (setq did-set t)
           finally
           (unless did-set
             (push (cons resolved set-val) trusted-dirs-list))
           ;; Now that resolved is permanently trusted, we can remove it from
           ;; the temporary cache
           (remhash resolved trusted-dirs--temporarily-trusted-cache)
           (unless no-revert
             (message "Added %s to the list of trusted directories"
                      resolved)
             (trusted-dirs--maybe-prompt-revert-newly-trusted-buffers))))

;;;###autoload
(defun trusted-dirs-add-current (&optional no-recursive no-revert)
  "Mark `default-directory' as a trusted directory.
NO-RECURSIVE and NO-REVERT are the same as for `trusted-dirs-add' (which see).

`default-directory' is processed according to
`trusted-dirs-truename-trusted-directories'."
  (interactive "P")
  (trusted-dirs-add default-directory no-recursive no-revert))

(defun trusted-dirs--read-trusted-dir (&optional prompt)
  "Read a trusted directory from the minibuffer with completion.
PROMPT is the prompt to use, defaulting to \"Trusted Directory: \"."
  (let ((ht (trusted-dirs-resolved-list))
        dirs)
    (maphash (lambda (dir _v) (push dir dirs)) ht)
    (completing-read (or prompt "Trusted Directory") dirs nil t)))

;;;###autoload
(defun trusted-dirs-remove (path &optional no-revert)
  "Mark PATH as an untrusted directory.
Interactively, prompt for PATH.  Return the number of entries removed, or nil if
none where removed.

By default, this asks the user if they want to run
`trusted-dirs-revert-newly-trusted-buffers'.  If NO-REVERT is set, don't ask or
call it.

PATH is processed according to `trusted-dirs-truename-trusted-directories'."
  (interactive (list (trusted-dirs--read-trusted-dir "Untrust Directory: ")))
  (cl-loop with resolved = (trusted-dirs--resolve-trusted-directory path)
           for entry in trusted-dirs-list
           for entry-dir = (trusted-dirs--resolve-trusted-directory
                            (car entry))
           when (trusted-dirs--path-equal-p entry-dir resolved)
           count t into removed-count
           else
           collect entry into new-list
           finally
           (setq trusted-dirs-list new-list)
           (unless no-revert
             (if (zerop removed-count)
                 (message "%s is not trusted" resolved)
               (message "Removed %s from the list of trusted directories"
                        resolved))
             (trusted-dirs--maybe-prompt-revert-newly-trusted-buffers))
           finally return (unless (zerop removed-count)
                            removed-count)))

(defun trusted-dirs-remove-current (&optional no-revert)
  "Mark `default-directory' as an untrusted directory.
NO-REVERT is the same as for `trusted-dirs-remove' (which see).  The return
value is also the same.

`default-directory' is processed according to
`trusted-dirs-truename-trusted-directories'."
  (interactive)
  (trusted-dirs-remove default-directory no-revert))

;;;###autoload
(defun trusted-dirs-add-temporary-directory
    (path &optional no-recursive no-revert)
  "Temporarily trust PATH.
PATH will be trusted until _ALL_ buffers that have it as their
`default-directory' are closed.  Unless NO-RECURSIVE is set, also trust
subdirectories of `default-directory'.  In this case buffers in all
subdirectories of `default-directory' will also be trusted, and PATH will not be
untrusted until _ALL_ of these buffers are closed as well.

Unless NO-REVERT is set, prompt the user to call
`trusted-dirs-revert-newly-trusted-buffers'.

Note that only non-special, visible, file-visiting buffers are considered."
  (interactive "DTemporarily Trust: \nP")
  (let ((resolved (trusted-dirs--resolve-trusted-directory path)))
    (when (trusted-dirs--permanently-trusted-p resolved t)
      (user-error "%s is already permanently trusted" resolved))
    (unless (trusted-dirs--find-buffers-in-dir resolved (not no-recursive) t)
      (user-error "There are no buffers in %s" resolved))
    (puthash resolved (if no-recursive t 'subdir)
             trusted-dirs--temporarily-trusted-cache)
    (unless no-revert
      (message "Temporarily trusted %s" resolved)
      (trusted-dirs--maybe-prompt-revert-newly-trusted-buffers))))

;;;###autoload
(defun trusted-dirs-add-temporary-buffer (&optional buffer-or-name no-revert)
  "Temporarily trust BUFFER-OR-NAME, defaulting to the current buffer.
The buffer will be trusted until it is closed.  If a new buffer visiting the
same file were to be created at a later time, that buffer would not be trusted.
Interactively, prompt for the buffer.

Unless NO-REVERT is set, prompt the user to revert the buffer if it is deemed to
have outdated trust information.  For an explanation of what this means, see
`trusted-dirs-revert-newly-trusted-buffers'."
  (interactive "bTemporarily Trust:")
  (unless buffer-or-name (setq buffer-or-name (current-buffer)))
  (unless (bufferp buffer-or-name)
    (setq buffer-or-name (get-buffer buffer-or-name)))
  (puthash buffer-or-name t trusted-dirs--temporarily-trusted-cache)
  (unless no-revert
    (message "Temporarily trusted %s"
             (trusted-dirs--pprint-buffer-name buffer-or-name))
    (when (trusted-dirs-outdated-trust-information-p buffer-or-name)
      (trusted-dirs--maybe-prompt-revert-newly-trusted-buffers
       (list buffer-or-name)))))

(defun trusted-dirs--filter-temporary-cache (predicate)
  "Return anything in the temporary trust cache that matches PREDICATE.
PREDICATE should be a function of one argument.  If will be passed each key in
`trusted-dirs--temporarily-trusted-cache'.  It should return non-nil if that
item should be included in the returned set."
  (cl-delete-if-not predicate
                    (hash-table-keys trusted-dirs--temporarily-trusted-cache)))

(defun trusted-dirs--read-temporary-directory (&optional prompt)
  "Prompt for and return the path of a temporarily trusted directory.
PROMPT defaults to \"Temporarily Trusted Directory: \"."
  (completing-read (or prompt "Temporarily Trusted Directory: ")
                   (trusted-dirs--filter-temporary-cache 'stringp)
                   nil t))

;;;###autoload
(defun trusted-dirs-remove-temporary-directory (path &optional no-revert)
  "Untrust the temporarily trusted directory PATH.

Unless NO-REVERT is set, prompt the user to revert the buffer if it is deemed to
have outdated trust information.  For an explanation of what this means, see
`trusted-dirs-revert-newly-trusted-buffers'."
  (interactive (list (trusted-dirs--read-temporary-directory
                      "Untrust Directory: ")))
  (let ((resolved (trusted-dirs--resolve-trusted-directory path)))
    (remhash resolved trusted-dirs--temporarily-trusted-cache)
    (unless no-revert
      (message "Untrusted %s" resolved)
      (trusted-dirs--maybe-prompt-revert-newly-trusted-buffers))))

(defun trusted-dirs--read-temporary-buffer (&optional prompt)
  "Prompt the user for a temporarily trusted buffer and it (not its name).
PROMPT defaults to \"Temporarily Trusted Buffer: \"."
  (let ((names (mapcar 'buffer-name
                       (trusted-dirs--filter-temporary-cache 'bufferp))))
    (get-buffer (read-buffer (or prompt "Temporarily Trusted Buffer: ")
                             nil t (lambda (buf-name)
                                     (unless (stringp buf-name)
                                       (setq buf-name (car buf-name)))
                                     (member buf-name names))))))

;;;###autoload
(defun trusted-dirs-remove-temporary-buffer (&optional buffer-or-name no-revert)
  "Untust BUFFER-OR-NAME if it is a temporarily trusted buffer.
If it was trusted, return non-nil, otherwise, return nil.  Note that this only
untrusts BUFFER-OR-NAME, and not its `default-directory'.  For that, see
`trusted-dirs-remove-temporary-directory'.

Unless NO-REVERT is set, prompt the user to revert the buffer if it is deemed to
have outdated trust information.  For an explanation of what this means, see
`trusted-dirs-revert-newly-trusted-buffers'."
  (interactive (list (trusted-dirs--read-temporary-buffer "Untrust Buffer: ")))
  (unless buffer-or-name (setq buffer-or-name (current-buffer)))
  (unless (bufferp buffer-or-name)
    (setq buffer-or-name (get-buffer buffer-or-name)))
  (remhash buffer-or-name trusted-dirs--temporarily-trusted-cache)
  (unless no-revert
    (message "Untrusted %s"
             (trusted-dirs--pprint-buffer-name buffer-or-name))
    (when (trusted-dirs-outdated-trust-information-p buffer-or-name)
      (trusted-dirs--maybe-prompt-revert-newly-trusted-buffers
       (list buffer-or-name)))))

;;;###autoload
(defun trusted-dirs-remove-temporary-current-buffer (&optional no-revert)
  "Untrust the current buffer, however it's temporarily trusted.
This will either untrust the current buffer directly, untrust its
`default-directory', or untrust a parent of its `default-directory'.  If need
be, it may do multiple of these.

Unless NO-REVERT is set, prompt the user to revert the buffer if it is deemed to
have outdated trust information.  For an explanation of what this means, see
`trusted-dirs-revert-newly-trusted-buffers'."
  (interactive)
  (let (steps)
    (while-let ((how (cdr (trusted-dirs--buffer-temporarily-trusted-p
                           (current-buffer)))))
      (push how steps)
      (if (stringp how)
          (trusted-dirs-remove-temporary-directory how t)
        (trusted-dirs-remove-temporary-buffer how t)))
    (unless no-revert
      (message "Untrusted %s"
               (trusted-dirs--pprint-list
                (nreverse steps)
                (lambda (elt)
                  (if (stringp elt)
                      elt
                    (concat "buffer " (buffer-name elt))))))
      (trusted-dirs--maybe-prompt-revert-newly-trusted-buffers))))

(eval-and-compile
  (defun trusted-dirs--quoted-symbol-p (form)
    "Return non-nil if FORM is a quoted symbol.
This returns non-nil if FORM is a proper list of two elements, the first being
the symbol \\='quote or \\='function and the second being a symbol."
    (and (memq (car-safe form) '(function quote))
         (consp (cdr form))
         (symbolp (cadr form))
         (null (cddr form)))))

(defmacro trusted-dirs-only-if-safe (function &optional replacement prefix suffix)
  "Return a function that will call FUNCTION if `default-directory' is safe.
If REPLACEMENT is non-nil, call it instead of FUNCTION if `default-directory' is
unsafe.  REPLACEMENT is called with the same arguments that FUNCTION would have
been called with.

If either PREFIX or SUFFIX is a string and FUNCTION is a symbol (this is a
macro, so these must be true at compile time), define a new function named by
concatenating PREFIX, the name of FUNCTION, and SUFFIX."
  (let* ((args (make-symbol "args"))
         (evaled-prefix (eval prefix t))
         (evaled-suffix (eval suffix t))
         (do-defun (and (or (stringp evaled-prefix) (stringp evaled-suffix))
                        (trusted-dirs--quoted-symbol-p function))))
    `(,@(if do-defun
            (list 'defun (intern (concat (when (stringp evaled-prefix)
                                           evaled-prefix)
                                         (symbol-name (cl-second function))
                                         (when (stringp evaled-suffix)
                                           evaled-suffix))))
          '(lambda))
      (&rest ,args)
      ,@(when do-defun
          (list (format "Execute `%s' when `default-directory' is safe.
The safety check is done with `trusted-dirs-safe-p'."
                        (cl-second function))))
      (require 'trusted-dirs)
      (if (trusted-dirs-safe-p)
          (apply ,function ,args)
        ,@(when replacement
            (list `(apply ,replacement ,args)))))))

(cl-defmacro trusted-dirs-add-hook-if-safe
    (hook function &optional (depth nil depthp) (local nil localp))
  "Like `add-hook', but only when `default-directory' is trusted.
This will add FUNCTION to HOOK, initializing it if necessary.  DEPTH and LOCAL
are the same as `add-hook' (which see).  If FUNCTION is a symbol, it is wrapped
in a new function who's name is formed by concatenating the name of FUNCTION and
`trusted-dirs-hook-function-name-suffix'."
  `(add-hook ,hook (trusted-dirs-only-if-safe
                    ,function nil ,trusted-dirs-generated-function-name-prefix
                    ,trusted-dirs-hook-function-name-suffix)
             ,@(when depthp
                 (list depth))
             ,@(when localp
                 (list local))))

(defun trusted-dirs-remove-hook (hook function &optional local)
  "Remove FUNCTION from HOOK if it was added by trusted-dirs.
This undoes `trusted-dirs-add-hook-if-safe'.  LOCAL is the same for this as for
`add-hook'.  This only works if FUNCTION is a symbol."
  (cl-check-type function symbol)
  (when-let ((wrapped (intern-soft
                       (format "%s%s%s"
                               trusted-dirs-generated-function-name-prefix
                               (symbol-name function)
                               trusted-dirs-hook-function-name-suffix))))
    (remove-hook hook wrapped local)))

(eval-and-compile
  (defun trusted-dirs--format-doc-string (format &rest args)
    "Call `format' fill the output as a documentation string.
This will call `format' using FORMAT and ARGS.  Every paragraph in the output
except the first line will then be filled to a `fill-column' of 80 using
`fill-region'."
    (let ((raw-string (apply 'format format args)))
      (with-temp-buffer
        (insert raw-string)
        (goto-char (point-min))
        (forward-line)
        (fill-individual-paragraphs (point) (point-max))
        (buffer-string))))

  (defun trusted-dirs--make-advice-function (target replacement)
    "Make `:around' advice for TARGET to only call it in safe directories.
If REPLACEMENT is non-nil, it will be called instead in unsafe directories."
    (let ((oldfun (make-symbol "oldfun"))
          (args (make-symbol "args"))
          (do-defun (trusted-dirs--quoted-symbol-p target)))
      `(,@(if do-defun
              `(defun ,(intern
                        (concat trusted-dirs-generated-function-name-prefix
                                (symbol-name (cl-second target))
                                trusted-dirs-advice-function-name-suffix)))
            '(lambda))
        (,oldfun &rest ,args)
        ,@(when do-defun
            (list
             (trusted-dirs--format-doc-string
              "Advice `:around' `%s' to only call it in safe directories.
The safety check is done with `trusted-dirs-safe-p'.  If this check fails, %s."
              (symbol-name (cl-second target))
              (cond
               ((trusted-dirs--quoted-symbol-p replacement)
                (concat (symbol-name (cl-second replacement))
                        " is called instead"))
               (replacement
                "an anonymous function is called instead.")
               (t "nil is returned instead.")))))
        (require 'trusted-dirs)
        (if (trusted-dirs-safe-p)
            (apply ,oldfun ,args)
          ,@(when replacement
              (list `(apply ,replacement ,args))))))))

(defmacro trusted-dirs-mark-function-unsafe (function &optional replacement)
  "Mark FUNCTION as only being runnable in safe directories.
This will add advice to FUNCTION such that it will simply return nil unless the
current directory is safe.  If REPLACEMENT is non-nil, it will be run instead of
FUNCTION in unsafe directories.  If FUNCTION is a symbol, it is wrapped
in a new function who's name is formed by concatenating the name of FUNCTION and
`trusted-dirs-advice-function-name-suffix'.

This will attempt to make the advice run before any other advice by giving it a
depth of -100 (see `add-function' for what this means), however, there is
nothing stopping other functions from doing this as well, so care must be taken
that these other pieces of advice do not call potentially unsafe functions."
  (let ((advice (trusted-dirs--make-advice-function function replacement)))
    (if (trusted-dirs--quoted-symbol-p function)
        `(advice-add ,function :around ,advice '(:depth -100))
      `(add-function :around ,function ,advice '(:depth -100)))))

(defun trusted-dirs-unmark-function (function)
  "Mark FUNCTION as safe for execution in unsafe directories.
This undoes the effects of `trusted-dirs-mark-function-unsafe'.  This only works
if FUNCTION is a symbol.

Note that this is a function and that is a macro.  Thus, this will only work if
the values of `trusted-dirs-generated-function-name-prefix' and
`trusted-dirs-advice-function-name-suffix' are the same as when
`trusted-dirs-mark-function-unsafe' was compiled."
  (cl-check-type function symbol)
  (when-let ((advice (intern-soft
                      (format "%s%s%s"
                              trusted-dirs-generated-function-name-prefix
                              (symbol-name function)
                              trusted-dirs-advice-function-name-suffix))))
    (advice-remove function advice)))

(provide 'trusted-dirs)
;;; trusted-dirs.el ends here