From 6d3b19fe469ff20d6225fd792918e1c0aad3d6f7 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Wed, 1 Jan 2025 03:17:50 -0800 Subject: [PATCH] Hopefully finish trusted-files.el --- elisp/trusted-dirs.el | 869 -------------------------------- elisp/trusted-files.el | 1068 ++++++++++++++++++++++++++++++++++++++++ init.el | 51 +- 3 files changed, 1098 insertions(+), 890 deletions(-) delete mode 100644 elisp/trusted-dirs.el create mode 100644 elisp/trusted-files.el diff --git a/elisp/trusted-dirs.el b/elisp/trusted-dirs.el deleted file mode 100644 index 4136b86..0000000 --- a/elisp/trusted-dirs.el +++ /dev/null @@ -1,869 +0,0 @@ -;;; 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 diff --git a/elisp/trusted-files.el b/elisp/trusted-files.el new file mode 100644 index 0000000..0cac10a --- /dev/null +++ b/elisp/trusted-files.el @@ -0,0 +1,1068 @@ +;;; 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 `default-directory'." + :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 `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-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) + +(defcustom trusted-files-always-trusted-buffer-functions + '(minibufferp) + "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 `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-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 `default-directory' as a trusted directory. +NO-RECURSIVE and NO-REVERT are the same as for `trusted-files-add' (which see). + +`default-directory' is processed according to +`trusted-files-truename-trusted-directories'." + (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) + "Mark `default-directory' as an untrusted directory. +NO-REVERT is the same as for `trusted-files-remove' (which see). + +`default-directory' is processed according to +`trusted-files-truename-trusted-directories'." + (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 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-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 `default-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 +`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-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 `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-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 `default-directory' 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 `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-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-mark-function-unsafe #'elisp-completion-at-point) + +;;;###autoload +(defvar-keymap trusted-files-map + :name "Trusted Files" + :doc "Prefix keymap for working with trusted files." + "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 diff --git a/init.el b/init.el index ef768a7..a0bd56c 100644 --- a/init.el +++ b/init.el @@ -38,6 +38,9 @@ (no-littering-theme-backups) (setq custom-file (no-littering-expand-etc-file-name "custom.el"))) +;; load things saved with custom +(load custom-file t t) + ;; diminish (use-package diminish :config @@ -624,6 +627,11 @@ With NO-EDGE, return nil if beg or end fall on the edge of the range." (advice-add 'sp-region-ok-p :around 'my/-evil-cp-region-ok-p-no-string) (advice-add 'evil-cp--balanced-block-p :around 'my/-evil-cp-block-ok-p-no-string)) +;; be (hopefully) safer +(require 'trusted-files) +(keymap-global-set "C-c t" 'trusted-files-map) +(trusted-files-modeline-mode) + ;; better lisp editing (use-package adjust-parens :hook (prog-mode . adjust-parens-mode) @@ -1053,7 +1061,7 @@ to `posframe-show' if the display is graphical." ;; flycheck (use-package flycheck - :hook ((sh-mode emacs-lisp-mode) . flycheck-mode) + :hook ((sh-mode emacs-lisp-mode) . trusted-files-flycheck-mode-if-safe) :custom (flycheck-indication-mode 'left-margin) :init @@ -1199,7 +1207,7 @@ With PROJECT, give diagnostics for all buffers in the current project." :init ;; (defun my/eglot-in-text-mode-only () ;; (when (eq major-mode 'text-mode) - ;; (eglot-ensure))) + ;; (trusted-files-eglot-ensure-if-safe))) (defvar my/-eglot-documentation-buffer nil "Buffer for showing documentation for `my/eglot-documentation-at-point'.") (defun my/eglot-documentation-at-point () @@ -1577,7 +1585,7 @@ otherwise, call `bibtex-find-text'." :hook ((LaTeX-mode . turn-on-reftex) (LaTeX-mode . LaTeX-math-mode) (LaTeX-mode . my/-setup-LaTeX-mode) - (LaTeX-mode . flycheck-mode)) + (LaTeX-mode . trusted-files-flycheck-mode-if-safe)) :bind (:map TeX-mode-map ("C-c ?" . latex-help)) :init @@ -1630,17 +1638,17 @@ otherwise, call `bibtex-find-text'." ;; blueprint (use-package blueprint-ts-mode - :hook (blueprint-ts-mode . eglot-ensure) + :hook (blueprint-ts-mode . trusted-files-eglot-ensure-if-safe) :after eglot) ;; python-ts-mode (use-package python-ts-mode :ensure nil - :hook (python-ts-mode . eglot-ensure)) + :hook (python-ts-mode . trusted-files-eglot-ensure-if-safe)) ;; java-ts-mode (use-package java-ts-mode - :hook ((java-ts-mode . eglot-ensure) + :hook ((java-ts-mode . trusted-files-eglot-ensure-if-safe) (java-ts-mode . my/-setup-java-ts-mode)) :config (defun my/-setup-java-ts-mode () @@ -1654,7 +1662,7 @@ otherwise, call `bibtex-find-text'." ;; c-ts-mode (use-package c-ts-mode :after evil - :hook ((c-ts-mode c++-ts-mode) . eglot-ensure) + :hook ((c-ts-mode c++-ts-mode) . trusted-files-eglot-ensure-if-safe) :init (setq-default c-ts-mode-indent-offset 4) :config @@ -1673,11 +1681,11 @@ otherwise, call `bibtex-find-text'." ;; php-mode (use-package php-mode - :hook (php-mode . eglot-ensure)) + :hook (php-mode . trusted-files-eglot-ensure-if-safe)) ;; web-mode (use-package web-mode - :hook (web-mode . eglot-ensure) + :hook (web-mode . trusted-files-eglot-ensure-if-safe) :init (add-to-list 'eglot-server-programs '(web-mode . ("vscode-html-language-server" "--stdio")))) @@ -1685,12 +1693,12 @@ otherwise, call `bibtex-find-text'." ;; JavaScript (use-package js :ensure nil - :hook (js-ts-mode . eglot-ensure)) + :hook (js-ts-mode . trusted-files-eglot-ensure-if-safe)) ;; TypeScript (use-package typescript-ts-mode :ensure nil - :hook (typescript-ts-mode . eglot-ensure) + :hook (typescript-ts-mode . trusted-files-eglot-ensure-if-safe) :init (add-to-list 'auto-mode-alist `(,(rx ".ts" eos) . typescript-ts-mode))) @@ -1721,24 +1729,24 @@ otherwise, call `bibtex-find-text'." ;; go mode (use-package go-mode :defer nil - :hook (go-mode . eglot-ensure)) + :hook (go-mode . trusted-files-eglot-ensure-if-safe)) (use-package go-ts-mode :ensure nil - :hook (go-ts-mode . eglot-ensure)) + :hook (go-ts-mode . trusted-files-eglot-ensure-if-safe)) ;; rust (use-package rust-mode) (use-package rust-ts-mode :ensure nil - :hook (rust-ts-mode . eglot-ensure)) + :hook (rust-ts-mode . trusted-files-eglot-ensure-if-safe)) ;; zig (use-package zig-mode - :hook (zig-mode . eglot-ensure)) + :hook (zig-mode . trusted-files-eglot-ensure-if-safe)) ;; lua (use-package lua-mode - :hook (lua-mode . eglot-ensure)) + :hook (lua-mode . trusted-files-eglot-ensure-if-safe)) ;; markdown (use-package markdown-mode @@ -1758,7 +1766,7 @@ otherwise, call `bibtex-find-text'." ;; json (use-package json-ts-mode - :hook (json-ts-mode . eglot-ensure)) + :hook (json-ts-mode . trusted-files-eglot-ensure-if-safe)) (use-package json-mode) ;; csv @@ -1769,7 +1777,7 @@ otherwise, call `bibtex-find-text'." ;; yaml (use-package yaml-ts-mode - :hook ((yaml-ts-mode . eglot-ensure) + :hook ((yaml-ts-mode . trusted-files-eglot-ensure-if-safe) (yaml-ts-mode . my/-setup-yaml-ts-mode)) :init (defun my/-setup-yaml-ts-mode () @@ -2382,7 +2390,7 @@ R is rest of the arguments to OLDFUN." ;; ledger (use-package ledger-mode) (use-package flycheck-ledger - :hook (ledger-mode . flycheck-mode)) + :hook (ledger-mode . trusted-files-flycheck-mode-if-safe)) ;; khard contacts (require 'khard) @@ -2533,7 +2541,7 @@ The name is compared with the field name using TESTFN (defaults to `equal')." "Setup up stuff in `org-mu4e-compose' buffers." (setq-local ltex-eglot-variable-save-method 'file) ;; this should come last so it can pick up the above - ;; (eglot-ensure) + ;; (trusted-files-eglot-ensure-if-safe) ) (add-hook 'org-mu4e-compose-mode-hook #'my/-setup-org-mu4e-compose-mode) @@ -2780,7 +2788,8 @@ one of the normal rainbow-delimiters-depth-N-face faces." (dashboard-refresh-buffer) (setq my/-dashboard-did-fix-image t))) (defun my/-dashboard-setup-function () - (add-hook 'window-configuration-change-hook 'my/-dashboard-fix-image nil t)) + (add-hook 'window-configuration-change-hook 'my/-dashboard-fix-image nil t) + (setq-local display-line-numbers nil)) (add-hook 'dashboard-mode-hook 'my/-dashboard-setup-function) (set-face-background 'dashboard-banner-logo-title nil) (dashboard-setup-startup-hook)