File CVE-2024-30205.patch of Package emacs.33222
From 2bc865ace050ff118db43f01457f95f95112b877 Mon Sep 17 00:00:00 2001
From: Ihor Radchenko <yantar92@posteo.net>
Date: Tue, 20 Feb 2024 14:59:20 +0300
Subject: org-file-contents: Consider all remote files unsafe
* lisp/org/org.el (org-file-contents): When loading files, consider all
remote files (like TRAMP-fetched files) unsafe, in addition to URLs.
---
lisp/org/org.el | 133 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 131 insertions(+), 2 deletions(-)
--- lisp/org/org.el
+++ lisp/org/org.el 2024-04-12 09:22:45.347777133 +0000
@@ -1413,6 +1413,34 @@ For more examples, see the system specif
(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.
@@ -4665,12 +4693,18 @@ from file or URL, and return nil.
If NOCACHE is non-nil, do a fresh fetch of FILE even if cached version
is available. This option applies only if FILE is a URL."
(let* ((is-url (org-file-url-p file))
+ (is-remote (condition-case nil
+ (file-remote-p file)
+ ;; In case of error, be safe.
+ (t t)))
(cache (and is-url
(not nocache)
(gethash file org--file-cache))))
(cond
(cache)
- (is-url
+ ((or is-url is-remote)
+ (if (org--should-fetch-remote-resource-p file)
+ (condition-case error
(with-current-buffer (url-retrieve-synchronously file)
(goto-char (point-min))
;; Move point to after the url-retrieve header.
@@ -4685,7 +4719,13 @@ is available. This option applies only
(funcall (if noerror #'message #'user-error)
"Unable to fetch file from %S"
file)
- nil)))
+ nil))
+ (error (if noerror
+ (message "Org couldn't download \"%s\": %s %S" file (car error) (cdr error))
+ (signal (car error) (cdr error)))))
+ (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
@@ -4698,6 +4738,95 @@ is available. This option applies only
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 (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.
This will extract info from a string like \"WAIT(w@/!)\"."
