Change: Query safety checks
- Variable org-ql-ask-unsafe-queries replaces org-ql-view-ask-unsafe-links. - New function: org-ql--ask-unsafe-query. - Tests: Improve
This commit is contained in:
Adam Porter
parent
0ca6b4b119
commit
71703def04
4 changed files with 82 additions and 44 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
31
org-ql.el
31
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.
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
(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 sexp-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.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue