procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* url-http.el (url-http-mark-connection-as-free): Verify that

Browse source 
connection is open before saving it.
	(url-http-handle-authentication): Use url-retrieve-internal
	instead of url-retrieve.
	(url-http-parse-headers): Adapt to new callback interface.
	(url-http): Handle non-blocking connections.
	(url-http-async-sentinel): Create.

	* url.el (url-retrieve): Update docstring for new callback interface.
	Remove all code.
	(url-retrieve-internal): Move code from url-retrieve here.

	* url-gw.el (url-open-stream): Use a non-blocking socket for
	`native' gateway method, if available.
This commit is contained in:
Chong Yidong 2006-10-27 14:44:25 +00:00
parent d32f600dfc
commit 5695d1dd75
4 changed files with 124 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lisp/url/ChangeLog
View file

@ -1,3 +1,20 @@
2006-10-27 Magnus Henoch <mange@freemail.hu>
* url-http.el (url-http-mark-connection-as-free): Verify that
connection is open before saving it.
(url-http-handle-authentication): Use url-retrieve-internal
instead of url-retrieve.
(url-http-parse-headers): Adapt to new callback interface.
(url-http): Handle non-blocking connections.
(url-http-async-sentinel): Create.
* url.el (url-retrieve): Update docstring for new callback interface.
Remove all code.
(url-retrieve-internal): Move code from url-retrieve here.
* url-gw.el (url-open-stream): Use a non-blocking socket for
`native' gateway method, if available.
2006-10-16 Magnus Henoch <mange@freemail.hu>
* url-http.el (url-https-create-secure-wrapper): Always use tls

9
lisp/url/url-gw.el
View file

@ -210,7 +210,8 @@ linked Emacs under SunOS 4.x"
(defun url-open-stream (name buffer host service)
"Open a stream to HOST, possibly via a gateway.
Args per `open-network-stream'.
Will not make a connection if `url-gateway-unplugged' is non-nil."
Will not make a connection if `url-gateway-unplugged' is non-nil.
Might do a non-blocking connection; use `process-status' to check."
(unless url-gateway-unplugged
(let ((gw-method (if (and url-gateway-local-host-regexp
(not (eq 'tls url-gateway-method))
@ -249,7 +250,11 @@ Will not make a connection if `url-gateway-unplugged' is non-nil."
(ssl
(open-ssl-stream name buffer host service))
((native)
(open-network-stream name buffer host service))
;; Use non-blocking socket if we can.
(make-network-process :name name :buffer buffer
:host host :service service
:nowait
(and nil (featurep 'make-network-process '(:nowait t)))))
(socks
(socks-open-network-stream name buffer host service))
(telnet

89
lisp/url/url-http.el
View file

@ -92,11 +92,12 @@ request.")
(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)
@ -336,8 +337,8 @@ This allows us to use `mail-fetch-field', etc."
(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."
@ -520,18 +521,21 @@ should be shown to the user."
(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
@ -653,7 +657,13 @@ should be shown to the user."
;; 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
@ -702,7 +712,13 @@ should be shown to the user."
;; 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)))
@ -1089,11 +1105,38 @@ CBARGS as the arguments."
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

39
lisp/url/url.el
View file

@ -128,13 +128,39 @@ URL is either a string or a parsed URL.
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)
@ -211,6 +237,9 @@ no further processing). URL is either a string or a parsed 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