Skip to content

Commit

Permalink
Merge remote-tracking branch 'gh/fix-set-url'
Browse files Browse the repository at this point in the history
  • Loading branch information
@aadcg
aadcg committed Apr 17, 2024
2 parents 38bff6b + ec082a3 commit c6dd36a
Show file tree
Hide file tree
Showing 5 changed files with 54 additions and 78 deletions.
4 changes: 0 additions & 4 deletions nyxt.asd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,10 +2,6 @@
;;;; SPDX-License-Identifier: BSD-3-Clause

#-asdf3.1 (error "Nyxt requires ASDF 3.1.2")
#+sbcl
(progn
(sb-ext:assert-version->= 2 0 0)
(require 'sb-bsd-sockets))

;; WARNING: We _must_ declare the translation host or else ASDF won't recognize
;; the pathnames as logical-pathnames, thus returning the system directory
Expand Down
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
5 changes: 5 additions & 0 deletions source/changelog.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,11 @@ elements are scaled accordingly.")
(:li "When on pre-release, push " (:code "X-pre-release")
" feature in addition to " (:code "X-pre-release-N") "one."))

(define-version "3.11.7"
(:nsection :title "Bug fixes"
(:ul
(:li "Fix query handling when invoking command" (:nxref :command 'set-url) "."))))

(define-version "3.11.6"
(:nsection :title "Bug fixes"
(:ul
Expand Down
35 changes: 6 additions & 29 deletions source/urls.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -137,17 +137,6 @@ signatures."
(setf (gethash scheme-name *schemes*)
(list callback error-callback)))

(defmemo lookup-hostname (name)
"Resolve hostname NAME and memoize the result."
;; `sb-bsd-sockets:get-host-by-name' may signal a `ns-try-again-condition' which is
;; not an error, so we can't use `ignore-errors' here.
(handler-case
#+sbcl
(sb-bsd-sockets:get-host-by-name name)
#-sbcl
(iolib/sockets:lookup-hostname name)
(t () nil)))

(export-always 'valid-tld-p)
(defun valid-tld-p (hostname)
"Return NIL if HOSTNAME does not include a valid TLD as determined by the
Expand Down Expand Up @@ -190,28 +179,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
10 changes: 9 additions & 1 deletion tests/offline/urls.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,15 @@
;; "valid syntax but unknown scheme"
(assert-equality #'quri:uri=
(quri:uri "https://search.atlas.engineer/searxng/search?q=foo:blank")
(url (first (nyxt::input->queries "foo:blank")))))
(url (first (nyxt::input->queries "foo:blank"))))
;; "'Partial' URLs without scheme but with path"
(assert-equality #'quri:uri=
(quri:uri "https://github.com/atlas-engineer")
(url (first (nyxt::input->queries "github.com/atlas-engineer"))))
;; IP address without scheme
(assert-equality #'quri:uri=
(quri:uri "https://127.0.0.1")
(url (first (nyxt::input->queries "127.0.0.1")))))

(define-test nyxt-urls ()
(assert-error 'simple-error
Expand Down

0 comments on commit c6dd36a

Please sign in to comment.