bug#56025: [WIP PATCH] 29.0.50; em-extpipe-test-2 times out on EMBA and Cygwin

[Jim Porter <jporterbugs@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1504 bytes --]

On 7/7/2022 5:42 AM, Ken Brown wrote:
> On 7/7/2022 12:42 AM, Jim Porter wrote:
>> On 7/6/2022 9:35 PM, Jim Porter wrote:
>>> Maybe it would be good to do it this way in general though, since 
>>> this would let us completely avoid the behavioral differences of EOF 
>>> on various platforms. I believe using a pipe should work consistently 
>>> everywhere, right? (It would also probably fix some other issues with 
>>> Eshell pipelines, but I'll need to read up on ptys, since it's been a 
>>> long time since I've done anything with them.)
>>
>> Just to clarify: by "do it this way in general", I only mean using a 
>> pipe when connecting commands in Eshell via "|", not using 
>> `eshell-needs-pipe'. This would necessitate enhancing `make-process' 
>> and friends to support what I described elsewhere.
> 
> That makes sense to me.

Ok, attached is a WIP patch to do this. It seems to work for me under 
Cygwin, although I've only lightly tested it in that environment. If 
this works for you too, I'll finish cleaning this up and add 
tests/documentation for it.

Note that in my patch, I temporarily undid my previous patch to send EOF 
multiple times. This is just for testing purposes, but since we're using 
a pipe for this connection now, a single call to `process-send-eof' 
should be sufficient. (There are some obscure cases where we might want 
to keep the current behavior, like redirecting to a process created some 
other way, so I think it makes sense to keep that code. Probably...)

[-- Attachment #2: 0001-WIP-Allow-using-PTYs-for-just-stdin-or-stdout-in-mak.patch --]
[-- Type: text/plain, Size: 17269 bytes --]

From f82c12f07ffc7c6c9db1232c7f6721e0a1ce300b Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sat, 16 Jul 2022 16:49:43 -0700
Subject: [PATCH] WIP: Allow using PTYs for just stdin or stdout in
 make-process

---
 lisp/eshell/esh-io.el   |   2 +-
 lisp/eshell/esh-proc.el |  48 +++++++------------
 src/callproc.c          |  37 ++++++++------
 src/lisp.h              |   3 +-
 src/process.c           | 104 ++++++++++++++++++++++++----------------
 src/process.h           |   5 +-
 6 files changed, 108 insertions(+), 91 deletions(-)

diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index c035890ddf..2f5091000b 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -287,7 +287,7 @@ eshell-close-target
     ;; anything, we'll just send the maximum we'd ever need.  See
     ;; bug#56025 for further details.
     (let ((i 0))
-      (while (and (<= (cl-incf i) 3)
+      (while (and (<= (cl-incf i) 1)    ; FIXME: Put this back at 3.
                   (eq (process-status target) 'run))
         (process-send-eof target))))
 
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 70426ccaf2..f5421ddd28 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -250,30 +250,6 @@ eshell-last-sync-output-start
   "A marker that tracks the beginning of output of the last subprocess.
 Used only on systems which do not support async subprocesses.")
 
-(defvar eshell-needs-pipe
-  '("bc"
-    ;; xclip.el (in GNU ELPA) calls all of these with
-    ;; `process-connection-type' set to nil.
-    "pbpaste" "putclip" "xclip" "xsel" "wl-copy")
-  "List of commands which need `process-connection-type' to be nil.
-Currently only affects commands in pipelines, and not those at
-the front.  If an element contains a directory part it must match
-the full name of a command, otherwise just the nondirectory part must match.")
-
-(defun eshell-needs-pipe-p (command)
-  "Return non-nil if COMMAND needs `process-connection-type' to be nil.
-See `eshell-needs-pipe'."
-  (and (bound-and-true-p eshell-in-pipeline-p)
-       (not (eq eshell-in-pipeline-p 'first))
-       ;; FIXME should this return non-nil for anything that is
-       ;; neither 'first nor 'last?  See bug#1388 discussion.
-       (catch 'found
-	 (dolist (exe eshell-needs-pipe)
-	   (if (string-equal exe (if (string-search "/" exe)
-				     command
-				   (file-name-nondirectory command)))
-	       (throw 'found t))))))
-
 (defun eshell-gather-process-output (command args)
   "Gather the output from COMMAND + ARGS."
   (require 'esh-var)
@@ -290,12 +266,24 @@ eshell-gather-process-output
     (cond
      ((fboundp 'make-process)
       (setq proc
-	    (let ((process-connection-type
-		   (unless (eshell-needs-pipe-p command)
-		     process-connection-type))
-		  (command (file-local-name (expand-file-name command))))
-	      (apply #'start-file-process
-		     (file-name-nondirectory command) nil command args)))
+	    (let ((command (file-local-name (expand-file-name command)))
+                  ;; FIXME: This is a bad way to do this, but it
+                  ;; should suffice for a proof of concept...
+                  (conn-type (cond
+                              ((eq eshell-in-pipeline-p 'first) 1)
+                              ((eq eshell-in-pipeline-p 'last) 2)
+                              (eshell-in-pipeline-p 0)
+                              (t 3))))
+              (make-process
+               :name (file-name-nondirectory command)
+               :buffer (current-buffer)
+               :command (cons command args)
+               :filter (if (eshell-interactive-output-p)
+	                   #'eshell-output-filter
+                         #'eshell-insertion-filter)
+               :sentinel #'eshell-sentinel
+               :connection-type conn-type
+               :file-handler t)))
       (eshell-record-process-object proc)
       (set-process-buffer proc (current-buffer))
       (set-process-filter proc (if (eshell-interactive-output-p)
diff --git a/src/callproc.c b/src/callproc.c
index dd162f36a6..aec0a2f5a5 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -650,7 +650,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
 
   child_errno
     = emacs_spawn (&pid, filefd, fd_output, fd_error, new_argv, env,
-                   SSDATA (current_dir), NULL, &oldset);
+                   SSDATA (current_dir), NULL, false, false, &oldset);
   eassert ((child_errno == 0) == (0 < pid));
 
   if (pid > 0)
@@ -1412,14 +1412,15 @@ emacs_posix_spawn_init_attributes (posix_spawnattr_t *attributes,
 int
 emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
              char **argv, char **envp, const char *cwd,
-             const char *pty, const sigset_t *oldset)
+             const char *pty_name, bool pty_in, bool pty_out,
+             const sigset_t *oldset)
 {
 #if USABLE_POSIX_SPAWN
   /* Prefer the simpler `posix_spawn' if available.  `posix_spawn'
      doesn't yet support setting up pseudoterminals, so we fall back
      to `vfork' if we're supposed to use a pseudoterminal.  */
 
-  bool use_posix_spawn = pty == NULL;
+  bool use_posix_spawn = pty_name == NULL;
 
   posix_spawn_file_actions_t actions;
   posix_spawnattr_t attributes;
@@ -1473,7 +1474,9 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
   /* vfork, and prevent local vars from being clobbered by the vfork.  */
   pid_t *volatile newpid_volatile = newpid;
   const char *volatile cwd_volatile = cwd;
-  const char *volatile pty_volatile = pty;
+  const char *volatile ptyname_volatile = pty_name;
+  bool volatile ptyin_volatile = pty_in;
+  bool volatile ptyout_volatile = pty_out;
   char **volatile argv_volatile = argv;
   int volatile stdin_volatile = std_in;
   int volatile stdout_volatile = std_out;
@@ -1495,7 +1498,9 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
 
   newpid = newpid_volatile;
   cwd = cwd_volatile;
-  pty = pty_volatile;
+  pty_name = ptyname_volatile;
+  pty_in = ptyin_volatile;
+  pty_out = ptyout_volatile;
   argv = argv_volatile;
   std_in = stdin_volatile;
   std_out = stdout_volatile;
@@ -1506,13 +1511,12 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
   if (pid == 0)
 #endif /* not WINDOWSNT */
     {
-      bool pty_flag = pty != NULL;
       /* Make the pty be the controlling terminal of the process.  */
 #ifdef HAVE_PTYS
       dissociate_controlling_tty ();
 
       /* Make the pty's terminal the controlling terminal.  */
-      if (pty_flag && std_in >= 0)
+      if (pty_in && std_in >= 0)
 	{
 #ifdef TIOCSCTTY
 	  /* We ignore the return value
@@ -1521,7 +1525,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
 #endif
 	}
 #if defined (LDISC1)
-      if (pty_flag && std_in >= 0)
+      if (pty_in && std_in >= 0)
 	{
 	  struct termios t;
 	  tcgetattr (std_in, &t);
@@ -1531,7 +1535,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
 	}
 #else
 #if defined (NTTYDISC) && defined (TIOCSETD)
-      if (pty_flag && std_in >= 0)
+      if (pty_in && std_in >= 0)
 	{
 	  /* Use new line discipline.  */
 	  int ldisc = NTTYDISC;
@@ -1548,18 +1552,21 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
      both TIOCSCTTY is defined.  */
 	/* Now close the pty (if we had it open) and reopen it.
 	   This makes the pty the controlling terminal of the subprocess.  */
-      if (pty_flag)
+      if (pty_name)
 	{
 
 	  /* I wonder if emacs_close (emacs_open (pty, ...))
 	     would work?  */
-	  if (std_in >= 0)
+	  if (pty_in && std_in >= 0)
 	    emacs_close (std_in);
-          std_out = std_in = emacs_open_noquit (pty, O_RDWR, 0);
-
+	  int ptyfd = emacs_open_noquit (pty_name, O_RDWR, 0);
+	  if (pty_in)
+	    std_in = ptyfd;
+	  if (pty_out)
+	    std_out = ptyfd;
 	  if (std_in < 0)
 	    {
-	      emacs_perror (pty);
+	      emacs_perror (pty_name);
 	      _exit (EXIT_CANCELED);
 	    }
 
@@ -1599,7 +1606,7 @@ emacs_spawn (pid_t *newpid, int std_in, int std_out, int std_err,
       /* Stop blocking SIGCHLD in the child.  */
       unblock_child_signal (oldset);
 
-      if (pty_flag)
+      if (pty_out)
 	child_setup_tty (std_out);
 #endif
 
diff --git a/src/lisp.h b/src/lisp.h
index dc496cc165..1a731c5dce 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4935,7 +4935,8 @@ #define DAEMON_RUNNING (w32_daemon_event != INVALID_HANDLE_VALUE)
 #endif
 
 extern int emacs_spawn (pid_t *, int, int, int, char **, char **,
-                        const char *, const char *, const sigset_t *);
+                        const char *, const char *, bool, bool,
+                        const sigset_t *);
 extern char **make_environment_block (Lisp_Object) ATTRIBUTE_RETURNS_NONNULL;
 extern void init_callproc_1 (void);
 extern void init_callproc (void);
diff --git a/src/process.c b/src/process.c
index d6d51b26e1..9858183ca0 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1846,20 +1846,23 @@ DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
 
   tem = plist_get (contact, QCconnection_type);
   if (EQ (tem, Qpty))
-    XPROCESS (proc)->pty_flag = true;
+    XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out = true;
   else if (EQ (tem, Qpipe))
-    XPROCESS (proc)->pty_flag = false;
+    XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out = false;
   else if (NILP (tem))
-    XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
+    XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out =
+      !NILP (Vprocess_connection_type);
+  else if (FIXNUMP (tem))
+    {
+      /* FIXME: Provide a better way of setting these independently.  */
+      XPROCESS (proc)->pty_in = XFIXNAT(tem) & 1;
+      XPROCESS (proc)->pty_out = XFIXNAT(tem) & 2;
+    }
   else
     report_file_error ("Unknown connection type", tem);
 
   if (!NILP (stderrproc))
-    {
-      pset_stderrproc (XPROCESS (proc), stderrproc);
-
-      XPROCESS (proc)->pty_flag = false;
-    }
+    pset_stderrproc (XPROCESS (proc), stderrproc);
 
 #ifdef HAVE_GNUTLS
   /* AKA GNUTLS_INITSTAGE(proc).  */
@@ -2099,66 +2102,80 @@ verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
 {
   struct Lisp_Process *p = XPROCESS (process);
-  int inchannel, outchannel;
+  int inchannel = -1, outchannel = -1;
   pid_t pid = -1;
   int vfork_errno;
   int forkin, forkout, forkerr = -1;
-  bool pty_flag = 0;
+  bool pty_in = false, pty_out = false;
   char pty_name[PTY_NAME_SIZE];
   Lisp_Object lisp_pty_name = Qnil;
+  int ptychannel = -1, pty_tty = -1;
   sigset_t oldset;
 
   /* Ensure that the SIGCHLD handler can notify
      `wait_reading_process_output'.  */
   child_signal_init ();
 
-  inchannel = outchannel = -1;
-
-  if (p->pty_flag)
-    outchannel = inchannel = allocate_pty (pty_name);
+  if (p->pty_in || p->pty_out)
+    ptychannel = allocate_pty (pty_name);
 
-  if (inchannel >= 0)
+  if (ptychannel >= 0)
     {
-      p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
       /* On most USG systems it does not work to open the pty's tty here,
 	 then close it and reopen it in the child.  */
       /* Don't let this terminal become our controlling terminal
 	 (in case we don't have one).  */
-      forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
-      if (forkin < 0)
+      pty_tty = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
+      if (pty_tty < 0)
 	report_file_error ("Opening pty", Qnil);
-      p->open_fd[SUBPROCESS_STDIN] = forkin;
-#else
-      forkin = forkout = -1;
 #endif /* not USG, or USG_SUBTTY_WORKS */
-      pty_flag = 1;
+      pty_in = p->pty_in;
+      pty_out = p->pty_out;
       lisp_pty_name = build_string (pty_name);
     }
+
+  /* Set up stdin for the child process.  */
+  if (ptychannel >= 0 && p->pty_in)
+    {
+      p->open_fd[SUBPROCESS_STDIN] = forkin = pty_tty;
+      outchannel = ptychannel;
+    }
   else
     {
-      if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
-	  || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
+      if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0)
 	report_file_error ("Creating pipe", Qnil);
       forkin = p->open_fd[SUBPROCESS_STDIN];
       outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
+    }
+
+  /* Set up stdout for the child process.  */
+  if (ptychannel >= 0 && p->pty_out)
+    {
+      forkout = pty_tty;
+      p->open_fd[READ_FROM_SUBPROCESS] = inchannel = ptychannel;
+    }
+  else
+    {
+      if (emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
+	report_file_error ("Creating pipe", Qnil);
       inchannel = p->open_fd[READ_FROM_SUBPROCESS];
       forkout = p->open_fd[SUBPROCESS_STDOUT];
 
 #if defined(GNU_LINUX) && defined(F_SETPIPE_SZ)
       fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max);
 #endif
+    }
 
