(defun url-http-mark-connection-as-free (host port proc)
(url-http-debug "Marking connection as free: %s:%d %S" host port proc)
- (set-process-buffer proc nil)
- (set-process-sentinel proc 'url-http-idle-sentinel)
- (puthash (cons host port)
- (cons proc (gethash (cons host port) url-http-open-connections))
- url-http-open-connections)
+ (when (memq (process-status proc) '(open run))
+ (set-process-buffer proc nil)
+ (set-process-sentinel proc 'url-http-idle-sentinel)
+ (puthash (cons host port)
+ (cons proc (gethash (cons host port) url-http-open-connections))
+ url-http-open-connections))
nil)
(defun url-http-find-free-connection (host port)
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers url-http-extra-headers))
- (url-retrieve url url-callback-function
- url-callback-arguments)))))))
+ (url-retrieve-internal url url-callback-function
+ url-callback-arguments)))))))
(defun url-http-parse-response ()
"Parse just the response code."
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers url-http-extra-headers))
- ;; Put in the current buffer a forwarding pointer to the new
- ;; destination buffer.
- ;; FIXME: This is a hack to fix url-retrieve-synchronously
- ;; 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 redirect-uri url-callback-function
- (cons :redirect
- (cons redirect-uri
- url-callback-arguments))))
- (url-mark-buffer-as-dead (current-buffer))))))
+ ;; Remember that the request was redirected.
+ (setf (car url-callback-arguments)
+ (nconc (list :redirect redirect-uri)
+ (car url-callback-arguments)))
+ ;; Put in the current buffer a forwarding pointer to the new
+ ;; destination buffer.
+ ;; FIXME: This is a hack to fix url-retrieve-synchronously
+ ;; 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-mark-buffer-as-dead (current-buffer)))))))
(4 ; Client error
;; 400 Bad Request
;; 401 Unauthorized
;; The request could not be understood by the server due to
;; malformed syntax. The client SHOULD NOT repeat the
;; request without modifications.
- (setq success t))))
+ (setq success t)))
+ ;; Tell the callback that an error occurred, and what the
+ ;; status code was.
+ (when success
+ (setf (car url-callback-arguments)
+ (nconc (list :error (list 'error 'http url-http-response-status))
+ (car url-callback-arguments)))))
(5
;; 500 Internal server error
;; 501 Not implemented
;; which received this status code was the result of a user
;; action, the request MUST NOT be repeated until it is
;; requested by a separate user action.
- nil)))
+ nil))
+ ;; Tell the callback that an error occurred, and what the
+ ;; status code was.
+ (when success
+ (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)))
url-current-object))
(set-process-buffer connection buffer)
- (set-process-sentinel connection 'url-http-end-of-document-sentinel)
(set-process-filter connection 'url-http-generic-filter)
- (process-send-string connection (url-http-create-request url))))
+ (let ((status (process-status connection)))
+ (cond
+ ((eq status 'connect)
+ ;; Asynchronous connection
+ (set-process-sentinel connection 'url-http-async-sentinel))
+ ((eq status 'failed)
+ ;; Asynchronous connection failed
+ (error "Could not create connection to %s:%d" (url-host url)
+ (url-port url)))
+ (t
+ (set-process-sentinel connection 'url-http-end-of-document-sentinel)
+ (process-send-string connection (url-http-create-request url)))))))
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.
+ (with-current-buffer (process-buffer proc)
+ (cond
+ ((string= (substring why 0 4) "open")
+ (set-process-sentinel proc 'url-http-end-of-document-sentinel)
+ (process-send-string proc (url-http-create-request url-current-object)))
+ (t
+ (setf (car url-callback-arguments)
+ (nconc (list :error (list 'error 'connection-failed why
+ :host (url-host url-current-object)
+ :service (url-port url-current-object)))
+ (car url-callback-arguments)))
+ (url-http-activate-callback)))))
+
;; Since Emacs 19/20 does not allow you to change the
;; `after-change-functions' hook in the midst of running them, we fake
;; an after change by hooking into the process filter and inserting
CALLBACK is called when the object has been completely retrieved, with
the current buffer containing the object, and any MIME headers associated
-with it. Normally it gets the arguments in the list CBARGS.
-However, if what we find is a redirect, CALLBACK is given
-two additional args, `:redirect' and the redirected URL,
-followed by CBARGS.
+with it. It is called as (apply CALLBACK STATUS CBARGS), where STATUS
+is a list with an even number of elements representing what happened
+during the request, with most recent events first. Each pair is one
+of:
+
+\(:redirect REDIRECTED-TO) - the request was redirected to this URL
+\(:error (ERROR-SYMBOL . DATA)) - an error occurred. The error can be
+signaled with (signal ERROR-SYMBOL DATA).
Return the buffer URL will load into, or nil if the process has
-already completed."
+already completed (i.e. URL was a mailto URL or similar; in this case
+the callback is not called).
+
+The variables `url-request-data', `url-request-method' and
+`url-request-extra-headers' can be dynamically bound around the
+request; dynamic binding of other variables doesn't necessarily
+take effect."
+;;; XXX: There is code in Emacs that does dynamic binding
+;;; of the following variables around url-retrieve:
+;;; url-standalone-mode, url-gateway-unplugged, w3-honor-stylesheets,
+;;; url-confirmation-func, url-cookie-multiple-line,
+;;; url-cookie-{{,secure-}storage,confirmation}
+;;; url-standalone-mode and url-gateway-unplugged should work as
+;;; usual. url-confirmation-func is only used in nnwarchive.el and
+;;; webmail.el; the latter should be updated. Is
+;;; url-cookie-multiple-line needed anymore? The other url-cookie-*
+;;; are (for now) only used in synchronous retrievals.
+ (url-retrieve-internal url callback (cons nil cbargs)))
+
+(defun url-retrieve-internal (url callback cbargs)
+ "Internal function; external interface is `url-retrieve'.
+CBARGS is what the callback will actually receive - the first item is
+the list of events, as described in the docstring of `url-retrieve'."
(url-do-setup)
(url-gc-dead-buffers)
(if (stringp url)
;; clear that it's a bug, but even then we need to decide how
;; url-http can then warn us that the download has completed.
;; In the mean time, we use this here workaround.
+ ;; XXX: The callback must always be called. Any
+ ;; exception is a bug that should be fixed, not worked
+ ;; around.
(setq retrieval-done t))
;; We used to use `sit-for' here, but in some cases it wouldn't
;; work because apparently pending keyboard input would always
projects / emacs.git / commitdiff