bug#37408: 27.0.50; list-processes can hang

[Lars Ingebrigtsen <larsi@gnus.org>]

OK, here's the relevant data in list-processes:

    p = #<process raw.githubusercontent.com<3>>
    type = network
    name = "raw.githubusercontent.com<3>"
    status = "connect"

The problem here is that when a process in the status "connect", it may
be in two distinctly different states: It may still be doing the DNS
lookup (which may fail for some reason or other), and it'll never
progress from that state.  This is usually cleaned up by whatever the
caller is, but if the user has `C-g' somewhere, the process may linger
in that condition.

And if it's in that state, then the rest of Fprocess_contact can't be
done, because the data isn't present.

But there's another "connect" state -- after the DNS has been completed,
and we're doing a TCP connect.  In that case, the rest of the function
is fine to do, because we've filled in the peer etc.

`list-processes' could avoid calling Fprocess_contact if the status is
"connect", but that would lose info on processes in the second
sub-state.

So I don't know...  Anybody got an idea?  Introducing a new state
("pre-connect") would probably break a lot of stuff; adding a timeout
parameter and then return nil if it's exceeded would be possible; making
list-processes not display the details for all "connect" processes is
possible.  It would look like this:

raw.githubus... --      connect  *http raw.githubuserc... --           Main         (connecting)

Patch for reference.

diff --git a/lisp/simple.el b/lisp/simple.el
index 358b6a4f20..5812111109 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4107,30 +4107,32 @@ list-processes--refresh
 		    (t "--")))
 		  (cmd
 		   (if (memq type '(network serial))
-		       (let ((contact (process-contact p t)))
-			 (if (eq type 'network)
-			     (format "(%s %s)"
-				     (if (plist-get contact :type)
-					 "datagram"
-				       "network")
-				     (if (plist-get contact :server)
-					 (format
-                                          "server on %s"
-					  (if (plist-get contact :host)
-                                              (format "%s:%s"
-						      (plist-get contact :host)
-                                                      (plist-get
-                                                       contact :service))
-					    (plist-get contact :local)))
-				       (format "connection to %s:%s"
-					       (plist-get contact :host)
-					       (plist-get contact :service))))
-			   (format "(serial port %s%s)"
-				   (or (plist-get contact :port) "?")
-				   (let ((speed (plist-get contact :speed)))
-				     (if speed
-					 (format " at %s b/s" speed)
-				       "")))))
+                       (if (equal status "connect")
+                           "(connecting)"
+		         (let ((contact (process-contact p t)))
+			   (if (eq type 'network)
+			       (format "(%s %s)"
+				       (if (plist-get contact :type)
+					   "datagram"
+				         "network")
+				       (if (plist-get contact :server)
+					   (format
+                                            "server on %s"
+					    (if (plist-get contact :host)
+                                                (format "%s:%s"
+						        (plist-get contact :host)
+                                                        (plist-get
+                                                         contact :service))
+					      (plist-get contact :local)))
+				         (format "connection to %s:%s"
+					         (plist-get contact :host)
+					         (plist-get contact :service))))
+			     (format "(serial port %s%s)"
+				     (or (plist-get contact :port) "?")
+				     (let ((speed (plist-get contact :speed)))
+				       (if speed
+					   (format " at %s b/s" speed)
+				         ""))))))
 		     (mapconcat 'identity (process-command p) " "))))
 	     (push (list p (vector name pid status buf-label tty thread cmd))
 		   tabulated-list-entries)))))


-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no