From: Magnus Henoch <mange@freemail.hu>
Date: Sun, 26 Nov 2006 13:22:52 +0000 (+0000)
Subject: (url-http): Define url-http-response-version.
X-Git-Tag: emacs-pretest-22.0.92~500
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b9b172ace737cc3d3df1af5b90e5e5a6b277bd6a;p=emacs.git

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

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