Merge from trunk.

8 files changed, 95 insertions, 45 deletions

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 55aa9194904..d6e25188c69 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,24 @@
+2012-03-25  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * url-queue.el (url-queue-kill-job): Check whether the buffer has
+        been killed asynchronously before selecting it.
+
+2012-03-14  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+        * url-queue.el (url-queue-kill-job): Make sure that the callback
+        is always called, even if we have a timeout.
+
+2012-03-11  Chong Yidong  <cyd@gnu.org>
+
+        * url-http.el (url-http-end-of-document-sentinel): Handle
+        keepalive expiry by calling url-http again (Bug#10223).
+        (url-http): New arg, for the above.
+
+2012-03-11  Devon Sean McCullough  <emacs-hacker2012@jovi.net>
+
+        * url-http.el (url-http-find-free-connection): Don't pass a nil
+        argument to url-http-mark-connection-as-busy (bug#10891).
+
 2012-02-20  Lars Ingebrigtsen  <larsi@gnus.org>
 
         * url-queue.el (url-queue-kill-job): Delete the process sentinel
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index 03527bceee7..085785524b7 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -478,7 +478,7 @@ names (ie: DAV:resourcetype)."
 
 ;;; Locking support
 (defvar url-dav-lock-identifier (concat "mailto:" user-mail-address)
-  "*URL used as contact information when creating locks in DAV.
+  "URL used as contact information when creating locks in DAV.
 This will be used as the contents of the DAV:owner/DAV:href tag to
 identify the owner of a LOCK when requesting it.  This will be shown
 to other users when the DAV:lockdiscovery property is requested, so
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 4bc5bd47488..d00a1174cdf 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -92,7 +92,7 @@
 
 (defvar url-handler-regexp
   "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
-  "*A regular expression for matching URLs handled by `file-name-handler-alist'.
+  "A regular expression for matching URLs handled by `file-name-handler-alist'.
 Some valid URL protocols just do not make sense to visit interactively
 \(about, data, info, irc, mailto, etc\).  This regular expression
 avoids conflicts with local files that look like URLs \(Gnus is
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 0c911260ca5..a4726489814 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -27,6 +27,7 @@
 (eval-when-compile (require 'cl))
 (defvar url-http-extra-headers)
 (defvar url-http-target-url)
+(defvar url-http-no-retry)
 (defvar url-http-proxy)
 (defvar url-http-connection-opened)
 (require 'url-gw)
@@ -153,38 +154,40 @@ request.")
 
 (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))
-        (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))
-    (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-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 ()
@@ -873,19 +876,26 @@ should be shown to the user."
               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))
-      (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)
+               (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
@@ -1163,11 +1173,14 @@ the end of the document."
       (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.
 When retrieval is completed, the function CALLBACK is executed with
-CBARGS as the arguments."
+CBARGS as the arguments.
+
+Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
+previous `url-http' call, which is being re-attempted."
   (check-type url vector "Need a pre-parsed URL.")
   (declare (special url-current-object
                     url-http-end-of-headers
@@ -1188,7 +1201,8 @@ CBARGS as the arguments."
   (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
@@ -1218,6 +1232,7 @@ CBARGS as the arguments."
                        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))
@@ -1233,6 +1248,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-http-no-retry retry-buffer
               url-http-connection-opened nil
               url-http-proxy url-using-proxy)
 
@@ -1259,6 +1275,7 @@ CBARGS as the arguments."
     (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)
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 7c988f9b119..0ea98cb06c9 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -64,7 +64,7 @@
     ("facsimiletelephonenumber" . "Fax")
     ("postaladdress"            . "Mailing Address")
     ("description"              . "Notes"))
-  "*An assoc list mapping LDAP attribute names to pretty descriptions of them.")
+  "An assoc list mapping LDAP attribute names to pretty descriptions of them.")
 
 (defvar url-ldap-attribute-formatters
   '(("mail"       . (lambda (x) (format "<a href='mailto:%s'>%s</a>" x x)))
@@ -76,7 +76,7 @@
     ("namingcontexts" . url-ldap-dn-formatter)
     ("defaultnamingcontext" . url-ldap-dn-formatter)
     ("member"     . url-ldap-dn-formatter))
-  "*An assoc list mapping LDAP attribute names to pretty formatters for them.")
+  "An assoc list mapping LDAP attribute names to pretty formatters for them.")
 
 (defsubst url-ldap-attribute-pretty-name (n)
   (or (cdr-safe (assoc (downcase n) url-ldap-pretty-names)) n))
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index a22d105b1a1..bfab147f267 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -29,7 +29,7 @@
 
 (defvar url-nfs-automounter-directory-spec
   "file:/net/%h%f"
-  "*How to invoke the NFS automounter.  Certain % sequences are recognized.
+  "How to invoke the NFS automounter.  Certain % sequences are recognized.
 
 %h -- the hostname of the NFS server
 %n -- the port # of the NFS server
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index 6e4cedddaf3..917c787df29 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -156,9 +156,21 @@ The variable `url-queue-timeout' sets a timeout."
       (while (setq process (get-buffer-process (url-queue-buffer job)))
         (set-process-sentinel process 'ignore)
         (ignore-errors
-          (delete-process process))))
-    (ignore-errors
-      (kill-buffer (url-queue-buffer job)))))
+          (delete-process process)))))
+  ;; Call the callback with an error message to ensure that the caller
+  ;; is notified that the job has failed.
+  (with-current-buffer
+      (if (and (bufferp (url-queue-buffer job))
+               (buffer-live-p (url-queue-buffer job)))
+          ;; Use the (partially filled) process buffer it it exists.
+          (url-queue-buffer job)
+        ;; If not, just create a new buffer, which will probably be
+        ;; killed again by the caller.
+        (generate-new-buffer " *temp*"))
+    (apply (url-queue-callback job)
+           (cons (list :error (list 'error 'url-queue-timeout
+                                    "Queue timeout exceeded"))
+                 (url-queue-cbargs job)))))
 
 (provide 'url-queue)
 
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index a56eb4cc810..ff18049e97b 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -212,7 +212,7 @@ Should be an assoc list of headers/contents.")
 
 ;; FIXME!!  (RFC 2616 gives examples like `compress, gzip'.)
 (defvar url-mime-encoding-string nil
-  "*String to send in the Accept-encoding: field in HTTP requests.")
+  "String to send in the Accept-encoding: field in HTTP requests.")
 
 ;; Perhaps the first few should actually be given decreasing `q's and
 ;; the list should be trimmed significantly.
@@ -233,7 +233,7 @@ Generated according to current coding system priorities."
                 ";q=0.5"))))
 
 (defvar url-mime-charset-string nil
-  "*String to send in the Accept-charset: field in HTTP requests.
+  "String to send in the Accept-charset: field in HTTP requests.
 The MIME charset corresponding to the most preferred coding system is
 given priority 1 and the rest are given priority 0.5.")
 
@@ -364,7 +364,7 @@ Currently supported methods:
 
 (defvar url-parse-syntax-table
   (copy-syntax-table emacs-lisp-mode-syntax-table)
-  "*A syntax table for parsing URLs.")
+  "A syntax table for parsing URLs.")
 
 (modify-syntax-entry ?' "\"" url-parse-syntax-table)
 (modify-syntax-entry ?` "\"" url-parse-syntax-table)
@@ -373,7 +373,7 @@ Currently supported methods:
 (modify-syntax-entry ?/ " " url-parse-syntax-table)
 
 (defvar url-load-hook nil
-  "*Hooks to be run after initializing the URL library.")
+  "Hooks to be run after initializing the URL library.")
 
 ;;; Make OS/2 happy - yeeks
 ;; (defvar      tcp-binary-process-input-services nil