Fix SET-URL

nyxt.asd

@@ -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

source/buffer.lisp

@@ -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=)
@@ -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
@@ -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))))))))
@@ -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))))))))
 
@@ -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)

source/urls.lisp

@@ -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
@@ -190,28 +179,19 @@ 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))
-  "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."
+(defun valid-url-p (url &key (check-tld-p t))
+  "Return non-nil when URL is a valid URL. CHECK-TLD-P also checks if
+the host has 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
+                  ;; `new-url-query' automatically falls back to HTTPS
+                  ;; if it makes for a valid URL:
+                  (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)

tests/offline/urls.lisp

@@ -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