From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Daiki Ueno Newsgroups: gmane.emacs.devel Subject: [PATCH] Add facility to collect stderr of async subprocess Date: Wed, 18 Mar 2015 16:37:08 +0900 Message-ID: References: <87d24d3uwz.fsf-ueno@gnu.org> <83pp87y6iu.fsf@gnu.org> <83mw3bxz9f.fsf@gnu.org> <83k2yfx8zi.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1426664282 28900 80.91.229.3 (18 Mar 2015 07:38:02 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 18 Mar 2015 07:38:02 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Mar 18 08:37:49 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YY8Y0-0001gf-LB for ged-emacs-devel@m.gmane.org; Wed, 18 Mar 2015 08:37:49 +0100 Original-Received: from localhost ([::1]:59546 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YY8Xz-0007V4-U1 for ged-emacs-devel@m.gmane.org; Wed, 18 Mar 2015 03:37:47 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:52549) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YY8XV-0007MD-Gw for emacs-devel@gnu.org; Wed, 18 Mar 2015 03:37:21 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YY8XR-0004i9-NV for emacs-devel@gnu.org; Wed, 18 Mar 2015 03:37:17 -0400 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:36743) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YY8XR-0004i3-I6 for emacs-devel@gnu.org; Wed, 18 Mar 2015 03:37:13 -0400 Original-Received: from du-a.org ([2001:e41:db5e:fb14::1]:34769 helo=localhost.localdomain) by fencepost.gnu.org with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1YY8XQ-0001Xb-EN for emacs-devel@gnu.org; Wed, 18 Mar 2015 03:37:13 -0400 In-Reply-To: (Daiki Ueno's message of "Wed, 18 Mar 2015 15:17:39 +0900") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2001:4830:134:3::e X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:183985 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii writes: >> In any case, supporting stderr could be a starting point, as it seems to >> be a long-standing request: >> https://lists.gnu.org/archive/html/emacs-devel/2004-04/msg01051.html >> and it wouldn't involve a portability issue. > > Redirecting the child's stderr is already supported on Windows, so > this is only a matter of having the higher layers DTRT. So, let's start with small (but common) things. The attached patch adds a new keyword `:stderr' to `make-process'. The argument can be either a buffer or a (newly introduced) pipe process. One could write: (make-process :name "test" :buffer (current-buffer) :command (list (expand-file-name "./test.sh")) :stderr "stderr") to collect the stderr output in the "stderr" buffer, or could write: (let ((stderr (make-pipe-process :name "stderr"))) (make-process :name "test" :buffer (current-buffer) :command (list (expand-file-name "./test.sh")) :stderr stderr) (set-process-filter stderr ...)) to collect the stderr output with a process filter. The patch should apply after the make-process patch: > From 206196c18652601920017b3a30316ac4205b42dd Mon Sep 17 00:00:00 2001 > From: Daiki Ueno > Date: Mon, 16 Mar 2015 11:38:05 +0900 > Subject: [PATCH] Generalize start-process with keyword args Comments appreciated. To be honest, a new process type to collect stderr might be overkill, but it would make it possible for the current process I/O functions to support further file descriptors / handles. Regards, -- Daiki Ueno --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Add-facility-to-collect-stderr-of-async-subprocess.patch >From 2319faa7a9853b562c2296030de70188aee75f8b Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Mon, 9 Mar 2015 09:50:32 +0900 Subject: [PATCH] Add facility to collect stderr of async subprocess * src/lisp.h (emacs_pipe2): New function declaration. * src/sysdep.c (emacs_pipe2): New function. (emacs_pipe): Define as a wrapper around emacs_pipe2. * src/process.h (struct Lisp_Process): New member stderr. * src/process.c (PIPECONN_P): New macro. (PIPECONN1_P): New macro. (Fdelete_process, Fprocess_status, Fset_process_buffer) (Fset_process_filter, Fset_process_sentinel, Fstop_process) (Fcontinue_process): Handle pipe process specially. (create_process): Respect Vprocess_pipe_list and Vprocess_standard_error. (Fmake_pipe_process): New function. (Fmake_process): Add new keyword argument :stderr. (deactivate_process): Call Fdelete_process on associated pipe process. (wait_reading_process_output): Don't consider a pipe process has gone when the read end is closed. (syms_of_process): Register Qpipe and Smake_pipe_process. * doc/lispref/processes.texi (Asynchronous Processes): Mention `make-pipe-process' and `:stderr' keyword of `make-process'. * test/automated/process-tests.el (process-test-stderr-buffer) (process-test-stderr-filter): New tests. * etc/NEWS: Mention pipe process. --- doc/lispref/ChangeLog | 5 + doc/lispref/processes.texi | 54 +++++++ etc/ChangeLog | 4 + etc/NEWS | 4 + src/ChangeLog | 22 +++ src/lisp.h | 1 + src/process.c | 303 +++++++++++++++++++++++++++++++++++++--- src/process.h | 3 + src/sysdep.c | 14 +- test/ChangeLog | 5 + test/automated/process-tests.el | 65 +++++++++ 11 files changed, 455 insertions(+), 25 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 06d4630..777d386 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2015-03-17 Daiki Ueno + + * processes.texi (Asynchronous Processes): Mention + `make-pipe-process' and `:stderr' keyword of `make-process'. + 2015-03-16 Daiki Ueno * processes.texi (Asynchronous Processes): Mention `make-process'. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 337669d..27ed697 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -743,6 +743,60 @@ Initialize the process filter to @var{filter}. @item :sentinel @var{sentinel} Initialize the process sentinel to @var{sentinel}. + +@item :stderr @var{stderr} +Associate @var{stderr} with the standard error of the process. +@var{stderr} is either a buffer or a pipe process created with +@code{make-pipe-process}. +@end table + +The original argument list, modified with the actual connection +information, is available via the @code{process-contact} function. +@end defun + +@defun make-pipe-process &rest args +This function creates a bidirectional pipe which can be attached to a +child process (typically through the @code{:stderr} keyword of +@code{make-process}). + +The arguments @var{args} are a list of keyword/argument pairs. +Omitting a keyword is always equivalent to specifying it with value +@code{nil}, except for @code{:coding}. +Here are the meaningful keywords: + +@table @asis +@item :name @var{name} +Use the string @var{name} as the process name. It is modified if +necessary to make it unique. + +@item :buffer @var{buffer} +Use @var{buffer} as the process buffer. + +@item :coding @var{coding} +If @var{coding} is a symbol, it specifies the coding system to be +used for both reading and writing of data from and to the +connection. If @var{coding} is a cons cell +@w{@code{(@var{decoding} . @var{encoding})}}, then @var{decoding} +will be used for reading and @var{encoding} for writing. + +If @var{coding} is @code{nil}, the coding system chosen for decoding +output is @code{undecided}, meaning deduce the encoding from the +actual data. +@xref{Output from Processes}. + +@item :noquery @var{query-flag} +Initialize the process query flag to @var{query-flag}. +@xref{Query Before Exit}. + +@item :stop @var{stopped} +If @var{stopped} is non-@code{nil}, start the process in the +``stopped'' state. + +@item :filter @var{filter} +Initialize the process filter to @var{filter}. + +@item :sentinel @var{sentinel} +Initialize the process sentinel to @var{sentinel}. @end table The original argument list, modified with the actual connection diff --git a/etc/ChangeLog b/etc/ChangeLog index 5d5a47f..d9a3006 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,5 +1,9 @@ 2015-03-18 Daiki Ueno + * NEWS: Mention pipe process. + +2015-03-18 Daiki Ueno + * NEWS: Mention `make-process'. 2015-03-03 Kelvin White diff --git a/etc/NEWS b/etc/NEWS index 8cfc238..da19b3f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -623,6 +623,10 @@ word syntax, use `\sw' instead. * Lisp Changes in Emacs 25.1 +** New process type `pipe', which can be used in combination with the + `:stderr' keyword of make-process to collect standard error output + of subprocess. + ** New function make-process provides a generalized Lisp interface to subprocess creation. diff --git a/src/ChangeLog b/src/ChangeLog index 8f9a5ee..421e3c5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,27 @@ 2015-03-17 Daiki Ueno + Add facility to collect stderr of async subprocess + * lisp.h (emacs_pipe2): New function declaration. + * sysdep.c (emacs_pipe2): New function. + (emacs_pipe): Define as a wrapper around emacs_pipe2. + * process.h (struct Lisp_Process): New member stderr. + * process.c (PIPECONN_P): New macro. + (PIPECONN1_P): New macro. + (Fdelete_process, Fprocess_status, Fset_process_buffer) + (Fset_process_filter, Fset_process_sentinel, Fstop_process) + (Fcontinue_process): Handle pipe process specially. + (create_process): Respect Vprocess_pipe_list and + Vprocess_standard_error. + (Fmake_pipe_process): New function. + (Fmake_process): Add new keyword argument :stderr. + (deactivate_process): Call Fdelete_process on associated pipe + process. + (wait_reading_process_output): Don't consider a pipe process has + gone when the read end is closed. + (syms_of_process): Register Qpipe and Smake_pipe_process. + +2015-03-17 Daiki Ueno + * process.c (Fmake_process): New function. (create_process, create_pty): Check p->pty_flag instead of Vprocess_connection_type. diff --git a/src/lisp.h b/src/lisp.h index b730619..2e161da 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4378,6 +4378,7 @@ extern void emacs_backtrace (int); extern _Noreturn void emacs_abort (void) NO_INLINE; extern int emacs_open (const char *, int, int); extern int emacs_pipe (int[2]); +extern int emacs_pipe2 (int[2], int); extern int emacs_close (int); extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); diff --git a/src/process.c b/src/process.c index 6068540..9596ccd 100644 --- a/src/process.c +++ b/src/process.c @@ -189,6 +189,8 @@ process_socket (int domain, int type, int protocol) #define NETCONN1_P(p) (EQ (p->type, Qnetwork)) #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial)) #define SERIALCONN1_P(p) (EQ (p->type, Qserial)) +#define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe)) +#define PIPECONN1_P(p) (EQ (p->type, Qpipe)) /* Number of events of change of status of a process. */ static EMACS_INT process_tick; @@ -420,6 +422,11 @@ pset_write_queue (struct Lisp_Process *p, Lisp_Object val) { p->write_queue = val; } +static void +pset_stderr (struct Lisp_Process *p, Lisp_Object val) +{ + p->stderr = val; +} static Lisp_Object @@ -846,7 +853,7 @@ nil, indicating the current buffer's process. */) p = XPROCESS (process); p->raw_status_new = 0; - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) { pset_status (p, list2 (Qexit, make_number (0))); p->tick = ++process_tick; @@ -912,7 +919,7 @@ nil, indicating the current buffer's process. */) status = p->status; if (CONSP (status)) status = XCAR (status); - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) { if (EQ (status, Qexit)) status = Qclosed; @@ -996,7 +1003,7 @@ Return BUFFER. */) CHECK_BUFFER (buffer); p = XPROCESS (process); pset_buffer (p, buffer); - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer)); setup_process_coding_systems (process); return buffer; @@ -1072,7 +1079,7 @@ The string argument is normally a multibyte string, except: } pset_filter (p, filter); - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCfilter, filter)); setup_process_coding_systems (process); return filter; @@ -1104,7 +1111,7 @@ It gets two arguments: the process, and a string describing the change. */) sentinel = Qinternal_default_process_sentinel; pset_sentinel (p, sentinel); - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel)); return sentinel; } @@ -1192,13 +1199,13 @@ DEFUN ("process-query-on-exit-flag", DEFUN ("process-contact", Fprocess_contact, Sprocess_contact, 1, 2, 0, doc: /* Return the contact info of PROCESS; t for a real child. -For a network or serial connection, the value depends on the optional -KEY arg. If KEY is nil, value is a cons cell of the form (HOST -SERVICE) for a network connection or (PORT SPEED) for a serial -connection. If KEY is t, the complete contact information for the -connection is returned, else the specific value for the keyword KEY is -returned. See `make-network-process' or `make-serial-process' for a -list of keywords. */) +For a network or serial connection, or a pipe, the value depends on +the optional KEY arg. If KEY is nil, value is a cons cell of the form +\(HOST SERVICE) for a network connection or (PORT SPEED) for a serial +connection, or (INPUT OUTPUT) for a pipe. If KEY is t, the complete +contact information for the connection is returned, else the specific +value for the keyword KEY is returned. See `make-network-process' or +`make-serial-process' for a list of keywords. */) (register Lisp_Object process, Lisp_Object key) { Lisp_Object contact; @@ -1395,10 +1402,14 @@ to use a pty, or nil to use the default specified through :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. + usage: (make-process &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem; + Lisp_Object stderr_proc; unsigned char **new_argv; ptrdiff_t new_argc; ptrdiff_t i; @@ -1442,6 +1453,27 @@ usage: (make-process &rest ARGS) */) if (!NILP (program)) CHECK_STRING (program); + stderr_proc = Fplist_get (contact, QCstderr); + if (!NILP (stderr_proc)) + { + if (PROCESSP (stderr_proc)) + { + if (!PIPECONN_P (stderr_proc)) + error ("Process is not a pipe process"); + } + else + { + struct gcpro gcpro1, gcpro2; + GCPRO2 (buffer, current_dir); + stderr_proc = CALLN (Fmake_pipe_process, + QCname, + concat2 (name, build_string (" stderr")), + QCbuffer, + Fget_buffer_create (stderr_proc)); + UNGCPRO; + } + } + proc = make_process (name); /* If an error occurs and we can't start the process, we want to remove it from the process list. This means that each error @@ -1475,6 +1507,12 @@ usage: (make-process &rest ARGS) */) else XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type); + if (!NILP (stderr_proc)) + { + pset_stderr (XPROCESS (proc), stderr_proc); + XPROCESS (proc)->pty_flag = 0; + } + #ifdef HAVE_GNUTLS /* AKA GNUTLS_INITSTAGE(proc). */ XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY; @@ -1719,16 +1757,16 @@ static void create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) { struct Lisp_Process *p = XPROCESS (process); - int inchannel, outchannel; + int inchannel, outchannel, errchannel; pid_t pid; int vfork_errno; - int forkin, forkout; + int forkin, forkout, forkerr; bool pty_flag = 0; char pty_name[PTY_NAME_SIZE]; Lisp_Object lisp_pty_name = Qnil; sigset_t oldset; - inchannel = outchannel = -1; + inchannel = outchannel = errchannel = -1; if (p->pty_flag) outchannel = inchannel = allocate_pty (pty_name); @@ -1748,6 +1786,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #else forkin = forkout = -1; #endif /* not USG, or USG_SUBTTY_WORKS */ + forkerr = -1; pty_flag = 1; lisp_pty_name = build_string (pty_name); } @@ -1760,6 +1799,23 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) outchannel = p->open_fd[WRITE_TO_SUBPROCESS]; inchannel = p->open_fd[READ_FROM_SUBPROCESS]; forkout = p->open_fd[SUBPROCESS_STDOUT]; + + if (!NILP (p->stderr)) + { + struct Lisp_Process *pp = XPROCESS (p->stderr); + + forkerr = pp->open_fd[SUBPROCESS_STDOUT]; + errchannel = pp->open_fd[READ_FROM_SUBPROCESS]; + + /* FORKERR will be redirected in child_setup. */ + fcntl (forkerr, F_SETFD, FD_CLOEXEC); + + /* Close unnecessary file descriptors. */ + close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]); + close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]); + } + else + forkerr = -1; } #ifndef WINDOWSNT @@ -1805,6 +1861,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) char **volatile new_argv_volatile = new_argv; int volatile forkin_volatile = forkin; int volatile forkout_volatile = forkout; + int volatile forkerr_volatile = forkerr; struct Lisp_Process *p_volatile = p; pid = vfork (); @@ -1814,6 +1871,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) new_argv = new_argv_volatile; forkin = forkin_volatile; forkout = forkout_volatile; + forkerr = forkerr_volatile; p = p_volatile; pty_flag = p->pty_flag; @@ -1824,6 +1882,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) { int xforkin = forkin; int xforkout = forkout; + int xforkerr = forkerr; /* Make the pty be the controlling terminal of the process. */ #ifdef HAVE_PTYS @@ -1923,10 +1982,13 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (pty_flag) child_setup_tty (xforkout); + + if (xforkerr < 0) + xforkerr = xforkout; #ifdef WINDOWSNT - pid = child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); + pid = child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir); #else /* not WINDOWSNT */ - child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); + child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir); #endif /* not WINDOWSNT */ } @@ -1971,6 +2033,11 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]); } #endif + if (!NILP (p->stderr)) + { + struct Lisp_Process *pp = XPROCESS (p->stderr); + close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]); + } } } @@ -2029,6 +2096,187 @@ create_pty (Lisp_Object process) p->pid = -2; } +DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process, + 0, MANY, 0, + doc: /* Create and return a bidirectional pipe process. + +In Emacs, pipes are represented by process objects, so input and +output work as for subprocesses, and `delete-process' closes a pipe. +However, a pipe process has no process id, it cannot be signaled, +and the status codes are different from normal processes. + +Arguments are specified as keyword/argument pairs. The following +arguments are defined: + +:name NAME -- NAME is the name of the process. It is modified if necessary to make it unique. + +:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate +with the process. Process output goes at the end of that buffer, +unless you specify an output stream or filter function to handle the +output. If BUFFER is not given, the value of NAME is used. + +:coding CODING -- If CODING is a symbol, it specifies the coding +system used for both reading and writing for this process. If CODING +is a cons (DECODING . ENCODING), DECODING is used for reading, and +ENCODING is used for writing. + +:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and +the process is running. If BOOL is not given, query before exiting. + +:stop BOOL -- Start process in the `stopped' state if BOOL non-nil. +In the stopped state, a pipe process does not accept incoming data, +but you can send outgoing data. The stopped state is cleared by +`continue-process' and set by `stop-process'. + +:filter FILTER -- Install FILTER as the process filter. + +:sentinel SENTINEL -- Install SENTINEL as the process sentinel. + +usage: (make-pipe-process &rest ARGS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + Lisp_Object proc, contact; + struct Lisp_Process *p; + struct gcpro gcpro1; + Lisp_Object name, buffer; + Lisp_Object tem, val; + ptrdiff_t specpdl_count; + int inchannel, outchannel; + + if (nargs == 0) + return Qnil; + + contact = Flist (nargs, args); + GCPRO1 (contact); + + name = Fplist_get (contact, QCname); + CHECK_STRING (name); + proc = make_process (name); + specpdl_count = SPECPDL_INDEX (); + record_unwind_protect (remove_process, proc); + p = XPROCESS (proc); + + if (emacs_pipe2 (p->open_fd + SUBPROCESS_STDIN, O_BINARY) != 0 + || emacs_pipe2 (p->open_fd + READ_FROM_SUBPROCESS, O_BINARY) != 0) + report_file_error ("Creating pipe", Qnil); + outchannel = p->open_fd[WRITE_TO_SUBPROCESS]; + inchannel = p->open_fd[READ_FROM_SUBPROCESS]; + + /* Child doesn't need inchannel/outchannel after exec. */ + fcntl (inchannel, F_SETFD, FD_CLOEXEC); + fcntl (outchannel, F_SETFD, FD_CLOEXEC); + + fcntl (inchannel, F_SETFL, O_NONBLOCK); + fcntl (outchannel, F_SETFL, O_NONBLOCK); + + /* Record this as an active process, with its channels. */ + chan_process[inchannel] = proc; + p->infd = inchannel; + p->outfd = outchannel; + + if (inchannel > max_process_desc) + max_process_desc = inchannel; + + buffer = Fplist_get (contact, QCbuffer); + if (NILP (buffer)) + buffer = name; + buffer = Fget_buffer_create (buffer); + pset_buffer (p, buffer); + + pset_childp (p, contact); + pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist))); + pset_type (p, Qpipe); + pset_sentinel (p, Fplist_get (contact, QCsentinel)); + pset_filter (p, Fplist_get (contact, QCfilter)); + pset_log (p, Qnil); + if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) + p->kill_without_query = 1; + if (tem = Fplist_get (contact, QCstop), !NILP (tem)) + pset_command (p, Qt); + eassert (! p->pty_flag); + + if (!EQ (p->command, Qt)) + { + FD_SET (inchannel, &input_wait_mask); + FD_SET (inchannel, &non_keyboard_wait_mask); + } +#ifdef ADAPTIVE_READ_BUFFERING + p->adaptive_read_buffering + = (NILP (Vprocess_adaptive_read_buffering) ? 0 + : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2); +#endif + + /* Make the process marker point into the process buffer (if any). */ + if (BUFFERP (buffer)) + set_marker_both (p->mark, buffer, + BUF_ZV (XBUFFER (buffer)), + BUF_ZV_BYTE (XBUFFER (buffer))); + + { + /* Setup coding systems for communicating with the network stream. */ + struct gcpro gcpro1; + /* Qt denotes we have not yet called Ffind_operation_coding_system. */ + Lisp_Object coding_systems = Qt; + Lisp_Object val; + + tem = Fplist_get (contact, QCcoding); + val = Qnil; + if (!NILP (tem)) + { + val = tem; + if (CONSP (val)) + val = XCAR (val); + } + else if (!NILP (Vcoding_system_for_read)) + val = Vcoding_system_for_read; + else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) + /* We dare not decode end-of-line format by setting VAL to + Qraw_text, because the existing Emacs Lisp libraries + assume that they receive bare code including a sequence of + CR LF. */ + val = Qnil; + else + { + if (CONSP (coding_systems)) + val = XCAR (coding_systems); + else if (CONSP (Vdefault_process_coding_system)) + val = XCAR (Vdefault_process_coding_system); + else + val = Qnil; + } + pset_decode_coding_system (p, val); + + if (!NILP (tem)) + { + val = tem; + if (CONSP (val)) + val = XCDR (val); + } + else if (!NILP (Vcoding_system_for_write)) + val = Vcoding_system_for_write; + else if (NILP (BVAR (current_buffer, enable_multibyte_characters))) + val = Qnil; + else + { + if (CONSP (coding_systems)) + val = XCDR (coding_systems); + else if (CONSP (Vdefault_process_coding_system)) + val = XCDR (Vdefault_process_coding_system); + else + val = Qnil; + } + pset_encode_coding_system (p, val); + } + /* This may signal an error. */ + setup_process_coding_systems (proc); + + specpdl_ptr = specpdl + specpdl_count; + + UNGCPRO; + return proc; +} + /* Convert an internal struct sockaddr to a lisp object (vector or string). The address family of sa is not included in the result. */ @@ -3946,6 +4194,7 @@ deactivate_process (Lisp_Object proc) int inchannel; struct Lisp_Process *p = XPROCESS (proc); int i; + Lisp_Object tem; #ifdef HAVE_GNUTLS /* Delete GnuTLS structures in PROC, if any. */ @@ -4004,6 +4253,9 @@ deactivate_process (Lisp_Object proc) max_process_desc = i; } } + + if (!NILP (p->stderr)) + Fdelete_process (p->stderr); } @@ -4897,7 +5149,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, available now and a closed pipe. With luck, a closed pipe will be accompanied by subprocess termination and SIGCHLD. */ - else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)) + else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc) + && !PIPECONN_P (proc)) ; #endif #ifdef HAVE_PTYS @@ -4929,7 +5182,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, #endif /* HAVE_PTYS */ /* If we can detect process termination, don't consider the process gone just because its pipe is closed. */ - else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)) + else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc) + && !PIPECONN_P (proc)) ; else { @@ -5964,7 +6218,8 @@ If PROCESS is a network or serial process, inhibit handling of incoming traffic. */) (Lisp_Object process, Lisp_Object current_group) { - if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process))) + if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process) + || PIPECONN_P (process))) { struct Lisp_Process *p; @@ -5993,7 +6248,8 @@ If PROCESS is a network or serial process, resume handling of incoming traffic. */) (Lisp_Object process, Lisp_Object current_group) { - if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process))) + if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process) + || PIPECONN_P (process))) { struct Lisp_Process *p; @@ -7040,7 +7296,7 @@ kill_buffer_processes (Lisp_Object buffer) FOR_EACH_PROCESS (tail, proc) if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)) { - if (NETCONN_P (proc) || SERIALCONN_P (proc)) + if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc)) Fdelete_process (proc); else if (XPROCESS (proc)->infd >= 0) process_send_signal (proc, SIGHUP, Qnil, 1); @@ -7340,6 +7596,7 @@ syms_of_process (void) DEFSYM (Qreal, "real"); DEFSYM (Qnetwork, "network"); DEFSYM (Qserial, "serial"); + DEFSYM (Qpipe, "pipe"); DEFSYM (QCbuffer, ":buffer"); DEFSYM (QChost, ":host"); DEFSYM (QCservice, ":service"); @@ -7356,6 +7613,7 @@ syms_of_process (void) DEFSYM (QCplist, ":plist"); DEFSYM (QCcommand, ":command"); DEFSYM (QCconnection_type, ":connection-type"); + DEFSYM (QCstderr, ":stderr"); DEFSYM (Qpty, "pty"); DEFSYM (Qpipe, "pipe"); @@ -7461,6 +7719,7 @@ The variable takes effect when `start-process' is called. */); defsubr (&Sset_process_plist); defsubr (&Sprocess_list); defsubr (&Smake_process); + defsubr (&Smake_pipe_process); defsubr (&Sserial_process_configure); defsubr (&Smake_serial_process); defsubr (&Sset_network_process_option); diff --git a/src/process.h b/src/process.h index 36979dc..92d7b64 100644 --- a/src/process.h +++ b/src/process.h @@ -105,6 +105,9 @@ struct Lisp_Process Lisp_Object gnutls_cred_type; #endif + /* Pipe process attached to standard error. */ + Lisp_Object stderr; + /* After this point, there are no Lisp_Objects any more. */ /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ diff --git a/src/sysdep.c b/src/sysdep.c index 0a0b0ac..2fe4624 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2257,19 +2257,27 @@ emacs_fopen (char const *file, char const *mode) /* Create a pipe for Emacs use. */ int -emacs_pipe (int fd[2]) +emacs_pipe2 (int fd[2], int flags) { #ifdef MSDOS return pipe (fd); #else /* !MSDOS */ - int result = pipe2 (fd, O_BINARY | O_CLOEXEC); + return pipe2 (fd, flags); +#endif /* !MSDOS */ +} + +int +emacs_pipe (int fd[2]) +{ + int result = emacs_pipe2 (fd, O_BINARY | O_CLOEXEC); +#ifndef MSDOS if (! O_CLOEXEC && result == 0) { fcntl (fd[0], F_SETFD, FD_CLOEXEC); fcntl (fd[1], F_SETFD, FD_CLOEXEC); } - return result; #endif /* !MSDOS */ + return result; } /* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs. diff --git a/test/ChangeLog b/test/ChangeLog index 6a474e1..0f61e24 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,8 @@ +2015-03-18 Daiki Ueno + + * automated/process-tests.el (process-test-stderr-buffer) + (process-test-stderr-filter): New tests. + 2015-03-10 Jackson Ray Hamilton * indent/js-indent-init-dynamic.js: Fix spelling error. diff --git a/test/automated/process-tests.el b/test/automated/process-tests.el index dabfbc5..3389387 100644 --- a/test/automated/process-tests.el +++ b/test/automated/process-tests.el @@ -72,4 +72,69 @@ (should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n")))) (when batfile (delete-file batfile)))))) +(ert-deftest process-test-stderr-buffer () + (let* ((stdout-buffer (generate-new-buffer "*stdout*")) + (stderr-buffer (generate-new-buffer "*stderr*")) + (proc (make-process :name "test" :buffer stdout-buffer + :command (list "bash" "-c" + (concat "echo hello stdout!; " + "echo hello stderr! >&2; " + "exit 20")) + :stderr stderr-buffer)) + (sentinel-called nil) + (start-time (float-time))) + (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 (with-current-buffer stdout-buffer + (goto-char (point-min)) + (looking-at "hello stdout!"))) + (should (with-current-buffer stderr-buffer + (goto-char (point-min)) + (looking-at "hello stderr!"))))) + +(ert-deftest process-test-stderr-filter () + (let* ((sentinel-called nil) + (stderr-sentinel-called nil) + (stdout-input nil) + (stderr-input nil) + (stdout-buffer (generate-new-buffer "*stdout*")) + (stderr-buffer (generate-new-buffer "*stderr*")) + (stderr-proc (make-pipe-process :name "stderr" + :buffer stderr-buffer)) + (proc (make-process :name "test" :buffer stdout-buffer + :command (list "bash" "-c" + (concat "echo hello stdout!; " + "echo hello stderr! >&2; " + "exit 20")) + :stderr stderr-proc)) + (start-time (float-time))) + (set-process-filter proc (lambda (proc input) + (push input stdout-input))) + (set-process-sentinel proc (lambda (proc msg) + (setq sentinel-called t))) + (set-process-filter stderr-proc (lambda (proc input) + (push input stderr-input))) + (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) + (should (equal 1 (with-current-buffer stdout-buffer + (point-max)))) + (should (equal "hello stdout!\n" + (mapconcat #'identity (nreverse stdout-input) ""))) + (should stderr-sentinel-called) + (should (equal 1 (with-current-buffer stderr-buffer + (point-max)))) + (should (equal "hello stderr!\n" + (mapconcat #'identity (nreverse stderr-input) ""))))) + (provide 'process-tests) -- 2.1.0 --=-=-=--