From 4f3437a2386e2ffdf37c99d476fa5ea3481b8d3c Mon Sep 17 00:00:00 2001 From: TEC Date: Sun, 12 Jun 2022 22:37:42 +0800 Subject: [PATCH] org: Add setting for remote file download policy * lisp/org.el (org-download-remote-resources, org-safe-remote-resources): Two new customisations to configure the policy for downloading remote resources. (org--should-fetch-remote-resource-p, org--safe-remote-resource-p, org--confirm-resource-safe, org-download-remote-resources): Introduce the new function `org--should-fetch-remote-resource-p' for internal use determining whether a remote resource should be downloaded according to the download policy. This function makes use of two helper functions, `org--safe-remote-resource-p' and `org--confirm-resource-safe'. (org-file-contents): Apply `org--safe-remote-resource-p' to file downloading. * lisp/org-persist.el (org-persist-write): Apply `org--safe-remote-resource-p' to url downloading. * lisp/org-attach.el (org-attach-attach): Apply `org--safe-remote-resource-p' to url downloading. --- lisp/org-attach.el | 6 ++- lisp/org-persist.el | 5 +- lisp/org.el | 115 ++++++++++++++++++++++++++++++++++++++------ 3 files changed, 109 insertions(+), 17 deletions(-) diff --git a/lisp/org-attach.el b/lisp/org-attach.el index 5ee2b84b2..6f21ad716 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -525,7 +525,11 @@ (defun org-attach-attach (file &optional visit-dir method) ((eq method 'cp) (copy-file file attach-file)) ((eq method 'ln) (add-name-to-file file attach-file)) ((eq method 'lns) (make-symbolic-link file attach-file)) - ((eq method 'url) (url-copy-file file attach-file))) + ((eq method 'url) + (if (or (not noninteractive) (org--should-fetch-remote-resource-p file)) + (url-copy-file file attach-file) + (error "The remote resource %S is considered unsafe, and will not be downloaded." + file)))) (run-hook-with-args 'org-attach-after-change-hook attach-dir) (org-attach-tag) (cond ((eq org-attach-store-link-p 'attached) diff --git a/lisp/org-persist.el b/lisp/org-persist.el index 068f58cec..f49abe8cd 100644 --- a/lisp/org-persist.el +++ b/lisp/org-persist.el @@ -655,7 +655,10 @@ (defun org-persist-write:url (c collection) (format "%s-%s.%s" persist-file (md5 path) ext)))) (unless (file-exists-p (file-name-directory file-copy)) (make-directory (file-name-directory file-copy) t)) - (url-copy-file path file-copy 'overwrite) + (if (org--should-fetch-remote-resource-p path) + (url-copy-file path file-copy 'overwrite) + (error "The remote resource %S is considered unsafe, and will not be downloaded." + path)) (format "%s-%s.%s" persist-file (md5 path) ext))))) (defun org-persist-write:index (container _) diff --git a/lisp/org.el b/lisp/org.el index 8e7aadde5..3a8acaa8f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1352,6 +1352,32 @@ (defcustom org-file-apps (string :tag "Command") (function :tag "Function"))))) +(defcustom org-download-remote-resources 'prompt + "The policy applied to requests to obtain remote resources. + +This affects keywords like #+setupfile and #+incude on export, +`org-persist-write:url',and `org-attach-attach' in +non-interactive Emacs sessions. + +This recognises four possible values: +- t, remote resources should always be downloaded. +- prompt, you will be prompted to download resources nt considered safe. +- safe, only resources considered safe will be downloaded. +- nil, never download remote resources. + +A resource is considered safe if it matches one of the patterns +in `org-safe-remote-resources'." + :group 'org + :type '(choice (const :tag "Always download remote resources" t) + (const :tag "Prompt before downloading an unsafe resource" prompt) + (const :tag "Only download resources considered safe" safe) + (const :tag "Never download any resources" nil))) + +(defcustom org-safe-remote-resources nil + "A list of regexp patterns matching safe URIs." + :group 'org + :type '(list regexp)) + (defcustom org-open-non-existing-files nil "Non-nil means `org-open-file' opens non-existing files. @@ -4466,21 +4492,25 @@ (defun org-file-contents (file &optional noerror nocache) (cond (cache) (is-url - (with-current-buffer (url-retrieve-synchronously file) - (goto-char (point-min)) - ;; Move point to after the url-retrieve header. - (search-forward "\n\n" nil :move) - ;; Search for the success code only in the url-retrieve header. - (if (save-excursion - (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror)) - ;; Update the cache `org--file-cache' and return contents. - (puthash file - (buffer-substring-no-properties (point) (point-max)) - org--file-cache) - (funcall (if noerror #'message #'user-error) - "Unable to fetch file from %S" - file) - nil))) + (if (org--should-fetch-remote-resource-p file) + (with-current-buffer (url-retrieve-synchronously file) + (goto-char (point-min)) + ;; Move point to after the url-retrieve header. + (search-forward "\n\n" nil :move) + ;; Search for the success code only in the url-retrieve header. + (if (save-excursion + (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror)) + ;; Update the cache `org--file-cache' and return contents. + (puthash file + (buffer-substring-no-properties (point) (point-max)) + org--file-cache) + (funcall (if noerror #'message #'user-error) + "Unable to fetch file from %S" + file) + nil)) + (funcall (if noerror #'message #'user-error) + "The remote resource %S is considered unsafe, and will not be downloaded." + file))) (t (with-temp-buffer (condition-case nil @@ -4493,6 +4523,61 @@ (defun org-file-contents (file &optional noerror nocache) file) nil))))))) +(defun org--should-fetch-remote-resource-p (uri) + "Return non-nil if the URI should be fetched." + (or (eq org-download-remote-resources t) + (org--safe-remote-resource-p uri) + (and (eq org-download-remote-resources 'prompt) + (org--confirm-resource-safe uri)))) + +(defun org--safe-remote-resource-p (uri) + "Return non-nil if URI is considered safe. +This checks every pattern in `org-safe-remote-resources', and +returns non-nil if any of them match." + (let (match-p (uri-patterns org-safe-remote-resources)) + (while (and (not match-p) uri-patterns) + (setq match-p (string-match-p (car uri-patterns) uri) + uri-patterns (cdr uri-patterns))) + match-p)) + +(defun org--confirm-resource-safe (uri) + "Ask the user if URI should be considered safe, returning non-nil if so." + (unless noninteractive + (let ((buf (get-buffer-create "*Org Remote Resource*"))) + ;; Set up the contents of the *Local Variables* buffer. + (with-current-buffer buf + (erase-buffer) + (insert "An org-mode document would like to download " + (propertize uri 'face '(:inherit org-link :weight normal)) + ", which is not considered safe.\n\n" + "Do you want to download this? You can type\n " + (propertize "!" 'face 'success) + " to download this resource, and permanantly mark it as safe.\n " + (propertize "y" 'face 'warning) + " to download this resource, just this once.\n " + (propertize "n" 'face 'error) + " to skip this resource.\n") + (setq-local cursor-type nil) + (set-buffer-modified-p nil) + (goto-char (point-min))) + ;; Display the buffer and read a choice. + (save-window-excursion + (pop-to-buffer buf) + (let* ((exit-chars '(?y ?n ?! ?\s)) + (prompt (format "Please type y, n, or !%s: " + (if (< (line-number-at-pos (point-max)) + (window-body-height)) + "" + ", or C-v/M-v to scroll"))) + char) + (setq char (read-char-choice prompt exit-chars)) + (when (= char ?!) + (customize-push-and-save + 'org-safe-remote-resources + (regexp-quote uri))) + (prog1 (memq char '(?! ?\s ?y)) + (quit-window t))))))) + (defun org-extract-log-state-settings (x) "Extract the log state setting from a TODO keyword string. This will extract info from a string like \"WAIT(w@/!)\"." -- 2.36.1