Implementing new pipe function to get around the limitation

that popen accepts a complete command. We need something which
accepts a program name, and a list of arguments, so that
we don't have to assemble together a correctly quoted string.
popen needs an alternative interface resembling execvp.

* eval.c (eval_init): New intrinsic registered, open-pipe-args.

* stream.c (struct stdio_handle): New member, pid.
(stdio_stream_print): Print the pid, if it is nonzero.
(pipevp_close): New close function.
(pipe_close): If h->pid is nonzero, it's a new-style pipe, which
must be closed with pipev_close.
(make_stdio_stream, make_pipe_stream): Initialize new stdio_handle
member to zero.
(make_pipevp_stream): New static function.
(open_pipevp): New function.

* stream.h (open_pipevp): Declared.

* txr.1: open-pipe-args added to stub section heading.

5 files changed, 128 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index 1585018d..949351a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2012-05-18  Kaz Kylheku  <kaz@kylheku.com>
+
+	Implementing new pipe function to get around the limitation
+	that popen accepts a complete command. We need something which
+	accepts a program name, and a list of arguments, so that
+	we don't have to assemble together a correctly quoted string.
+	popen needs an alternative interface resembling execvp.
+
+	* eval.c (eval_init): New intrinsic registered, open-pipe-args.
+
+	* stream.c (struct stdio_handle): New member, pid.
+	(stdio_stream_print): Print the pid, if it is nonzero.
+	(pipevp_close): New close function.
+	(pipe_close): If h->pid is nonzero, it's a new-style pipe, which
+	must be closed with pipev_close.
+	(make_stdio_stream, make_pipe_stream): Initialize new stdio_handle
+	member to zero.
+	(make_pipevp_stream): New static function.
+	(open_pipevp): New function.
+
+	* stream.h (open_pipevp): Declared.
+
+	* txr.1: open-pipe-args added to stub section heading.
+
 2012-05-17  Kaz Kylheku  <kaz@kylheku.com>
 
 	* match.c (v_collect): Implemented semantics for repeat symbol.
diff --git a/eval.c b/eval.c
index 337f4f80..af8841ac 100644
--- a/eval.c
+++ b/eval.c
@@ -2291,6 +2291,7 @@ void eval_init(void)
   reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory));
   reg_fun(intern(lit("open-file"), user_package), func_n2(open_file));
   reg_fun(intern(lit("open-pipe"), user_package), func_n2(open_pipe));
+  reg_fun(intern(lit("open-pipe-args"), user_package), func_n3o(open_pipevp, 2));
 
   reg_var(intern(lit("*user-package*"), user_package), &user_package);
   reg_var(intern(lit("*keyword-package*"), user_package), &keyword_package);
diff --git a/stream.c b/stream.c
index 0201c3eb..574c170e 100644
--- a/stream.c
+++ b/stream.c
@@ -70,12 +70,16 @@ struct stdio_handle {
   FILE *f;
   val descr;
   utf8_decoder_t ud;
+  pid_t pid;
 };
 
 static void stdio_stream_print(val stream, val out)
 {
   struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
-  format(out, lit("#<~s ~s>"), stream->co.cls, h->descr, nao);
+  if (h->pid)
+    format(out, lit("#<~s ~s>"), stream->co.cls, h->descr, nao);
+  else
+    format(out, lit("#<~s ~s ~s>"), stream->co.cls, h->descr, h->pid, nao);
 }
 
 static void stdio_stream_destroy(val stream)
@@ -270,12 +274,21 @@ static struct strm_ops stdio_ops = {
   stdio_flush
 };
 
