org-capture: Prevent recursive evaluation of %(...) placeholders

* lisp/org-capture.el (org-capture-templates): Improve docstring.
(org-capture-fill-template): Prevent recursive evaluation of %(...)
placeholders.  Fix escaping of % character in templates.
* testing/lisp/test-org-capture.el: New file.

Reported-by: Thomas Preindl <thomas.preindl@gmail.com>
<http://permalink.gmane.org/gmane.emacs.orgmode/103018>
This commit is contained in:
Nicolas Goaziou 2015-11-29 16:53:35 +01:00
parent bd79085be0
commit bd3a2cbf2f
3 changed files with 312 additions and 182 deletions

View File

@ -104,6 +104,15 @@ Org files.
The new algorithm doesn't remove TAB characters not used for The new algorithm doesn't remove TAB characters not used for
indentation. indentation.
*** Secure placeholders in capture templates
Placeholders in capture templates are no longer expanded recursively.
However, ~%(...)~ constructs are expanded very late, so you can still
fill the contents of the S-exp with the replacement text of other
placeholders.
Only ~%(...)~ placeholders initially present are expanded. This
prevents evaluating potentially malicious code when another placehold,
e.g., ~%i~ expands to a S-exp.
*** ~org-babel-check-confirm-evaluate~ is now a function instead of a macro *** ~org-babel-check-confirm-evaluate~ is now a function instead of a macro
The calling convention has changed. The calling convention has changed.

View File

