New: standard stream redirection for subprocesses.

When subprocesses are created using open-command,
open-process, run or sh, any streams not bound by
those functions are obtained from *stdin*, *stdout*
or *stderr*, as appropriate. Thus manipulating these
variables has the effect of redirecting not only
local output within the program but over coprocesses
as well.

* stream.c (struct save_fds): New type.
(FDS_IN, FDS_OUT, FDS_ERR): New macros.
(fds_init, fds_subst, fds_swizzle, fds_restore): New static
functions.
(open_command, open_process, run): "Swizzle" and restore
the standard file descriptors.

* txr.1: Updated documentation of affected function.

2 files changed, 215 insertions, 11 deletions

diff --git a/stream.c b/stream.c
index 39dbc18e..4c6e3584 100644
--- a/stream.c
+++ b/stream.c
@@ -3419,15 +3419,98 @@ val open_tail(val path, val mode_str, val seek_end_p)
   return set_mode_props(m, stream);
 }
 
+struct save_fds {
+  int in;
+  int out;
+  int err;
+};
+
+#define FDS_IN  1
+#define FDS_OUT 2
+#define FDS_ERR 4
+
+static void fds_init(struct save_fds *fds)
+{
+  fds->in = fds->out = fds->err = -1;
+}
+
+static int fds_subst(val stream, int fd_std)
+{
+  int fd_orig = c_num(stream_fd(stream));
+
+  if (fd_orig == fd_std)
+    return -1;
+
+  {
+    int fd_dup = dup(fd_std);
+
+    if (fd_dup != -1) {
+      dup2(fd_orig, fd_std);
+      return fd_dup;
+    }
+
+    uw_throwf(file_error_s, lit("failed to duplicate file descriptor: ~d/~s"),
+              num(errno), string_utf8(strerror(errno)), nao);
+  }
+}
+
+static void fds_swizzle(struct save_fds *fds, int flags)
+{
+  if ((flags & FDS_IN) != 0)
+    fds->in = fds_subst(std_input, STDIN_FILENO);
+
+  if ((flags & FDS_OUT) != 0)
+    fds->out = fds_subst(std_output, STDOUT_FILENO);
+
+  if ((flags & FDS_ERR) != 0)
+    fds->err = fds_subst(std_error, STDERR_FILENO);
+}
+
+static void fds_restore(struct save_fds *fds)
+{
+  if (fds->in != -1) {
+    dup2(fds->in, STDIN_FILENO);
+    close(fds->in);
+  }
+
+  if (fds->out != -1) {
+    dup2(fds->out, STDOUT_FILENO);
+    close(fds->out);
+  }
+
+  if (fds->err != -1) {
+    dup2(fds->err, STDERR_FILENO);
+    close(fds->err);
+  }
+}
+
+
 val open_command(val path, val mode_str)
 {
   struct stdio_mode m, m_r = stdio_mode_init_r;
-  FILE *f = w_popen(c_str(path), c_str(normalize_mode(&m, mode_str, m_r)));
+  val mode = normalize_mode(&m, mode_str, m_r);
+  int input = m.read != 0;
+  struct save_fds sfds;
+  FILE *f = 0;
+
+  fds_init(&sfds);
+
+  uw_simple_catch_begin;
+
+  fds_swizzle(&sfds, (input ? FDS_IN : FDS_OUT) | FDS_ERR);
+
+  f = w_popen(c_str(path), c_str(mode));
 
   if (!f)
     uw_throwf(file_error_s, lit("error opening pipe ~a: ~d/~s"),
               path, num(errno), string_utf8(strerror(errno)), nao);
 
+  uw_unwind {
+    fds_restore(&sfds);
+  }
+
+  uw_catch_end;
+
   return set_mode_props(m, make_pipe_stream(f, path));
 }
 
@@ -3442,10 +3525,18 @@ val open_process(val name, val mode_str, val args)
   char **argv = 0;
   val iter;
   int i, nargs;
+  struct save_fds sfds;
+  val ret = nil;
 
   args = default_bool_arg(args);
   nargs = c_num(length(args)) + 1;
 
+  fds_init(&sfds);
+
+  uw_simple_catch_begin;
+
+  fds_swizzle(&sfds, (input ? FDS_IN : FDS_OUT) | FDS_ERR);
+
   if (pipe(fd) == -1) {
     uw_throwf(file_error_s, lit("opening pipe ~a, pipe syscall failed: ~d/~s"),
               name, num(errno), string_utf8(strerror(errno)), nao);
@@ -3518,8 +3609,16 @@ val open_process(val name, val mode_str, val args)
 
     free(utf8mode);
     /* TODO: catch potential OOM exception here and kill process. */
-    return set_mode_props(m, make_pipevp_stream(f, name, pid));
+    ret = set_mode_props(m, make_pipevp_stream(f, name, pid));
   }
+
+  uw_unwind {
+    fds_restore(&sfds);
+  }
+
+  uw_catch_end;
+
+  return ret;
 }
 #else
 
@@ -3623,6 +3722,8 @@ static val run(val name, val args)
   char **argv = 0;
   val iter;
   int i, nargs;
+  struct save_fds sfds;
+  val ret = nil;
 
   args = default_bool_arg(args);
   nargs = c_num(length(args)) + 1;
