aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLars Ingebrigtsen2018-04-13 16:38:10 +0200
committerLars Ingebrigtsen2018-04-13 16:38:10 +0200
commit4a6302330384ad89bcfccce6b563eb5462b753a9 (patch)
tree2695c81d4681e5e62fbbde9dbd9fd68707423f35
parent1fd104d30a8985e1f6962eb325207efad96273b6 (diff)
downloademacs-4a6302330384ad89bcfccce6b563eb5462b753a9.tar.gz
emacs-4a6302330384ad89bcfccce6b563eb5462b753a9.zip
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.
-rw-r--r--lisp/net/gnutls.el4
-rw-r--r--lisp/net/network-stream.el3
-rw-r--r--lisp/url/url-http.el47
-rw-r--r--lisp/url/url-util.el2
4 files changed, 29 insertions, 27 deletions
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."
154 (cons 'gnutls-x509pki 154 (cons 'gnutls-x509pki
155 (gnutls-boot-parameters 155 (gnutls-boot-parameters
156 :type 'gnutls-x509pki 156 :type 'gnutls-x509pki
157 :hostname host)))))) 157 :hostname (puny-encode-domain host)))))))
158 (if nowait 158 (if nowait
159 process 159 process
160 (gnutls-negotiate :process process 160 (gnutls-negotiate :process process
161 :type 'gnutls-x509pki 161 :type 'gnutls-x509pki
162 :hostname host)))) 162 :hostname (puny-encode-domain host)))))
163 163
164(define-error 'gnutls-error "GnuTLS error") 164(define-error 'gnutls-error "GnuTLS error")
165 165
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')."
295 (if (gnutls-available-p) 295 (if (gnutls-available-p)
296 (let ((cert (network-stream-certificate host service parameters))) 296 (let ((cert (network-stream-certificate host service parameters)))
297 (condition-case nil 297 (condition-case nil
298 (gnutls-negotiate :process stream :hostname host 298 (gnutls-negotiate :process stream
299 :hostname (puny-encode-domain host)
299 :keylist (and cert (list cert))) 300 :keylist (and cert (list cert)))
300 ;; If we get a gnutls-specific error (for instance if 301 ;; If we get a gnutls-specific error (for instance if
301 ;; the certificate the server gives us is completely 302 ;; 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.")
244 (when url-current-lastloc 244 (when url-current-lastloc
245 (if (not (url-p url-current-lastloc)) 245 (if (not (url-p url-current-lastloc))
246 (setq url-current-lastloc (url-generic-parse-url url-current-lastloc))) 246 (setq url-current-lastloc (url-generic-parse-url url-current-lastloc)))
247 (let* ((referer url-current-lastloc) 247 (let ((referer (copy-sequence url-current-lastloc)))
248 (referer-string (url-recreate-url referer))) 248 (setf (url-host referer) (puny-encode-domain (url-host referer)))
249 (when (and (not (memq url-privacy-level '(low high paranoid))) 249 (let ((referer-string (url-recreate-url referer)))
250 (not (and (listp url-privacy-level) 250 (when (and (not (memq url-privacy-level '(low high paranoid)))
251 (memq 'lastloc url-privacy-level)))) 251 (not (and (listp url-privacy-level)
252 ;; url-privacy-level allows referer. But url-lastloc-privacy-level 252 (memq 'lastloc url-privacy-level))))
253 ;; may restrict who we send it to. 253 ;; url-privacy-level allows referer. But url-lastloc-privacy-level
254 (cl-case url-lastloc-privacy-level 254 ;; may restrict who we send it to.
255 (host-match 255 (cl-case url-lastloc-privacy-level
256 (let ((referer-host (url-host referer)) 256 (host-match
257 (url-host (url-host url))) 257 (let ((referer-host (url-host referer))
258 (when (string= referer-host url-host) 258 (url-host (url-host url)))
259 referer-string))) 259 (when (string= referer-host url-host)
260 (domain-match 260 referer-string)))
261 (let ((referer-domain (url-domain referer)) 261 (domain-match
262 (url-domain (url-domain url))) 262 (let ((referer-domain (url-domain referer))
263 (when (and referer-domain 263 (url-domain (url-domain url)))
264 url-domain 264 (when (and referer-domain
265 (string= referer-domain url-domain)) 265 url-domain
266 referer-string))) 266 (string= referer-domain url-domain))
267 (otherwise 267 referer-string)))
268 referer-string)))))) 268 (otherwise
269 referer-string)))))))
269 270
270;; Building an HTTP request 271;; Building an HTTP request
271(defun url-http-user-agent-string () 272(defun url-http-user-agent-string ()
@@ -298,7 +299,7 @@ as the Referer-header (subject to `url-privacy-level'."
298 'url-http-proxy-basic-auth-storage)) 299 'url-http-proxy-basic-auth-storage))
299 (url-get-authentication url-http-proxy nil 'any nil)))) 300 (url-get-authentication url-http-proxy nil 'any nil))))
300 (real-fname (url-filename url-http-target-url)) 301 (real-fname (url-filename url-http-target-url))
301 (host (url-http--encode-string (url-host url-http-target-url))) 302 (host (url-host url-http-target-url))
302 (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers)) 303 (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
303 nil 304 nil
304 (url-get-authentication (or 305 (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."
645 ;; 645 ;;
646 ;; Domain delegations change rarely enough that we won't bother with 646 ;; Domain delegations change rarely enough that we won't bother with
647 ;; cache invalidation, I think. 647 ;; cache invalidation, I think.
648 (let* ((host-parts (split-string (url-host url) "\\.")) 648 (let* ((host-parts (split-string (puny-encode-domain (url-host url)) "\\."))
649 (result (gethash host-parts url--domain-cache 'not-found))) 649 (result (gethash host-parts url--domain-cache 'not-found)))
650 (when (eq result 'not-found) 650 (when (eq result 'not-found)
651 (setq result 651 (setq result