emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] New remote resource download policy
@ 2022-06-12 14:43 Timothy
  2022-06-12 16:18 ` Daniel Fleischer
                   ` (2 more replies)
  0 siblings, 3 replies; 11+ messages in thread
From: Timothy @ 2022-06-12 14:43 UTC (permalink / raw)
  To: emacs-orgmode


[-- Attachment #1.1: Type: text/plain, Size: 492 bytes --]

Hi All,

As was raised in the `#+include: URL' thread
(<https://list.orgmode.org/877d5sd7yu.fsf@gmail.com>), currently Org will
automatically download files without confirmation in various circumstances.

This patch introduces two variables to control Org’s attitude towards
downloading files, and hooks them into the relevant parts of the codebase.

When prompting for downloading, this uses an approach borrowed from file local
variable confirmation.

All the best,
Timothy

[-- Attachment #1.2: Type: text/html, Size: 3186 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-org-Add-setting-for-remote-file-download-policy.patch --]
[-- Type: text/x-patch, Size: 8990 bytes --]

From 4f3437a2386e2ffdf37c99d476fa5ea3481b8d3c Mon Sep 17 00:00:00 2001
From: TEC <tec@tecosaur.com>
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


^ permalink raw reply related	[flat|nested] 11+ messages in thread
end of thread, other threads:[~2022-07-16  9:53 UTC | newest]

Thread overview: 11+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-06-12 14:43 [PATCH] New remote resource download policy Timothy
2022-06-12 16:18 ` Daniel Fleischer
2022-06-14  9:40 ` Robert Pluim
2022-06-22  9:58   ` Timothy
2022-06-15 12:35 ` Max Nikulin
2022-06-22 10:01   ` Timothy
2022-06-22 16:55     ` Max Nikulin
2022-06-29 15:27       ` Timothy
2022-06-30 16:57         ` Max Nikulin
2022-07-16  9:47           ` Timothy
2022-06-25  7:50     ` Max Nikulin

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).