From f82c12f07ffc7c6c9db1232c7f6721e0a1ce300b Mon Sep 17 00:00:00 2001 From: Jim Porter 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