diff --git a/org-ql-search.el b/org-ql-search.el index 8a012be..145b37c 100644 --- a/org-ql-search.el +++ b/org-ql-search.el @@ -275,7 +275,9 @@ For example, an org-ql dynamic block header could look like: (-let* (((&plist :query :columns :sort :ts-format :take) params) (query (cl-etypecase query (string (org-ql--plain-query query)) - (t query))) + (list ;; SAFETY: Query is in sexp form: ask for confirmation, because it could contain arbitrary code. + (org-ql--ask-unsafe-query query) + query))) (columns (or columns '(heading todo (priority "P")))) ;; MAYBE: Custom column functions. (format-fns diff --git a/org-ql-view.el b/org-ql-view.el index 29e5499..089baf6 100644 --- a/org-ql-view.el +++ b/org-ql-view.el @@ -97,23 +97,6 @@ Based on `org-agenda-mode-map'.") "Options for `org-ql-view'." :group 'org-ql) -(defcustom org-ql-view-ask-unsafe-links t - "Ask before opening a link that could run arbitrary code. -Org QL queries in sexp form can contain arbitrary expressions. -When opening an \"org-ql-search:\" link that contains a query in -sexp form, and this option is non-nil, the user will be prompted -for confirmation before opening the link. - -This variable may be set file-locally to disable this warning in -files that the user assumes are safe (e.g. of known provenance). -Users who are entirely unconcerned about this issue may disable -the option globally (at their own risk, however minimal it -probably is). - -See Info node `(org-ql)Queries'." - :type 'boolean - :risky t) - (defcustom org-ql-view-display-buffer-action nil "Action argument passed through `pop-to-buffer' to `display-buffer', which see." :type '(cons function alist)) @@ -644,18 +627,10 @@ protocol. See, e.g. `org-ql-view--link-store'." (stringp buffers-files) (cl-every #'stringp buffers-files)) (error "CAUTION: Link not opened because unsafe buffers-files parameter detected: %s" buffers-files)) - (when (and org-ql-view-ask-unsafe-links - (or (string-match (rx bol (0+ space) "(") query) - (listp query))) - ;; Query is in sexp form: ask for confirmation, because it could contain arbitrary code. - (let ((query-string (propertize (cl-etypecase query - (list (prin1-to-string query)) - (string query)) - ;; FIXME: The face doesn't seem to be displayed. - 'face 'font-lock-warning-face))) - (unless (yes-or-no-p (concat "Query is in sexp form and could contain arbitrary code: " - query-string " Execute it? ")) - (user-error "Query aborted by user")))) + (when (or (listp query) + (string-match (rx bol (0+ space) "(") query)) + ;; SAFETY: Query is in sexp form: ask for confirmation, because it could contain arbitrary code. + (org-ql--ask-unsafe-query query)) (org-ql-search buffers-files query :sort sort :super-groups groups diff --git a/org-ql.el b/org-ql.el index 3b97307..c479161 100644 --- a/org-ql.el +++ b/org-ql.el @@ -137,6 +137,24 @@ This list should not contain any duplicates.")) ;; TODO: Add info manual link. :link '(url-link "https://github.com/alphapapa/org-ql")) +(defcustom org-ql-ask-unsafe-queries t + "Ask before running a query that could run arbitrary code. +Org QL queries in sexp form can contain arbitrary expressions. +When opening an \"org-ql-search:\" link or updating a dynamic +block that contains a query in sexp form, and this option is +non-nil, the user will be prompted for confirmation before +opening the link. + +This variable may be set file-locally to disable this warning in +files that the user assumes are safe (e.g. of known provenance). +Users who are entirely unconcerned about this issue may disable +the option globally (at their own risk, however minimal it +probably is). + +See Info node `(org-ql)Queries'." + :type 'boolean + :risky t) + ;;;; Macros (cl-defmacro org-ql--defpred (name args docstring &rest body) @@ -531,6 +549,19 @@ from within ELEMENT's buffer." (setf (cadr element) properties) element)) +(defun org-ql--ask-unsafe-query (query) + "Signal an error if user rejects running QUERY. +If `org-ql-view-ask-unsafe-links' is nil, does nothing and +returns nil." + (when org-ql-ask-unsafe-queries + (let ((query-string (propertize (cl-etypecase query + (list (prin1-to-string query)) + (string query)) + 'face 'font-lock-warning-face))) + (unless (yes-or-no-p (concat "Query is in sexp form and could contain arbitrary code: " + query-string " Execute it? ")) + (user-error "Query aborted by user"))))) + ;;;;; Query processing ;; Processing, compiling, etc. for queries. diff --git a/tests/test-org-ql.el b/tests/test-org-ql.el index be81d81..e1c40d5 100644 --- a/tests/test-org-ql.el +++ b/tests/test-org-ql.el @@ -1422,7 +1422,7 @@ RESULTS should be a list of strings as returned by (org-mode))) (cl-flet* ((open-link-in - (link buffer) + (link buffer input) ;; Org REDUCED THE NUMBER OF ARGUMENTS TO `org-open-link-from-string'! That BREAKS BACKWARD ;; COMPATIBILITY! So I have to make my own function so these tests can work across Org versions! (with-current-buffer buffer @@ -1431,9 +1431,12 @@ RESULTS should be a list of strings as returned by (insert "* TODO Test heading\n\n") (insert link) (backward-char 1) - (org-open-at-point))) + (with-simulated-input input + (org-open-at-point)))) + (var-after-link-save-open - (var buffers-files query &key sort super-groups (buffer link-buffer) (input "RET")) + (var buffers-files query &key sort super-groups + (buffer link-buffer) (store-input "RET") open-input) (org-ql-search buffers-files query :super-groups super-groups :sort sort :title title :buffer view-buffer) @@ -1441,26 +1444,53 @@ RESULTS should be a list of strings as returned by (cl-assert (member '("org-ql-search" :follow org-ql-view--link-open :store org-ql-view--link-store) org-link-parameters) t) - (with-simulated-input input + (with-simulated-input store-input ;; Avoid writing "Stored: ..." to test output. (let ((inhibit-message t)) (call-interactively #'org-store-link nil))) (kill-buffer)) (cl-assert (and org-stored-links (caar org-stored-links)) t) - (open-link-in (caar org-stored-links) buffer) + (open-link-in (caar org-stored-links) buffer open-input) (with-current-buffer (get-buffer (concat "*Org QL View: " title "*")) (prog1 (buffer-local-value var (current-buffer)) (kill-buffer))))) (describe "Queries" :var ((string-query "todo:TODO regexp:heading") - (sexp-query '(and (todo "TODO") (regexp "heading")))) - (it "Sexps match" - (expect (var-after-link-save-open 'org-ql-view-query temp-filenames sexp-query) :to-equal sexp-query)) - (it "Strings match" - ;; NOTE: This test includes the string query being replaced with its sexp form after the query is run. - (expect (var-after-link-save-open 'org-ql-view-query temp-filenames string-query) - :to-equal sexp-query))) + (string-query-in-sexp-form '(and (todo "TODO") (regexp "heading"))) + ;; NOTE: The sexp query must be one that `org-ql--query-sexp-to-string' + ;; can't convert to a string. + (sexp-query '(or (todo "TODO") (regexp "heading")))) + + (describe "in sexp form" + + (describe "prompt when `org-ql-ask-unsafe-queries' is non-nil" + :var ((org-ql-ask-unsafe-queries t)) + + (it "and signal an error when rejected by user" + (expect (var-after-link-save-open 'org-ql-view-query temp-filenames sexp-query + :open-input "no RET") + :to-throw 'user-error '("Query aborted by user"))) + (it "and run when approved by user" + (expect (var-after-link-save-open 'org-ql-view-query temp-filenames sexp-query + :open-input "yes RET") + :to-equal sexp-query))) + + (it "don't prompt when `org-ql-ask-unsafe-queries' is nil" + (let ((org-ql-ask-unsafe-queries nil)) + (expect (var-after-link-save-open 'org-ql-view-query temp-filenames sexp-query) + :to-equal sexp-query))) + + (it "match after restoring" + (let ((org-ql-ask-unsafe-queries nil)) ; Disable safety check for this test. + (expect (var-after-link-save-open 'org-ql-view-query temp-filenames sexp-query) + :to-equal sexp-query)))) + + (describe "in string form" + (it "match after restoring" + ;; NOTE: This test includes the string query being replaced with its sexp form after the query is run. + (expect (var-after-link-save-open 'org-ql-view-query temp-filenames string-query) + :to-equal string-query-in-sexp-form)))) (describe "Grouping" :var ((query '(and (todo "TODO") (regexp "heading"))) @@ -1487,11 +1517,11 @@ RESULTS should be a list of strings as returned by (one-filename (car temp-filenames))) (it "Can search a file by filename" (expect (var-after-link-save-open 'org-ql-view-buffers-files one-filename query - :input "M-n M-n RET") + :store-input "M-n M-n RET") :to-equal one-filename)) (it "Can search multiple files by filename" (expect (var-after-link-save-open 'org-ql-view-buffers-files temp-filenames query - :input "M-n M-n RET") + :store-input "M-n M-n RET") :to-equal temp-filenames)) (it "Can search buffer containing the link" ;; This is sort-of a special case because of how the test link-opening function works.