ispell.el: Make sure hunspell specific dict names are used for standard dicts when...

[gnu-emacs] / lisp / url / url-http.el

diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index b43ed7617adce4d2f6bfaede6710865cfeb13d61..5dd3a75170203d93b442115b6f916c55f9b0a163 100644 (file)
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1,6 +1,6 @@
 ;;; url-http.el --- HTTP retrieval routines
 
 ;;; url-http.el --- HTTP retrieval routines
 

-;; Copyright (C) 1999, 2001, 2004-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2004-2013 Free Software Foundation, Inc.

 
 ;; Author: Bill Perry <wmperry@gnu.org>
 ;; Keywords: comm, data, processes
 
 ;; Author: Bill Perry <wmperry@gnu.org>
 ;; Keywords: comm, data, processes


@@ -24,11 +24,32 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+
+(defvar url-callback-arguments)
+(defvar url-callback-function)
+(defvar url-current-object)
+(defvar url-http-after-change-function)
+(defvar url-http-chunked-counter)
+(defvar url-http-chunked-length)
+(defvar url-http-chunked-start)
+(defvar url-http-connection-opened)
+(defvar url-http-content-length)
+(defvar url-http-content-type)
+(defvar url-http-data)
+(defvar url-http-end-of-headers)

 (defvar url-http-extra-headers)
 (defvar url-http-extra-headers)

-(defvar url-http-target-url)
+(defvar url-http-method)
+(defvar url-http-no-retry)
+(defvar url-http-process)

 (defvar url-http-proxy)
 (defvar url-http-proxy)

