From 1d313bf5f0d296d766bd3a0e6d030df37c71711b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 19 Sep 2022 22:27:10 +0200 Subject: '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. --- NEWS | 7 +++++++ configure.ac | 3 ++- doc/ref/posix.texi | 20 +++++++++++++++++- libguile/posix.c | 51 +++++++++++++++++++++++++++++++++++++++------ libguile/posix.h | 3 ++- test-suite/tests/posix.test | 35 +++++++++++++++++++++++++++++++ 6 files changed, 110 insertions(+), 9 deletions(-) diff --git a/NEWS b/NEWS index 05bd1f6e5..19d314f4a 100644 --- a/NEWS +++ b/NEWS @@ -18,6 +18,13 @@ pass O_CLOEXEC to the underlying `open' call. It can now be done by appending "e" to the `mode' string passed as a second argument. See "File Ports" in the manual for more info. +** `pipe' now takes flags as an optional argument + +This lets you pass flags such as O_CLOEXEC and O_NONBLOCK, as with the +pipe2(2) system call found on GNU/Linux and GNU/Hurd, instead of having +to call `fnctl' afterwards. See "Ports and File Descriptors" in the +manual for details. + ** Abstract Unix-domain sockets are supported It is now possible to create an AF_UNIX socket with a leading zero byte diff --git a/configure.ac b/configure.ac index b36cf0c15..801110d1b 100644 --- a/configure.ac +++ b/configure.ac @@ -534,6 +534,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # fork - unavailable on Windows # sched_getaffinity, sched_setaffinity - GNU extensions (glibc) # sendfile - non-POSIX, found in glibc +# pipe2 - non-POSIX, found in glibc (GNU/Linux and GNU/Hurd) # AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \ @@ -545,7 +546,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \ index bcopy memcpy rindex truncate isblank _NSGetEnviron \ strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat \ - sched_getaffinity sched_setaffinity sendfile]) + sched_getaffinity sched_setaffinity sendfile pipe2]) # The newlib C library uses _NL_ prefixed locale langinfo constants. AC_CHECK_DECLS([_NL_NUMERIC_GROUPING], [], [], [[#include ]]) diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index 19911a427..6a9f54102 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -318,7 +318,7 @@ the file descriptor will be closed even if a port is using it. The return value is unspecified. @end deffn -@deffn {Scheme Procedure} pipe +@deffn {Scheme Procedure} pipe [flags] @deffnx {C Function} scm_pipe () @cindex pipe Return a newly created pipe: a pair of ports which are linked together @@ -329,6 +329,24 @@ for communication with a newly forked child process. The need to flush the output port can be avoided by making it unbuffered using @code{setvbuf} (@pxref{Buffering}). +Optionally, on systems that support it such as GNU/Linux and +GNU/Hurd, @var{flags} can specify a bitwise-or of the following +constants: + +@table @code +@item O_CLOEXEC +Mark the returned file descriptors as close-on-exec; +@item O_DIRECT +Create a pipe that performs input/output in ``packet" +mode---see @command{man 2 pipe} for details; +@item O_NONBLOCK +Set the @code{O_NONBLOCK} status flag (non-blocking input and +output) on the file descriptors. +@end table + +On systems that do @emph{not} support it, passing a non-zero +@var{flags} value triggers a @code{system-error} exception. + @defvar PIPE_BUF A write of up to @code{PIPE_BUF} many bytes to a pipe is atomic, meaning when done it goes into the pipe instantaneously and as a 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); diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index 500dbb94a..1b1580f5d 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -230,6 +230,41 @@ (apply throw args))))) (throw 'unresolved)))) +;; +;; pipe +;; + +(with-test-prefix "pipe" + + (pass-if-equal "in and out" + "hi!\n" + (let ((in+out (pipe))) + (display "hi!\n" (cdr in+out)) + (close-port (cdr in+out)) + (let ((str (list->string (list (read-char (car in+out)) + (read-char (car in+out)) + (read-char (car in+out)) + (read-char (car in+out)))))) + (and (eof-object? (read-char (car in+out))) + (begin + (close-port (car in+out)) + str))))) + + (pass-if-equal "O_CLOEXEC" + (list FD_CLOEXEC FD_CLOEXEC) + (let* ((in+out (catch 'system-error + (lambda () + (pipe O_CLOEXEC)) + (lambda args + (if (= (system-error-errno args) ENOSYS) + (throw 'unresolved) + (apply throw args))))) + (flags (list (fcntl (car in+out) F_GETFD) + (fcntl (cdr in+out) F_GETFD)))) + (close-port (car in+out)) + (close-port (cdr in+out)) + flags))) + ;; ;; system* ;; -- cgit v1.2.1