-      if (!NILP (p->stderrproc))
-	{
-	  struct Lisp_Process *pp = XPROCESS (p->stderrproc);
+  if (!NILP (p->stderrproc))
+    {
+      struct Lisp_Process *pp = XPROCESS (p->stderrproc);
 
-	  forkerr = pp->open_fd[SUBPROCESS_STDOUT];
+      forkerr = pp->open_fd[SUBPROCESS_STDOUT];
 
-	  /* Close unnecessary file descriptors.  */
-	  close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
-	  close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
-	}
+      /* Close unnecessary file descriptors.  */
+      close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
+      close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
     }
 
   if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
@@ -2183,7 +2200,8 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
      we just reopen the device (see emacs_get_tty_pgrp) as this is
      more portable (see USG_SUBTTY_WORKS above).  */
 
-  p->pty_flag = pty_flag;
+  p->pty_in = pty_in;
+  p->pty_out = pty_out;
   pset_status (p, Qrun);
 
   if (!EQ (p->command, Qt)
@@ -2199,13 +2217,15 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
   block_input ();
   block_child_signal (&oldset);
 
-  pty_flag = p->pty_flag;
-  eassert (pty_flag == ! NILP (lisp_pty_name));
+  pty_in = p->pty_in;
+  pty_out = p->pty_out;
+  eassert ((pty_in || pty_out) == ! NILP (lisp_pty_name));
 
   vfork_errno
     = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
                    SSDATA (current_dir),
-                   pty_flag ? SSDATA (lisp_pty_name) : NULL, &oldset);
+                   pty_in || pty_out ? SSDATA (lisp_pty_name) : NULL,
+                   pty_in, pty_out, &oldset);
 
   eassert ((vfork_errno == 0) == (0 < pid));
 