-(defvar url-http-connection-opened)
+(defvar url-http-response-status)
+(defvar url-http-response-version)
+(defvar url-http-target-url)
+(defvar url-http-transfer-encoding)
+(defvar url-http-end-of-headers)
+(defvar url-show-status)
+

 (require 'url-gw)
 (require 'url-util)
 (require 'url-parse)
 (require 'url-gw)
 (require 'url-util)
 (require 'url-parse)


@@ -109,8 +130,8 @@ request.")
     (503 service-unavailable             "Service unavailable")
     (504 gateway-timeout                 "Gateway time-out")
     (505 http-version-not-supported      "HTTP version not supported")
     (503 service-unavailable             "Service unavailable")
     (504 gateway-timeout                 "Gateway time-out")
     (505 http-version-not-supported      "HTTP version not supported")

-    (507 insufficient-storage            "Insufficient storage")
-"The HTTP return codes and their text."))
+    (507 insufficient-storage            "Insufficient storage"))
+  "The HTTP return codes and their text.")

 
 ;(eval-when-compile
 ;; These are all macros so that they are hidden from external sight
 
 ;(eval-when-compile
 ;; These are all macros so that they are hidden from external sight


@@ -153,38 +174,40 @@ request.")
 
 (defun url-http-find-free-connection (host port)
   (let ((conns (gethash (cons host port) url-http-open-connections))
 
 (defun url-http-find-free-connection (host port)
   (let ((conns (gethash (cons host port) url-http-open-connections))

-       (found nil))
-    (while (and conns (not found))
+       (connection nil))
+    (while (and conns (not connection))

       (if (not (memq (process-status (car conns)) '(run open connect)))
          (progn
            (url-http-debug "Cleaning up dead process: %s:%d %S"
                            host port (car conns))
            (url-http-idle-sentinel (car conns) nil))
       (if (not (memq (process-status (car conns)) '(run open connect)))
          (progn
            (url-http-debug "Cleaning up dead process: %s:%d %S"
                            host port (car conns))
            (url-http-idle-sentinel (car conns) nil))

-       (setq found (car conns))
-       (url-http-debug "Found existing connection: %s:%d %S" host port found))
+       (setq connection (car conns))
+       (url-http-debug "Found existing connection: %s:%d %S" host port connection))

       (pop conns))
       (pop conns))

-    (if found
+    (if connection

        (url-http-debug "Reusing existing connection: %s:%d" host port)
       (url-http-debug "Contacting host: %s:%d" host port))
     (url-lazy-message "Contacting host: %s:%d" host port)
        (url-http-debug "Reusing existing connection: %s:%d" host port)
       (url-http-debug "Contacting host: %s:%d" host port))
     (url-lazy-message "Contacting host: %s:%d" host port)

-    (url-http-mark-connection-as-busy
-     host port
-     (or found
-         (let ((buf (generate-new-buffer " *url-http-temp*")))
-           ;; `url-open-stream' needs a buffer in which to do things
-           ;; like authentication.  But we use another buffer afterwards.
-           (unwind-protect
-               (let ((proc (url-open-stream host buf host port)))
-                ;; url-open-stream might return nil.
-                (when (processp proc)
-                  ;; Drop the temp buffer link before killing the buffer.
-                  (set-process-buffer proc nil))
-                 proc)
-            ;; If there was an error on connect, make sure we don't
-            ;; get queried.
-            (when (get-buffer-process buf)
-              (set-process-query-on-exit-flag (get-buffer-process buf) nil))
-             (kill-buffer buf)))))))
+
+    (unless connection
+      (let ((buf (generate-new-buffer " *url-http-temp*")))
+       ;; `url-open-stream' needs a buffer in which to do things
+       ;; like authentication.  But we use another buffer afterwards.
+       (unwind-protect
+           (let ((proc (url-open-stream host buf host port)))
+             ;; url-open-stream might return nil.
+             (when (processp proc)
+               ;; Drop the temp buffer link before killing the buffer.
+               (set-process-buffer proc nil)
+               (setq connection proc)))
+         ;; If there was an error on connect, make sure we don't
+         ;; get queried.
+         (when (get-buffer-process buf)
+           (set-process-query-on-exit-flag (get-buffer-process buf) nil))
+         (kill-buffer buf))))
+
+    (if connection
+       (url-http-mark-connection-as-busy host port connection))))

 
 ;; Building an HTTP request
 (defun url-http-user-agent-string ()
 
 ;; Building an HTTP request
 (defun url-http-user-agent-string ()


@@ -192,23 +215,14 @@ request.")
          (and (listp url-privacy-level)
               (memq 'agent url-privacy-level)))
       ""
          (and (listp url-privacy-level)
               (memq 'agent url-privacy-level)))
       ""

-    (format "User-Agent: %sURL/%s%s\r\n"
+    (format "User-Agent: %sURL/%s\r\n"

            (if url-package-name
                (concat url-package-name "/" url-package-version " ")
              "")
            (if url-package-name
                (concat url-package-name "/" url-package-version " ")
              "")

-           url-version
-           (cond
-            ((and url-os-type url-system-type)
-             (concat " (" url-os-type "; " url-system-type ")"))
-            ((or url-os-type url-system-type)
-             (concat " (" (or url-system-type url-os-type) ")"))
-            (t "")))))
+           url-version)))

 
 (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 (&optional ref-url)
   "Create an HTTP request for `url-http-target-url', referred to by REF-URL."

-  (declare (special proxy-info
-                   url-http-method url-http-data
-                   url-http-extra-headers))

   (let* ((extra-headers)
         (request nil)
         (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))
   (let* ((extra-headers)
         (request nil)
         (no-cache (cdr-safe (assoc "Pragma" url-http-extra-headers)))


@@ -219,9 +233,8 @@ request.")
                         nil
                       (let ((url-basic-auth-storage
                              'url-http-proxy-basic-auth-storage))
                         nil
                       (let ((url-basic-auth-storage
                              'url-http-proxy-basic-auth-storage))

-                        (url-get-authentication url-http-target-url nil 'any nil))))
-        (real-fname (concat (url-filename url-http-target-url)
-                            (url-recreate-url-attributes url-http-target-url)))
+                        (url-get-authentication url-http-proxy nil 'any nil))))
+        (real-fname (url-filename url-http-target-url))

         (host (url-host url-http-target-url))
         (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
                   nil
         (host (url-host url-http-target-url))
         (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers))
                   nil


@@ -320,8 +333,10 @@ request.")
              ;; Authorization
              auth
              ;; Cookies
              ;; Authorization
              auth
              ;; Cookies

-             (url-cookie-generate-header-lines host real-fname
-                                               (equal "https" (url-type url-http-target-url)))
+            (when (url-use-cookies url-http-target-url)
+              (url-cookie-generate-header-lines
+               host real-fname
+               (equal "https" (url-type url-http-target-url))))

              ;; If-modified-since
              (if (and (not no-cache)
                       (member url-http-method '("GET" nil)))
              ;; If-modified-since
              (if (and (not no-cache)
                       (member url-http-method '("GET" nil)))


@@ -352,15 +367,18 @@ request.")
 ;; Parsing routines
 (defun url-http-clean-headers ()
   "Remove trailing \r from header lines.
 ;; Parsing routines
 (defun url-http-clean-headers ()
   "Remove trailing \r from header lines.

-This allows us to use `mail-fetch-field', etc."
-  (declare (special url-http-end-of-headers))
-  (goto-char (point-min))
-  (while (re-search-forward "\r$" url-http-end-of-headers t)
-    (replace-match "")))
+This allows us to use `mail-fetch-field', etc.
+Return the number of characters removed."
+  (let ((end (marker-position url-http-end-of-headers)))
+    (goto-char (point-min))
+    (while (re-search-forward "\r$" url-http-end-of-headers t)
+      (replace-match ""))
+    (- end url-http-end-of-headers)))
+
+(defvar status)
+(defvar success)

 
 (defun url-http-handle-authentication (proxy)
 
 (defun url-http-handle-authentication (proxy)

-  (declare (special status success url-http-method url-http-data
-                   url-callback-function url-callback-arguments))

   (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
   (let ((auths (or (nreverse
                    (mail-fetch-field
   (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal"))
   (let ((auths (or (nreverse
                    (mail-fetch-field


@@ -420,8 +438,6 @@ This allows us to use `mail-fetch-field', etc."
 
 (defun url-http-parse-response ()
   "Parse just the response code."
 
 (defun url-http-parse-response ()
   "Parse just the response code."

-  (declare (special url-http-end-of-headers url-http-response-status
-                   url-http-response-version))

   (if (not url-http-end-of-headers)
       (error "Trying to parse HTTP response code in odd buffer: %s" (buffer-name)))
   (url-http-debug "url-http-parse-response called in (%s)" (buffer-name))
   (if (not url-http-end-of-headers)
       (error "Trying to parse HTTP response code in odd buffer: %s" (buffer-name)))
   (url-http-debug "url-http-parse-response called in (%s)" (buffer-name))


@@ -456,11 +472,6 @@ Return t if and only if the current buffer is still active and
 should be shown to the user."
   ;; The comments after each status code handled are taken from RFC
   ;; 2616 (HTTP/1.1)
 should be shown to the user."
   ;; The comments after each status code handled are taken from RFC
   ;; 2616 (HTTP/1.1)

-  (declare (special url-http-end-of-headers url-http-response-status
-                   url-http-response-version
-                   url-http-method url-http-data url-http-process
-                   url-callback-function url-callback-arguments))
-

   (url-http-mark-connection-as-free (url-host url-current-object)
                                    (url-port url-current-object)
                                    url-http-process)
   (url-http-mark-connection-as-free (url-host url-current-object)
                                    (url-port url-current-object)
                                    url-http-process)


@@ -491,16 +502,14 @@ should be shown to the user."
        (class nil)
        (success nil)
        ;; other status symbols: jewelry and luxury cars
        (class nil)
        (success nil)
        ;; other status symbols: jewelry and luxury cars

-       (status-symbol (cadr (assq url-http-response-status url-http-codes)))
-       ;; The filename part of a URL could be in remote file syntax,
-       ;; see Bug#6717 for an example.  We disable file name
-       ;; handlers, therefore.
-       (file-name-handler-alist nil))
+       (status-symbol (cadr (assq url-http-response-status url-http-codes))))

     (setq class (/ url-http-response-status 100))
     (setq class (/ url-http-response-status 100))

-    (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status)
-    (url-http-handle-cookies)
+    (url-http-debug "Parsed HTTP headers: class=%d status=%d"
+                    class url-http-response-status)
+    (when (url-use-cookies url-http-target-url)
+      (url-http-handle-cookies))

 
 

-    (case class
+    (pcase class

       ;; Classes of response codes
       ;;
       ;; 5xx = Server Error
       ;; Classes of response codes
       ;;
       ;; 5xx = Server Error


@@ -513,7 +522,8 @@ should be shown to the user."
        ;; 101 = Switching protocols
        ;; 102 = Processing (Added by DAV)
        (url-mark-buffer-as-dead buffer)
        ;; 101 = Switching protocols
        ;; 102 = Processing (Added by DAV)
        (url-mark-buffer-as-dead buffer)

-       (error "HTTP responses in class 1xx not supported (%d)" url-http-response-status))
+       (error "HTTP responses in class 1xx not supported (%d)"
+              url-http-response-status))

       (2                               ; Success
        ;; 200 Ok
        ;; 201 Created
       (2                               ; Success
        ;; 200 Ok
        ;; 201 Created


@@ -523,12 +533,12 @@ should be shown to the user."
        ;; 205 Reset content
        ;; 206 Partial content
        ;; 207 Multi-status (Added by DAV)
        ;; 205 Reset content
        ;; 206 Partial content
        ;; 207 Multi-status (Added by DAV)

-       (case status-symbol
-        ((no-content reset-content)
+       (pcase status-symbol
+        ((or `no-content `reset-content)

          ;; No new data, just stay at the same document
          (url-mark-buffer-as-dead buffer)
          (setq success t))
          ;; No new data, just stay at the same document
          (url-mark-buffer-as-dead buffer)
          (setq success t))

-        (otherwise
+        (_

          ;; Generic success for all others.  Store in the cache, and
          ;; mark it as successful.
          (widen)
          ;; Generic success for all others.  Store in the cache, and
          ;; mark it as successful.
          (widen)


@@ -545,8 +555,8 @@ should be shown to the user."
        ;; 307 Temporary redirect
        (let ((redirect-uri (or (mail-fetch-field "Location")
                               (mail-fetch-field "URI"))))
        ;; 307 Temporary redirect
        (let ((redirect-uri (or (mail-fetch-field "Location")
                               (mail-fetch-field "URI"))))

-        (case status-symbol
-          (multiple-choices        ; 300
+        (pcase status-symbol
+          (`multiple-choices       ; 300

            ;; Quoth the spec (section 10.3.1)
            ;; -------------------------------
            ;; The requested resource corresponds to any one of a set of
            ;; Quoth the spec (section 10.3.1)
            ;; -------------------------------
            ;; The requested resource corresponds to any one of a set of


@@ -563,7 +573,7 @@ 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)
            ;; We do not support agent-driven negotiation, so we just
            ;; redirect to the preferred URI if one is provided.
            nil)

-          ((moved-permanently found temporary-redirect) ; 301 302 307
+          ((or `moved-permanently `found `temporary-redirect) ; 301 302 307

            ;; If the 301|302 status code is received in response to a
            ;; request other than GET or HEAD, the user agent MUST NOT
            ;; automatically redirect the request unless it can be
            ;; If the 301|302 status code is received in response to a
            ;; request other than GET or HEAD, the user agent MUST NOT
            ;; automatically redirect the request unless it can be


@@ -571,20 +581,20 @@ should be shown to the user."
            ;; conditions under which the request was issued.
            (unless (member url-http-method '("HEAD" "GET"))
              (setq redirect-uri nil)))
            ;; conditions under which the request was issued.
            (unless (member url-http-method '("HEAD" "GET"))
              (setq redirect-uri nil)))

-          (see-other                   ; 303
+          (`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))
            ;; 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))
            ;; 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
            ;; 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


@@ -592,7 +602,7 @@ should be shown to the user."
            ;; responses MUST only be generated by origin servers.
            (error "Redirection thru a proxy server not supported: %s"
                   redirect-uri))
            ;; responses MUST only be generated by origin servers.
            (error "Redirection thru a proxy server not supported: %s"
                   redirect-uri))

-          (otherwise
+          (_

            ;; Treat everything like '300'
            nil))
         (when redirect-uri
            ;; Treat everything like '300'
            nil))
         (when redirect-uri


@@ -641,7 +651,8 @@ should be shown to the user."
                        (url-retrieve-internal
                         redirect-uri url-callback-function
                         url-callback-arguments
                        (url-retrieve-internal
                         redirect-uri url-callback-function
                         url-callback-arguments

-                        (url-silent url-current-object)))
+                        (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.
                   (url-mark-buffer-as-dead buffer))
               ;; We hit url-max-redirections, so issue an error and
               ;; stop redirecting.


@@ -673,51 +684,51 @@ should be shown to the user."
        ;; 422 Unprocessable Entity (Added by DAV)
        ;; 423 Locked
        ;; 424 Failed Dependency
        ;; 422 Unprocessable Entity (Added by DAV)
        ;; 423 Locked
        ;; 424 Failed Dependency

-       (case status-symbol
-        (unauthorized                  ; 401
+       (pcase status-symbol
+        (`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))
          ;; 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"))
          ;; 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.
          (setq success t))
          ;; The server understood the request, but is refusing to
          ;; fulfill it.  Authorization will not help and the request
          ;; SHOULD NOT be repeated.
          (setq success t))

-        (not-found                     ; 404
+        (`not-found                    ; 404

          ;; Not found
          (setq success t))
          ;; Not found
          (setq success 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.
          (setq success t))
          ;; 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.
          (setq success 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.
          (setq success t))
          ;; 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.
          (setq success 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))
          ;; 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.
          (setq success t))
          ;; 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.
          (setq success 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
          ;; 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


@@ -726,11 +737,11 @@ should be shown to the user."
          ;; information for the user to recognize the source of the
          ;; conflict.
          (setq success t))
          ;; information for the user to recognize the source of the
          ;; conflict.
          (setq success t))

-        (gone                          ; 410
+        (`gone                          ; 410

          ;; The requested resource is no longer available at the
          ;; server and no forwarding address is known.
          (setq success t))
          ;; The requested resource is no longer available at the
          ;; server and no forwarding address is known.
          (setq success 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
          ;; 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


@@ -740,35 +751,35 @@ should be shown to the user."
          ;; `url-http-create-request' automatically calculates the
          ;; content-length.
          (setq success t))
          ;; `url-http-create-request' automatically calculates the
          ;; content-length.
          (setq success 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.
          (setq success t))
          ;; The precondition given in one or more of the
          ;; request-header fields evaluated to false when it was
          ;; tested on the server.
          (setq success t))

-        ((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.
          (setq success t))
          ;; The server is refusing to process a request because the
          ;; request entity|URI is larger than the server is willing or
          ;; able to process.
          (setq success 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.
          (setq success t))
          ;; 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.
          (setq success 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.
          (setq success t))
          ;; 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.
          (setq success 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
          ;; request could not be met by the next-hop server.
          (setq success t))
          ;; 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
          ;; request could not be met by the next-hop server.
          (setq success t))

-        (otherwise
+        (_

          ;; The request could not be understood by the server due to
          ;; malformed syntax.  The client SHOULD NOT repeat the
          ;; request without modifications.
          ;; The request could not be understood by the server due to
          ;; malformed syntax.  The client SHOULD NOT repeat the
          ;; request without modifications.


@@ -788,17 +799,17 @@ should be shown to the user."
        ;; 505 HTTP version not supported
        ;; 507 Insufficient storage
        (setq success t)
        ;; 505 HTTP version not supported
        ;; 507 Insufficient storage
        (setq success t)

-       (case url-http-response-status
-        (not-implemented               ; 501
+       (pcase url-http-response-status
+        (`not-implemented              ; 501

          ;; The server does not support the functionality required to
          ;; fulfill the request.
          nil)
          ;; 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)
          ;; 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
          ;; 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


@@ -807,19 +818,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)
          ;; 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)
          ;; 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)
          ;; 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
          ;; 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


@@ -834,7 +845,7 @@ should be shown to the user."
         (setf (car url-callback-arguments)
               (nconc (list :error (list 'error 'http url-http-response-status))
                      (car url-callback-arguments)))))
         (setf (car url-callback-arguments)
               (nconc (list :error (list 'error 'http url-http-response-status))
                      (car url-callback-arguments)))))

-      (otherwise
+      (_

        (error "Unknown class of HTTP response code: %d (%d)"
              class url-http-response-status)))
     (if (not success)
        (error "Unknown class of HTTP response code: %d (%d)"
              class url-http-response-status)))
     (if (not success)


@@ -846,9 +857,6 @@ should be shown to the user."
 ;; Miscellaneous
 (defun url-http-activate-callback ()
   "Activate callback specified when this buffer was created."
 ;; Miscellaneous
 (defun url-http-activate-callback ()
   "Activate callback specified when this buffer was created."

-  (declare (special url-http-process
-                   url-callback-function
-                   url-callback-arguments))

   (url-http-mark-connection-as-free (url-host url-current-object)
                                    (url-port url-current-object)
                                    url-http-process)
   (url-http-mark-connection-as-free (url-host url-current-object)
                                    (url-port url-current-object)
                                    url-http-process)


@@ -866,24 +874,33 @@ should be shown to the user."
              url-http-open-connections))
 
 (defun url-http-end-of-document-sentinel (proc why)
              url-http-open-connections))
 
 (defun url-http-end-of-document-sentinel (proc why)

-  ;; Sentinel used for old HTTP/0.9 or connections we know are going
-  ;; to die as the 'end of document' notifier.
+  ;; Sentinel used to handle (i) terminated old HTTP/0.9 connections,
+  ;; and (ii) closed connection due to reusing a HTTP connection which
+  ;; we believed was still alive, but which the server closed on us.
+  ;; We handle case (ii) by calling `url-http' again.

   (url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
                  (process-buffer proc))
   (url-http-idle-sentinel proc why)
   (when (buffer-name (process-buffer proc))
     (with-current-buffer (process-buffer proc)
       (goto-char (point-min))
   (url-http-debug "url-http-end-of-document-sentinel in buffer (%s)"
                  (process-buffer proc))
   (url-http-idle-sentinel proc why)
   (when (buffer-name (process-buffer proc))
     (with-current-buffer (process-buffer proc)
       (goto-char (point-min))

-      (if (not (looking-at "HTTP/"))
-         ;; HTTP/0.9 just gets passed back no matter what
-         (url-http-activate-callback)
-       (if (url-http-parse-headers)
-           (url-http-activate-callback))))))
+      (cond ((not (looking-at "HTTP/"))
+            (if url-http-no-retry
+                ;; HTTP/0.9 just gets passed back no matter what
+                (url-http-activate-callback)
+              ;; Call `url-http' again if our connection expired.
+              (erase-buffer)
+               (let ((url-request-method url-http-method)
+                     (url-request-extra-headers url-http-extra-headers)
+                     (url-request-data url-http-data))
+                 (url-http url-current-object url-callback-function
+                           url-callback-arguments (current-buffer)))))
+           ((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.
 
 (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.

-  (declare (special url-http-end-of-headers))

   (url-lazy-message "Reading %s..." (url-pretty-length nd)))
 
 (defun url-http-content-length-after-change-function (st nd length)
   (url-lazy-message "Reading %s..." (url-pretty-length nd)))
 
 (defun url-http-content-length-after-change-function (st nd length)


@@ -891,11 +908,6 @@ should be shown to the user."
 More sophisticated percentage downloaded, etc.
 Also does minimal parsing of HTTP headers and will actually cause
 the callback to be triggered."
 More sophisticated percentage downloaded, etc.
 Also does minimal parsing of HTTP headers and will actually cause
 the callback to be triggered."

-  (declare (special url-current-object
-                   url-http-end-of-headers
-                   url-http-content-length
-                   url-http-content-type
-                   url-http-process))

   (if url-http-content-type
       (url-display-percentage
        "Reading [%s]... %s of %s (%d%%)"
   (if url-http-content-type
       (url-display-percentage
        "Reading [%s]... %s of %s (%d%%)"


@@ -928,12 +940,6 @@ 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."
 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."

-  (declare (special url-current-object
-                   url-http-end-of-headers
-                   url-http-content-type
-                   url-http-chunked-length
-                   url-http-chunked-counter
-                   url-http-process url-http-chunked-start))

   (save-excursion
     (goto-char st)
     (let ((read-next-chunk t)
   (save-excursion
     (goto-char st)
     (let ((read-next-chunk t)


@@ -1019,17 +1025,6 @@ the end of the document."
 (defun url-http-wait-for-headers-change-function (st nd length)
   ;; This will wait for the headers to arrive and then splice in the
   ;; next appropriate after-change-function, etc.
 (defun url-http-wait-for-headers-change-function (st nd length)
   ;; This will wait for the headers to arrive and then splice in the
   ;; next appropriate after-change-function, etc.

-  (declare (special url-current-object
-                   url-http-end-of-headers
-                   url-http-content-type
-                   url-http-content-length
-                   url-http-transfer-encoding
-                   url-callback-function
-                   url-callback-arguments
-                   url-http-process
-                   url-http-method
-                   url-http-after-change-function
-                   url-http-response-status))

   (url-http-debug "url-http-wait-for-headers-change-function (%s)"
                  (buffer-name))
   (let ((end-of-headers nil)
   (url-http-debug "url-http-wait-for-headers-change-function (%s)"
                  (buffer-name))
   (let ((end-of-headers nil)


@@ -1051,7 +1046,7 @@ the end of the document."
          (setq url-http-end-of-headers (set-marker (make-marker)
                                                    (point))
                end-of-headers t)
          (setq url-http-end-of-headers (set-marker (make-marker)
                                                    (point))
                end-of-headers t)

-         (url-http-clean-headers)))
+         (setq nd (- nd (url-http-clean-headers)))))

 
       (if (not end-of-headers)
          ;; Haven't seen the end of the headers yet, need to wait
 
       (if (not end-of-headers)
          ;; Haven't seen the end of the headers yet, need to wait


@@ -1155,33 +1150,25 @@ the end of the document."
     (when (eq process-buffer (current-buffer))
       (goto-char (point-max)))))
 
     (when (eq process-buffer (current-buffer))
       (goto-char (point-max)))))
 

-;;;###autoload
-(defun url-http (url callback cbargs)
+(defun url-http (url callback cbargs &optional retry-buffer)

   "Retrieve URL via HTTP asynchronously.
 URL must be a parsed URL.  See `url-generic-parse-url' for details.
   "Retrieve URL via HTTP asynchronously.
 URL must be a parsed URL.  See `url-generic-parse-url' for details.

-When retrieval is completed, the function CALLBACK is executed with
-CBARGS as the arguments."
-  (check-type url vector "Need a pre-parsed URL.")
-  (declare (special url-current-object
-                   url-http-end-of-headers
-                   url-http-content-type
-                   url-http-content-length
-                   url-http-transfer-encoding
-                   url-http-after-change-function
-                   url-callback-function
-                   url-callback-arguments
-                   url-show-status
-                   url-http-method
-                   url-http-extra-headers
-                   url-http-data
-                   url-http-chunked-length
-                   url-http-chunked-start
-                   url-http-chunked-counter
-                   url-http-process))
+
+When retrieval is completed, execute the function CALLBACK, using
+the arguments listed in CBARGS.  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).
+
+Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
+previous `url-http' call, which is being re-attempted."
+  (cl-check-type url vector "Need a pre-parsed URL.")

   (let* ((host (url-host (or url-using-proxy url)))
         (port (url-port (or url-using-proxy url)))
         (connection (url-http-find-free-connection host port))
   (let* ((host (url-host (or url-using-proxy url)))
         (port (url-port (or url-using-proxy url)))
         (connection (url-http-find-free-connection host port))

-        (buffer (generate-new-buffer (format " *http %s:%d*" host port))))
+        (buffer (or retry-buffer
+                    (generate-new-buffer
+                      (format " *http %s:%d*" host port)))))

     (if (not connection)
        ;; Failed to open the connection for some reason
        (progn
     (if (not connection)
        ;; Failed to open the connection for some reason
        (progn


@@ -1211,6 +1198,7 @@ CBARGS as the arguments."
                       url-http-extra-headers
                       url-http-data
                       url-http-target-url
                       url-http-extra-headers
                       url-http-data
                       url-http-target-url

+                      url-http-no-retry

                       url-http-connection-opened
                       url-http-proxy))
          (set (make-local-variable var) nil))
                       url-http-connection-opened
                       url-http-proxy))
          (set (make-local-variable var) nil))


@@ -1226,6 +1214,7 @@ CBARGS as the arguments."
              url-callback-arguments cbargs
              url-http-after-change-function 'url-http-wait-for-headers-change-function
              url-http-target-url url-current-object
              url-callback-arguments cbargs
              url-http-after-change-function 'url-http-wait-for-headers-change-function
              url-http-target-url url-current-object

+             url-http-no-retry retry-buffer

              url-http-connection-opened nil
              url-http-proxy url-using-proxy)
 
              url-http-connection-opened nil
              url-http-proxy url-using-proxy)
 


@@ -1240,18 +1229,19 @@ CBARGS as the arguments."
            ;; Asynchronous connection failed
            (error "Could not create connection to %s:%d" host port))
           (t
            ;; Asynchronous connection failed
            (error "Could not create connection to %s:%d" host port))
           (t

-           (set-process-sentinel connection 'url-http-end-of-document-sentinel)
+           (set-process-sentinel connection
+                                  'url-http-end-of-document-sentinel)

            (process-send-string connection (url-http-create-request)))))))
     buffer))
 
 (defun url-http-async-sentinel (proc why)
            (process-send-string connection (url-http-create-request)))))))
     buffer))
 
 (defun url-http-async-sentinel (proc why)

-  (declare (special url-callback-arguments))

   ;; We are performing an asynchronous connection, and a status change
   ;; has occurred.
   (when (buffer-name (process-buffer proc))
     (with-current-buffer (process-buffer proc)
       (cond
        (url-http-connection-opened
   ;; We are performing an asynchronous connection, and a status change
   ;; has occurred.
   (when (buffer-name (process-buffer proc))
     (with-current-buffer (process-buffer proc)
       (cond
        (url-http-connection-opened

+       (setq url-http-no-retry t)

        (url-http-end-of-document-sentinel proc why))
        ((string= (substring why 0 4) "open")
        (setq url-http-connection-opened t)
        (url-http-end-of-document-sentinel proc why))
        ((string= (substring why 0 4) "open")
        (setq url-http-connection-opened t)


@@ -1279,7 +1269,6 @@ CBARGS as the arguments."
   ;; 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.
   ;; 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.

-  (declare (special url-http-after-change-function))

   (and (process-buffer proc)
        (/= (length data) 0)
        (with-current-buffer (process-buffer proc)
   (and (process-buffer proc)
        (/= (length data) 0)
        (with-current-buffer (process-buffer proc)


@@ -1310,7 +1299,6 @@ CBARGS as the arguments."
        (url-request-data nil))
     (url-retrieve-synchronously url)))
 
        (url-request-data nil))
     (url-retrieve-synchronously url)))
 

-;;;###autoload

 (defun url-http-file-exists-p (url)
   (let ((status nil)
        (exists nil)
 (defun url-http-file-exists-p (url)
   (let ((status nil)
        (exists nil)


@@ -1324,7 +1312,6 @@ CBARGS as the arguments."
       (kill-buffer buffer))
     exists))
 
       (kill-buffer buffer))
     exists))
 

-;;;###autoload

 (defalias 'url-http-file-readable-p 'url-http-file-exists-p)
 
 (defun url-http-head-file-attributes (url &optional id-format)
 (defalias 'url-http-file-readable-p 'url-http-file-exists-p)
 
 (defun url-http-head-file-attributes (url &optional id-format)


@@ -1344,13 +1331,11 @@ CBARGS as the arguments."
 
 (declare-function url-dav-file-attributes "url-dav" (url &optional id-format))
 
 
 (declare-function url-dav-file-attributes "url-dav" (url &optional id-format))
 

-;;;###autoload

 (defun url-http-file-attributes (url &optional id-format)
   (if (url-dav-supported-p url)
       (url-dav-file-attributes url id-format)
     (url-http-head-file-attributes url id-format)))
 
 (defun url-http-file-attributes (url &optional id-format)
   (if (url-dav-supported-p url)
       (url-dav-file-attributes url id-format)
     (url-http-head-file-attributes url id-format)))
 

-;;;###autoload

 (defun url-http-options (url)
   "Return a property list describing options available for URL.
 This list is retrieved using the `OPTIONS' HTTP method.
 (defun url-http-options (url)
   "Return a property list describing options available for URL.
 This list is retrieved using the `OPTIONS' HTTP method.


@@ -1428,9 +1413,7 @@ p3p
 ;; with url-http.el on systems with 8-character file names.
 (require 'tls)
 
 ;; with url-http.el on systems with 8-character file names.
 (require 'tls)
 

-;;;###autoload

 (defconst url-https-default-port 443 "Default HTTPS port.")
 (defconst url-https-default-port 443 "Default HTTPS port.")

-;;;###autoload

 (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
 
 ;; FIXME what is the point of this alias being an autoload?
 (defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
 
 ;; FIXME what is the point of this alias being an autoload?