[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Add facility to collect stderr of async subprocess
|
From: |
Daiki Ueno |
|
Subject: |
Re: [PATCH] Add facility to collect stderr of async subprocess |
|
Date: |
Wed, 08 Apr 2015 11:55:17 +0900 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (gnu/linux) |
Paul Eggert <address@hidden> 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
>From 5924db1deeb49869d82906891e003c80be4bb486 Mon Sep 17 00:00:00 2001
From: Daiki Ueno <address@hidden>
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}.
+
address@hidden :stderr @var{stderr}
+Associate @var{stderr} with the standard error of the process.
address@hidden is either a buffer or a pipe process created with
address@hidden
address@hidden table
+
+The original argument list, modified with the actual connection
+information, is available via the @code{process-contact} function.
address@hidden defun
+
address@hidden 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
address@hidden).
+
+The arguments @var{args} are a list of keyword/argument pairs.
+Omitting a keyword is always equivalent to specifying it with value
address@hidden, except for @code{:coding}.
+Here are the meaningful keywords:
+
address@hidden @asis
address@hidden :name @var{name}
+Use the string @var{name} as the process name. It is modified if
+necessary to make it unique.
+
address@hidden :buffer @var{buffer}
+Use @var{buffer} as the process buffer.
+
address@hidden :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
address@hidden@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}.
+
address@hidden :noquery @var{query-flag}
+Initialize the process query flag to @var{query-flag}.
address@hidden Before Exit}.
+
address@hidden :stop @var{stopped}
+If @var{stopped} is address@hidden, start the process in the
+``stopped'' state.
+
address@hidden :filter @var{filter}
+Initialize the process filter to @var{filter}.
+
address@hidden :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
- Re: [PATCH] Add facility to collect stderr of async subprocess, Daiki Ueno, 2015/04/07
- Re: [PATCH] Add facility to collect stderr of async subprocess, Paul Eggert, 2015/04/07
- Re: [PATCH] Add facility to collect stderr of async subprocess,
Daiki Ueno <=
- Re: [PATCH] Add facility to collect stderr of async subprocess, Eli Zaretskii, 2015/04/08
- Re: [PATCH] Add facility to collect stderr of async subprocess, Eli Zaretskii, 2015/04/08
- Re: [PATCH] Add facility to collect stderr of async subprocess, Daiki Ueno, 2015/04/08
- Re: [PATCH] Add facility to collect stderr of async subprocess, Daiki Ueno, 2015/04/10
- Re: [PATCH] Add facility to collect stderr of async subprocess, Ted Zlatanov, 2015/04/18
Re: [PATCH] Add facility to collect stderr of async subprocess, Eli Zaretskii, 2015/04/08