@@ -3635,6 +3736,12 @@ static val run(val name, val args)
   }
   argv[i] = 0;
 
+  fds_init(&sfds);
+
+  uw_simple_catch_begin;
+
+  fds_swizzle(&sfds, FDS_IN | FDS_OUT | FDS_ERR);
+
   pid = fork();
 
   if (pid == -1) {
@@ -3649,22 +3756,32 @@ static val run(val name, val args)
     execvp(argv[0], argv);
     _exit(errno);
   } else {
-    int status;
+    int status, wres;
     for (i = 0; i < nargs; i++)
       free(argv[i]);
     free(argv);
-    while (waitpid(pid, &status, 0) == -1 && errno == EINTR)
+    while ((wres = waitpid(pid, &status, 0)) == -1 && errno == EINTR)
       ;
-    if (status < 0)
-      return nil;
+    if (wres != -1) {
 #if HAVE_SYS_WAIT
-    if (WIFEXITED(status)) {
-      int exitstatus = WEXITSTATUS(status);
-      return num(exitstatus);
-    }
+      if (WIFEXITED(status)) {
+        int exitstatus = WEXITSTATUS(status);
+        ret = num(exitstatus);
+        goto out;
+      }
 #endif
-    return status == 0 ? zero : nil;
+      ret = (status == 0 ? zero : nil);
+    }
+  }
+
+out:
+  uw_unwind {
+    fds_restore(&sfds);
   }
+
+  uw_catch_end;
+
+  return ret;
 }
 
 static val sh(val command)
@@ -3677,10 +3794,17 @@ static val run(val command, val args)
   const wchar_t **wargv = 0;
   val iter;
   int i, nargs, status;
+  struct save_fds sfds;
 
   args = default_bool_arg(args);
   nargs = c_num(length(args)) + 1;
 
+  fds_init(&sfds);
+
+  uw_simple_catch_begin;
+
+  fds_swizzle(&sfds, FDS_IN | FDS_OUT | FDS_ERR);
+
   wargv = coerce(const wchar_t **, chk_malloc((nargs + 2) * sizeof *wargv));
 
   for (i = 0, iter = cons(command, args); iter; i++, iter = cdr(iter))
@@ -3693,6 +3817,12 @@ static val run(val command, val args)
 
   gc_hint(args);
 
+  uw_unwind {
+    fds_restore(&sfds);
+  }
+
+  uw_catch_end;
+
   return (status < 0) ? nil : num(status);
 }
 
diff --git a/txr.1 b/txr.1
index 0032d4c9..1007bf6d 100644
--- a/txr.1
+++ b/txr.1
@@ -35214,6 +35214,65 @@ the program's output can be gathered by reading from the returned stream.
 When the program finishes output, it will close the stream, which can be
 detected as normal end of data.
 
+The standard input and error file descriptors of an input coprocess
+are obtained from the streams stored in the
+.code *stdin*
+and
+.code *stderr*
+special variables, respectively. Similarly, the standard output and error
+file descriptors of an output coprocess are obtained from the
+.code *stdout*
+and
+.code *stderr*
+special variables.  These variables must contain streams on which the
+.code fileno
+function is meaningful, otherwise the operation will fail.
+What this functionality means is that re-binding the special variables
+for standard streams has the effect of redirection. For example,
+the following two expressions achieve the same effect of creating
+a stream which reads the output of the
+.code cat
+program, which reads and produces the contents of the file
+.codn text-file .
+
+.cblk
+  ;; redirect input by rebinding *stdin*
+  (let ((*stdin* (open-file "text-file")))
+    (open-command "cat"))
+
+  ;; redirect input using POSIX shell redirection syntax
+  (open-command "cat < text-file")
+.cble
+
+The following is erroneous:
+
+.cblk
+  ;; (let ((*stdin* (make-string-input-stream "abc")))
+       (open-command "cat"))
+.cble
+
+A string input or output stream doesn't have an operating system file
+descriptor; it cannot be passed to a coprocess.
+
+The streams
+.codn *stdin* ,
+.code *stdout*
+and
+.code *stderr*
+are not synchronized with their underlying file descriptors prior to
+the execution of a coprocess. It is up to the program to ensure that
+previous output to
+.code *stdout*
+or
+.code *stderr*
+is flushed, so that the output of the coprocess isn't re-ordered
+with regard to output produced by the program. Similarly,
+input buffered in
+.code *stdin*
+is not available to the coprocess, even though it has not
+yet been read by the program. The program is responsible for preventing this
+situation also.
+
 If a coprocess terminates abnormally or unsuccessfully, an exception is raised.
 
 .SS* Symbols and Packages
@@ -36391,6 +36450,21 @@ value from the failed
 .code exec
 attempt.
 
+The standard input, output and error file descriptors of an executed
+command are obtained from the streams stored in the
+.codn *stdin* ,
+.code *stdout*
+and
+.code *stderr*
+special variables, respectively. For a detailed description of the
+behavior and restrictions, see the
+.code open-command
+function, whose description of this mechanism applies to the
+.code run
+and
+.code sh
+function also.
+
 Note: as of \*(TX 120, the
 .code sh
 function is implemented using