diff --git a/elisp/trusted-dirs.el b/elisp/trusted-dirs.el new file mode 100644 index 0000000..4136b86 --- /dev/null +++ b/elisp/trusted-dirs.el @@ -0,0 +1,869 @@ +;;; 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/init.el b/init.el index 70e57e9..ef768a7 100644 --- a/init.el +++ b/init.el @@ -1,8 +1,8 @@ ;;; init.el --- Configuration entry point -*- lexical-binding: t -*- ;;; Commentary: ;;; Code: - (require 'cl-lib) +(require 'xdg) ;; Some other config files (cl-eval-when (compile load eval) @@ -354,8 +354,7 @@ PRED is nil, the value of `my/kill-some-buffers-default-pred' is used." (dolist (buffer ask-again-buffers) (act-on (ask-about buffer nil) buffer nil)) ;; Do this last so that tty frames don't auto-close half way through - (dolist (buffer to-kill) - (kill-buffer buffer))))) + (mapc 'kill-buffer to-kill)))) (keymap-global-set "C-x K" 'my/kill-some-buffers) (use-package tab-bar @@ -371,7 +370,23 @@ PRED is nil, the value of `my/kill-some-buffers-default-pred' is used." :hook (emacs-startup . global-jinx-mode) :config (evil-define-key 'normal 'global - "z=" #'jinx-correct)) + "z=" #'jinx-correct) + (defun my/jinx-visit-dictionary (language &optional other-window) + "Visit the dictionary file for LANGUAGE in another window. +With OTHER-WINDOW, visit the file in another window. Interactively, use the +current buffer's language, prompting if there is more than one. OTHER-WINDOW is +t with a prefix argument." + (interactive (list + (let ((langs (split-string jinx-languages " "))) + (if (length= langs 1) + (car langs) + (completing-read "Language: " langs nil t))) + current-prefix-arg)) + (let* ((config-dir (expand-file-name "enchant" (xdg-config-home))) + (dict-path (expand-file-name (concat language ".dic") config-dir))) + (if other-window + (find-file-other-window dict-path) + (find-file dict-path))))) ;; recentf (use-package recentf @@ -899,9 +914,7 @@ visual states." ("M-g r" . consult-imenu-multi) :map help-map ("TAB". consult-info) - ("". consult-info) - ("C-m" . consult-man) - ("". consult-info)) + ("RET" . consult-man)) :hook (minibuffer-setup . my/consult-setup-minibuffer-completion) :init (defun my/consult-setup-minibuffer-completion ()