@@ -2263,7 +2283,7 @@ create_pty (Lisp_Object process)
 {
   struct Lisp_Process *p = XPROCESS (process);
   char pty_name[PTY_NAME_SIZE];
-  int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
+  int pty_fd = !(p->pty_in || p->pty_out) ? -1 : allocate_pty (pty_name);
 
   if (pty_fd >= 0)
     {
@@ -2301,7 +2321,7 @@ create_pty (Lisp_Object process)
 	 we just reopen the device (see emacs_get_tty_pgrp) as this is
 	 more portable (see USG_SUBTTY_WORKS above).  */
 
-      p->pty_flag = 1;
+      p->pty_in = p->pty_out = true;
       pset_status (p, Qrun);
       setup_process_coding_systems (process);
 
@@ -2412,7 +2432,7 @@ DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
     p->kill_without_query = 1;
   if (tem = plist_get (contact, QCstop), !NILP (tem))
     pset_command (p, Qt);
-  eassert (! p->pty_flag);
+  eassert (! p->pty_in && ! p->pty_out);
 
   if (!EQ (p->command, Qt)
       && !EQ (p->filter, Qt))
@@ -3147,7 +3167,7 @@ DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
     p->kill_without_query = 1;
   if (tem = plist_get (contact, QCstop), !NILP (tem))
     pset_command (p, Qt);
-  eassert (! p->pty_flag);
+  eassert (! p->pty_in && ! p->pty_out);
 
   if (!EQ (p->command, Qt)
       && !EQ (p->filter, Qt))
@@ -6798,7 +6818,7 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
     error ("Process %s is not active",
 	   SDATA (p->name));
 
-  if (!p->pty_flag)
+  if (! p->pty_in)
     current_group = Qnil;
 
   /* If we are using pgrps, get a pgrp number and make it negative.  */
@@ -7167,7 +7187,7 @@ DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
       send_process (proc, "", 0, Qnil);
     }
 
-  if (XPROCESS (proc)->pty_flag)
+  if (XPROCESS (proc)->pty_in)
     send_process (proc, "\004", 1, Qnil);
   else if (EQ (XPROCESS (proc)->type, Qserial))
     {
diff --git a/src/process.h b/src/process.h
index 392b661ce6..92baf0c4cb 100644
--- a/src/process.h
+++ b/src/process.h
@@ -156,8 +156,9 @@ #define EMACS_PROCESS_H
     /* True means kill silently if Emacs is exited.
        This is the inverse of the `query-on-exit' flag.  */
     bool_bf kill_without_query : 1;
-    /* True if communicating through a pty.  */
-    bool_bf pty_flag : 1;
+    /* True if communicating through a pty for input or output.  */
+    bool_bf pty_in : 1;
+    bool_bf pty_out : 1;
     /* Flag to set coding-system of the process buffer from the
        coding_system used to decode process output.  */
     bool_bf inherit_coding_system_flag : 1;
-- 
2.25.1