emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master e859acb: Rewrite `url-domain' to avoid network traf


From: Lars Ingebrigtsen
Subject: [Emacs-diffs] master e859acb: Rewrite `url-domain' to avoid network traffic
Date: Tue, 1 May 2018 08:26:42 -0400 (EDT)

branch: master
commit e859acb11cacd0c661b730d43151f77281e17d7d
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    Rewrite `url-domain' to avoid network traffic
    
    * lisp/url/url-util.el (url-domain): Don't talk DNS to determine
    the domain, because this is slow.
    
    * test/lisp/url/url-util-tests.el (url-domain-tests): Add tests
    for `url-domain'.
---
 lisp/url/url-util.el            | 45 ++++++++++++++++++-----------------------
 test/lisp/url/url-util-tests.el | 12 +++++++++++
 2 files changed, 32 insertions(+), 25 deletions(-)

diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 51c5624..9bfbca6 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -628,34 +628,29 @@ Creates FILE and its parent directories if they do not 
exist."
      (set-file-modes file #o0600))))
 
 (autoload 'puny-encode-domain "puny")
-(autoload 'dns-query "dns")
-
-(defvar url--domain-cache (make-hash-table :test 'equal :size 17)
-  "Cache to minimize dns lookups.")
+(autoload 'url-domsuf-cookie-allowed-p "url-domsuf")
 
 ;;;###autoload
 (defun url-domain (url)
-  "Return the domain of the host of the url, or nil if url does
-not contain a registered name."
-  ;; Determining the domain of a name can not be done with simple
-  ;; textual manipulations.  a.b.c is either host a in domain b.c
-  ;; (www.google.com), or domain a.b.c with no separate host
-  ;; (bbc.co.uk).  Instead of guessing based on tld (which in any case
-  ;; may be inaccurate in the face of subdelegations), we look for
-  ;; domain delegations in DNS.
-  ;;
-  ;; Domain delegations change rarely enough that we won't bother with
-  ;; cache invalidation, I think.
-  (let* ((host-parts (split-string (puny-encode-domain (url-host url)) "\\."))
-         (result (gethash host-parts url--domain-cache 'not-found)))
-    (when (eq result 'not-found)
-      (setq result
-            (cl-loop for parts on host-parts
-                     for dom = (mapconcat #'identity parts ".")
-                     when (dns-query dom 'SOA)
-                     return dom))
-      (puthash host-parts result url--domain-cache))
-    result))
+  "Return the domain of the host of the url.
+Return nil if this can't be determined."
+  (let* ((host (puny-encode-domain (url-host url)))
+         (parts (nreverse (split-string host "\\.")))
+         (candidate (pop parts))
+         found)
+    ;; IP addresses aren't domains.
+    (when (string-match "\\`[0-9.]+\\'" host)
+      (setq parts nil))
+    ;; We assume that the top-level domain is never an appropriate
+    ;; thing as "the domain", so we start at the next one (eg.
+    ;; "fsf.org").
+    (while (and parts
+                (not (setq found
+                           (url-domsuf-cookie-allowed-p
+                            (setq candidate (concat (pop parts) "."
+                                                    candidate))))))
+      )
+    (and found candidate)))
 
 (provide 'url-util)
 
diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el
index ee97d97..2e2875a 100644
--- a/test/lisp/url/url-util-tests.el
+++ b/test/lisp/url/url-util-tests.el
@@ -46,6 +46,18 @@
                    ("key2" "val2")
                    ("key1" "val1")))))
 
+(ert-deftest url-domain-tests ()
+  (should (equal (url-domain (url-generic-parse-url "http://www.fsf.co.uk";))
+                 "fsf.co.uk"))
+  (should (equal (url-domain (url-generic-parse-url "http://fsf.co.uk";))
+                 "fsf.co.uk"))
+  (should (equal (url-domain (url-generic-parse-url "http://co.uk";))
+                 nil))
+  (should (equal (url-domain (url-generic-parse-url "http://www.fsf.com";))
+                 "fsf.com"))
+  (should (equal (url-domain (url-generic-parse-url "http://192.168.0.1";))
+                 nil)))
+
 (provide 'url-util-tests)
 
 ;;; url-util-tests.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]