Re: url-retrieve may cause hang

[Magnus Henoch]

address@hidden (Kim F. Storm) writes:

> I doubt it is very tricky to do.  
>
> You should check with (featurep 'make-network-process '(:nowait t))
> to see if non-blocking connect is possible, and fallback to
> the current blocking code if not.
>
> Try making the change -- then we can look at the patches and judge
> whether it is ok to install before the release (if it hasn't happened
> before).

I have attached my first attempt.  There are two problems with it:

- DNS lookups are still synchronous.  It seems we would need an
  external library like GNU adns for that.

- There is no protocol for letting the callback know that retrieval
  failed.  Without this patch, the caller would immediately get an
  error, but now the error is signalled in the sentinel.  One solution
  would be to introduce an :error argument to the callback, similar to
  the :redirect one.

What do you think?

Magnus

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   17 Oct 2006 14:03:41 -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 
!                                               (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 17 Oct 2006 14:03:42 -0000
***************
*** 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
--- 1089,1120 ----
                                      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)
+   (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
+       ;; XXX: should the callback get this error?
+       (error "Could not create connection to %s:%d" (url-host 
url-current-object)
+            (url-port url-current-object))))))
+ 
  ;; 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