'pipe' now takes an optional 'flags' parameter.

This is the same strategy as used for the 'accept4' bindings introduced
in 6e0965104c579431e5a786b60e1a964a112c73b8.

* libguile/posix.c (scm_pipe): Rename to...
(scm_pipe2): ... this.  Add an optional 'flags' parameter and honor it.
(scm_pipe): Rewrite as a call to 'scm_pipe2'.
* libguile/posix.h (scm_pipe2): New declaration.
* test-suite/tests/posix.test ("pipe"): New tests.
* configure.ac: Look for 'pipe2'.
* NEWS: Update.

2 files changed, 47 insertions, 7 deletions

diff --git a/libguile/posix.c b/libguile/posix.c
index f4ca72d3e..475312c2a 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -226,8 +226,8 @@ char *getlogin (void);
 SCM_SYMBOL (sym_read_pipe, "read pipe");
 SCM_SYMBOL (sym_write_pipe, "write pipe");
 
-SCM_DEFINE (scm_pipe, "pipe", 0, 0, 0,
-            (),
+SCM_DEFINE (scm_pipe2, "pipe", 0, 1, 0,
+            (SCM flags),
 	    "Return a newly created pipe: a pair of ports which are linked\n"
 	    "together on the local machine.  The @emph{car} is the input\n"
 	    "port and the @emph{cdr} is the output port.  Data written (and\n"
@@ -236,20 +236,54 @@ SCM_DEFINE (scm_pipe, "pipe", 0, 0, 0,
 	    "child process.  The need to flush the output port can be\n"
 	    "avoided by making it unbuffered using @code{setvbuf}.\n"
 	    "\n"
+            "Optionally, on systems that support it such as GNU/Linux and\n"
+            "GNU/Hurd, @var{flags} can specify a bitwise-or of the following\n"
+            "constants:\n"
+            "\n"
+            "@table @code\n"
+            "@item O_CLOEXEC\n"
+            "Mark the returned file descriptors as close-on-exec;\n"
+            "@item O_DIRECT\n"
+            "Create a pipe that performs input/output in \"packet\"\n"
+            "mode---see @command{man 2 pipe} for details;\n"
+            "@item O_NONBLOCK\n"
+            "Set the @code{O_NONBLOCK} status flag (non-blocking input and\n"
+            "output) on the file descriptors.\n"
+            "@end table\n"
+            "\n"
+            "On systems that do @emph{not} support it, passing a non-zero\n"
+            "@var{flags} value triggers a @code{system-error} exception.\n"
+	    "\n"
 	    "Writes occur atomically provided the size of the data in bytes\n"
 	    "is not greater than the value of @code{PIPE_BUF}.  Note that\n"
 	    "the output port is likely to block if too much data (typically\n"
 	    "equal to @code{PIPE_BUF}) has been written but not yet read\n"
 	    "from the input port.")
-#define FUNC_NAME s_scm_pipe
+#define FUNC_NAME s_scm_pipe2
 {
-  int fd[2], rv;
+  int fd[2], rv, c_flags;
   SCM p_rd, p_wt;
 
-  rv = pipe (fd);
+  if (SCM_UNBNDP (flags))
+    c_flags = 0;
+  else
+    SCM_VALIDATE_INT_COPY (1, flags, c_flags);
+
+#ifdef HAVE_PIPE2
+  rv = pipe2 (fd, c_flags);
+#else
+  if (c_flags == 0)
+    rv = pipe (fd);
+  else
+    /* 'pipe2' cannot be emulated on systems that lack it: calling
+       'fnctl' afterwards to set the relevant flags is not equivalent
+       because it's not atomic.  */
+    rv = ENOSYS;
+#endif
+
   if (rv)
     SCM_SYSERROR;
-  
+
   p_rd = scm_i_fdes_to_port (fd[0], scm_mode_bits ("r"), sym_read_pipe,
                              SCM_FPORT_OPTION_NOT_SEEKABLE);
   p_wt = scm_i_fdes_to_port (fd[1], scm_mode_bits ("w"), sym_write_pipe,
@@ -258,6 +292,11 @@ SCM_DEFINE (scm_pipe, "pipe", 0, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM
+scm_pipe (void)
+{
+  return scm_pipe2 (SCM_INUM0);
+}
 
 #ifdef HAVE_GETGROUPS
 SCM_DEFINE (scm_getgroups, "getgroups", 0, 0, 0,
diff --git a/libguile/posix.h b/libguile/posix.h
index ff3bec9ea..e62c84afe 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -1,7 +1,7 @@
 #ifndef SCM_POSIX_H
 #define SCM_POSIX_H
 
-/* Copyright 1995-1998,2000-2001,2003,2006,2008-2011,2018,2021
+/* Copyright 1995-1998,2000-2001,2003,2006,2008-2011,2018,2021,2022
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -34,6 +34,7 @@ SCM_API SCM scm_setsid (void);
 SCM_API SCM scm_getsid (SCM pid);
 SCM_API SCM scm_setpgid (SCM pid, SCM pgid);
 SCM_API SCM scm_pipe (void);
+SCM_INTERNAL SCM scm_pipe2 (SCM flags);
 SCM_API SCM scm_getgroups (void);
 SCM_API SCM scm_setgroups (SCM groups);
 SCM_API SCM scm_getpgrp (void);