Skip to content

Commit

Permalink
Refactor set-url queries.
Browse files Browse the repository at this point in the history 
Fixes the following issue reported in #3385. Input such as
"github.com/atlas-engineer" must be interpreted as a URL, not as a search query.
  • Loading branch information
@shamazmazum @aadcg
shamazmazum authored and aadcg committed Apr 17, 2024
1 parent 38bff6b commit 14dac1e
Show file tree
Hide file tree
Showing 2 changed files with 40 additions and 62 deletions.
78 changes: 34 additions & 44 deletions source/buffer.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1398,33 +1398,29 @@ Loads the entry with default `prompter:actions-on-return'."))
(:documentation "Structure that processes a new URL query from user input.
Checks whether a valid https or local file URL is requested, in a DWIM fashion."))

(defmethod initialize-instance :after ((query new-url-query)
&key check-dns-p &allow-other-keys)
;; Trim whitespace, in particular to detect URL properly.
(setf (query query) (str:trim (query query)))
(cond
((engine query)
;; First check engine: if set, no need to change anything.
nil)
((valid-url-p (query query)
:check-dns-p nil)
;; Valid URLs should be passed forward.
nil)
((and check-dns-p
(valid-tld-p (query query)))
(setf (query query) (str:concat "https://" (query query))))
;; Rest is for invalid URLs:
((uiop:file-exists-p (query query))
(setf (query query)
(str:concat
"file://"
(uiop:native-namestring
(uiop:ensure-absolute-pathname
(query query) *default-pathname-defaults*)))))
(t
(setf (engine query)
(or (engine query)
(default-search-engine))))))
(defmethod initialize-instance :after ((query new-url-query) &key &allow-other-keys)
(with-slots (query engine) query
;; Trim whitespace, in particular to detect URL properly.
(setf query (str:trim query))
(cond
(engine
;; First check engine: if set, no need to change anything.
nil)
((valid-url-p query :check-tld-p nil)
;; Valid URLs should be passed forward.
nil)
((valid-url-p (str:concat "https://" query) :check-tld-p t)
(setf query (str:concat "https://" query)))
;; Rest is for invalid URLs:
((uiop:file-exists-p query)
(setf query
(str:concat
"file://"
(uiop:native-namestring
(uiop:ensure-absolute-pathname
query *default-pathname-defaults*)))))
(t
(setf engine (or engine (default-search-engine)))))))

(defun encode-url-char (c)
(if (find c '("+" "&" "%") :test #'string=)
Expand All @@ -1449,19 +1445,17 @@ Checks whether a valid https or local file URL is requested, in a DWIM fashion."
(fallback-url (engine query)))
(t (query query)))))

(defun make-completion-query (completion &key engine (check-dns-p t))
(defun make-completion-query (completion &key engine)
(typecase completion
(string (make-instance 'new-url-query
:engine engine
:check-dns-p check-dns-p
:query completion))
:engine engine
:query completion))
(list (make-instance 'new-url-query
:engine engine
:check-dns-p check-dns-p
:query (second completion)
:label (first completion)))))

(defun input->queries (input &key (check-dns-p t) (engine-completion-p))
(defun input->queries (input &key (engine-completion-p))
(let* ((terms (sera:tokens input))
(engines (let ((all-prefixed-engines
(remove-if
Expand All @@ -1477,23 +1471,20 @@ Checks whether a valid https or local file URL is requested, in a DWIM fashion."
(mapcar #'shortcut engines)
:test #'string=))
(list (make-instance 'new-url-query
:query input
:check-dns-p check-dns-p)))
:query input)))
(or (mappend (lambda (engine)
(append
(list (make-instance 'new-url-query
:query (str:join " " (rest terms))
:engine engine
:check-dns-p check-dns-p))
:query (str:join " " (rest terms))
:engine engine))
;; Some engines (I'm looking at you, Wikipedia!)
;; return garbage in response to an empty request.
(when (and engine-completion-p
(search-auto-complete-p (current-buffer))
(completion-function engine)
(rest terms))
(mapcar (rcurry #'make-completion-query
:engine engine
:check-dns-p check-dns-p)
:engine engine)
(with-protect ("Error while completing search: ~a" :condition)
(funcall (completion-function engine)
(str:join " " (rest terms))))))))
Expand All @@ -1506,8 +1497,7 @@ Checks whether a valid https or local file URL is requested, in a DWIM fashion."
(completion (completion-function engine))
(all-terms (str:join " " terms)))
(mapcar (rcurry #'make-completion-query
:engine engine
:check-dns-p check-dns-p)
:engine engine)
(with-protect ("Error while completing default search: ~a" :condition)
(funcall (completion-function engine) all-terms))))))))

Expand All @@ -1516,14 +1506,14 @@ Checks whether a valid https or local file URL is requested, in a DWIM fashion."
(prompter:filter-preprocessor
(lambda (suggestions source input)
(declare (ignore suggestions source))
(input->queries input :check-dns-p t :engine-completion-p nil)))
(input->queries input :engine-completion-p nil)))
(prompter:filter-postprocessor
(lambda (suggestions source input)
(declare (ignore source))
;; Avoid long computations until the user has finished the query.
(sleep 0.15)
(append suggestions
(input->queries input :check-dns-p nil :engine-completion-p t))))
(input->queries input :engine-completion-p t))))
(prompter:filter nil)
(prompter:actions-on-return #'buffer-load*))
(:export-class-name-p t)
Expand Down
24 changes: 6 additions & 18 deletions source/urls.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -190,28 +190,16 @@ Usually means that either:
(sera:true (find scheme (browser-schemes *browser*) :test #'string=)))

(export-always 'valid-url-p)
(defun valid-url-p (url &key (check-dns-p t))
(defun valid-url-p (url &key (check-tld-p t))
"Return non-nil when URL is a valid URL.
The domain name existence is verified only if CHECK-DNS-P is T. Domain name
validation may take significant time since it looks up the DNS."
When CHECK-TLD-P is non-nil, check if the host is a known TLD."
(let ((%url (ignore-errors (quri:uri url))))
(and %url
(valid-scheme-p (quri:uri-scheme %url))
;; `new-url-query' automatically falls back to HTTPS if it makes for
;; a valid URL:
(or (not (quri:uri-http-p %url))
(and
;; "http:/https://www.iana.org/assignments/special-use-domain-names/special-use-domain-names.xml/" does not have a host.
;; A valid URL may have an empty domain, e.g. http://192.168.1.1.
(quri:uri-host %url)
(or
(not check-dns-p)
(valid-tld-p (quri:uri-host %url))
;; "http://algo" has the "algo" hostname but it's probably invalid
;; unless it's found on the local network. We also need to
;; support "localhost" and the current system hostname.
(or (quri:ip-addr-p (quri:uri-host %url))
(lookup-hostname (quri:uri-host %url)))))))))
(if (and check-tld-p (quri:uri-http-p %url))
(or (quri:ip-addr-p (quri:uri-host %url))
(valid-tld-p (quri:uri-domain %url)))
t))))

(-> ensure-url (t) quri:uri)
(export-always 'ensure-url)
Expand Down

0 comments on commit 14dac1e

Please sign in to comment.