From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Fri, 13 Apr 2018 14:38:10 +0000 (+0200)
Subject: Make Unicode domain names work again in URL after recent changes
X-Git-Tag: emacs-27.0.90~5252
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4a6302330384ad89bcfccce6b563eb5462b753a9;p=emacs.git

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

diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 57ac26fc741..cea6c25112e 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 f55f5486b62..19e0c6421fb 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 45e887b348d..bb3e76997a8 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 77e015068a3..b2064484809 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