org: Add setting for remote file download policy

* lisp/org.el (org-resource-download-policy, 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): 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, org-attach-url): Apply `org--safe-remote-resource-p' to url downloading.

Author: tecosaur

lisp/org-attach.el

@@ -486,7 +486,9 @@ DIR-property exists (that is different from the unset one)."
 (defun org-attach-url (url)
  "Attach URL."
  (interactive "MURL of the file to attach: \n")
- (let ((org-attach-method 'url))
+ (let ((org-attach-method 'url)
+ (org-safe-remote-resources ; Assume saftey if in an interactive session.
+ (if noninteractive org-safe-remote-resources '(""))))
  (org-attach-attach url)))
 
 (defun org-attach-buffer (buffer-name)
@@ -525,9 +527,12 @@ METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
  ((eq method 'mv) (rename-file file attach-file))
  ((eq method 'cp) (copy-file file attach-file))
  ((eq method 'ln) (add-name-to-file file attach-file))
- ;; We pass integer third argument to auto-expand "~" in FILE.
  ((eq method 'lns) (make-symbolic-link file attach-file 1))
- ((eq method 'url) (url-copy-file file attach-file)))
+ ((eq method 'url)
+ (if (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)

lisp/org-persist.el

@@ -657,7 +657,10 @@ COLLECTION is the plist holding data 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 _)

lisp/org.el

@@ -1353,6 +1353,34 @@ For more examples, see the system specific constants
 (string :tag "Command")
 (function :tag "Function")))))
 
+(defcustom org-resource-download-policy '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-url' 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.
+URI regexps are applied to both URLs and Org files requesting
+remote resources."
+ :group 'org
+ :type '(list regexp))
+
 (defcustom org-open-non-existing-files nil
  "Non-nil means `org-open-file' opens non-existing files.
 
@@ -4468,21 +4496,25 @@ is available. This option applies only if FILE is a URL."
  (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
@@ -4495,6 +4527,74 @@ is available. This option applies only if FILE is a URL."
  file)
  nil)))))))
 
+(defun org--should-fetch-remote-resource-p (uri)
+ "Return non-nil if the URI should be fetched."
+ (or (eq org-resource-download-policy t)
+ (org--safe-remote-resource-p uri)
+ (and (eq org-resource-download-policy '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 ((uri-patterns org-safe-remote-resources)
+ (file-uri (and buffer-file-name
+ (concat "file://" (file-truename buffer-file-name))))
+ match-p)
+ (while (and (not match-p) uri-patterns)
+ (setq match-p (or (string-match-p (car uri-patterns) uri)
+ (and file-uri (string-match-p (car uri-patterns) file-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 ((current-file (and buffer-file-name (file-truename buffer-file-name)))
+ (buf (get-buffer-create "*Org Remote Resource*")))
+ ;; Set up the contents of the *Org Remote Resource* 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 "f" 'face 'success)
+ " to download this resource, and permanantly mark all resources in "
+ (propertize current-file 'face 'fixed-pitch-serif)
+ " 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 ?! ?f ?\s))
+ (prompt (format "Please type y, n, f, 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 (memq char '(?! ?f))
+ (customize-push-and-save
+ 'org-safe-remote-resources
+ (list (rx string-start
+ (literal
+ (if (and (= char ?f) current-file)
+ (concat "file://" current-file) uri))
+ string-end))))
+ (prog1 (memq char '(?! ?\s ?y ?f))
+ (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@/!)\"."