emacs-config/elisp/trusted-files.el

;;; trusted-files.el --- Simplistic security for Eglot and auto-complete. -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
(require 'cl-lib)
(require 'cus-edit)
(require 'keymap)

(eval-and-compile
  (defconst trusted-files-generated-function-name-prefix "trusted-files--"
    "Prefix to append to generated functions.
This is used by `trusted-files-add-hook-if-safe' and
`trusted-files-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-files-hook-function-name-suffix
    "@trusted-files-hook-if-safe"
    "Suffix to append to function names in `trusted-files-add-hook-if-safe'.
Note that `trusted-files-add-hook-if-safe' is a macro, so if this value is
changed (which you probably shouldn't do), code that calls
`trusted-files-add-hook-if-safe' will need to be recompiled.")

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

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

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

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

(defun trusted-files--remove-extra-path-parts (path)
  "Remove extra path parts from PATH.
This removes \".\" and \"..\" components.  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))))
    expanded))

(defun trusted-files--resolve-trusted-directory (path &optional leave-slash)
  "Resolve PATH, which is resolved according to user settings.
If `trusted-files-truename-trusted-directories' is set, return the
`file-truename' of PATH.  In any case, remove \".\" and \"..\" components from
PATH and make it absolute.

With LEAVE-SLASH, only return a path with a trialing slash if PATH has a
trailing slash."
  (unless leave-slash
    (cond
     ((file-directory-p path) (setq path (file-name-as-directory path)))
     ((file-exists-p path) (setq path (directory-file-name path)))))
  (if trusted-files-truename-trusted-directories
      (file-truename path)
    (trusted-files--remove-extra-path-parts path)))

(defsubst trusted-files--resolve-current-directory (path &optional leave-slash)
  "Resolve PATH, which is resolved according to user settings.
If `trusted-files-truename-current-directory' is set, return the `file-truename'
of PATH.  In any case, remove \".\" and \"..\" components from PATH and make it
absolute.

With LEAVE-SLASH, only return a path with a trialing slash if PATH has a
trailing slash."
  (unless leave-slash
    (cond
     ((file-directory-p path) (setq path (file-name-as-directory path)))
     ((file-exists-p path) (setq path (directory-file-name path)))))
  (if trusted-files-truename-current-directory
      (file-truename path)
    (trusted-files--remove-extra-path-parts path)))

(defun trusted-files--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)))

(defun trusted-files--custom-set-value (sym val)
  "Set SYM (probably `trusted-files-list') to the alist VAL.
This parses the alist VAL and converts it to a hash table, resolving entries as
necessary."
  (let ((table (make-hash-table :test 'equal)))
    (dolist (entry val)
      (cl-destructuring-bind (dir . type) entry
        (when (file-name-absolute-p dir)
          (let* ((resolved (trusted-files--resolve-trusted-directory dir))
                 (current (gethash resolved table)))
            ;; only add a new entry if another entry with a more specific rule
            ;; does not exist
            (unless (eq current t)
              (puthash resolved type table))))))
    (set-default-toplevel-value sym table)))

(defun trusted-files--custom-get-value (sym)
  "Convert SYM (probably `trusted-files-list') to an alist."
  (let ((table (default-toplevel-value sym))
        out)
    (maphash (lambda (dir type)
               (push (cons dir type) out))
             table)
    out))

(defcustom trusted-files-list ()
  "List of directories that should be considered safe.
This is actually a hash table.  The keys are trusted paths and the values are
how they are trusted.  If the value is \\='subdir, that directory and all of its
subdirectories are trusted.  Any other non-nil value mean only trust that
directory and its direct children.  If the path is a file, either value means to
trust only that file.

The format of the paths is fairly specific.  Thus, you probably should not
modify this directly.  Use `trusted-files-add' and `trusted-files-remove' to add
a specific path.  If you want to set this to some value, use `setopt' or
`customize-save-variable' to set it.  In this case, you will need to pass an
alist with the cars being the directory and the cdrs being either \\='dir or
\\='subdir.  Note that in this case, relative paths will be IGNORED.  That is,
they will be removed before this is set.  Resolve any relative paths before
passing them to `setopt'."
  :group 'trusted-files
  :tag "Trusted Directories"
  :type '(repeat
          (cons :tag "Entry"
                (directory
                 :tag "Directory"
                 :validate trusted-files--validate-only-allow-absolute-paths)
                (choice :tag "Also Trust Subdirectories"
                        (const :tag "Yes" subdir)
                        (const :tag "No" dir))))
  :set #'trusted-files--custom-set-value
  :get #'trusted-files--custom-get-value
  :risky t)

(defcustom trusted-files-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 the current buffer 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-files-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))
  :risky t)

(defcustom trusted-files-modeline-ignored-buffer-rules
  '((trusted-files-normal-buffer-p . t))
  "List of rules matching buffers in which to skip drawing the mode line.
Each element in this list is:
  - a cons with the cdr being t and the car being a regexp
  - a cons with the cdr being nil and the car being a literal buffer name
  - a cons with a cdr of nil and the car being a function of one argument that
    takes a buffer (not its name) and returns non-nil if that buffer should be
    ignored.
  - as above, but with a cdr of t. In this case, the function should return
    non-nil if the buffer should have SHOWN.  That is, the inverse of above."
  :group 'trusted-files
  :tag "Mode Line Ignored Buffer Rules"
  :type '(repeat (choice (cons :tag "String Pattern"
                               (string :tag "Pattern")
                               (boolean :tag "Use Regexp"))
                         (cons :tag "Predicate Function"
                               (function :tag "Function")
                               (boolean :tag "Negated"))))
  :risky t)

(defun trusted-files--eshell-buffer-p (buffer)
  "Return non-nil if BUFFER is an `eshell' buffer."
  (with-current-buffer buffer
    (derived-mode-p 'eshell-mode)))

(defun trusted-files--scratch-buffer-p (buffer)
  "Return non-nil if BUFFER is a `scratch-buffer' buffer."
  (and (equal (buffer-name buffer) "*scratch*")
       (not (buffer-file-name buffer))))

(defcustom trusted-files-always-trusted-buffer-functions
  '(minibufferp trusted-files--eshell-buffer-p trusted-files--scratch-buffer-p)
  "A list of functions that are called to test if the current buffer is safe.
When a buffer is tested for safety (via `trusted-files-safe-p'), this hook is
run.  If any function returns non-nil, the current buffer is considered safe
without any additional checks."
  :group 'trusted-files
  :tag "Always Trusted Buffer Predicates"
  :type '(repeat (function :tag "Predicate"))
  :risky t)

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

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

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

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

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

(defvar-local trusted-files--saved-buffer-name nil
  "Internal variable used by `trusted-files-safe-p'.
This might not be accurate to the buffers current name.")
;;;###autoload (put 'trusted-files--saved-buffer-name 'risky-local-variable t)

(defvar trusted-files--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-files--cleanup-temporary-trusted-cache', which is called from
`kill-buffer-hook'.")
;;;###autoload (put 'trusted-files--temporarily-trusted-cache 'risky-local-variable t)

(defun trusted-files--hide-modeline-in-buffer-p (&optional buffer)
  "Return non-nil if the mode line component should be hidden in BUFFER.
BUFFER defaults to the current buffer.  For an explanation of how this is
decided, see `trusted-files-modeline-ignored-buffer-rules'."
  (unless buffer (setq buffer (current-buffer)))
  (cl-loop for entry in trusted-files-modeline-ignored-buffer-rules
           when (pcase entry
                  (`(,(cl-type string) . nil)
                   (equal (car entry) (buffer-name buffer)))
                  (`(,(cl-type string) . t)
                   (string-match-p (car entry)
                                   (buffer-name buffer)))
                  (`(,(cl-type function) . ,negate)
                   (xor (funcall (car entry) buffer) negate)))
           return t))

(defun trusted-files--modeline-string ()
  "Return the trusted-files mode line string for the current buffer.
To change when this is shown, customize `trusted-files-show-in-modeline'."
  (let* ((safe (car (trusted-files-safe-p nil t)))
         (temporary (car (memq safe
                               '(temp-buffer temp-dir temp-subdir)))))
    (and (not (trusted-files--hide-modeline-in-buffer-p))
         (or (eq trusted-files-show-in-modeline t)
             (and temporary
                  (memq trusted-files-show-in-modeline
                        '(dynamic-temporary dynamic-temporary-untrusted)))
             (and (not safe) (eq trusted-files-show-in-modeline 'untrusted))
             (and trusted-files--did-protected-function-run
                  (memq trusted-files-show-in-modeline
                        '(dynamic dynamic-temporary)))
             (and trusted-files--did-protected-function-fail
                  (memq trusted-files-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-files-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-files-remove-temporary-current-buffer))))
           (safe '(:propertize "Trusted"
                   face trusted-files-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-files-untrusted-modeline-face
                help-echo "This buffer is untrusted.")))
          " "))))

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

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

(defun trusted-files--subdirectory-p (parent child &optional no-resolve)
  "Return non-nil if CHILD is a subdirectory of PARENT.
This will resolve both PARENT and CHILD with
`trusted-files--resolve-current-directory', unless NO-RESOLVED is non-nil."
  (unless no-resolve
    (setq parent (trusted-files--resolve-current-directory parent)
          child (trusted-files--resolve-current-directory child)))
  (or (equal parent "/")
      (equal (directory-file-name parent)
             (directory-file-name child))
      (and (equal parent (file-name-as-directory parent))
           (string-prefix-p (file-name-as-directory parent) child))))

(defun trusted-files--buffer-path (&optional buffer)
  "Return the path of BUFFER.
BUFFER defaults to the current buffer."
  (unless buffer (setq buffer (current-buffer)))
  (if-let ((file (buffer-file-name buffer)))
      (trusted-files--resolve-current-directory file)
    (file-name-as-directory (trusted-files--resolve-current-directory
                             (buffer-local-value 'default-directory buffer)))))

(defun trusted-files--path-and-parents (path &optional no-resolve)
  "Return a list of PATH and each of its parent directories.

Unless NO-RESOLVE, resolve PATH with `trusted-files--resolve-current-directory'."
  (cl-loop with start = (if no-resolve
                            path
                          (trusted-files--resolve-current-directory path))
           for prev = nil then cur
           for cur = start then (file-name-directory
                                 (directory-file-name cur))
           while (not (equal prev cur))
           collect cur))

(defun trusted-files--buffer-path-and-parents (&optional buffer)
  "Return a list of the path of BUFFER and each of its parent directories.
BUFFER defaults to the current buffer."
  (trusted-files--path-and-parents (trusted-files--buffer-path buffer)))

(defsubst trusted-files--file-names-directory-p (path)
  "Return non-nil if PATH names a directory.
On U*IX-like systems, this probably just checks if PATH ends with a slash."
  (equal path (file-name-as-directory path)))

(defun trusted-files--same-file-or-direct-descendant-p
    (parent child &optional no-resolve)
  "Return non-nil if CHILD is a direct descendant of PARENT.
That is, return non-nil if PARENT and CHILD are the same path or if PARENT is a
directory and CHILD is a direct descendant.

Unless NO-RESOLVE is set, resolve both PARENT and CHILD with
`trusted-files--resolve-current-directory'."
  (unless no-resolve
    (setq parent (trusted-files--resolve-current-directory parent)
          child (trusted-files--resolve-current-directory child)))
  (or (equal parent child)
      (and (trusted-files--file-names-directory-p parent)
           (string-prefix-p parent child)
           (not (cl-position ?/ (substring (directory-file-name child)
                                           (length parent)))))))

(defun trusted-files--find-buffers
    (path &optional subdir-too  special-too resolved)
  "Return a list of buffers that visit PATH or a direct descendant of PATH.
If SUBDIR-TOO is set, also search for subdirectories of PATH.  If SPECIAL-TOO is
set, also consider buffers that are special.  Otherwise, only consider regular,
visible, file-visiting buffers.

Unless RESOLVED is set, resolve PATH with
`trusted-files--resolve-current-directory'."
  (unless resolved (setq path (trusted-files--resolve-current-directory path)))
  (let (out)
    (dolist (buffer (buffer-list) out)
      (when (or special-too (trusted-files-normal-buffer-p buffer))
        (let ((target-dir (trusted-files--buffer-path buffer)))
          (when (or (and subdir-too (trusted-files--subdirectory-p
                                     path target-dir))
                    (trusted-files--same-file-or-direct-descendant-p
                     path target-dir t))
            (push buffer out)))))))

(defun trusted-files--cleanup-temporary-trusted-cache ()
  "Cleanup `trusted-files--temporarily-trusted-cache'."
  (remhash (current-buffer) trusted-files--temporarily-trusted-cache)
  (cl-loop for cur in (trusted-files--buffer-path-and-parents)
           for rule = (gethash cur trusted-files--temporarily-trusted-cache)
           when (and rule (null (delq (current-buffer)
                                      (trusted-files--find-buffers
                                       cur (eq rule 'subdir)))))
           collect cur into steps
           and do (remhash cur trusted-files--temporarily-trusted-cache)
           finally do
           (when steps
             (message "Untrusted %s" (trusted-files--pprint-list steps)))))

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

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

Return a cons.  For the car if the BUFFER is trusted, return \\='temp-buffer.  If
BUFFER's parent directory is exactly trusted, return \\='temp-dir.  If a higher
up 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-files--temporarily-trusted-cache)
        (cons 'temp-buffer buffer))
   (cl-loop for cur in (trusted-files--buffer-path-and-parents buffer)
            for i upfrom 0
            for result = (gethash cur trusted-files--temporarily-trusted-cache)
            ;; direct parent (or exact match)
            when (and result (< i 2)) return (cons 'temp-dir cur)
            ;; other parent
            when (eq result 'subdir) return (cons 'temp-subdir cur))))

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

Return a cons.  For the car if PATH is trusted, return \\='file.  If PATH's
direct parent is trusted, return \\='dir, If another parent directory of PATH is
trusted, return \\='subdir.  For the cdr, return the directory that matched."
  (cl-loop for cur in (trusted-files--path-and-parents path resolved)
           for i upfrom 0
           for result = (gethash cur trusted-files-list)
           ;; exact match
           when (and result (zerop i)) return (cons 'file cur)
           ;; direct parent
           when (and result (= i 1)) return (cons 'dir cur)
           ;; otherwise, other parent
           when (eq result 'subdir) return (cons 'subdir cur)))

(defun trusted-files--always-trusted-buffer-p (buffer)
  "Return non-nil if BUFFER is an always trusted buffer.
This calls each function in `trusted-files-always-trusted-buffer-functions'
until one of them return non-nil.  If none of them does, this return nil.
Otherwise, it returns a cons of the symbol \\='buffer and BUFFER."
  (when (run-hook-with-args-until-success
         'trusted-files-always-trusted-buffer-functions buffer)
    (cons 'buffer buffer)))

(defun trusted-files-safe-p (&optional buffer no-modify)
  "Return non-nil if BUFFER is considered safe.
BUFFER defaults to the current buffer.  Also, if BUFFER is unsafe, set
`trusted-files--did-protected-function-fail' to t unless NO-MODIFY is non-nil.
In any case, set `trusted-files--did-protected-function-run' to t unless
NO-MODIFY is non-nil.

This can return a few different things depending on how BUFFER is trusted.  See
`trusted-files--permanently-trusted-p',
`trusted-files--always-trusted-buffer-p', and
`trusted-files--buffer-temporarily-trusted-p' for a list of possible return
values."
  (unless buffer (setq buffer (current-buffer)))
  (let ((path (trusted-files--buffer-path buffer)))
    (unless no-modify
      (setq trusted-files--did-protected-function-run t))
    (let ((result (or (trusted-files--always-trusted-buffer-p buffer)
                      (trusted-files--permanently-trusted-p path)
                      (trusted-files--buffer-temporarily-trusted-p buffer))))
      (unless (or no-modify result)
        (setq trusted-files--did-protected-function-fail t))
      (unless no-modify
        (when (and trusted-files--saved-buffer-name
                   (not (equal path trusted-files--saved-buffer-name)))
          (trusted-files--maybe-prompt-revert-newly-trusted-buffers
           (list buffer)))
        (setq trusted-files--saved-buffer-name path)
        (force-mode-line-update))
      result)))

(defun trusted-files--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-files--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-files-outdated-trust-information-p (&optional buffer)
  "Return non-nil if BUFFER has outdated trust information.
See `trusted-files-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-files-safe-p nil t)))
      (or (and safe trusted-files--did-protected-function-fail)
          (and (not safe) trusted-files--did-protected-function-run
               (not trusted-files--did-protected-function-fail))))))

(cl-defun trusted-files--outdated-buffer-list (&optional (buffers (buffer-list)))
  "Return a list of buffers that have outdated trust information.
See `trusted-files-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-files-outdated-trust-information-p buffers))

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

(defun trusted-files--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-files--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-files--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-files-revert-newly-trusted-buffers
    (&optional force silent (buffers (trusted-files--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-files--outdated-buffer-list buffers))
      (with-current-buffer buffer
        (if (not (buffer-file-name))
            (when (or force
                      (and (buffer-modified-p)
                           (yes-or-no-p
                            (format "DISCARD CHANGES and revert %s?"
                                    (trusted-files--pprint-buffer-name
                                     buffer)))))
              (revert-buffer nil t)
              (push buffer reverted)))
        (when (and (not force)
                   (buffer-modified-p)
                   (y-or-n-p (format "Save and revert %s?"
                                     (trusted-files--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-files--pprint-list reverted
                                   #'trusted-files--pprint-buffer-name)))))

(cl-defun trusted-files--maybe-prompt-revert-newly-trusted-buffers
    (&optional (buffers (trusted-files--outdated-buffer-list
                         (trusted-files--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-files-revert-newly-trusted-buffers'.

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

;;;###autoload
(defun trusted-files-add (path &optional no-recursive no-revert)
  "Mark PATH as a trusted file.
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-files-revert-newly-trusted-buffers'.  If NO-REVERT is set, don't ask or
call it.

PATH is processed according to `trusted-files-truename-trusted-directories'."
  (interactive "fTrust File: \nP")
  (let ((resolved (trusted-files--resolve-trusted-directory path)))
    (puthash resolved (if no-recursive
                          t
                        'subdir)
             trusted-files-list)
    (customize-save-variable
     'trusted-files-list (trusted-files--custom-get-value 'trusted-files-list))
    ;; Now that resolved is permanently trusted, we can remove it from
    ;; the temporary cache
    (remhash resolved trusted-files--temporarily-trusted-cache)
    (unless no-revert
      (message "Added %s to the list of trusted directories"
               resolved)
      (trusted-files--maybe-prompt-revert-newly-trusted-buffers))))

;;;###autoload
(defun trusted-files-add-current (&optional no-recursive no-revert)
  "Mark the current buffer as a trusted file.
NO-RECURSIVE and NO-REVERT are the same as for `trusted-files-add' (which see)."
  (interactive "P")
  (trusted-files-add (trusted-files--buffer-path) no-recursive no-revert))

(defun trusted-files--read-trusted-file (&optional prompt)
  "Read a trusted directory from the minibuffer with completion.
PROMPT is the prompt to use, defaulting to \"Trusted File: \"."
  (completing-read (or prompt "Trusted File: ")
                   (hash-table-keys trusted-files-list) nil t))

;;;###autoload
(defun trusted-files-remove (path &optional no-revert)
  "Remove PATH from the list of trusted files.
Interactively, prompt for PATH.

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

PATH is processed according to `trusted-files-truename-trusted-directories'."
  (interactive (list (trusted-files--read-trusted-file "Untrust: ")))
  (let* ((resolved (trusted-files--resolve-trusted-directory path))
         (old-val (gethash resolved trusted-files-list)))
    (if (not old-val)
        (unless no-revert (message "%s is not trusted" resolved))
      (remhash resolved trusted-files-list)
      (customize-save-variable
       'trusted-files-list (trusted-files--custom-get-value 'trusted-files-list))
      (unless no-revert
        (message "Removed %s from the list of trusted directories"
                 resolved)
        (trusted-files--maybe-prompt-revert-newly-trusted-buffers)))))

(defun trusted-files-remove-current (&optional no-revert)
  "Remove the current buffer from the list of trusted files.
NO-REVERT is the same as for `trusted-files-remove' (which see)."
  (interactive)
  (trusted-files-remove (trusted-files--buffer-path) no-revert))

;;;###autoload
(defun trusted-files-add-temporary-directory
    (path &optional no-recursive no-revert)
  "Temporarily trust PATH.
PATH will be trusted until _ALL_ buffers that visit files located in PATH are
closed.  Unless NO-RECURSIVE is set, also trust
subdirectories of PATH.  In this case buffers visiting files in all
subdirectories of PATH 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-files-revert-newly-trusted-buffers'.

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

;;;###autoload
(defun trusted-files-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-files-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-files--temporarily-trusted-cache)
  (unless no-revert
    (message "Temporarily trusted %s"
             (trusted-files--pprint-buffer-name buffer-or-name))
    (when (trusted-files-outdated-trust-information-p buffer-or-name)
      (trusted-files--maybe-prompt-revert-newly-trusted-buffers
       (list buffer-or-name)))))

(defun trusted-files--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-files--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-files--temporarily-trusted-cache)))

(defun trusted-files--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-files--filter-temporary-cache 'stringp)
                   nil t))

;;;###autoload
(defun trusted-files-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-files-revert-newly-trusted-buffers'."
  (interactive (list (trusted-files--read-temporary-directory
                      "Untrust Directory: ")))
  (let ((resolved (trusted-files--resolve-trusted-directory path)))
    (remhash resolved trusted-files--temporarily-trusted-cache)
    (unless no-revert
      (message "Untrusted %s" resolved)
      (trusted-files--maybe-prompt-revert-newly-trusted-buffers))))

(defun trusted-files--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-files--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-files-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 directory.  For that, see
`trusted-files-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-files-revert-newly-trusted-buffers'."
  (interactive (list (trusted-files--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-files--temporarily-trusted-cache)
  (unless no-revert
    (message "Untrusted %s"
             (trusted-files--pprint-buffer-name buffer-or-name))
    (when (trusted-files-outdated-trust-information-p buffer-or-name)
      (trusted-files--maybe-prompt-revert-newly-trusted-buffers
       (list buffer-or-name)))))

;;;###autoload
(defun trusted-files-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 visited file, or untrust
a parent directory of its such.  If need be, it may untrust multiple things.

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-files-revert-newly-trusted-buffers'."
  (interactive)
  (let (steps)
    (while-let ((how (cdr (trusted-files--buffer-temporarily-trusted-p
                           (current-buffer)))))
      (push how steps)
      (if (stringp how)
          (trusted-files-remove-temporary-directory how t)
        (trusted-files-remove-temporary-buffer how t)))
    (unless no-revert
      (message "Untrusted %s"
               (trusted-files--pprint-list
                (nreverse steps)
                (lambda (elt)
                  (if (stringp elt)
                      elt
                    (concat "buffer " (buffer-name elt))))))
      (trusted-files--maybe-prompt-revert-newly-trusted-buffers))))

(eval-and-compile
  (defun trusted-files--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-files-only-if-safe (function &optional replacement prefix suffix)
  "Return a function that will call FUNCTION if the current buffer is safe.  If
REPLACEMENT is non-nil, call it instead of FUNCTION if the current buffer 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-files--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 the current buffer is safe.
The safety check is done with `trusted-files-safe-p'."
                        (cl-second function))))
      (require 'trusted-files)
      (if (trusted-files-safe-p)
          (apply ,function ,args)
        ,@(when replacement
            (list `(apply ,replacement ,args)))))))

(cl-defmacro trusted-files-add-hook-if-safe
    (hook function &optional (depth nil depthp) (local nil localp))
  "Like `add-hook', but only when the current buffer 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-files-hook-function-name-suffix'."
  `(add-hook ,hook (trusted-files-only-if-safe
                    ,function nil ,trusted-files-generated-function-name-prefix
                    ,trusted-files-hook-function-name-suffix)
             ,@(when depthp
                 (list depth))
             ,@(when localp
                 (list local))))

(defun trusted-files-remove-hook (hook function &optional local)
  "Remove FUNCTION from HOOK if it was added by trusted-files.
This undoes `trusted-files-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-files-generated-function-name-prefix
                               (symbol-name function)
                               trusted-files-hook-function-name-suffix))))
    (remove-hook hook wrapped local)))

(eval-and-compile
  (defun trusted-files--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-files--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-files--quoted-symbol-p target)))
      `(,@(if do-defun
              `(defun ,(intern
                        (concat trusted-files-generated-function-name-prefix
                                (symbol-name (cl-second target))
                                trusted-files-advice-function-name-suffix)))
            '(lambda))
        (,oldfun &rest ,args)
        ,@(when do-defun
            (list
             (trusted-files--format-doc-string
              "Only call `%s' in safe directories.
This is meant to be used as `:around' advice.  The safety check is done with
`trusted-files-safe-p'.  If this check fails, %s."
              (symbol-name (cl-second target))
              (cond
               ((trusted-files--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-files)
        (if (trusted-files-safe-p)
            (apply ,oldfun ,args)
          ,@(when replacement
              (list `(apply ,replacement ,args))))))))

(defmacro trusted-files-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-files-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-files--make-advice-function function replacement)))
    (if (trusted-files--quoted-symbol-p function)
        `(advice-add ,function :around ,advice '(:depth -100))
      `(add-function :around ,function ,advice '(:depth -100)))))

(defun trusted-files-unmark-function (function)
  "Mark FUNCTION as safe for execution in unsafe directories.
This undoes the effects of `trusted-files-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-files-generated-function-name-prefix' and
`trusted-files-advice-function-name-suffix' are the same as when
`trusted-files-mark-function-unsafe' was compiled."
  (cl-check-type function symbol)
  (when-let ((advice (intern-soft
                      (format "%s%s%s"
                              trusted-files-generated-function-name-prefix
                              (symbol-name function)
                              trusted-files-advice-function-name-suffix))))
    (advice-remove function advice)))

;;; Wrapper functions
(defmacro trusted-files--define-safe-wrapper (function &optional require)
  "Define a safe wrapper around FUNCTION.
FUNCTION must be an unquoted symbol (checked at compile time).  A new function
will be defined by prefixing FUNCTION's name with \"trusted-files-\" and
suffixing it with \"-if-safe\".  If FUNCTION is a command, it will be executed
with `command-execlute'. Otherwilse, will be called with `funcall' and passed no
arguments.

If REQUIRE is non-nil, it should be a symbol that will be passed to `require' if
it is deemed safe to run FUNCTION."
  (cl-check-type function symbol)
  (let ((args (make-symbol "args"))
        (interactive (make-symbol "interactive")))
    `(defun ,(intern (concat "trusted-files-" (symbol-name function) "-if-safe"))
         (&rest ,args)
       ,(format "Call `%s' only if it is safe to do so.
The check if performed with `trusted-files-safe-p'.%s"
                function (if (stringp (help-function-arglist nil))
                             ""
                           (format "\n\n%s" (cons 'fn (help-function-arglist
                                                       function t)))))
       (declare (interactive-only ,(format "use `%s' directly instead"
                                           function)))
       ,@(when (commandp function)
           (list `(interactive nil ,@(command-modes function))))
       ;; this comes first to make sure that it is never showed by a macro
       ;; wrapping it in `lambda'.
       (let ((,interactive (called-interactively-p 'any)))
         (require 'trusted-files)
         (when (trusted-files-safe-p)
           ,@(when require
               (list `(require ',require)))
           (if ,interactive
               (call-interactively #',function)
             (apply #',function ,args)))))))

(trusted-files--define-safe-wrapper eglot eglot)
(trusted-files--define-safe-wrapper eglot-ensure eglot)
(trusted-files--define-safe-wrapper flymake-mode flymake)
(trusted-files--define-safe-wrapper flycheck-mode flycheck)
(trusted-files--define-safe-wrapper sly sly)
(trusted-files-mark-function-unsafe #'elisp-completion-at-point)

;;;###autoload
(defvar-keymap trusted-files-map
  :doc "Prefix keymap for working with trusted files."
  :prefix 'trusted-files-map
  "a" #'trusted-files-add
  "A" #'trusted-files-add-current
  "r" #'trusted-files-remove
  "R" #'trusted-files-remove-current
  "b" #'trusted-files-add-temporary-buffer
  "B" #'trusted-files-remove-temporary-buffer
  "d" #'trusted-files-add-temporary-directory
  "D" #'trusted-files-remove-temporary-directory)

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

;; Local Variables:
;; jinx-local-words: "untrust untrusts"
;; End: