Merge 'master' into noverlay

1 files changed, 336 insertions, 255 deletions

diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 51f158e5c21..94ef156108c 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1,6 +1,6 @@
 ;;; url-http.el --- HTTP retrieval routines  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1999, 2001, 2004-2017 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2004-2022 Free Software Foundation, Inc.
 
 ;; Author: Bill Perry <wmperry@gnu.org>
 ;; Maintainer: emacs-devel@gnu.org
@@ -36,6 +36,7 @@
 (defvar url-current-object)
 (defvar url-http-after-change-function)
 (defvar url-http-chunked-counter)
+(defvar url-http-chunked-last-crlf-missing)
 (defvar url-http-chunked-length)
 (defvar url-http-chunked-start)
 (defvar url-http-connection-opened)
@@ -54,6 +55,7 @@
 (defvar url-http-target-url)
 (defvar url-http-transfer-encoding)
 (defvar url-show-status)
+(defvar url-http-referer)
 
 (require 'url-gw)
 (require 'url-parse)
@@ -65,7 +67,7 @@
 
 (defconst url-http-default-port 80 "Default HTTP port.")
 (defconst url-http-asynchronous-p t "HTTP retrievals are asynchronous.")
-(defalias 'url-http-expand-file-name 'url-default-expander)
+(defalias 'url-http-expand-file-name #'url-default-expander)
 
 (defvar url-http-real-basic-auth-storage nil)
 (defvar url-http-proxy-basic-auth-storage nil)
@@ -149,16 +151,7 @@ request.")
 ;; These routines will allow us to implement persistent HTTP
 ;; connections.
 (defsubst url-http-debug (&rest args)
-  (if quit-flag
-      (let ((proc (get-buffer-process (current-buffer))))
-	;; The user hit C-g, honor it!  Some things can get in an
-	;; incredibly tight loop (chunked encoding)
-	(if proc
-	    (progn
-	      (set-process-sentinel proc nil)
-	      (set-process-filter proc nil)))
-	(error "Transfer interrupted!")))
-  (apply 'url-debug 'http args))
+  (apply #'url-debug 'http args))
 
 (defun url-http-mark-connection-as-busy (host port proc)
   (url-http-debug "Marking connection as busy: %s:%d %S" host port proc)
@@ -233,11 +226,40 @@ request.")
         (os-info (unless (and (listp url-privacy-level)
                               (memq 'os url-privacy-level))
                    (format "(%s; %s)" url-system-type url-os-type)))
-        (url-info (format "URL/%s" url-version)))
+        (url-info "URL/Emacs"))
     (string-join (delq nil (list package-info url-info
                                  emacs-info os-info))
                  " ")))
 
+(defun url-http--get-referer (url)
+  (url-http-debug "getting referer from buffer: buffer:%S target-url:%S lastloc:%S" (current-buffer) url url-current-lastloc)
+  (when url-current-lastloc
+    (if (not (url-p url-current-lastloc))
+        (setq url-current-lastloc (url-generic-parse-url url-current-lastloc)))
+    (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 ()
   "Compute a User-Agent string.
@@ -254,8 +276,9 @@ The string is based on `url-privacy-level' and `url-user-agent'."
                 ((eq url-user-agent 'default) (url-http--user-agent-default-string))))))
     (if ua-string (format "User-Agent: %s\r\n" (string-trim ua-string)) "")))
 
-(defun url-http-create-request (&optional ref-url)
-  "Create an HTTP request for `url-http-target-url', referred to by REF-URL."
+(defun url-http-create-request ()
+  "Create an HTTP request for `url-http-target-url'.
+Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')."
   (let* ((extra-headers)
 	 (request nil)
 	 (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
@@ -268,13 +291,14 @@ The string is based on `url-privacy-level' and `url-user-agent'."
 			      '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
 					  (and (boundp 'proxy-info)
 					       proxy-info)
-					  url-http-target-url) nil 'any nil))))
+					  url-http-target-url) nil 'any nil)))
+         (ref-url (url-http--encode-string url-http-referer)))
     (if (equal "" real-fname)
 	(setq real-fname "/"))
     (setq no-cache (and no-cache (string-match "no-cache" no-cache)))
@@ -288,12 +312,6 @@ The string is based on `url-privacy-level' and `url-user-agent'."
 					   (string= ref-url "")))
 	(setq ref-url nil))
 
-    ;; We do not want to expose the referrer if the user is paranoid.
-    (if (or (memq url-privacy-level '(low high paranoid))
-	    (and (listp url-privacy-level)
-		 (memq 'lastloc url-privacy-level)))
-	(setq ref-url nil))
-
     ;; url-http-extra-headers contains an assoc-list of
     ;; header/value pairs that we need to put into the request.
     (setq extra-headers (mapconcat
@@ -312,7 +330,13 @@ The string is based on `url-privacy-level' and `url-user-agent'."
              ;; The request
              (or url-http-method "GET") " "
              (url-http--encode-string
-              (if using-proxy (url-recreate-url url-http-target-url) real-fname))
+              (if (and using-proxy
+                       ;; Bug#35969.
+                       (not (equal "https" (url-type url-http-target-url))))
+                  (let ((url (copy-sequence url-http-target-url)))
+                    (setf (url-host url) (puny-encode-domain (url-host url)))
+                    (url-recreate-url url))
+                real-fname))
              " HTTP/" url-http-version "\r\n"
              ;; Version of MIME we speak
              "MIME-Version: 1.0\r\n"
@@ -329,9 +353,11 @@ The string is based on `url-privacy-level' and `url-user-agent'."
                      (url-scheme-get-property
                       (url-type url-http-target-url) 'default-port))
                  (format
-                  "Host: %s:%d\r\n" (puny-encode-domain host)
+                  "Host: %s:%d\r\n" (url-http--encode-string
+                                     (puny-encode-domain host))
                   (url-port url-http-target-url))
-               (format "Host: %s\r\n" (puny-encode-domain host)))
+               (format "Host: %s\r\n"
+                       (url-http--encode-string (puny-encode-domain host))))
              ;; Who its from
              (if url-personal-mail-address
                  (concat
@@ -434,49 +460,57 @@ Return the number of characters removed."
 	auth
 	(strength 0))
 
-    ;; find strongest supported auth
-    (dolist (this-auth auths)
-      (setq this-auth (url-eat-trailing-space
-		       (url-strip-leading-spaces
-			this-auth)))
-      (let* ((this-type
-	      (downcase (if (string-match "[ \t]" this-auth)
-                            (substring this-auth 0 (match-beginning 0))
-                          this-auth)))
-	     (registered (url-auth-registered this-type))
-	     (this-strength (cddr registered)))
-	(when (and registered (> this-strength strength))
-	  (setq auth this-auth
-		type this-type
-		strength this-strength))))
-
-    (if (not (url-auth-registered type))
-	(progn
-	  (widen)
-	  (goto-char (point-max))
-	  (insert "<hr>Sorry, but I do not know how to handle " (or type auth url "")
-		  " authentication.  If you'd like to write it,"
-		  " please use M-x report-emacs-bug RET.<hr>")
-          ;; We used to set a `status' var (declared "special") but I can't
-          ;; find the corresponding let-binding, so it's probably an error.
-          ;; FIXME: Maybe it was supposed to set `success', i.e. to return t?
-          ;; (setq status t)
-          nil) ;; Not success yet.
-
-      (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth)))
-	     (auth (url-get-authentication auth-url
-					   (cdr-safe (assoc "realm" args))
-					   type t args)))
-	(if (not auth)
-            t                           ;Success.
-	  (push (cons (if proxy "Proxy-Authorization" "Authorization") auth)
-		url-http-extra-headers)
-	  (let ((url-request-method url-http-method)
-		(url-request-data url-http-data)
-		(url-request-extra-headers url-http-extra-headers))
-	    (url-retrieve-internal url url-callback-function
-				   url-callback-arguments))
-          nil))))) ;; Not success yet.
+    ;; If we're here, then we got a 40x Unauthorized response from the
+    ;; server.  If we already have "Authorization" in the extra
+    ;; headers, then this means that we've already tried sending
+    ;; credentials to the server, and they were wrong, so just give
+    ;; up.
+    (let ((authorization (assoc "Authorization" url-http-extra-headers)))
+      (if (and authorization
+               (not (string-match "^NTLM " (cdr authorization)))) ;Bug#43566
+          t ;; Instruct caller to signal an error.  Bug#50511
+        ;; Find strongest supported auth.
+        (dolist (this-auth auths)
+          (setq this-auth (string-trim this-auth))
+          (let* ((this-type
+                  (downcase (if (string-match "[ \t]" this-auth)
+                                (substring this-auth 0 (match-beginning 0))
+                              this-auth)))
+                 (registered (url-auth-registered this-type))
+                 (this-strength (cddr registered)))
+            (when (and registered (> this-strength strength))
+              (setq auth this-auth
+                    type this-type
+                    strength this-strength))))
+
+        (if (not (url-auth-registered type))
+            (progn
+              (widen)
+              (goto-char (point-max))
+              (insert "<hr>Sorry, but I do not know how to handle "
+                      (or type auth url "")
+                      " authentication.  If you'd like to write it,"
+                      " please use M-x report-emacs-bug RET.<hr>")
+              ;; We used to set a `status' var (declared "special") but I can't
+              ;; find the corresponding let-binding, so it's probably an error.
+              ;; FIXME: Maybe it was supposed to set `success', i.e. to return t?
+              ;; (setq status t)
+              nil) ;; Not success yet.
+
+          (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth)))
+                 (auth (url-get-authentication auth-url
+                                               (cdr-safe (assoc "realm" args))
+                                               type t args)))
+            (if (not auth)
+                t                           ;Success.
+              (push (cons (if proxy "Proxy-Authorization" "Authorization") auth)
+                    url-http-extra-headers)
+              (let ((url-request-method url-http-method)
+                    (url-request-data url-http-data)
+                    (url-request-extra-headers url-http-extra-headers))
+                (url-retrieve-internal url url-callback-function
+                                       url-callback-arguments))
+              nil))))))) ;; Not success yet.
 
 (defun url-http-parse-response ()
   "Parse just the response code."
@@ -485,11 +519,11 @@ Return the number of characters removed."
   (url-http-debug "url-http-parse-response called in (%s)" (buffer-name))
   (goto-char (point-min))
   (skip-chars-forward " \t\n")		; Skip any blank crap
-  (skip-chars-forward "HTTP/")		; Skip HTTP Version
+  (skip-chars-forward "/HPT")		; Skip HTTP Version "HTTP/".
   (setq url-http-response-version
 	(buffer-substring (point)
 			  (progn
-			    (skip-chars-forward "[0-9].")
+			    (skip-chars-forward "0-9.")
 			    (point))))
   (setq url-http-response-status (read (current-buffer))))
 
@@ -511,6 +545,24 @@ work correctly."
 (declare-function gnutls-peer-status "gnutls.c" (proc))
 (declare-function gnutls-negotiate "gnutls.el" t t)
 
+(defun url-http--insert-file-helper (buffer url &optional visit)
+  (with-current-buffer buffer
+    (when (bound-and-true-p url-http-response-status)
+      ;; Don't signal an error if VISIT is non-nil, because
+      ;; 'insert-file-contents' doesn't.  This is required to
+      ;; support, e.g., 'browse-url-emacs', which is a fancy way of
+      ;; visiting the HTML source of a URL: in that case, we want to
+      ;; display a file buffer even if the URL does not exist and
+      ;; 'url-retrieve-synchronously' returns 404 or whatever.
+      (unless (or visit
+                  (or (and (>= url-http-response-status 200)
+                           (< url-http-response-status 300))
+                      (= url-http-response-status 304))) ; "Not modified"
+        (let ((desc (nth 2 (assq url-http-response-status url-http-codes))))
+          (kill-buffer buffer)
+          ;; Signal file-error per bug#16733.
+          (signal 'file-error (list url desc)))))))
+
 (defun url-http-parse-headers ()
  "Parse and handle HTTP specific headers.
 Return t if and only if the current buffer is still active and
@@ -535,6 +587,13 @@ should be shown to the user."
   (url-http-debug "url-http-parse-headers called in (%s)" (buffer-name))
   (url-http-parse-response)
   (mail-narrow-to-head)
+  (when url-debug
+    (save-excursion
+      (goto-char (point-min))
+      (while (not (eobp))
+        (url-http-debug "Response: %s"
+                        (buffer-substring (point) (line-end-position)))
+        (forward-line 1))))
   ;;(narrow-to-region (point-min) url-http-end-of-headers)
   (let ((connection (mail-fetch-field "Connection")))
     ;; In HTTP 1.0, keep the connection only if there is a
@@ -585,7 +644,7 @@ should be shown to the user."
        ;; 206 Partial content
        ;; 207 Multi-status (Added by DAV)
        (pcase status-symbol
-	 ((or `no-content `reset-content)
+	 ((or 'no-content 'reset-content)
 	  ;; No new data, just stay at the same document
 	  (url-mark-buffer-as-dead buffer))
 	 (_
@@ -606,7 +665,7 @@ should be shown to the user."
        (let ((redirect-uri (or (mail-fetch-field "Location")
 			       (mail-fetch-field "URI"))))
 	 (pcase status-symbol
-	   (`multiple-choices	    ; 300
+	   ('multiple-choices	    ; 300
 	    ;; Quoth the spec (section 10.3.1)
 	    ;; -------------------------------
 	    ;; The requested resource corresponds to any one of a set of
@@ -623,40 +682,38 @@ should be shown to the user."
 	    ;; We do not support agent-driven negotiation, so we just
 	    ;; redirect to the preferred URI if one is provided.
 	    nil)
-           (`see-other			; 303
+           ('found			; 302
+	    ;; 302 Found was ambiguously defined in the standards, but
+	    ;; it's now recommended that it's treated like 303 instead
+	    ;; of 307, since that's what most servers expect.
+	    (setq url-http-method "GET"
+		  url-http-data nil))
+           ('see-other			; 303
 	    ;; The response to the request can be found under a different
 	    ;; URI and SHOULD be retrieved using a GET method on that
 	    ;; resource.
 	    (setq url-http-method "GET"
 		  url-http-data nil))
-	   (`not-modified		; 304
+	   ('not-modified		; 304
 	    ;; The 304 response MUST NOT contain a message-body.
 	    (url-http-debug "Extracting document from cache... (%s)"
 			    (url-cache-create-filename (url-view-url t)))
 	    (url-cache-extract (url-cache-create-filename (url-view-url t)))
 	    (setq redirect-uri nil
 		  success t))
-	   (`use-proxy			; 305
+	   ('use-proxy			; 305
 	    ;; The requested resource MUST be accessed through the
 	    ;; proxy given by the Location field.  The Location field
 	    ;; gives the URI of the proxy.  The recipient is expected
 	    ;; to repeat this single request via the proxy.  305
 	    ;; responses MUST only be generated by origin servers.
-	    (error "Redirection thru a proxy server not supported: %s"
+	    (error "Redirection through a proxy server not supported: %s"
 		   redirect-uri))
 	   (_
 	    ;; Treat everything like '300'
 	    nil))
 	 (when redirect-uri
-	   ;; Clean off any whitespace and/or <...> cruft.
-	   (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri)
-	       (setq redirect-uri (match-string 1 redirect-uri)))
-	   (if (string-match "^<\\(.*\\)>$" redirect-uri)
-	       (setq redirect-uri (match-string 1 redirect-uri)))
-
-	   ;; Some stupid sites (like sourceforge) send a
-	   ;; non-fully-qualified URL (ie: /), which royally confuses
-	   ;; the URL library.
+	   ;; Handle relative redirect URIs.
 	   (if (not (string-match url-nonrelative-link redirect-uri))
                ;; Be careful to use the real target URL, otherwise we may
                ;; compute the redirection relative to the URL of the proxy.
@@ -695,12 +752,12 @@ should be shown to the user."
 		   ;; without changing the API.  Instead url-retrieve should
 		   ;; either simply not return the "destination" buffer, or it
 		   ;; should take an optional `dest-buf' argument.
-		   (set (make-local-variable 'url-redirect-buffer)
-			(url-retrieve-internal
-			 redirect-uri url-callback-function
-			 url-callback-arguments
-			 (url-silent url-current-object)
-			 (not (url-use-cookies url-current-object))))
+                   (setq-local url-redirect-buffer
+                               (url-retrieve-internal
+                                redirect-uri url-callback-function
+                                url-callback-arguments
+                                (url-silent url-current-object)
+                                (not (url-use-cookies url-current-object))))
 		   (url-mark-buffer-as-dead buffer))
 	       ;; We hit url-max-redirections, so issue an error and
 	       ;; stop redirecting.
@@ -734,50 +791,50 @@ should be shown to the user."
        ;; 424 Failed Dependency
        (setq success
              (pcase status-symbol
-               (`unauthorized			; 401
+               ('unauthorized			; 401
                 ;; The request requires user authentication.  The response
                 ;; MUST include a WWW-Authenticate header field containing a
                 ;; challenge applicable to the requested resource.  The
                 ;; client MAY repeat the request with a suitable
                 ;; Authorization header field.
                 (url-http-handle-authentication nil))
-               (`payment-required              ; 402
+               ('payment-required              ; 402
                 ;; This code is reserved for future use
                 (url-mark-buffer-as-dead buffer)
                 (error "Somebody wants you to give them money"))
-               (`forbidden			; 403
+               ('forbidden			; 403
                 ;; The server understood the request, but is refusing to
                 ;; fulfill it.  Authorization will not help and the request
                 ;; SHOULD NOT be repeated.
                 t)
-               (`not-found			; 404
+               ('not-found			; 404
                 ;; Not found
                 t)
-               (`method-not-allowed		; 405
+               ('method-not-allowed		; 405
                 ;; The method specified in the Request-Line is not allowed
                 ;; for the resource identified by the Request-URI.  The
                 ;; response MUST include an Allow header containing a list of
                 ;; valid methods for the requested resource.
                 t)
-               (`not-acceptable		; 406
+               ('not-acceptable		; 406
                 ;; The resource identified by the request is only capable of
                 ;; generating response entities which have content
                 ;; characteristics not acceptable according to the accept
                 ;; headers sent in the request.
                 t)
-               (`proxy-authentication-required ; 407
+               ('proxy-authentication-required ; 407
                 ;; This code is similar to 401 (Unauthorized), but indicates
                 ;; that the client must first authenticate itself with the
                 ;; proxy.  The proxy MUST return a Proxy-Authenticate header
                 ;; field containing a challenge applicable to the proxy for
                 ;; the requested resource.
                 (url-http-handle-authentication t))
-               (`request-timeout		; 408
+               ('request-timeout		; 408
                 ;; The client did not produce a request within the time that
                 ;; the server was prepared to wait.  The client MAY repeat
                 ;; the request without modifications at any later time.
                 t)
-               (`conflict			; 409
+               ('conflict			; 409
                 ;; The request could not be completed due to a conflict with
                 ;; the current state of the resource.  This code is only
                 ;; allowed in situations where it is expected that the user
@@ -786,11 +843,11 @@ should be shown to the user."
                 ;; information for the user to recognize the source of the
                 ;; conflict.
                 t)
-               (`gone                          ; 410
+               ('gone                          ; 410
                 ;; The requested resource is no longer available at the
                 ;; server and no forwarding address is known.
                 t)
-               (`length-required		; 411
+               ('length-required		; 411
                 ;; The server refuses to accept the request without a defined
                 ;; Content-Length.  The client MAY repeat the request if it
                 ;; adds a valid Content-Length header field containing the
@@ -800,29 +857,29 @@ should be shown to the user."
                 ;; `url-http-create-request' automatically calculates the
                 ;; content-length.
                 t)
-               (`precondition-failed		; 412
+               ('precondition-failed		; 412
                 ;; The precondition given in one or more of the
                 ;; request-header fields evaluated to false when it was
                 ;; tested on the server.
                 t)
-               ((or `request-entity-too-large `request-uri-too-large) ; 413 414
+               ((or 'request-entity-too-large 'request-uri-too-large) ; 413 414
                 ;; The server is refusing to process a request because the
                 ;; request entity|URI is larger than the server is willing or
                 ;; able to process.
                 t)
-               (`unsupported-media-type	; 415
+               ('unsupported-media-type	; 415
                 ;; The server is refusing to service the request because the
                 ;; entity of the request is in a format not supported by the
                 ;; requested resource for the requested method.
                 t)
-               (`requested-range-not-satisfiable ; 416
+               ('requested-range-not-satisfiable ; 416
                 ;; A server SHOULD return a response with this status code if
                 ;; a request included a Range request-header field, and none
                 ;; of the range-specifier values in this field overlap the
                 ;; current extent of the selected resource, and the request
                 ;; did not include an If-Range request-header field.
                 t)
-               (`expectation-failed		; 417
+               ('expectation-failed		; 417
                 ;; The expectation given in an Expect request-header field
                 ;; could not be met by this server, or, if the server is a
                 ;; proxy, the server has unambiguous evidence that the
@@ -849,16 +906,16 @@ should be shown to the user."
        ;; 507 Insufficient storage
        (setq success t)
        (pcase url-http-response-status
-	 (`not-implemented		; 501
+	 ('not-implemented		; 501
 	  ;; The server does not support the functionality required to
 	  ;; fulfill the request.
 	  nil)
-	 (`bad-gateway			; 502
+	 ('bad-gateway			; 502
 	  ;; The server, while acting as a gateway or proxy, received
 	  ;; an invalid response from the upstream server it accessed
 	  ;; in attempting to fulfill the request.
 	  nil)
-	 (`service-unavailable		; 503
+	 ('service-unavailable		; 503
 	  ;; The server is currently unable to handle the request due
 	  ;; to a temporary overloading or maintenance of the server.
 	  ;; The implication is that this is a temporary condition
@@ -867,19 +924,19 @@ should be shown to the user."
 	  ;; header.  If no Retry-After is given, the client SHOULD
 	  ;; handle the response as it would for a 500 response.
 	  nil)
-	 (`gateway-timeout		; 504
+	 ('gateway-timeout		; 504
 	  ;; The server, while acting as a gateway or proxy, did not
 	  ;; receive a timely response from the upstream server
 	  ;; specified by the URI (e.g. HTTP, FTP, LDAP) or some other
 	  ;; auxiliary server (e.g. DNS) it needed to access in
 	  ;; attempting to complete the request.
 	  nil)
-	 (`http-version-not-supported	; 505
+	 ('http-version-not-supported	; 505
 	  ;; The server does not support, or refuses to support, the
 	  ;; HTTP protocol version that was used in the request
 	  ;; message.
 	  nil)
-	 (`insufficient-storage		; 507 (DAV)
+	 ('insufficient-storage		; 507 (DAV)
 	  ;; The method could not be performed on the resource
 	  ;; because the server is unable to store the representation
 	  ;; needed to successfully complete the request.  This
@@ -899,16 +956,21 @@ should be shown to the user."
 	      class url-http-response-status)))
     (if (not success)
 	(url-mark-buffer-as-dead buffer)
+      ;; Narrow the buffer for url-handle-content-transfer-encoding to
+      ;; find only the headers relevant to this transaction.
+      (and (not (buffer-narrowed-p))
+                (mail-narrow-to-head))
       (url-handle-content-transfer-encoding))
     (url-http-debug "Finished parsing HTTP headers: %S" success)
     (widen)
     (goto-char (point-min))
     success))
 
-(declare-function zlib-decompress-region "decompress.c" (start end))
+(declare-function zlib-decompress-region "decompress.c"
+                  (start end &optional allow-partial))
 
 (defun url-handle-content-transfer-encoding ()
-  (let ((encoding (mail-fetch-field "content-encoding")))
+  (let ((encoding (mail-fetch-field "content-encoding" nil nil nil t)))
     (when (and encoding
 	       (fboundp 'zlib-available-p)
 	       (zlib-available-p)
@@ -917,7 +979,7 @@ should be shown to the user."
 	(widen)
 	(goto-char (point-min))
 	(when (search-forward "\n\n")
-	  (zlib-decompress-region (point) (point-max)))))))
+	  (zlib-decompress-region (point) (point-max) t))))))
 
 ;; Miscellaneous
 (defun url-http-activate-callback ()
@@ -966,14 +1028,17 @@ should be shown to the user."
                    (setq url-using-proxy
                          (url-generic-parse-url url-using-proxy)))
                  (url-http url-current-object url-callback-function
-                           url-callback-arguments (current-buffer)))))
+                           url-callback-arguments (current-buffer)
+                           (and (string= "https" (url-type url-current-object))
+                                'tls)))))
 	    ((url-http-parse-headers)
 	     (url-http-activate-callback))))))
 
 (defun url-http-simple-after-change-function (_st _nd _length)
   ;; Function used when we do NOT know how long the document is going to be
   ;; Just _very_ simple 'downloaded %d' type of info.
-  (url-lazy-message "Reading %s..." (file-size-human-readable (buffer-size))))
+  (url-lazy-message "Reading %s..."
+                    (funcall byte-count-to-string-function (buffer-size))))
 
 (defun url-http-content-length-after-change-function (_st nd _length)
   "Function used when we DO know how long the document is going to be.
@@ -981,28 +1046,23 @@ More sophisticated percentage downloaded, etc.
 Also does minimal parsing of HTTP headers and will actually cause
 the callback to be triggered."
   (if url-http-content-type
-      (url-display-percentage
+      (url-display-message
        "Reading [%s]... %s of %s (%d%%)"
-       (url-percentage (- nd url-http-end-of-headers)
-		       url-http-content-length)
        url-http-content-type
-       (file-size-human-readable (- nd url-http-end-of-headers))
-       (file-size-human-readable url-http-content-length)
+       (funcall byte-count-to-string-function (- nd url-http-end-of-headers))
+       (funcall byte-count-to-string-function url-http-content-length)
        (url-percentage (- nd url-http-end-of-headers)
 		       url-http-content-length))
-    (url-display-percentage
+    (url-display-message
      "Reading... %s of %s (%d%%)"
-     (url-percentage (- nd url-http-end-of-headers)
-		     url-http-content-length)
-     (file-size-human-readable (- nd url-http-end-of-headers))
-     (file-size-human-readable url-http-content-length)
+     (funcall byte-count-to-string-function (- nd url-http-end-of-headers))
+     (funcall byte-count-to-string-function url-http-content-length)
      (url-percentage (- nd url-http-end-of-headers)
 		     url-http-content-length)))
 
   (if (> (- nd url-http-end-of-headers) url-http-content-length)
       (progn
 	;; Found the end of the document!  Wheee!
-	(url-display-percentage nil nil)
 	(url-lazy-message "Reading... done.")
 	(if (url-http-parse-headers)
 	    (url-http-activate-callback)))))
@@ -1012,87 +1072,97 @@ the callback to be triggered."
 Cannot give a sophisticated percentage, but we need a different
 function to look for the special 0-length chunk that signifies
 the end of the document."
-  (save-excursion
-    (goto-char st)
-    (let ((read-next-chunk t)
-	  (case-fold-search t)
-	  (regexp nil)
-	  (no-initial-crlf nil))
-      ;; We need to loop thru looking for more chunks even within
-      ;; one after-change-function call.
-      (while read-next-chunk
-	(setq no-initial-crlf (= 0 url-http-chunked-counter))
-	(if url-http-content-type
-	    (url-display-percentage nil
-	     "Reading [%s]... chunk #%d"
-	     url-http-content-type url-http-chunked-counter)
-	  (url-display-percentage nil
-	   "Reading... chunk #%d"
-	   url-http-chunked-counter))
-	(url-http-debug "Reading chunk %d (%d %d %d)"
-			url-http-chunked-counter st nd length)
-	(setq regexp (if no-initial-crlf
-			 "\\([0-9a-z]+\\).*\r?\n"
-		       "\r?\n\\([0-9a-z]+\\).*\r?\n"))
-
-	(if url-http-chunked-start
-	    ;; We know how long the chunk is supposed to be, skip over
-	    ;; leading crap if possible.
-	    (if (> nd (+ url-http-chunked-start url-http-chunked-length))
-		(progn
-		  (url-http-debug "Got to the end of chunk #%d!"
-				  url-http-chunked-counter)
-		  (goto-char (+ url-http-chunked-start
-				url-http-chunked-length)))
-	      (url-http-debug "Still need %d bytes to hit end of chunk"
-			      (- (+ url-http-chunked-start
-				    url-http-chunked-length)
-				 nd))
-	      (setq read-next-chunk nil)))
-	(if (not read-next-chunk)
-	    (url-http-debug "Still spinning for next chunk...")
-	  (if no-initial-crlf (skip-chars-forward "\r\n"))
-	  (if (not (looking-at regexp))
-	      (progn
-	   ;; Must not have received the entirety of the chunk header,
-		;; need to spin some more.
-		(url-http-debug "Did not see start of chunk @ %d!" (point))
-		(setq read-next-chunk nil))
- 	    (add-text-properties (match-beginning 0) (match-end 0)
-				 (list 'start-open t
-				       'end-open t
-				       'chunked-encoding t
-				       'face 'cursor
-				       'invisible t))
-	    (setq url-http-chunked-length (string-to-number (buffer-substring
-                                                             (match-beginning 1)
-                                                             (match-end 1))
-                                                            16)
-		  url-http-chunked-counter (1+ url-http-chunked-counter)
-		  url-http-chunked-start (set-marker
-					  (or url-http-chunked-start
-					      (make-marker))
-					  (match-end 0)))
-;	    (if (not url-http-debug)
-		(delete-region (match-beginning 0) (match-end 0));)
-	    (url-http-debug "Saw start of chunk %d (length=%d, start=%d"
-			    url-http-chunked-counter url-http-chunked-length
-			    (marker-position url-http-chunked-start))
-	    (if (= 0 url-http-chunked-length)
-		(progn
-		  ;; Found the end of the document!  Wheee!
-		  (url-http-debug "Saw end of stream chunk!")
-		  (setq read-next-chunk nil)
-		  (url-display-percentage nil nil)
-		  ;; Every chunk, even the last 0-length one, is
-		  ;; terminated by CRLF.  Skip it.
-		  (when (looking-at "\r?\n")
-		    (url-http-debug "Removing terminator of last chunk")
-		    (delete-region (match-beginning 0) (match-end 0)))
-		  (if (re-search-forward "^\r?\n" nil t)
-		      (url-http-debug "Saw end of trailers..."))
-		  (if (url-http-parse-headers)
-		      (url-http-activate-callback))))))))))
+  (if url-http-chunked-last-crlf-missing
+      (progn
+        (goto-char url-http-chunked-last-crlf-missing)
+        (if (not (looking-at "\r\n"))
+	    (url-http-debug
+             "Still spinning for the terminator of last chunk...")
+          (url-http-debug "Saw the last CRLF.")
+          (delete-region (match-beginning 0) (match-end 0))
+          (when (url-http-parse-headers)
+	    (url-http-activate-callback))))
+    (save-excursion
+      (goto-char st)
+      (let ((read-next-chunk t)
+	    (case-fold-search t)
+	    (regexp nil)
+	    (no-initial-crlf nil))
+        ;; We need to loop thru looking for more chunks even within
+        ;; one after-change-function call.
+        (while read-next-chunk
+	  (setq no-initial-crlf (= 0 url-http-chunked-counter))
+	  (url-http-debug "Reading chunk %d (%d %d %d)"
+			  url-http-chunked-counter st nd length)
+	  (setq regexp (if no-initial-crlf
+			   "\\([0-9a-z]+\\).*\r?\n"
+		         "\r?\n\\([0-9a-z]+\\).*\r?\n"))
+
+	  (if url-http-chunked-start
+	      ;; We know how long the chunk is supposed to be, skip over
+	      ;; leading crap if possible.
+	      (if (> nd (+ url-http-chunked-start url-http-chunked-length))
+		  (progn
+		    (url-http-debug "Got to the end of chunk #%d!"
+				    url-http-chunked-counter)
+		    (goto-char (+ url-http-chunked-start
+				  url-http-chunked-length)))
+	        (url-http-debug "Still need %d bytes to hit end of chunk"
+			        (- (+ url-http-chunked-start
+				      url-http-chunked-length)
+				   nd))
+	        (setq read-next-chunk nil)))
+	  (if (not read-next-chunk)
+	      (url-http-debug "Still spinning for next chunk...")
+	    (if no-initial-crlf (skip-chars-forward "\r\n"))
+	    (if (not (looking-at regexp))
+	        (progn
+	          ;; Must not have received the entirety of the chunk header,
+		  ;; need to spin some more.
+		  (url-http-debug "Did not see start of chunk @ %d!" (point))
+		  (setq read-next-chunk nil))
+              ;; The data we got may have started in the middle of the
+              ;; initial chunk header, so move back to the start of the
+              ;; line and re-compute.
+              (when (= url-http-chunked-counter 0)
+                (beginning-of-line)
+                (looking-at regexp))
+              (add-text-properties (match-beginning 0) (match-end 0)
+                                   (list 'chunked-encoding t
+				         'face 'cursor
+				         'invisible t))
+	      (setq url-http-chunked-length
+                    (string-to-number (buffer-substring (match-beginning 1)
+                                                        (match-end 1))
+                                      16)
+		    url-http-chunked-counter (1+ url-http-chunked-counter)
+		    url-http-chunked-start (set-marker
+					    (or url-http-chunked-start
+					        (make-marker))
+					    (match-end 0)))
+	      (delete-region (match-beginning 0) (match-end 0))
+	      (url-http-debug "Saw start of chunk %d (length=%d, start=%d"
+			      url-http-chunked-counter url-http-chunked-length
+			      (marker-position url-http-chunked-start))
+	      (if (= 0 url-http-chunked-length)
+		  (progn
+		    ;; Found the end of the document!  Wheee!
+		    (url-http-debug "Saw end of stream chunk!")
+		    (setq read-next-chunk nil)
+		    ;; Every chunk, even the last 0-length one, is
+		    ;; terminated by CRLF.  Skip it.
+		    (if (not (looking-at "\r?\n"))
+                        (progn
+	                  (url-http-debug
+                           "Spinning for the terminator of last chunk...")
+                          (setq url-http-chunked-last-crlf-missing
+                                      (point)))
+		      (url-http-debug "Removing terminator of last chunk")
+		      (delete-region (match-beginning 0) (match-end 0))
+		      (when (re-search-forward "^\r?\n" nil t)
+		        (url-http-debug "Saw end of trailers..."))
+		      (when (url-http-parse-headers)
+		        (url-http-activate-callback))))))))))))
 
 (defun url-http-wait-for-headers-change-function (_st nd _length)
   ;; This will wait for the headers to arrive and then splice in the
@@ -1146,8 +1216,7 @@ the end of the document."
 	  ;; We got back a headerless malformed response from the
 	  ;; server.
 	  (url-http-activate-callback))
-	 ((or (= url-http-response-status 204)
-	      (= url-http-response-status 205))
+	 ((memq url-http-response-status '(204 205))
 	  (url-http-debug "%d response must have headers only (%s)."
 			  url-http-response-status (buffer-name))
 	  (when (url-http-parse-headers)
@@ -1182,11 +1251,11 @@ the end of the document."
 	  (url-http-debug
 	   "Saw HTTP/0.9 response, connection closed means end of document.")
 	  (setq url-http-after-change-function
-		'url-http-simple-after-change-function))
+		#'url-http-simple-after-change-function))
 	 ((equal url-http-transfer-encoding "chunked")
 	  (url-http-debug "Saw chunked encoding.")
 	  (setq url-http-after-change-function
-		'url-http-chunked-encoding-after-change-function)
+		#'url-http-chunked-encoding-after-change-function)
 	  (when (> nd url-http-end-of-headers)
 	    (url-http-debug
 	     "Calling initial chunked-encoding for extra data at end of headers")
@@ -1197,7 +1266,7 @@ the end of the document."
 	  (url-http-debug
 	   "Got a content-length, being smart about document end.")
 	  (setq url-http-after-change-function
-		'url-http-content-length-after-change-function)
+		#'url-http-content-length-after-change-function)
 	  (cond
 	   ((= 0 url-http-content-length)
 	    ;; We got a NULL body!  Activate the callback
@@ -1218,7 +1287,7 @@ the end of the document."
 	 (t
 	  (url-http-debug "No content-length, being dumb.")
 	  (setq url-http-after-change-function
-		'url-http-simple-after-change-function)))))
+		#'url-http-simple-after-change-function)))))
     ;; We are still at the beginning of the buffer... must just be
     ;; waiting for a response.
     (url-http-debug "Spinning waiting for headers...")
@@ -1234,7 +1303,7 @@ passing it an updated value of CBARGS as arguments.  The first
 element in CBARGS should be a plist describing what has happened
 so far during the request, as described in the docstring of
 `url-retrieve' (if in doubt, specify nil).  The current buffer
-then CALLBACK is executed is the retrieval buffer.
+when CALLBACK is executed is the retrieval buffer.
 
 Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
 previous `url-http' call, which is being re-attempted.
@@ -1246,9 +1315,7 @@ The return value of this function is the retrieval buffer."
   (cl-check-type url url "Need a pre-parsed URL.")
   (let* (;; (host (url-host (or url-using-proxy url)))
 	 ;; (port (url-port (or url-using-proxy url)))
-	 (nsm-noninteractive (or url-request-noninteractive
-				 (and (boundp 'url-http-noninteractive)
-				      url-http-noninteractive)))
+	 (nsm-noninteractive (not (url-interactive-p)))
          ;; The following binding is needed in url-open-stream, which
          ;; is called from url-http-find-free-connection.
          (url-current-object url)
@@ -1258,7 +1325,8 @@ The return value of this function is the retrieval buffer."
          (mime-accept-string url-mime-accept-string)
 	 (buffer (or retry-buffer
 		     (generate-new-buffer
-                      (format " *http %s:%d*" (url-host url) (url-port url))))))
+                      (format " *http %s:%d*" (url-host url) (url-port url)))))
+         (referer (url-http--encode-string (url-http--get-referer url))))
     (if (not connection)
 	;; Failed to open the connection for some reason
 	(progn
@@ -1278,6 +1346,7 @@ The return value of this function is the retrieval buffer."
 		       url-http-after-change-function
 		       url-http-response-version
 		       url-http-response-status
+                       url-http-chunked-last-crlf-missing
 		       url-http-chunked-length
 		       url-http-chunked-counter
 		       url-http-chunked-start
@@ -1293,7 +1362,8 @@ The return value of this function is the retrieval buffer."
 		       url-http-no-retry
 		       url-http-connection-opened
                        url-mime-accept-string
-		       url-http-proxy))
+		       url-http-proxy
+                       url-http-referer))
 	  (set (make-local-variable var) nil))
 
 	(setq url-http-method (or url-request-method "GET")
@@ -1301,6 +1371,7 @@ The return value of this function is the retrieval buffer."
 	      url-http-noninteractive url-request-noninteractive
 	      url-http-data url-request-data
 	      url-http-process connection
+              url-http-chunked-last-crlf-missing nil
 	      url-http-chunked-length nil
 	      url-http-chunked-start nil
 	      url-http-chunked-counter 0
@@ -1311,15 +1382,16 @@ The return value of this function is the retrieval buffer."
 	      url-http-no-retry retry-buffer
 	      url-http-connection-opened nil
               url-mime-accept-string mime-accept-string
-	      url-http-proxy url-using-proxy)
+	      url-http-proxy url-using-proxy
+              url-http-referer referer)
 
 	(set-process-buffer connection buffer)
-	(set-process-filter connection 'url-http-generic-filter)
+	(set-process-filter connection #'url-http-generic-filter)
 	(pcase (process-status connection)
-          (`connect
+          ('connect
            ;; Asynchronous connection
            (set-process-sentinel connection 'url-http-async-sentinel))
-          (`failed
+          ('failed
            ;; Asynchronous connection failed
            (error "Could not create connection to %s:%d" (url-host url)
                   (url-port url)))
@@ -1328,19 +1400,28 @@ The return value of this function is the retrieval buffer."
                                             (url-type url-current-object)))
                (url-https-proxy-connect connection)
              (set-process-sentinel connection
-                                   'url-http-end-of-document-sentinel)
+                                   #'url-http-end-of-document-sentinel)
              (process-send-string connection (url-http-create-request)))))))
     buffer))
 
 (defun url-https-proxy-connect (connection)
-  (setq url-http-after-change-function 'url-https-proxy-after-change-function)
-  (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n"
-                                                  "Host: %s\r\n"
-                                                  "\r\n")
-                                          (url-host url-current-object)
-                                          (or (url-port url-current-object)
-                                              url-https-default-port)
-                                          (url-host url-current-object))))
+  (setq url-http-after-change-function #'url-https-proxy-after-change-function)
+  (process-send-string
+   connection
+   (format
+    (concat "CONNECT %s:%d HTTP/1.1\r\n"
+            "Host: %s\r\n"
+            (let ((proxy-auth (let ((url-basic-auth-storage
+                                     'url-http-proxy-basic-auth-storage))
+                                (url-get-authentication url-http-proxy nil
+                                                        'any nil))))
+              (and proxy-auth
+                   (concat "Proxy-Authorization: " proxy-auth "\r\n")))
+            "\r\n")
+    (puny-encode-domain (url-host url-current-object))
+    (or (url-port url-current-object)
+        url-https-default-port)
+    (puny-encode-domain (url-host url-current-object)))))
 
 (defun url-https-proxy-after-change-function (_st _nd _length)
   (let* ((process-buffer (current-buffer))
@@ -1362,17 +1443,17 @@ The return value of this function is the retrieval buffer."
             (condition-case e
                 (let ((tls-connection (gnutls-negotiate
                                        :process proc
-                                       :hostname (url-host url-current-object)
+                                       :hostname (puny-encode-domain (url-host url-current-object))
                                        :verify-error nil)))
                   ;; check certificate validity
                   (setq tls-connection
                         (nsm-verify-connection tls-connection
-                                               (url-host url-current-object)
+                                               (puny-encode-domain (url-host url-current-object))
                                                (url-port url-current-object)))
                   (with-current-buffer process-buffer (erase-buffer))
                   (set-process-buffer tls-connection process-buffer)
                   (setq url-http-after-change-function
-                        'url-http-wait-for-headers-change-function)
+                        #'url-http-wait-for-headers-change-function)
                   (set-process-filter tls-connection 'url-http-generic-filter)
                   (process-send-string tls-connection
                                        (url-http-create-request)))
@@ -1381,10 +1462,10 @@ The return value of this function is the retrieval buffer."
                (error "gnutls-error: %s" e))
               (error
                (url-http-activate-callback)
-               (error "error: %s" e)))
-          (error "error: gnutls support needed!")))
+               (error "Error: %s" e)))
+          (error "Error: gnutls support needed!")))
        (t
-        (message "error response: %d" url-http-response-status)
+        (url-http-debug "error response: %d" url-http-response-status)
         (url-http-activate-callback))))))
 
 (defun url-http-async-sentinel (proc why)
@@ -1424,24 +1505,25 @@ The return value of this function is the retrieval buffer."
   ;; Sometimes we get a zero-length data chunk after the process has
   ;; been changed to 'free', which means it has no buffer associated
   ;; with it.  Do nothing if there is no buffer, or 0 length data.
-  (and (process-buffer proc)
-       (/= (length data) 0)
-       (with-current-buffer (process-buffer proc)
-	 (url-http-debug "Calling after change function `%s' for `%S'" url-http-after-change-function proc)
-	 (funcall url-http-after-change-function
-		  (point-max)
-		  (progn
-		    (goto-char (point-max))
-		    (insert data)
-		    (point-max))
-		  (length data)))))
+  (let ((b (process-buffer proc)))
+    (when (and (buffer-live-p b) (not (zerop (length data))))
+      (with-current-buffer b
+        (url-http-debug "Calling after change function `%s' for `%S'"
+                        url-http-after-change-function proc)
+        (funcall url-http-after-change-function
+                 (point-max)
+                 (progn
+                   (goto-char (point-max))
+                   (insert data)
+                   (point-max))
+                 (length data))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; file-name-handler stuff from here on out
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defalias 'url-http-symbol-value-in-buffer
   (if (fboundp 'symbol-value-in-buffer)
-      'symbol-value-in-buffer
+      #'symbol-value-in-buffer
     (lambda (symbol buffer &optional unbound-value)
       "Return the value of SYMBOL in BUFFER, or UNBOUND-VALUE if it is unbound."
       (with-current-buffer buffer
@@ -1563,7 +1645,6 @@ p3p
 
 ;; HTTPS.  This used to be in url-https.el, but that file collides
 ;; with url-http.el on systems with 8-character file names.
-(require 'tls)
 
 (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")