+static int pipevp_close(FILE *f, pid_t pid)
+{
+  int status;
+  fclose(f);
+  while (waitpid(pid, &status, 0) == -1 && errno == EINTR)
+    ;
+  return status;
+}
+
 static val pipe_close(val stream, val throw_on_error)
 {
   struct stdio_handle *h = (struct stdio_handle *) stream->co.handle;
 
   if (h->f != 0) {
-    int status = pclose(h->f);
+    int status = h->pid != 0 ? pipevp_close(h->f, h->pid) : pclose(h->f);
     h->f = 0;
 
     if (status != 0 && throw_on_error) {
@@ -702,6 +715,7 @@ val make_stdio_stream(FILE *f, val descr, val input, val output)
   h->f = f;
   h->descr = descr;
   utf8_decoder_init(&h->ud);
+  h->pid = 0;
   return stream;
 }
 
@@ -712,9 +726,22 @@ val make_pipe_stream(FILE *f, val descr, val input, val output)
   h->f = f;
   h->descr = descr;
   utf8_decoder_init(&h->ud);
+  h->pid = 0;
   return stream;
 }
 
+static val make_pipevp_stream(FILE *f, val descr, pid_t pid)
+{
+  struct stdio_handle *h = (struct stdio_handle *) chk_malloc(sizeof *h);
+  val stream = cobj((mem_t *) h, stream_s, &pipe_ops.cobj_ops);
+  h->f = f;
+  h->descr = descr;
+  utf8_decoder_init(&h->ud);
+  h->pid = pid;
+  return stream;
+}
+
+
 val make_string_input_stream(val string)
 {
   return cobj((mem_t *) cons(string, zero), stream_s, &string_in_ops.cobj_ops);
@@ -1502,6 +1529,78 @@ val open_pipe(val path, val mode_str)
   return make_pipe_stream(f, path, input, output);
 }
 
+val open_pipevp(val name, val mode_str, val args)
+{
+  int input = equal(mode_str, lit("r")) || equal(mode_str, lit("rb"));
+  int fd[2];
+  pid_t pid;
+  char **argv = 0, *utf8name = 0;
+  val iter;
+  int i, nargs = c_num(length(args));
+
+  if (pipe(fd) == -1) {
+    uw_throwf(file_error_s, lit("opening pipe ~a, pipe syscall failed: ~a/~s"),
+              name, num(errno), string_utf8(strerror(errno)), nao);
+  }
+
+  argv = (char **) chk_malloc((nargs + 1) * sizeof *argv);
+
+  for (i = 0, iter = args; iter; i++, iter = cdr(iter)) {
+    val arg = car(iter);
+    argv[i] = utf8_dup_to(c_str(arg));
+  }
+  argv[i] = 0;
+
+  utf8name = utf8_dup_to(c_str(name));
+
+  pid = fork();
+
+  if (pid == -1) {
+    uw_throwf(file_error_s, lit("opening pipe ~a, fork syscall failed: ~a/~s"),
+              name, num(errno), string_utf8(strerror(errno)), nao);
+  } 
+  
+  if (pid == 0) {
+    if (input) {
+      dup2(fd[1], STDOUT_FILENO);
+      close(fd[0]);
+    } else {
+      dup2(fd[0], STDIN_FILENO);
+      close(fd[1]);
+    }
+
+    execvp(utf8name, argv);
+    _exit(1);
+  } else {
+    int whichfd;
+    char *utf8mode = utf8_dup_to(c_str(mode_str));
+    FILE *f;
+
+    if (input) {
+      close(fd[1]);
+      whichfd = fd[0];
+    } else {
+      close(fd[0]);
+      whichfd = fd[1];
+    }
+
+    for (i = 0; i < nargs; i++)
+      free(argv[i]);
+    free(argv);
+
+    if ((f = fdopen(whichfd, utf8mode)) == 0) {
+      kill(pid, SIGKILL);
+      free(utf8mode);
+      uw_throwf(file_error_s, lit("opening pipe ~a, fdopen failed: ~a/~s"),
+                name, num(errno), string_utf8(strerror(errno)), nao);
+    }
+
+    free(utf8mode);
+    /* TODO: catch potential OOM exception here and kill process. */
+    return make_pipevp_stream(f, name, pid);
+  }
+}
+
 void stream_init(void)
 {
   protect(&std_input, &std_output, &std_debug, &std_error, (val *) 0);
diff --git a/stream.h b/stream.h
index cae9bf98..06862594 100644
--- a/stream.h
+++ b/stream.h
@@ -53,5 +53,6 @@ val flush_stream(val stream);
 val open_directory(val path);
 val open_file(val path, val mode_str);
 val open_pipe(val path, val mode_str);
+val open_pipevp(val path, val mode_str, val args);
 
 void stream_init(void);
diff --git a/txr.1 b/txr.1
index 057c27d1..3de6196b 100644
--- a/txr.1
+++ b/txr.1
@@ -7483,7 +7483,7 @@ Examples:
 
 .SS Function open-directory
 
-.SS Functions open-file, open-pipe
+.SS Functions open-file, open-pipe, open-pipe-args
 
 .SS Variables *user-package*, *keyword-package*, *system-package*