[Emacs-diffs] master 4a63023 1/3: Make Unicode domain names work again in URL after recent changes

[Lars Ingebrigtsen]

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

    Make Unicode domain names work again in URL after recent changes
    
    * lisp/net/gnutls.el (open-gnutls-stream): IDNA-encode hostnames
    before passing them on to gnutls for verification.
    
    * lisp/net/network-stream.el (network-stream-open-starttls): Ditto.
    
    * lisp/url/url-http.el (url-http--get-referer): Be IDNA-aware.
    (url-http-create-request): Don't de-Unicodify host names, because
    they may be IDNA names (that are later encoded).
    
    * lisp/url/url-util.el (url-domain): Be IDNA-aware when doing
    domain name computations.
---
 lisp/net/gnutls.el         |  4 ++--
 lisp/net/network-stream.el |  3 ++-
 lisp/url/url-http.el       | 47 +++++++++++++++++++++++-----------------------
 lisp/url/url-util.el       |  2 +-
 4 files changed, 29 insertions(+), 27 deletions(-)

diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 57ac26f..cea6c25 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -154,12 +154,12 @@ trust and key files, and priority string."
                        (cons 'gnutls-x509pki
                              (gnutls-boot-parameters
                               :type 'gnutls-x509pki
-                              :hostname host))))))
+                              :hostname (puny-encode-domain host)))))))
     (if nowait
         process
       (gnutls-negotiate :process process
                         :type 'gnutls-x509pki
-                        :hostname host))))
+                        :hostname (puny-encode-domain host)))))
 
 (define-error 'gnutls-error "GnuTLS error")
 
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index f55f548..19e0c64 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -295,7 +295,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
        (if (gnutls-available-p)
            (let ((cert (network-stream-certificate host service parameters)))
              (condition-case nil
-                 (gnutls-negotiate :process stream :hostname host
+                 (gnutls-negotiate :process stream
+                                    :hostname (puny-encode-domain host)
                                    :keylist (and cert (list cert)))
                ;; If we get a gnutls-specific error (for instance if
                ;; the certificate the server gives us is completely
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 45e887b..bb3e769 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -244,28 +244,29 @@ request.")
   (when url-current-lastloc
     (if (not (url-p url-current-lastloc))
         (setq url-current-lastloc (url-generic-parse-url url-current-lastloc)))
-    (let* ((referer url-current-lastloc)
-           (referer-string (url-recreate-url referer)))
-      (when (and (not (memq url-privacy-level '(low high paranoid)))
-                 (not (and (listp url-privacy-level)
-                           (memq 'lastloc url-privacy-level))))
-        ;; url-privacy-level allows referer.  But url-lastloc-privacy-level
-        ;; may restrict who we send it to.
-        (cl-case url-lastloc-privacy-level
-          (host-match
-           (let ((referer-host (url-host referer))
-                 (url-host (url-host url)))
-             (when (string= referer-host url-host)
-               referer-string)))
-          (domain-match
-           (let ((referer-domain (url-domain referer))
-                 (url-domain (url-domain url)))
-             (when (and referer-domain
-                        url-domain
-                        (string= referer-domain url-domain))
-               referer-string)))
-          (otherwise
-           referer-string))))))
+    (let ((referer (copy-sequence url-current-lastloc)))
+      (setf (url-host referer) (puny-encode-domain (url-host referer)))
+      (let ((referer-string (url-recreate-url referer)))
+        (when (and (not (memq url-privacy-level '(low high paranoid)))
+                   (not (and (listp url-privacy-level)
+                             (memq 'lastloc url-privacy-level))))
+          ;; url-privacy-level allows referer.  But url-lastloc-privacy-level
+          ;; may restrict who we send it to.
+          (cl-case url-lastloc-privacy-level
+            (host-match
+             (let ((referer-host (url-host referer))
+                   (url-host (url-host url)))
+               (when (string= referer-host url-host)
+                 referer-string)))
+            (domain-match
+             (let ((referer-domain (url-domain referer))
+                   (url-domain (url-domain url)))
+               (when (and referer-domain
+                          url-domain
+                          (string= referer-domain url-domain))
+                 referer-string)))
+            (otherwise
+             referer-string)))))))
 
 ;; Building an HTTP request
 (defun url-http-user-agent-string ()
@@ -298,7 +299,7 @@ as the Referer-header (subject to `url-privacy-level'."
                              'url-http-proxy-basic-auth-storage))
                         (url-get-authentication url-http-proxy nil 'any nil))))
         (real-fname (url-filename url-http-target-url))
-        (host (url-http--encode-string (url-host url-http-target-url)))
+        (host (url-host url-http-target-url))
         (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
                   nil
                 (url-get-authentication (or
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 77e0150..b206448 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -645,7 +645,7 @@ not contain a registered name."
   ;;
   ;; Domain delegations change rarely enough that we won't bother with
   ;; cache invalidation, I think.
-  (let* ((host-parts (split-string (url-host url) "\\."))
+  (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