@ -219,15 +219,20 @@ properties are:
is finalized. is finalized.
The template defines the text to be inserted. Often this is an The template defines the text to be inserted. Often this is an
org-mode entry (so the first line should start with a star) that Org mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded in this order: be replaced with content and expanded:
%[pathname] Insert the contents of the file given by `pathname'. %[pathname] Insert the contents of the file given by
`pathname'. These placeholders are expanded at the very
beginning of the process so they can be used to extend the
current template.
%(sexp) Evaluate elisp `(sexp)' and replace it with the results. %(sexp) Evaluate elisp `(sexp)' and replace it with the results.
For convenience, %:keyword (see below) placeholders within Only placeholders pre-existing within the template, or
the expression will be expanded prior to this. introduced with %[pathname] are expanded this way. Since this
happens very late in the process, other %-escapes can be used to
fill the expression.
%<...> The result of format-time-string on the ... format specification. %<...> The result of format-time-string on the ... format specification.
%t Time stamp, date only. %t Time stamp, date only.
%T Time stamp with date and time. %T Time stamp with date and time.
@ -256,8 +261,9 @@ be replaced with content and expanded in this order:
A default value and a completion table ca be specified like this: A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}. %^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here. %? After completing the template, position cursor here.
%\\n Insert the text entered at the nth %^{prompt}, where `n' is %number Insert the text entered at the nth %^{prompt}, where `number' is a
a number, starting from 1. number, starting from 1. These placeholders are expanded as the
last step of the process.
Apart from these general escapes, you can access information specific to Apart from these general escapes, you can access information specific to
the link type that is created. For example, calling `org-capture' in emails the link type that is created. For example, calling `org-capture' in emails
@ -277,7 +283,10 @@ gnus | %:from %:fromname %:fromaddress
gnus | %:group, for messages also all email fields gnus | %:group, for messages also all email fields
w3, w3m | %:type %:url w3, w3m | %:type %:url
info | %:type %:file %:node info | %:type %:file %:node
calendar | %:type %:date" calendar | %:type %:date
When you need to insert a literal percent sign in the template,
you can escape ambiguous cases with a backward slash, e.g., \\%i."
:group 'org-capture :group 'org-capture
:version "24.1" :version "24.1"
:type :type
@ -1536,7 +1545,7 @@ The template may still contain \"%?\" for cursor positioning."
(if (< (nth 2 dct) org-extend-today-until) (if (< (nth 2 dct) org-extend-today-until)
(encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
ct)) ct))
(plist-p (if org-store-link-plist t nil)) (plist-p org-store-link-plist)
(v-c (and (> (length kill-ring) 0) (current-kill 0))) (v-c (and (> (length kill-ring) 0) (current-kill 0)))
(v-x (or (org-get-x-clipboard 'PRIMARY) (v-x (or (org-get-x-clipboard 'PRIMARY)
(org-get-x-clipboard 'CLIPBOARD) (org-get-x-clipboard 'CLIPBOARD)
@ -1545,8 +1554,8 @@ The template may still contain \"%?\" for cursor positioning."
(v-T (format-time-string (cdr org-time-stamp-formats) ct1)) (v-T (format-time-string (cdr org-time-stamp-formats) ct1))
(v-u (concat "[" (substring v-t 1 -1) "]")) (v-u (concat "[" (substring v-t 1 -1) "]"))
(v-U (concat "[" (substring v-T 1 -1) "]")) (v-U (concat "[" (substring v-T 1 -1) "]"))
;; `initial' and `annotation' might habe been passed. ;; `initial' and `annotation' might have been passed. But if
;; But if the property list has them, we prefer those values ;; the property list has them, we prefer those values.
(v-i (or (plist-get org-store-link-plist :initial) (v-i (or (plist-get org-store-link-plist :initial)
initial initial
(org-capture-get :initial) (org-capture-get :initial)
@ -1557,11 +1566,11 @@ The template may still contain \"%?\" for cursor positioning."
"")) ""))
;; Is the link empty? Then we do not want it... ;; Is the link empty? Then we do not want it...
(v-a (if (equal v-a "[[]]") "" v-a)) (v-a (if (equal v-a "[[]]") "" v-a))
(clipboards (remove nil (list v-i (clipboards (remq nil (list v-i
(org-get-x-clipboard 'PRIMARY) (org-get-x-clipboard 'PRIMARY)
(org-get-x-clipboard 'CLIPBOARD) (org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY) (org-get-x-clipboard 'SECONDARY)
v-c))) v-c)))
(l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]") (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]")
(v-A (if (and v-a (string-match l-re v-a)) (v-A (if (and v-a (string-match l-re v-a))
(replace-match "[[\\1][%^{Link description}]]" nil nil v-a) (replace-match "[[\\1][%^{Link description}]]" nil nil v-a)
@ -1570,203 +1579,233 @@ The template may still contain \"%?\" for cursor positioning."
(replace-match "\\1" nil nil v-a) (replace-match "\\1" nil nil v-a)
v-a)) v-a))
(v-n user-full-name) (v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker) (v-k (and (marker-buffer org-clock-marker)
(org-no-properties org-clock-heading))) (org-no-properties org-clock-heading)))
(v-K (if (marker-buffer org-clock-marker) (v-K (if (marker-buffer org-clock-marker)
(org-make-link-string (org-make-link-string
(buffer-file-name (marker-buffer org-clock-marker)) (buffer-file-name (marker-buffer org-clock-marker))
org-clock-heading))) org-clock-heading)))
(v-f (or (org-capture-get :original-file-nondirectory) "")) (v-f (or (org-capture-get :original-file-nondirectory) ""))
(v-F (or (org-capture-get :original-file) "")) (v-F (or (org-capture-get :original-file) ""))
v-I
(org-startup-folded nil) (org-startup-folded nil)
(org-inhibit-startup t) (org-inhibit-startup t)
org-time-was-given org-end-time-was-given x strings)
prompt completions char time pos default histvar strings)
(setq org-store-link-plist (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a))
(plist-put org-store-link-plist :annotation v-a) (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i))
org-store-link-plist
(plist-put org-store-link-plist :initial v-i))
(setq initial v-i) (setq initial v-i)
(unless template (setq template "") (message "No template") (ding) (unless template
(sit-for 1)) (setq template "")
(message "no template") (ding)
(sit-for 1))
(save-window-excursion (save-window-excursion
(org-switch-to-buffer-other-window (get-buffer-create "*Capture*")) (org-switch-to-buffer-other-window (get-buffer-create "*Capture*"))
(erase-buffer) (erase-buffer)
;; Turn on org-mode in temp buffer, set local variables. This
;; is to support completion in interactive prompts
(let ((org-inhibit-startup t)) (org-mode))
(insert template) (insert template)
(goto-char (point-min)) (goto-char (point-min))
(org-capture-steal-local-variables buffer) (org-capture-steal-local-variables buffer)
(setq buffer-file-name nil mark-active nil) (setq buffer-file-name nil)
(setq mark-active nil)
;; %[] Insert contents of a file. ;; %[] insert contents of a file.
(goto-char (point-min)) (save-excursion
(while (re-search-forward "%\\[\\(.+\\)\\]" nil t) (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
(unless (org-capture-escaped-%)
(let ((start (match-beginning 0))
(end (match-end 0))
(filename (expand-file-name (match-string 1))))
(goto-char start)
(delete-region start end)
(condition-case error
(insert-file-contents filename)
(error (insert (format "%%![Couldn not insert %s: %s]"
filename error)))))))
;; The current time
(goto-char (point-min))
(while (re-search-forward "%<\\([^>\n]+\\)>" nil t)
(replace-match (format-time-string (match-string 1)) t t))
;; Simple %-escapes
(goto-char (point-min))
(while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t)
(unless (org-capture-escaped-%)
(when (and initial (equal (match-string 0) "%i"))
(save-match-data
(let* ((lead (buffer-substring
(point-at-bol) (match-beginning 0))))
(setq v-i (mapconcat 'identity
(org-split-string initial "\n")
(concat "\n" lead))))))
(replace-match (or (eval (intern (concat "v-" (match-string 1)))) "")
t t)))
;; From the property list
(when plist-p
(goto-char (point-min))
(while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
(unless (org-capture-escaped-%) (unless (org-capture-escaped-%)
(and (setq x (or (plist-get org-store-link-plist (let ((start (match-beginning 0))
(intern (match-string 1))) "")) (end (match-end 0))
(replace-match x t t))))) (filename (expand-file-name (match-string 1))))
(goto-char start)
(delete-region start end)
(condition-case error
(insert-file-contents filename)
(error (insert (format "%%![couldn not insert %s: %s]"
filename
error))))))))
;; %() embedded elisp ;; Mark %() embedded elisp for later evaluation.
(goto-char (point-min)) (org-capture--expand-embedded-elisp 'mark)
(org-capture-expand-embedded-elisp)
;; Turn on org-mode in temp buffer, set local variables (let ((regexp "%\\(:[-a-za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlntTuUx]\\|\
;; This is to support completion in interactive prompts ^\\(?:{\\([^}]*\\)}\\)?\\([CgGLptTuU]\\)?\\)")
(let ((org-inhibit-startup t)) (org-mode)) (strings))
;; Interactive template entries (while (re-search-forward regexp nil t)
(goto-char (point-min)) (let ((pos (copy-marker (match-beginning 0)))
(while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) (end (copy-marker (match-end 0)))
(unless (org-capture-escaped-%) (value (match-string 1))
(setq char (if (match-end 3) (match-string-no-properties 3)) (time-string (match-string 2))
prompt (if (match-end 2) (match-string-no-properties 2))) (prompt (match-string-no-properties 3))
(goto-char (match-beginning 0)) (key (match-string 4)))
(replace-match "") (unless (org-capture-escaped-%)
(setq completions nil default nil) (goto-char pos)
(when prompt (delete-region pos end)
(setq completions (org-split-string prompt "|") (pcase (string-to-char value)
prompt (pop completions) (?<
default (car completions) ;; The current time.
histvar (intern (concat (insert (format-time-string time-string)))
"org-capture-template-prompt-history::" (?:
(or prompt ""))) ;; From the property list.
completions (mapcar 'list completions))) (insert (or (plist-get org-store-link-plist (intern value))
(unless (boundp histvar) (set histvar nil)) "")))
(cond (?i (let ((lead (buffer-substring-no-properties
((member char '("G" "g")) (line-beginning-position) pos)))
(let* ((org-last-tags-completion-table (insert (mapconcat #'identity
(org-global-tags-completion-table (split-string initial "\n")
(if (equal char "G") (concat "\n" lead)))))
(org-agenda-files) (?^
(and file (list file))))) ;; Interactive template entries.
(org-add-colon-after-tag-completion t) (let ((completions nil)
(ins (org-icompleting-read (default nil)
(if prompt (concat prompt ": ") "Tags: ") (histvar nil))
'org-tags-completion-function nil nil nil (when prompt
'org-tags-history))) (setq completions (org-split-string prompt "|"))
(setq ins (mapconcat 'identity (setq prompt (pop completions))
(setq default (car completions))
(setq histvar
(intern (concat
"org-capture-template-prompt-history::"
(or prompt ""))))
(setq completions (mapcar #'list completions)))
(pcase (string-to-char key)
((or ?G ?g)
(let* ((org-last-tags-completion-table
(org-global-tags-completion-table
(cond ((equal key "G") (org-agenda-files))
(file (list file))
(t nil))))
(org-add-colon-after-tag-completion t)
(ins (mapconcat
#'identity
(org-split-string (org-split-string
ins (org-re "[^[:alnum:]_@#%]+")) (completing-read
":")) (if prompt (concat prompt ": ") "Tags: ")
(when (string-match "\\S-" ins) 'org-tags-completion-function nil nil nil
(or (equal (char-before) ?:) (insert ":")) 'org-tags-history)
(insert ins) "[^[:alnum:]_@#%]+")
(or (equal (char-after) ?:) (insert ":")) ":")))
(and (org-at-heading-p) (when (org-string-nw-p ins)
(let ((org-ignore-region t)) (unless (eq (char-before) ?:) (insert ":"))
(org-set-tags nil 'align)))))) (insert ins)
((equal char "C") (unless (eq (char-after) ?:) (insert ":"))
(cond ((= (length clipboards) 1) (insert (car clipboards))) (and (org-at-heading-p)
((> (length clipboards) 1) (let ((org-ignore-region t))
(insert (read-string "Clipboard/kill value: " (org-set-tags nil 'align))))))
(car clipboards) '(clipboards . 1) (?C
(car clipboards)))))) (cond
((equal char "L") ((= (length clipboards) 1) (insert (car clipboards)))
(cond ((= (length clipboards) 1) ((> (length clipboards) 1)
(org-insert-link 0 (car clipboards))) (insert (read-string "Clipboard/kill value: "
((> (length clipboards) 1) (car clipboards)
(org-insert-link 0 (read-string "Clipboard/kill value: " '(clipboards . 1)
(car clipboards) (car clipboards))))))
'(clipboards . 1) (?L
(car clipboards)))))) (cond ((= (length clipboards) 1)
((equal char "p") (org-insert-link 0 (car clipboards)))
(org-set-property (org-no-properties prompt) nil)) ((> (length clipboards) 1)
(char (org-insert-link
;; These are the date/time related ones 0
(setq org-time-was-given (equal (upcase char) char)) (read-string "Clipboard/kill value: "
(setq time (org-read-date (equal (upcase char) char) t nil (car clipboards)
prompt)) '(clipboards . 1)
(if (equal (upcase char) char) (setq org-time-was-given t)) (car clipboards))))))
(org-insert-time-stamp time org-time-was-given (?p (org-set-property prompt nil))
(member char '("u" "U")) ((guard key)
nil nil (list org-end-time-was-given))) ;; These are the date/time related ones.
(t (let* ((upcase? (equal (upcase key) key))
(let (org-completion-use-ido) (org-time-was-given upcase?)
(push (org-completing-read-no-i (org-end-time-was-given)
(concat (if prompt prompt "Enter string") (time (org-read-date upcase? t nil prompt)))
(if default (concat " [" default "]")) (org-insert-time-stamp
": ") time org-time-was-given
completions nil nil nil histvar default) (member key '("u" "U"))
strings) nil nil (list org-end-time-was-given))))
(insert (car strings))))))) (t
;; Replace %n escapes with nth %^{...} string (push (completing-read
(concat (or prompt "Enter string")
(and default (format " [%s]" default))
": ")
completions nil nil nil histvar default)
strings)
(insert (car strings))))))
(?a (insert v-a))
(?A (insert v-A))
(?c (insert v-c))
(?f (insert v-f))
(?F (insert v-F))
(?k (insert v-k))
(?K (insert v-K))
(?l (insert v-l))
(?t (insert v-t))
(?T (insert v-T))
(?u (insert v-u))
(?U (insert v-U))
(?x (insert v-x)))
(set-marker pos nil)
(set-marker end nil)))))
;; Replace %n escapes with nth %^{...} string.
(setq strings (nreverse strings)) (setq strings (nreverse strings))
(goto-char (point-min)) (save-excursion
(while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
(unless (org-capture-escaped-%) (unless (org-capture-escaped-%)
(replace-match (replace-match
(nth (1- (string-to-number (match-string 1))) strings) (nth (1- (string-to-number (match-string 1))) strings)
nil t))) nil t))))
;; Expand %() embedded Elisp. Limit to Sexp originally marked.
(org-capture--expand-embedded-elisp)
;; Make sure there are no empty lines before the text, and that ;; Make sure there are no empty lines before the text, and that
;; it ends with a newline character ;; it ends with a newline character.
(goto-char (point-min)) (goto-char (point-min))
(while (looking-at "[ \t]*\n") (replace-match "")) (while (looking-at "[ \t]*\n") (replace-match ""))
(if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) (when (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n"))
;; Return the expanded template and kill the temporary buffer ;; Return the expanded template and kill the temporary buffer.
(untabify (point-min) (point-max)) (untabify (point-min) (point-max))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(prog1 (buffer-string) (kill-buffer (current-buffer)))))) (prog1 (buffer-substring-no-properties (point-min) (point-max))
(kill-buffer (current-buffer))))))
(defun org-capture-escaped-% () (defun org-capture-escaped-% ()
"Check if % was escaped - if yes, unescape it now." "Non-nil if % was escaped.
(if (equal (char-before (match-beginning 0)) ?\\) If yes, unescape it now. Assume match-data contains the
(progn placeholder to check."
(delete-region (1- (match-beginning 0)) (match-beginning 0)) (save-excursion
t) (goto-char (match-beginning 0))
nil)) (let ((n (abs (skip-chars-backward "\\\\"))))
(delete-char (/ (1+ n) 2))
(= (% n 2) 1))))
(defun org-capture-expand-embedded-elisp () (defun org-capture--expand-embedded-elisp (&optional mark)
"Evaluate embedded elisp %(sexp) and replace with the result." "Evaluate embedded elisp %(sexp) and replace with the result.
(goto-char (point-min)) When optional MARK argument is non-nil, mark Sexp with a text
(while (re-search-forward "%(" nil t) property (`org-embedded-elisp') for later evaluation. Only
(unless (org-capture-escaped-%) marked Sexp are evaluated when this argument is nil."
(goto-char (match-beginning 0)) (save-excursion
(let ((template-start (point))) (goto-char (point-min))
(forward-char 1) (while (re-search-forward "%(" nil t)
(let* ((sexp (read (current-buffer))) (unless (org-capture-escaped-%)
(result (org-eval (if mark
(org-capture--expand-keyword-in-embedded-elisp sexp)))) (put-text-property
(delete-region template-start (point)) (match-beginning 0) (match-end 0) 'org-embedded-elisp t)
(when result (when (get-text-property (match-beginning 0) 'org-embedded-elisp)
(if (stringp result) (goto-char (match-beginning 0))
(insert result) (let ((template-start (point)))
(error "Capture template sexp `%s' must evaluate to string or nil" (forward-char 1)
sexp)))))))) (let* ((sexp (read (current-buffer)))
(result (org-eval
(org-capture--expand-keyword-in-embedded-elisp
sexp))))
(delete-region template-start (point))
(when result
(if (stringp result)
(insert result)
(error
"Capture template sexp `%s' must evaluate to string or nil"
sexp)))))))))))
(defun org-capture--expand-keyword-in-embedded-elisp (attr) (defun org-capture--expand-keyword-in-embedded-elisp (attr)
"Recursively replace capture link keywords in ATTR sexp. "Recursively replace capture link keywords in ATTR sexp.

View File

@ -0,0 +1,82 @@
;;; test-org-capture.el --- Tests for org-capture.el -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Nicolas Goaziou
;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Unit tests for Org Capture library.
;;; Code:
(require 'org-capture)
(ert-deftest test-org-capture/fill-template ()
"Test `org-capture-fill-template' specifications."
;; %(sexp) placeholder.
(should
(equal "success!\n"
(org-capture-fill-template "%(concat \"success\" \"!\")")))
;; %<...> placeholder.
(should
(equal (concat (format-time-string "%Y") "\n")
(org-capture-fill-template "%<%Y>")))
;; %t and %T placeholders.
(should
(equal (concat (format-time-string (car org-time-stamp-formats)) "\n")
(org-capture-fill-template "%t")))
(should
(equal (concat (format-time-string (cdr org-time-stamp-formats)) "\n")
(org-capture-fill-template "%T")))
;; %u and %U placeholders.
(should
(string-match-p
(format-time-string (substring (car org-time-stamp-formats) 1 -1))
(org-capture-fill-template "%u")))
(should
(string-match-p
(format-time-string (substring (cdr org-time-stamp-formats) 1 -1))
(org-capture-fill-template "%U")))
;; %i placeholder. Make sure sexp placeholders are not expanded
;; when they are inserted through this one.
(should
(equal "success!\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "%i" "success!"))))
(should-not
(equal "failure!\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "%i" "%(concat \"failure\" \"!\")"))))
;; Test %-escaping with / character.
(should
(equal "%i\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "\\%i" "success!"))))
(should
(equal "\\success!\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "\\\\%i" "success!"))))
(should
(equal "\\%i\n"
(let ((org-store-link-plist nil))
(org-capture-fill-template "\\\\\\%i" "success!")))))
(provide 'test-org-capture)
;;; test-org-capture.el ends here