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

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

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
+    (when (or (listp query)
-               (or (string-match (rx bol (0+ space) "(") query)
+              (string-match (rx bol (0+ space) "(") query))
-                   (listp query)))
+      ;; SAFETY: Query is in sexp form: ask for confirmation, because it could contain arbitrary code.
-      ;; Query is in sexp form: ask for confirmation, because it could contain arbitrary code.
+      (org-ql--ask-unsafe-query query))
-      (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"))))
     (org-ql-search buffers-files query
       :sort sort
       :super-groups groups

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.

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"))))
+                (string-query-in-sexp-form '(and (todo "TODO") (regexp "heading")))
-          (it "Sexps match"
+                ;; NOTE: The sexp query must be one that `org-ql--query-sexp-to-string'
-            (expect (var-after-link-save-open 'org-ql-view-query temp-filenames sexp-query) :to-equal sexp-query))
+                ;; can't convert to a string.
-          (it "Strings match"
+                (sexp-query '(or (todo "TODO") (regexp "heading"))))
-            ;; 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)
+          (describe "in sexp form"
-                    :to-equal sexp-query)))
+
+            (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.