cvs diff: Diffing . Index: ChangeLog =================================================================== RCS file: /sources/emacs/emacs/lisp/url/ChangeLog,v retrieving revision 1.86 diff -c -r1.86 ChangeLog *** ChangeLog 16 Oct 2006 14:28:46 -0000 1.86 --- ChangeLog 25 Oct 2006 22:50:23 -0000 *************** *** 1,3 **** --- 1,20 ---- + 2006-10-23 Magnus Henoch + + * 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 * url-http.el (url-https-create-secure-wrapper): Always use tls Index: url-gw.el =================================================================== RCS file: /sources/emacs/emacs/lisp/url/url-gw.el,v retrieving revision 1.13 diff -c -r1.13 url-gw.el *** url-gw.el 26 Apr 2006 20:40:18 -0000 1.13 --- url-gw.el 25 Oct 2006 22:50:23 -0000 *************** *** 210,216 **** (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." (unless url-gateway-unplugged (let ((gw-method (if (and url-gateway-local-host-regexp (not (eq 'tls url-gateway-method)) --- 210,217 ---- (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. ! 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,255 **** (ssl (open-ssl-stream name buffer host service)) ((native) ! (open-network-stream name buffer host service)) (socks (socks-open-network-stream name buffer host service)) (telnet --- 250,260 ---- (ssl (open-ssl-stream name buffer host service)) ((native) ! ;; 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 Index: url-http.el =================================================================== RCS file: /sources/emacs/emacs/lisp/url/url-http.el,v retrieving revision 1.35 diff -c -r1.35 url-http.el *** url-http.el 16 Oct 2006 14:28:46 -0000 1.35 --- url-http.el 25 Oct 2006 22:50:23 -0000 *************** *** 92,102 **** (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) nil) (defun url-http-find-free-connection (host port) --- 92,103 ---- (defun url-http-mark-connection-as-free (host port proc) (url-http-debug "Marking connection as free: %s:%d %S" host port proc) ! (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,343 **** (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))))))) (defun url-http-parse-response () "Parse just the response code." --- 337,344 ---- (let ((url-request-method url-http-method) (url-request-data url-http-data) (url-request-extra-headers url-http-extra-headers)) ! (url-retrieve-internal url url-callback-function ! url-callback-arguments))))))) (defun url-http-parse-response () "Parse just the response code." *************** *** 520,537 **** (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)))))) (4 ; Client error ;; 400 Bad Request ;; 401 Unauthorized --- 521,541 ---- (let ((url-request-method url-http-method) (url-request-data url-http-data) (url-request-extra-headers url-http-extra-headers)) ! ;; 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,659 **** ;; 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)))) (5 ;; 500 Internal server error ;; 501 Not implemented --- 657,669 ---- ;; 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))) ! ;; 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,708 **** ;; 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))) (otherwise (error "Unknown class of HTTP response code: %d (%d)" class url-http-response-status))) --- 712,724 ---- ;; 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)) ! ;; 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,1099 **** 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)))) buffer)) ;; 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 --- 1105,1142 ---- url-current-object)) (set-process-buffer connection buffer) (set-process-filter connection 'url-http-generic-filter) ! (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 Index: url.el =================================================================== RCS file: /sources/emacs/emacs/lisp/url/url.el,v retrieving revision 1.21 diff -c -r1.21 url.el *** url.el 20 Feb 2006 21:54:08 -0000 1.21 --- url.el 25 Oct 2006 22:50:23 -0000 *************** *** 128,140 **** 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. Return the buffer URL will load into, or nil if the process has ! already completed." (url-do-setup) (url-gc-dead-buffers) (if (stringp url) --- 128,166 ---- CALLBACK is called when the object has been completely retrieved, with the current buffer containing the object, and any MIME headers associated ! 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 (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,216 **** --- 237,245 ---- ;; 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