Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix for issue with initial-input in org-ql-view--complete-buffers-files (Fix #227) #228

Closed
wants to merge 15 commits into from
Closed

Fix for issue with initial-input in org-ql-view--complete-buffers-files (Fix #227) #228

Show file tree
Hide file tree
Changes from 11 commits
Commits
Show all changes
15 commits
Select commit Hold shift + click to select a range
7b990e5
Fix for issue with initial-input in org-ql-view--complete-buffers-files
ahmed-shariff Jun 30, 2021
7120b63
Refactor of org-ql-view--complete-buffers-files
ahmed-shariff Jul 3, 2021
89b8476
Test cases for all org-ql-view--*-buffers-files functions
ahmed-shariff Jul 4, 2021
cc6e22d
Allow reading buffer names for buffers-or-names
ahmed-shariff Jul 5, 2021
06bdfc7
Fn always promts for buffer/files; handle buffer obj and list
ahmed-shariff Jul 5, 2021
b68d836
Using completing-read-multiple for org-ql-view--complete-buffers-files
ahmed-shariff Jul 19, 2021
cabf88e
removing duplcates when expanding buffers-files
ahmed-shariff Jul 19, 2021
788951a
Replacing org-ql-view--expand-buffers-files
ahmed-shariff Sep 13, 2021
ffaebcb
Merge branch 'master' of https://github.com/alphapapa/org-ql
ahmed-shariff Sep 13, 2021
564d491
Fixes for using mulitiple values and related test suite improvements
ahmed-shariff Sep 13, 2021
aa9c6cc
Adding `comma separated` instruction to readme
ahmed-shariff Sep 15, 2021
cea1651
Cleaning up functions and improvements for clarity.
ahmed-shariff Sep 16, 2021
576f9d3
Handling support for functions \w functions using completing-read-mul…
ahmed-shariff Sep 16, 2021
2d49745
Fix: \w duplicates & func's with buffers/names with expand/contract
ahmed-shariff Sep 17, 2021
d8f2922
Abstract buffers-files being flattened to a list of strings
ahmed-shariff Sep 24, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion README.org
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -115,7 +115,7 @@ Read ~QUERY~ and search with ~org-ql~. Interactively, prompt for these variable
+ ~buffer~: search the current buffer
+ ~all~: search all Org buffers
+ ~agenda~: search buffers returned by the function ~org-agenda-files~
+ A space-separated list of file or buffer names
+ A comma-separated list of file, buffer names, or the above keywords

~GROUPS~: An ~org-super-agenda~ group set. See variable ~org-super-agenda-groups~.

Expand Down
121 changes: 79 additions & 42 deletions org-ql-view.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1032,54 +1032,91 @@ current buffer. Otherwise BUFFERS-FILES is returned unchanged."
(string (expand-file-name it))
(otherwise it))
list)))
;; TODO: Test this more exhaustively.
(pcase buffers-files
((pred listp)
(pcase (expand-files buffers-files)
((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files))))
"org-agenda-files")
((and (guard (file-exists-p org-directory))
(pred (seq-set-equal-p (org-ql-search-directories-files
:directories (list org-directory)))))
"org-directory")
(_ buffers-files)))
((pred (equal (current-buffer)))
"buffer")
((or 'org-agenda-files '(function org-agenda-files))
"org-agenda-files")
((and (pred bufferp) (guard (buffer-file-name buffers-files)))
(buffer-file-name buffers-files))
(_ buffers-files))))
(-->
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved
;; TODO: Test this more exhaustively.
(pcase buffers-files
((pred listp)
(pcase (expand-files buffers-files)
((pred (seq-set-equal-p (mapcar #'expand-file-name (org-agenda-files))))
"org-agenda-files")
((and (guard (file-exists-p org-directory))
(pred (seq-set-equal-p (org-ql-search-directories-files
:directories (list org-directory)))))
"org-directory")
(_ buffers-files)))
((pred (equal (current-buffer)))
"buffer")
((or 'org-agenda-files '(function org-agenda-files))
"org-agenda-files")
((and (pred bufferp) (guard (buffer-file-name buffers-files)))
(buffer-file-name buffers-files))
((pred bufferp)
(buffer-name buffers-files))
(_ buffers-files))
;; All items needs to be strings to pick duplicates when used with the extend conterpart.
;; So making sure the buffers are convered to file names
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved
(if (stringp it)
it
(-map
(lambda (buffer-file)
(if (bufferp buffer-file)
(--if-let (buffer-file-name buffer-file)
it
(buffer-name buffer-file))
buffer-file))
it)))))
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved

(defun org-ql-view--complete-buffers-files ()
"Return value for `org-ql-view-buffers-files' using completion."
(cl-labels ((initial-input
() (when org-ql-view-buffers-files
(org-ql-view--contract-buffers-files
org-ql-view-buffers-files))))
(if (and org-ql-view-buffers-files
(bufferp org-ql-view-buffers-files))
;; Buffers can't be input by name, so if the default value is a buffer, just use it.
;; TODO: Find a way to fix this.
"Return value for `org-ql-view-buffers-files' using completion.
When `org-ql-view-buffers-files' cannot be contracted to a string
representation `org-ql-view-buffers-files' is returned."
(let* ((contracted-org-ql-view-buffers-files
(when org-ql-view-buffers-files
(org-ql-view--contract-buffers-files
org-ql-view-buffers-files)))
(initial-input (pcase contracted-org-ql-view-buffers-files
('nil nil)
('string contracted-org-ql-view-buffers-files)
((pred listp)
(mapconcat 'identity contracted-org-ql-view-buffers-files
","))
(_ (format "%s" contracted-org-ql-view-buffers-files))))
(completion-read-result (completing-read-multiple
"Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil initial-input)))
(if (equal completion-read-result initial-input)
org-ql-view-buffers-files
(org-ql-view--expand-buffers-files
(completing-read "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil (initial-input))))))
(org-ql-view--expand-buffers-files completion-read-result))))

(defun org-ql-view--expand-buffers-files (buffers-files)
"Return BUFFERS-FILES expanded to a list of files or buffers.
The counterpart to `org-ql-view--contract-buffers-files'."
(pcase-exhaustive buffers-files
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
(buffer-list)))
("org-agenda-files" (org-agenda-files))
("org-directory" (org-ql-search-directories-files))
((or "" "buffer") (current-buffer))
((pred bufferp) buffers-files)
((pred listp) buffers-files)
;; A single filename.
((pred stringp) buffers-files)))
The counterpart to `org-ql-view--contract-buffers-files'.
This always returns a list of string values."
(-->
(-map (lambda (buffer-file)
(pcase-exhaustive buffer-file
("all" (--select (equal (buffer-local-value 'major-mode it) 'org-mode)
(buffer-list)))
("org-agenda-files" (org-agenda-files))
("org-directory" (org-ql-search-directories-files))
((or "" "buffer")
(current-buffer))
((pred bufferp) (list buffer-file))
;; A single filename.
((pred stringp) (list buffer-file))
(_ (error (format "Value %s is not a valid buffer/file" buffer-file)))))
(-list buffers-files))
-flatten -non-nil
;; expanding all file-buffers to file names to avoid duplicate entries being formed
(-map (lambda (buffer-file)
(if (bufferp buffer-file)
(--if-let (buffer-file-name buffer-file)
it
(buffer-name buffer-file))
buffer-file))
it)
-uniq))
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved

(defun org-ql-view--complete-super-groups ()
"Return value for `org-ql-view-super-groups' using completion."
Expand Down
1 change: 1 addition & 0 deletions org-ql.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -375,6 +375,7 @@ each priority the newest items would appear first."
;; It feels unintuitive that `find-file-noselect' returns
;; a buffer if the filename doesn't exist.
(find-file-noselect it))
(get-buffer it)
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved
(user-error "Can't open file: %s" it)))))
;; Ignore special/hidden buffers.
(--remove (string-prefix-p " " (buffer-name it)))))
Expand Down
91 changes: 84 additions & 7 deletions tests/test-org-ql.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1686,19 +1686,19 @@ with keyword arg NOW in PLIST."
(unquoted-lambda-in-list-link "[[org-ql-search:todo:?buffers-files%3D%28%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29%29]]"))
(it "Errors for a quoted lambda"
(expect (open-link quoted-lambda-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: (lambda nil (error UNSAFE))")))
:to-throw 'error '("Value lambda is not a valid buffer/file")))
(it "Errors for an unquoted lambda"
(expect (open-link unquoted-lambda-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: (lambda nil (error UNSAFE))")))
:to-throw 'error '("Value lambda is not a valid buffer/file")))
(it "Errors for a quoted lambda in a list"
(if (version< (org-version) "9.3")
(expect (open-link quoted-lambda-in-list-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: ((quote (lambda nil (error UNSAFE))))"))
:to-throw 'error '("Value (quote (lambda nil (error UNSAFE))) is not a valid buffer/file"))
(expect (open-link quoted-lambda-in-list-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: ('(lambda nil (error UNSAFE)))"))))
:to-throw 'error '("Value (quote (lambda nil (error UNSAFE))) is not a valid buffer/file"))))
(it "Errors for an unquoted lambda in a list"
(expect (open-link unquoted-lambda-in-list-link)
:to-throw 'error '("CAUTION: Link not opened because unsafe buffers-files parameter detected: ((lambda nil (error UNSAFE)))"))))
:to-throw 'error '("Value (lambda nil (error UNSAFE)) is not a valid buffer/file"))))
Comment on lines -1689 to +1701
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why did you change these errors? These are important safety tests.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I had added a explicit error when the input to the org-ql-view--expand-buffers-files function,

org-ql/org-ql-view.el

Line 1108 in 564d491

(_ (error (format "Value %s is not a valid buffer/file" buffer-file)))))

According to my understanding, the previous errors being tested were because of the pcase failing. So roll back the error I triggering and the pacse to fail which would lead to the older errors?
Even then, in this implementation the return value is always a list, which makes the error being produced to be a bit different than what it previously had.

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not sure what you mean. Do you understand the potential security issue here?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

To clarify, the potential values for the org-ql-view--expand-buffers-files now are the following:

  • A buffer
  • A string
  • A file-name
  • one of "all", "org-agenda-files", "org-directory", "buffer", or an empty string (which evaluates to the same values as "buffer")
  • a list containing above values

I am also converting all buffer objects to string values to avoid duplicates that are introduced because of the buffer/buffer-name of a file and a file-name being passed.

As a result this function now always returns a list of strings (or at least should, will add tests for these :D).

This is in part due to moving to using completing-read-multiple which returns a list by default. Because of this, I had dropped the listp predicate in the pcase inside the function since now all elements in the list are being processed individually. This in-turn results in the unsafe values for buffers/files being tested in the link safety section never getting to the point where that error gets signalled since they never match any of the values in the current pcase. Which was why I was signalling an error when an invalid value is passed. Does this make sense?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I may have overlooked that functions are a valid input to buffers-files in org-ql-select. Which might be creating a whole bunch of new problems :)

Currently (in the master branch) the following should create a view with the function

(org-ql-search #'a-function-returning-list-of-files '(level 1))

with the value for org-ql-view-buffers-files is set to #'a-function-returning-list-of-files.

If I understand this correctly, this is left as such so refreshing the view would recall the function? (or alternatively the evaluated value can be stored?)

I am not sure how a function would translate to a value in completing-read-mulitple, so I am skipping prompting for that entirely when refreshing a view with a function as a value for org-ql-view-buffers-files.

The safety concern you were referring to before comes from allowing a function to be used as a parameter for org-ql-select? Currently the org-ql-view--expand-buffers-files function would signal an error if used with a function, and when storing a link, the function's evaled value is used for buffers-files.

Does that cover the problem with unsafe values for buffers-files?

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You can see where the error is signaled here:

org-ql/org-ql-view.el

Line 638 in 94f9e6f

(error "CAUTION: Link not opened because unsafe buffers-files parameter detected: %s" buffers-files))

That safety check should be left there, in that function, where links are followed. IIUC, the change you made to the tests would cause that check to not be tested, which could lead to security vulnerabilities in the future.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That check looks at either the value returned by the org-ql-view--expand-buffers-files or the current-buffer. If I understand it correctly, it was there to make sure the value returned by the org-ql-view--expand-buffers-files function is not another function that can get evaluated once passed to org-ql-select. Currently, if I understand when and how org-ql-view--expand-buffers-files gets called, in a valid situation, it only should get values that I had previously mentioned, anything else would result in the error on the new tests being signaled.

If the concern is future changes to the org-ql-view--expand-buffers-files function results in returning a function value, that function can be mocked to make sure the error in

org-ql/org-ql-view.el

Line 638 in 94f9e6f

(error "CAUTION: Link not opened because unsafe buffers-files parameter detected: %s" buffers-files))

get's signaled?


(describe "super-groups parameter"
:var ((quoted-lambda-link "[[org-ql-search:todo:?super-groups%3D%28lambda%20nil%20%28error%20%22UNSAFE%22%29%29]]")
Expand Down Expand Up @@ -2068,7 +2068,7 @@ with keyword arg NOW in PLIST."
(it "Can search a file by filename"
(expect (var-after-link-save-open 'org-ql-view-buffers-files one-filename query
:store-input "M-n M-n RET")
:to-equal one-filename))
:to-equal (list one-filename)))
(it "Can search multiple files by filename"
(expect (var-after-link-save-open 'org-ql-view-buffers-files temp-filenames query
:store-input "M-n M-n RET")
Expand Down Expand Up @@ -2111,7 +2111,84 @@ with keyword arg NOW in PLIST."
(it "Refuses to link to non-file-backed buffer"
(expect (var-after-link-save-open 'org-ql-view-buffers-files link-buffer query
:buffer link-buffer)
:to-throw 'user-error '("Views that search non-file-backed buffers can’t be linked to"))))))
:to-throw 'user-error '("Views that search non-file-backed buffers can’t be linked to"))))
(describe "while completion for files/buffers"
(describe "contracting org-ql-view-buffers-files"
(it "list of files to \"org-agenda-files\""
(spy-on 'org-agenda-files :and-return-value temp-filenames)
(expect (org-ql-view--contract-buffers-files temp-filenames) :to-equal "org-agenda-files"))
(it "list of files to \"org-directory\""
(spy-on 'org-agenda-files :and-return-value '())
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved
;; Also indirectly tests org-ql-search-directories-files
(let ((org-directory temp-dir)) ;; the :var binding does not work? https://github.com/jorgenschaefer/emacs-buttercup/issues/127
(expect (org-ql-view--contract-buffers-files temp-filenames) :to-equal "org-directory")))
(it "to \"buffer\" when passing current-buffer"
(with-current-buffer (org-ql-test-data-buffer "data.org")
(expect (org-ql-view--contract-buffers-files (current-buffer)) :to-equal "buffer")))
(it "to \"org-agenda-files\" from symbol values ('org-agenda-files or #'org-agenda-files)"
(spy-on 'org-agenda-files :and-return-value temp-filenames)
(expect (org-ql-view--contract-buffers-files 'org-agenda-files) :to-equal "org-agenda-files")
(expect (org-ql-view--contract-buffers-files #'org-agenda-files) :to-equal "org-agenda-files"))
(it "arbitarary list of buffers/files"
(let ((value1 '("a.org" "b.org"))
(value2 'a))
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved
(expect (org-ql-view--contract-buffers-files value1) :to-equal value1)
;; If the value does not result to a buffer, file, or string, throws error
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved
(expect (org-ql-view--contract-buffers-files value2) :to-throw))))
(describe "expanding org-ql-view-buffers-files"
(it "returns all buffers with `org-mode' as the major-mode"
(let ((buffers (list (generate-new-buffer "test.org") (generate-new-buffer "test.other"))))
(with-current-buffer (car buffers)
(org-mode))
(spy-on 'buffer-list :and-return-value buffers)
(expect (org-ql-view--expand-buffers-files "all") :to-equal (list (buffer-name (car buffers))))))
(it "returns values of \"org-agenda-files\""
(let ((org-agenda-files (mapcar
(lambda (it)
(buffer-name it))
(list (generate-new-buffer "test1")
(generate-new-buffer "test2")))))
(expect (org-ql-view--expand-buffers-files "org-agenda-files") :to-equal org-agenda-files)))
(it "returns values of \"org-directory\""
;; Also indirectly tests `org-ql-view--expand-buffers-files'
(let ((org-directory temp-dir))
(expect (org-ql-view--expand-buffers-files "org-directory") :to-equal temp-filenames)))
(it "returns the current buffer"
(with-temp-buffer
ahmed-shariff marked this conversation as resolved.
Show resolved Hide resolved
(expect (org-ql-view--expand-buffers-files "buffer") :to-equal (list (buffer-name (current-buffer))))))
(it "returns literal value(s)"
(with-temp-buffer
(expect (org-ql-view--expand-buffers-files (current-buffer)) :to-equal (list (buffer-name (current-buffer)))))
(let ((test-buffer (generate-new-buffer "test")))
(expect (org-ql-view--expand-buffers-files test-buffer) :to-equal (list (buffer-name test-buffer))))
(let ((list-of-numbers '(1 2 3))
(literal-string "random string"))
;; If the value does not result to a buffer, file, or string, throws error
(expect (org-ql-view--expand-buffers-files list-of-numbers) :to-throw)
(expect (org-ql-view--expand-buffers-files literal-string) :to-equal (list literal-string)))))
(describe "testing `org-ql-view--complete-buffers-files'"
(it "returns `org-agenda-files'"
(let ((org-ql-view-buffers-files temp-filenames))
(spy-on 'org-ql-view--contract-buffers-files :and-call-through)
(spy-on 'org-agenda-files :and-return-value temp-filenames)
(spy-on 'completing-read-multiple :and-return-value "org-agenda-files")
(expect (org-ql-view--complete-buffers-files) :to-equal temp-filenames)
(expect 'org-ql-view--contract-buffers-files :to-have-been-called-with temp-filenames)
;; Also testing if the initial values are set correctly
(expect 'completing-read-multiple :to-have-been-called-with "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil "org-agenda-files")))
(it "returns nil"
(let ((org-ql-view-buffers-files nil))
(spy-on 'completing-read-multiple :and-return-value nil)
(expect (org-ql-view--complete-buffers-files) :to-equal nil)
(expect 'completing-read-multiple :to-have-been-called-with "Buffers/Files: "
(list 'buffer 'org-agenda-files 'org-directory 'all)
nil nil nil)))
(it "returna a list of buffers/files"
(let ((list-of-files temp-filenames))
(spy-on 'completing-read-multiple :and-return-value list-of-files)
(expect (org-ql-view--complete-buffers-files) :to-equal list-of-files)))))))

;; MAYBE: Also test `org-ql-views', although I already know it works now.
;; (describe "org-ql-views")
Expand Down