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: Re: [PATCH] Add facility to collect stderr of async subprocess Date: Wed, 08 Apr 2015 11:55:17 +0900 Message-ID: References: <87d24d3uwz.fsf-ueno@gnu.org> <83pp87y6iu.fsf@gnu.org> <83mw3bxz9f.fsf@gnu.org> <83k2yfx8zi.fsf@gnu.org> <83egomxog1.fsf@gnu.org> <83ego5tjgt.fsf@gnu.org> <877ftno4fr.fsf-ueno@gnu.org> <55247A98.5020302@cs.ucla.edu> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1428461762 8407 80.91.229.3 (8 Apr 2015 02:56:02 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 8 Apr 2015 02:56:02 +0000 (UTC) Cc: emacs-devel@gnu.org To: Paul Eggert Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Apr 08 04:55:56 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 1Yfg9j-0005Tb-Ew for ged-emacs-devel@m.gmane.org; Wed, 08 Apr 2015 04:55:55 +0200 Original-Received: from localhost ([::1]:50210 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yfg9i-0001tS-Lq for ged-emacs-devel@m.gmane.org; Tue, 07 Apr 2015 22:55:54 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45668) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yfg9J-0001tA-LA for emacs-devel@gnu.org; Tue, 07 Apr 2015 22:55:33 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Yfg9E-0004A0-Rf for emacs-devel@gnu.org; Tue, 07 Apr 2015 22:55:29 -0400 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:57999) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Yfg9E-00049r-Hw for emacs-devel@gnu.org; Tue, 07 Apr 2015 22:55:24 -0400 Original-Received: from du-a.org ([219.94.251.20]:40988 helo=localhost.localdomain) by fencepost.gnu.org with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1Yfg9C-0006MC-Oz; Tue, 07 Apr 2015 22:55:23 -0400 In-Reply-To: <55247A98.5020302@cs.ucla.edu> (Paul Eggert's message of "Tue, 07 Apr 2015 17:47:20 -0700") 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:185128 Archived-At: --=-=-= Content-Type: text/plain Paul Eggert writes: > I took a quick look, and in the ordinary POSIXish code there's a race > condition between the calls to pipe2 and the calls to fcntl with > FD_CLOEXEC. If some other thread forks and execs a process after > pipe2 but before fcntl, that process will have access to the pipe ends > and this could cause problems. Instead, please call pipe2 (.., > O_BINARY | O_CLOEXEC) so that the other process won't see the pipe > end. Any child process that needs to have the pipe end survive an > exec should then call fcntl (pipe_end, F_SETFD, 0) before execing. Thanks. Actually, the special case of pipe2 flags was not necessary; it was a wreck when I tried to support FD above 2 (for stderr, the flag is cleared in child_setup). I updated the patch and it's now much simpler. Regards, -- Daiki Ueno --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=v3-0001-Add-facility-to-collect-stderr-of-async-subproces.patch >From 5924db1deeb49869d82906891e003c80be4bb486 Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Tue, 7 Apr 2015 17:42:09 +0900 Subject: [PATCH v3] Add facility to collect stderr of async subprocess * src/w32.h (register_aux_fd): New function declaration. * src/w32.c (register_aux_fd): New function. * src/process.h (struct Lisp_Process): New member stderrproc. * 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 p->stderrproc. (Fmake_pipe_process): New function. (Fmake_process): Add new keyword argument :stderr. (wait_reading_process_output): Specially handle a pipe process when it gets an EOF. (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/processes.texi | 52 +++++++ etc/NEWS | 4 + src/process.c | 302 +++++++++++++++++++++++++++++++++++++--- src/process.h | 3 + src/w32.c | 32 +++++ src/w32.h | 1 + test/automated/process-tests.el | 67 +++++++++ 7 files changed, 440 insertions(+), 21 deletions(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 3e9cc50..59bc846 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -741,6 +741,58 @@ 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 default rules for finding the +coding system will apply. @xref{Default Coding Systems}. + +@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/NEWS b/etc/NEWS index 0332fc5..cf26bbf 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -671,6 +671,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 an alternative interface to `start-process'. It allows programs to set process parameters such as process filter, sentinel, etc., through keyword arguments (similar to diff --git a/src/process.c b/src/process.c index 2800fa5..e9bf059 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; @@ -411,6 +413,11 @@ pset_write_queue (struct Lisp_Process *p, Lisp_Object val) { p->write_queue = val; } +static void +pset_stderrproc (struct Lisp_Process *p, Lisp_Object val) +{ + p->stderrproc = val; +} static Lisp_Object @@ -837,7 +844,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; @@ -903,7 +910,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; @@ -987,7 +994,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; @@ -1063,7 +1070,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; @@ -1095,7 +1102,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; } @@ -1183,13 +1190,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; @@ -1386,10 +1393,15 @@ 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. Specifying this implies +`:connection-type' is set to `pipe'. + usage: (make-process &rest ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem; + Lisp_Object xstderr, stderrproc; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1; USE_SAFE_ALLOCA; @@ -1433,6 +1445,27 @@ usage: (make-process &rest ARGS) */) if (!NILP (program)) CHECK_STRING (program); + stderrproc = Qnil; + xstderr = Fplist_get (contact, QCstderr); + if (PROCESSP (xstderr)) + { + if (!PIPECONN_P (xstderr)) + error ("Process is not a pipe process"); + stderrproc = xstderr; + } + else if (!NILP (xstderr)) + { + struct gcpro gcpro1, gcpro2; + CHECK_STRING (program); + GCPRO2 (buffer, current_dir); + stderrproc = CALLN (Fmake_pipe_process, + QCname, + concat2 (name, build_string (" stderr")), + QCbuffer, + Fget_buffer_create (xstderr)); + 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 @@ -1463,6 +1496,13 @@ usage: (make-process &rest ARGS) */) else report_file_error ("Unknown connection type", tem); + if (!NILP (stderrproc)) + { + pset_stderrproc (XPROCESS (proc), stderrproc); + + XPROCESS (proc)->pty_flag = false; + } + #ifdef HAVE_GNUTLS /* AKA GNUTLS_INITSTAGE(proc). */ XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY; @@ -1705,10 +1745,10 @@ 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 = -1; pid_t pid; int vfork_errno; - int forkin, forkout; + int forkin, forkout, forkerr = -1; bool pty_flag = 0; char pty_name[PTY_NAME_SIZE]; Lisp_Object lisp_pty_name = Qnil; @@ -1746,6 +1786,18 @@ 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->stderrproc)) + { + struct Lisp_Process *pp = XPROCESS (p->stderrproc); + + forkerr = pp->open_fd[SUBPROCESS_STDOUT]; + errchannel = pp->open_fd[READ_FROM_SUBPROCESS]; + + /* Close unnecessary file descriptors. */ + close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]); + close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]); + } } #ifndef WINDOWSNT @@ -1792,6 +1844,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 (); @@ -1801,6 +1854,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; @@ -1811,6 +1865,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 @@ -1910,10 +1965,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 */ } @@ -1958,6 +2016,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->stderrproc)) + { + struct Lisp_Process *pp = XPROCESS (p->stderrproc); + close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]); + } } } @@ -2016,6 +2079,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_pipe (p->open_fd + SUBPROCESS_STDIN) != 0 + || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0) + report_file_error ("Creating pipe", Qnil); + outchannel = p->open_fd[WRITE_TO_SUBPROCESS]; + inchannel = p->open_fd[READ_FROM_SUBPROCESS]; + + fcntl (inchannel, F_SETFL, O_NONBLOCK); + fcntl (outchannel, F_SETFL, O_NONBLOCK); + +#ifdef WINDOWSNT + register_aux_fd (inchannel, outchannel); +#endif + + /* 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. */ @@ -4884,7 +5128,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 @@ -4916,8 +5161,18 @@ 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 if (nread == 0 && PIPECONN_P (proc)) + { + /* Preserve status of processes already terminated. */ + XPROCESS (proc)->tick = ++process_tick; + deactivate_process (proc); + if (EQ (XPROCESS (proc)->status, Qrun)) + pset_status (XPROCESS (proc), + list2 (Qexit, make_number (0))); + } else { /* Preserve status of processes already terminated. */ @@ -5954,7 +6209,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; @@ -5983,7 +6239,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; @@ -7030,7 +7287,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); @@ -7330,6 +7587,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"); @@ -7346,6 +7604,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"); @@ -7451,6 +7710,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..e889055 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 the standard error of this process. */ + Lisp_Object stderrproc; + /* 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/w32.c b/src/w32.c index 6f16704..77bf307 100644 --- a/src/w32.c +++ b/src/w32.c @@ -9473,6 +9473,38 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) pset_childp (p, childp2); } +/* For make-pipe-process */ +void +register_aux_fd (int infd, int outfd) +{ + cp = new_child (); + if (!cp) + error ("Could not create child process"); + cp->fd = infd; + cp->status = STATUS_READ_ACKNOWLEDGED; + + if (fd_info[ infd ].cp != NULL) + { + error ("fd_info[fd = %d] is already in use", infd); + } + fd_info[ infd ].cp = cp; + fd_info[ infd ].hnd = (HANDLE) _get_osfhandle (infd); + + if (fd_info[ outfd ].cp != NULL) + { + error ("fd_info[fd = %d] is already in use", outfd); + } + fd_info[ outfd ].cp = cp; + fd_info[ outfd ].hnd = (HANDLE) _get_osfhandle (outfd); + + cp->ovl_read.hEvent = CreateEvent (NULL, TRUE, FALSE, NULL); + if (cp->ovl_read.hEvent == NULL) + error ("Could not create read event"); + cp->ovl_write.hEvent = CreateEvent (NULL, TRUE, FALSE, NULL); + if (cp->ovl_write.hEvent == NULL) + error ("Could not create write event"); +} + #ifdef HAVE_GNUTLS ssize_t diff --git a/src/w32.h b/src/w32.h index 9b3521d..32d232e 100644 --- a/src/w32.h +++ b/src/w32.h @@ -202,6 +202,7 @@ extern int random (void); extern int fchmod (int, mode_t); extern int sys_rename_replace (char const *, char const *, BOOL); extern int pipe2 (int *, int); +extern void register_aux_fd (int, int); extern void set_process_dir (char *); extern int sys_spawnve (int, char *, char **, char **); diff --git a/test/automated/process-tests.el b/test/automated/process-tests.el index dabfbc5..3267999 100644 --- a/test/automated/process-tests.el +++ b/test/automated/process-tests.el @@ -72,4 +72,71 @@ (should (string= (buffer-string) "arg1 = \"x &y\", arg2 = \n")))) (when batfile (delete-file batfile)))))) +(ert-deftest process-test-stderr-buffer () + (skip-unless (executable-find "bash")) + (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 () + (skip-unless (executable-find "bash")) + (let* ((sentinel-called nil) + (stderr-sentinel-called nil) + (stdout-output nil) + (stderr-output 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-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) + (should (equal 1 (with-current-buffer stdout-buffer + (point-max)))) + (should (equal "hello stdout!\n" + (mapconcat #'identity (nreverse stdout-output) ""))) + (should stderr-sentinel-called) + (should (equal 1 (with-current-buffer stderr-buffer + (point-max)))) + (should (equal "hello stderr!\n" + (mapconcat #'identity (nreverse stderr-output) ""))))) + (provide 'process-tests) -- 2.1.0 --=-=-=--