(url-http): Define url-http-response-version.

(url-http-parse-response): Set it.
(url-http-parse-headers): Use it to determine keep-alive behavior.

2 files changed, 24 insertions, 4 deletions

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 2175a4e53d0..c50dcf52897 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -2,6 +2,9 @@
 
         * url-http.el (url-http-wait-for-headers-change-function): Use
         `when' instead of `if' when possible.
+        (url-http): Define url-http-response-version.
+        (url-http-parse-response): Set it.
+        (url-http-parse-headers): Use it to determine keep-alive behavior.
 
 2006-11-23  Diane Murray  <disumu@x3y2z1.net>
 
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 2fb608d2b92..ad556c30a07 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -358,14 +358,19 @@ This allows us to use `mail-fetch-field', etc."
 
 (defun url-http-parse-response ()
   "Parse just the response code."
-  (declare (special url-http-end-of-headers url-http-response-status))
+  (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))
   (goto-char (point-min))
   (skip-chars-forward " \t\n")          ; Skip any blank crap
   (skip-chars-forward "HTTP/")          ; Skip HTTP Version
-  (read (current-buffer))
+  (setq url-http-response-version
+        (buffer-substring (point)
+                          (progn
+                            (skip-chars-forward "[0-9].")
+                            (point))))
   (setq url-http-response-status (read (current-buffer))))
 
 (defun url-http-handle-cookies ()
@@ -391,6 +396,7 @@ 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))
 
@@ -407,9 +413,19 @@ should be shown to the user."
   (mail-narrow-to-head)
   ;;(narrow-to-region (point-min) url-http-end-of-headers)
   (let ((connection (mail-fetch-field "Connection")))
-    (if (and connection
-             (string= (downcase connection) "close"))
+    ;; In HTTP 1.0, keep the connection only if there is a
+    ;; "Connection: keep-alive" header.
+    ;; In HTTP 1.1 (and greater), keep the connection unless there is a
+    ;; "Connection: close" header
+    (cond 
+     ((string= url-http-response-version "1.0")
+      (unless (and connection
+                   (string= (downcase connection) "keep-alive"))
         (delete-process url-http-process)))
+     (t
+      (when (and connection
+                 (string= (downcase connection) "close"))
+        (delete-process url-http-process)))))
   (let ((class nil)
         (success nil))
     (setq class (/ url-http-response-status 100))
@@ -1093,6 +1109,7 @@ CBARGS as the arguments."
                        url-http-content-length
                        url-http-transfer-encoding
                        url-http-after-change-function
+                       url-http-response-version
                        url-http-response-status
                        url-http-chunked-length
                        url-http-chunked-counter