From c871d4b8158acf40ddf0a02f9813679fdecf0296 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sun, 17 Jul 2022 20:25:00 -0700 Subject: [PATCH 1/2] Allow creating processes where only one of stdin or stdout is a PTY * src/lisp.h (emacs_spawn): * src/callproc.c (emacs_spawn): Add PTY_IN and PTY_OUT arguments to specify which streams should be set up as a PTY. (call_process): Adjust call to 'emacs_spawn'. * src/process.h (Lisp_Process): Replace 'pty_flag' with 'pty_in' and 'pty_out'. * src/process.c (is_pty_from_symbol): New function. (make-process): Allow :connection-type to be a cons cell, and allow using a stderr process with a PTY for stdin/stdout. (create_process): Handle creating a process where only one of stdin or stdout is a PTY. * lisp/eshell/esh-proc.el (eshell-needs-pipe, eshell-needs-pipe-p): Remove. (eshell-gather-process-output): Use 'make-process' and set ':connection-type' as needed by the value of 'eshell-in-pipeline-p'. * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Don't signal an error when ':connection-type' is a cons cell. * test/src/process-tests.el (process-test-sentinel-wait-function-working-p): Allow passing PROC in, and rework into... (process-test-wait-for-sentinel): ... this. (process-test-sentinel-accept-process-output) (process-test-sentinel-sit-for, process-test-quoted-batfile) (process-test-stderr-filter): Use 'process-test-wait-for-sentinel'. (make/process/test-connection-type): New function. (make-process/connection-type/pty, make-process/connection-type/pty-2) (make-process/connection-type/pipe) (make-process/connection-type/pipe-2) (make-process/connection-type/in-pty) (make-process/connection-type/out-pty) (make-process/connection-type/pty-with-stderr-buffer) (make-process/connection-type/out-pty-with-stderr-buffer): New tests. * doc/lispref/processes.texi (Asynchronous Processes): Document new ':connection-type' behavior. (Output from Processes): Remove caveat about ':stderr' forcing 'make-process' to use pipes. * etc/NEWS: Announce this change. --- doc/lispref/processes.texi | 28 +++----- etc/NEWS | 12 ++++ lisp/eshell/esh-proc.el | 55 ++++++---------- lisp/net/tramp-adb.el | 5 +- lisp/net/tramp-sh.el | 5 +- lisp/net/tramp.el | 5 +- src/callproc.c | 37 ++++++----- src/lisp.h | 3 +- src/process.c | 129 +++++++++++++++++++++++-------------- src/process.h | 5 +- test/src/process-tests.el | 121 ++++++++++++++++++++++++---------- 11 files changed, 245 insertions(+), 160 deletions(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 80c371e1c6..a7e08054c7 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -705,12 +705,13 @@ Asynchronous Processes Initialize the type of device used to communicate with the subprocess. Possible values are @code{pty} to use a pty, @code{pipe} to use a pipe, or @code{nil} to use the default derived from the value of the -@code{process-connection-type} variable. This parameter and the value -of @code{process-connection-type} are ignored if a non-@code{nil} -value is specified for the @code{:stderr} parameter; in that case, the -type will always be @code{pipe}. On systems where ptys are not -available (MS-Windows), this parameter is likewise ignored, and pipes -are used unconditionally. +@code{process-connection-type} variable. If @var{type} is a cons cell +@w{@code{(@var{input} . @var{output})}}, then @var{input} will be used +for standard input and @var{output} for standard output (and standard +error if @code{:stderr} is @code{nil}). + +On systems where ptys are not available (MS-Windows), this parameter +is ignored, and pipes are used unconditionally. @item :noquery @var{query-flag} Initialize the process query flag to @var{query-flag}. @@ -1530,20 +1531,11 @@ Output from Processes default filter discards the output. If the subprocess writes to its standard error stream, by default -the error output is also passed to the process filter function. If -Emacs uses a pseudo-TTY (pty) for communication with the subprocess, -then it is impossible to separate the standard output and standard -error streams of the subprocess, because a pseudo-TTY has only one -output channel. In that case, if you want to keep the output to those -streams separate, you should redirect one of them to a file---for -example, by using an appropriate shell command via -@code{start-process-shell-command} or a similar function. - - Alternatively, you could use the @code{:stderr} parameter with a +the error output is also passed to the process filter function. +Alternatively, you could use the @code{:stderr} parameter with a non-@code{nil} value in a call to @code{make-process} (@pxref{Asynchronous Processes, make-process}) to make the destination -of the error output separate from the standard output; in that case, -Emacs will use pipes for communicating with the subprocess. +of the error output separate from the standard output. When a subprocess terminates, Emacs reads any pending output, then stops reading output from that subprocess. Therefore, if the diff --git a/etc/NEWS b/etc/NEWS index 6d4fce1237..dc79f0826a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2229,6 +2229,12 @@ they will still be escaped, so the '.foo' symbol is still printed as and remapping parent of basic faces does not work reliably. Instead of remapping 'mode-line', you have to remap 'mode-line-active'. ++++ +** 'make-process' has been extended to support ptys when ':stderr' is set. +Previously, setting ':stderr' to a non-nil value would force the +process's connection to use pipes. Now, Emacs will use a pty for +stdin and stdout if requested no matter the value of ':stderr'. + --- ** User option 'mail-source-ignore-errors' is now obsolete. The whole mechanism for prompting users to continue in case of @@ -3188,6 +3194,12 @@ translation. This is useful when quoting shell arguments for a remote shell invocation. Such shells are POSIX conformant by default. ++++ +** 'make-process' can set connection type independently for input and output. +When calling 'make-process', communication via pty can be enabled +selectively for just input or output by passing a cons cell for +':connection-type', e.g. '(pipe . pty)'. + +++ ** 'signal-process' now consults the list 'signal-process-functions'. This is to determine which function has to be called in order to diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 70426ccaf2..99b43661f2 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,31 +266,36 @@ 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))) + (conn-type (pcase (bound-and-true-p eshell-in-pipeline-p) + ('first '(nil . pipe)) + ('last '(pipe . nil)) + ('t 'pipe) + ('nil nil)))) + (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) - #'eshell-output-filter - #'eshell-insertion-filter)) - (set-process-sentinel proc #'eshell-sentinel) (run-hook-with-args 'eshell-exec-hook proc) (when (fboundp 'process-coding-system) (let ((coding-systems (process-coding-system proc))) (setq decoding (car coding-systems) encoding (cdr coding-systems))) - ;; If start-process decided to use some coding system for + ;; If `make-process' decided to use some coding system for ;; decoding data sent from the process and the coding system ;; doesn't specify EOL conversion, we had better convert CRLF ;; to LF. (if (vectorp (coding-system-eol-type decoding)) (setq decoding (coding-system-change-eol-conversion decoding 'dos) changed t)) - ;; Even if start-process left the coding system for encoding + ;; Even if `make-process' left the coding system for encoding ;; data sent from the process undecided, we had better use the ;; same one as what we use for decoding. But, we should ;; suppress EOL conversion. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index de55856830..451128ab20 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -904,7 +904,10 @@ tramp-adb-handle-make-process (signal 'wrong-type-argument (list #'symbolp coding))) (when (eq connection-type t) (setq connection-type 'pty)) - (unless (memq connection-type '(nil pipe pty)) + (unless (or (and (consp connection-type) + (memq (car connection-type) '(nil pipe pty)) + (memq (cdr connection-type) '(nil pipe pty))) + (memq connection-type '(nil pipe pty))) (signal 'wrong-type-argument (list #'symbolp connection-type))) (unless (or (null filter) (eq filter t) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e772af9e0a..8c48c3fc1e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2851,7 +2851,10 @@ tramp-sh-handle-make-process (signal 'wrong-type-argument (list #'symbolp coding))) (when (eq connection-type t) (setq connection-type 'pty)) - (unless (memq connection-type '(nil pipe pty)) + (unless (or (and (consp connection-type) + (memq (car connection-type) '(nil pipe pty)) + (memq (cdr connection-type) '(nil pipe pty))) + (memq connection-type '(nil pipe pty))) (signal 'wrong-type-argument (list #'symbolp connection-type))) (unless (or (null filter) (eq filter t) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b11fd293cc..8b654944fe 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4605,7 +4605,10 @@ tramp-handle-make-process (signal 'wrong-type-argument (list #'symbolp coding))) (when (eq connection-type t) (setq connection-type 'pty)) - (unless (memq connection-type '(nil pipe pty)) + (unless (or (and (consp connection-type) + (memq (car connection-type) '(nil pipe pty)) + (memq (cdr connection-type) '(nil pipe pty))) + (memq connection-type '(nil pipe pty))) (signal 'wrong-type-argument (list #'symbolp connection-type))) (unless (or (null filter) (eq filter t) (functionp filter)) (signal 'wrong-type-argument (list #'functionp filter))) 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 2afe135674..264228618d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4941,7 +4941,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..da5e9cb182 100644 --- a/src/process.c +++ b/src/process.c @@ -1316,6 +1316,19 @@ set_process_filter_masks (struct Lisp_Process *p) add_process_read_fd (p->infd); } +static bool +is_pty_from_symbol (Lisp_Object symbol) +{ + if (EQ (symbol, Qpty)) + return true; + else if (EQ (symbol, Qpipe)) + return false; + else if (NILP (symbol)) + return !NILP (Vprocess_connection_type); + else + report_file_error ("Unknown connection type", symbol); +} + DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, 2, 2, 0, doc: /* Give PROCESS the filter function FILTER; nil means default. @@ -1741,15 +1754,18 @@ DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0, :connection-type TYPE -- TYPE is control type of device used to communicate with subprocesses. Values are `pipe' to use a pipe, `pty' to use a pty, or nil to use the default specified through -`process-connection-type'. +`process-connection-type'. If TYPE is a cons (INPUT . OUTPUT), then +INPUT will be used for standard input and OUTPUT for standard output +(and standard error if `:stderr' is nil). :filter FILTER -- Install FILTER as the process filter. :sentinel SENTINEL -- Install SENTINEL as the process sentinel. :stderr STDERR -- STDERR is either a buffer or a pipe process attached -to the standard error of subprocess. Specifying this implies -`:connection-type' is set to `pipe'. If STDERR is nil, standard error +to the standard error of subprocess. When specifying this, the +subprocess's standard error will always communicate via a pipe, no +matter the value of `:connection-type'. If STDERR is nil, standard error is mixed with standard output and sent to BUFFER or FILTER. (Note that specifying :stderr will create a new, separate (but associated) process, with its own filter and sentinel. See @@ -1845,22 +1861,20 @@ DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0, CHECK_TYPE (NILP (tem), Qnull, tem); tem = plist_get (contact, QCconnection_type); - if (EQ (tem, Qpty)) - XPROCESS (proc)->pty_flag = true; - else if (EQ (tem, Qpipe)) - XPROCESS (proc)->pty_flag = false; - else if (NILP (tem)) - XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type); + if (CONSP (tem)) + { + XPROCESS (proc)->pty_in = is_pty_from_symbol (XCAR (tem)); + XPROCESS (proc)->pty_out = is_pty_from_symbol (XCDR (tem)); + } else - report_file_error ("Unknown connection type", tem); - - if (!NILP (stderrproc)) { - pset_stderrproc (XPROCESS (proc), stderrproc); - - XPROCESS (proc)->pty_flag = false; + XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out = + is_pty_from_symbol (tem); } + if (!NILP (stderrproc)) + pset_stderrproc (XPROCESS (proc), stderrproc); + #ifdef HAVE_GNUTLS /* AKA GNUTLS_INITSTAGE(proc). */ verify (GNUTLS_STAGE_EMPTY == 0); @@ -2099,66 +2113,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 +2211,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 +2228,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 +2294,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 +2332,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 +2443,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 +3178,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 +6829,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 +7198,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; diff --git a/test/src/process-tests.el b/test/src/process-tests.el index f1ed7e18d5..41320672a0 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -38,10 +38,11 @@ ;; Timeout in seconds; the test fails if the timeout is reached. (defvar process-test-sentinel-wait-timeout 2.0) -;; Start a process that exits immediately. Call WAIT-FUNCTION, -;; possibly multiple times, to wait for the process to complete. -(defun process-test-sentinel-wait-function-working-p (wait-function) - (let ((proc (start-process "test" nil "bash" "-c" "exit 20")) +(defun process-test-wait-for-sentinel (proc exit-status &optional wait-function) + "Set a sentinel on PROC and wait for it to be called with EXIT-STATUS. +Call WAIT-FUNCTION, possibly multiple times, to wait for the +process to complete." + (let ((wait-function (or wait-function #'accept-process-output)) (sentinel-called nil) (start-time (float-time))) (set-process-sentinel proc (lambda (_proc _msg) @@ -50,21 +51,22 @@ process-test-sentinel-wait-function-working-p (> (- (float-time) start-time) process-test-sentinel-wait-timeout))) (funcall wait-function)) - (cl-assert (eq (process-status proc) 'exit)) - (cl-assert (= (process-exit-status proc) 20)) - sentinel-called)) + (should sentinel-called) + (should (eq (process-status proc) 'exit)) + (should (= (process-exit-status proc) exit-status)))) (ert-deftest process-test-sentinel-accept-process-output () (skip-unless (executable-find "bash")) (with-timeout (60 (ert-fail "Test timed out")) - (should (process-test-sentinel-wait-function-working-p - #'accept-process-output)))) + (let ((proc (start-process "test" nil "bash" "-c" "exit 20"))) + (should (process-test-wait-for-sentinel proc 20))))) (ert-deftest process-test-sentinel-sit-for () (skip-unless (executable-find "bash")) (with-timeout (60 (ert-fail "Test timed out")) - (should - (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t)))))) + (let ((proc (start-process "test" nil "bash" "-c" "exit 20"))) + (should (process-test-wait-for-sentinel + proc 20 (lambda () (sit-for 0.01 t))))))) (when (eq system-type 'windows-nt) (ert-deftest process-test-quoted-batfile () @@ -97,17 +99,8 @@ process-test-stderr-buffer "echo hello stderr! >&2; " "exit 20")) :buffer stdout-buffer - :stderr stderr-buffer)) - (sentinel-called nil) - (start-time (float-time))) - (set-process-sentinel proc (lambda (_proc _msg) - (setq sentinel-called t))) - (while (not (or sentinel-called - (> (- (float-time) start-time) - process-test-sentinel-wait-timeout))) - (accept-process-output)) - (cl-assert (eq (process-status proc) 'exit)) - (cl-assert (= (process-exit-status proc) 20)) + :stderr stderr-buffer))) + (process-test-wait-for-sentinel proc 20) (should (with-current-buffer stdout-buffer (goto-char (point-min)) (looking-at "hello stdout!"))) @@ -118,8 +111,7 @@ process-test-stderr-buffer (ert-deftest process-test-stderr-filter () (skip-unless (executable-find "bash")) (with-timeout (60 (ert-fail "Test timed out")) - (let* ((sentinel-called nil) - (stderr-sentinel-called nil) + (let* ((stderr-sentinel-called nil) (stdout-output nil) (stderr-output nil) (stdout-buffer (generate-new-buffer "*stdout*")) @@ -131,23 +123,14 @@ process-test-stderr-filter (concat "echo hello stdout!; " "echo hello stderr! >&2; " "exit 20")) - :stderr stderr-proc)) - (start-time (float-time))) + :stderr stderr-proc))) (set-process-filter proc (lambda (_proc input) (push input stdout-output))) - (set-process-sentinel proc (lambda (_proc _msg) - (setq sentinel-called t))) (set-process-filter stderr-proc (lambda (_proc input) (push input stderr-output))) (set-process-sentinel stderr-proc (lambda (_proc _input) (setq stderr-sentinel-called t))) - (while (not (or sentinel-called - (> (- (float-time) start-time) - process-test-sentinel-wait-timeout))) - (accept-process-output)) - (cl-assert (eq (process-status proc) 'exit)) - (cl-assert (= (process-exit-status proc) 20)) - (should sentinel-called) + (process-test-wait-for-sentinel proc 20) (should (equal 1 (with-current-buffer stdout-buffer (point-max)))) (should (equal "hello stdout!\n" @@ -289,6 +272,74 @@ make-process-w32-debug-spawn-error (error :got-error)))) (should have-called-debugger)))) +(defun make-process/test-connection-type (ttys &rest args) + "Make a process and check whether its standard streams match TTYS. +This calls `make-process', passing ARGS to adjust how the process +is created. TTYS should be a list of 3 boolean values, +indicating whether the subprocess's stdin, stdout, and stderr +should be a TTY, respectively." + (declare (indent 1)) + (let* (;; MS-Windows doesn't support communicating via pty. + (ttys (if (eq system-type 'windows-nt) '(nil nil nil) ttys)) + (expected-output (concat (and (nth 0 ttys) "stdin\n") + (and (nth 1 ttys) "stdout\n") + (and (nth 2 ttys) "stderr\n"))) + (stdout-buffer (generate-new-buffer "*stdout*")) + (proc (apply + #'make-process + :name "test" + :command (list "sh" "-c" + (concat "if [ -t 0 ]; then echo stdin; fi; " + "if [ -t 1 ]; then echo stdout; fi; " + "if [ -t 2 ]; then echo stderr; fi")) + :buffer stdout-buffer + args))) + (process-test-wait-for-sentinel proc 0) + (should (equal (with-current-buffer stdout-buffer (buffer-string)) + expected-output)))) + +(ert-deftest make-process/connection-type/pty () + (skip-unless (executable-find "sh")) + (make-process/test-connection-type '(t t t) + :connection-type 'pty)) + +(ert-deftest make-process/connection-type/pty-2 () + (skip-unless (executable-find "sh")) + (make-process/test-connection-type '(t t t) + :connection-type '(pty . pty))) + +(ert-deftest make-process/connection-type/pipe () + (skip-unless (executable-find "sh")) + (make-process/test-connection-type '(nil nil nil) + :connection-type 'pipe)) + +(ert-deftest make-process/connection-type/pipe-2 () + (skip-unless (executable-find "sh")) + (make-process/test-connection-type '(nil nil nil) + :connection-type '(pipe . pipe))) + +(ert-deftest make-process/connection-type/in-pty () + (skip-unless (executable-find "sh")) + (make-process/test-connection-type '(t nil nil) + :connection-type '(pty . pipe))) + +(ert-deftest make-process/connection-type/out-pty () + (skip-unless (executable-find "sh")) + (make-process/test-connection-type '(nil t t) + :connection-type '(pipe . pty))) + +(ert-deftest make-process/connection-type/pty-with-stderr-buffer () + (skip-unless (executable-find "sh")) + (let ((stderr-buffer (generate-new-buffer "*stderr*"))) + (make-process/test-connection-type '(t t nil) + :connection-type 'pty :stderr stderr-buffer))) + +(ert-deftest make-process/connection-type/out-pty-with-stderr-buffer () + (skip-unless (executable-find "sh")) + (let ((stderr-buffer (generate-new-buffer "*stderr*"))) + (make-process/test-connection-type '(nil t nil) + :connection-type '(pipe . pty) :stderr stderr-buffer))) + (ert-deftest make-process/file-handler/found () "Check that the `:file-handler’ argument of `make-process’ works as expected if a file name handler is found." -- 2.25.1