File CVE-2024-30205.patch of Package emacs.37474
---
lisp/org/org.el | 123 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 122 insertions(+), 1 deletion(-)
--- lisp/org/org.el
+++ lisp/org/org.el 2024-04-12 09:21:32.185139348 +0000
@@ -1859,6 +1859,34 @@ changes to the current buffer."
:group 'org-link-follow
:type 'boolean)
+(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' will open non-existing files.
When nil, an error will be generated.
@@ -5196,6 +5224,10 @@ Support for group tags is controlled by
(defun org-file-contents (file &optional noerror)
"Return the contents of FILE, as a string."
+ (if (and file
+ (file-remote-p file)
+ (not (org--should-fetch-remote-resource-p file)))
+ (message "The remote resource %S is considered unsafe, and will not be downloaded." file)
(if (or (not file) (not (file-readable-p file)))
(if (not noerror)
(error "Cannot read file \"%s\"" file)
@@ -5203,7 +5235,96 @@ Support for group tags is controlled by
"")
(with-temp-buffer
(insert-file-contents file)
- (buffer-string))))
+ (buffer-string)))))
+
+(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 (buffer-base-buffer))
+ (concat "file://" (file-truename (buffer-file-name (buffer-base-buffer))))))
+ 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 (buffer-base-buffer))
+ (file-truename (buffer-file-name (buffer-base-buffer)))))
+ (domain (and (string-match
+ (rx (seq "http" (? "s") "://")
+ (optional (+ (not (any "@/\n"))) "@")
+ (optional "www.")
+ (one-or-more (not (any ":/?\n"))))
+ uri)
+ (match-string 0 uri)))
+ (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 permanently mark it as safe.\n "
+ (if domain
+ (concat
+ (propertize "d" 'face 'success)
+ " to download this resource, and mark the domain ("
+ (propertize domain 'face '(:inherit org-link :weight normal))
+ ") as safe.\n ")
+ "")
+ (if current-file
+ (concat
+ (propertize "f" 'face 'success)
+ " to download this resource, and permanently mark all resources in "
+ (propertize current-file 'face 'underline)
+ " 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 (append '(?y ?n ?! ?d ?\s) (and current-file '(?f))))
+ (prompt (format "Please type y, n%s, d, or !%s: "
+ (if current-file ", f" "")
+ (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 ?d))
+ (customize-push-and-save
+ 'org-safe-remote-resources
+ (list (if (eq char ?d)
+ (concat "\\`" (regexp-quote domain) "\\(?:/\\|\\'\\)")
+ (concat "\\`"
+ (regexp-quote
+ (if (and (= char ?f) current-file)
+ (concat "file://" current-file) uri))
+ "\\'")))))
+ (prog1 (memq char '(?y ?! ?d ?\s ?f))
+ (quit-window t)))))))
(defun org-extract-log-state-settings (x)
"Extract the log state setting from a TODO keyword string.
