bug#52835: [PATCH v6 1/3] Add spawn*.

2022-12-22 Thread Bug reports for GUILE, GNU's Ubiquitous Extension Language
* libguile/posix.c: Include spawn.h from Gnulib.
(do_spawn, scm_spawn_process): New functions.
---
 libguile/posix.c | 81 
 libguile/posix.h |  2 ++
 2 files changed, 83 insertions(+)

diff --git a/libguile/posix.c b/libguile/posix.c
index b5352c2c4..e92625483 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -33,6 +33,7 @@
 #include 
 #include 
 #include 
+#include 
 
 #ifdef HAVE_SCHED_H
 # include 
@@ -1426,6 +1427,86 @@ start_child (const char *exec_file, char **exec_argv,
 }
 #endif
 
+static int
+do_spawn (char *exec_file, char **exec_argv, char **exec_env, int in, int out, 
int err)
+{
+  int pid = -1;
+
+  posix_spawn_file_actions_t actions;
+  posix_spawnattr_t *attrp = NULL;
+
+  int max_fd = 1024;
+
+#if defined (HAVE_GETRLIMIT) && defined (RLIMIT_NOFILE)
+  {
+struct rlimit lim = { 0, 0 };
+if (getrlimit (RLIMIT_NOFILE, &lim) == 0)
+  max_fd = lim.rlim_cur;
+  }
+#endif
+
+  posix_spawn_file_actions_init (&actions);
+
+  int free_fd_slots = 0;
+  int fd_slot[3];
+
+  for (int fdnum = 3;free_fd_slots < 3 && fdnum < max_fd;fdnum++)
+{
+  if (fdnum != in && fdnum != out && fdnum != err)
+{
+  fd_slot[free_fd_slots] = fdnum;
+  free_fd_slots++;
+}
+}
+
+  /* Move the fds out of the way, so that duplicate fds or fds equal
+ to 0, 1, 2 don't trample each other */
+
+  posix_spawn_file_actions_adddup2 (&actions, in, fd_slot[0]);
+  posix_spawn_file_actions_adddup2 (&actions, out, fd_slot[1]);
+  posix_spawn_file_actions_adddup2 (&actions, err, fd_slot[2]);
+  posix_spawn_file_actions_adddup2 (&actions, fd_slot[0], 0);
+  posix_spawn_file_actions_adddup2 (&actions, fd_slot[1], 1);
+  posix_spawn_file_actions_adddup2 (&actions, fd_slot[2], 2);
+
+  while (--max_fd > 2)
+posix_spawn_file_actions_addclose (&actions, max_fd);
+
+  if (posix_spawnp (&pid, exec_file, &actions, attrp, exec_argv, environ) != 0)
+  return -1;
+
+  return pid;
+}
+
+SCM_DEFINE (scm_spawn_process, "spawn*", 5, 0, 0,
+   (SCM prog, SCM args, SCM in, SCM out, SCM err),
+"Spawns a new child process executing @var{prog} with arguments\n"
+"@var{args}, with its standard input, output and error file descriptors\n"
+"set to @var{in}, @var{out}, @var{err}.")
+#define FUNC_NAME s_scm_spawn_process
+{
+  int pid;
+  char *exec_file;
+  char **exec_argv;
+  char **exec_env = environ;
+
+  exec_file = scm_to_locale_string (prog);
+  exec_argv = scm_i_allocate_string_pointers (args);
+
+  pid = do_spawn (exec_file, exec_argv, exec_env,
+  scm_to_int (in),
+  scm_to_int (out),
+  scm_to_int (err));
+
+  free (exec_file);
+
+  if (pid == -1)
+  SCM_SYSERROR;
+
+  return scm_from_int (pid);
+}
+#undef FUNC_NAME
+
 #ifdef HAVE_START_CHILD
 static SCM
 scm_piped_process (SCM prog, SCM args, SCM from, SCM to)
diff --git a/libguile/posix.h b/libguile/posix.h
index 6504eaea8..c2703f9ab 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -69,6 +69,8 @@ SCM_API SCM scm_tmpnam (void);
 SCM_API SCM scm_tmpfile (void);
 SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
 SCM_API SCM scm_close_pipe (SCM port);
+SCM_API SCM scm_spawn_process (SCM prog, SCM args,
+   SCM in, SCM out, SCM err);
 SCM_API SCM scm_system_star (SCM cmds);
 SCM_API SCM scm_utime (SCM object, SCM actime, SCM modtime,
SCM actimens, SCM modtimens, SCM flags);
-- 
2.38.1






bug#52835: [PATCH v6 3/3] Move popen and posix procedures to spawn*.

2022-12-22 Thread Bug reports for GUILE, GNU's Ubiquitous Extension Language
* libguile/posix.c (scm_piped_process, scm_init_popen): Remove
functions.
(scm_port_to_fd_with_default): New helper function.
(scm_system_star): Rewrite using scm_spawn_process.
(scm_init_popen): Remove the definition of piped-process.
(scm_init_posix): Now make popen available unconditionally.

* module/ice-9/popen.scm (port-with-defaults): New helper procedure.
(spawn): New procedure.
(open-process): Rewrite using spawn.
(pipeline): Rewrite using spawn*.

* test-suite/tests/popen.test ("piped-process", "piped-process:
with-output"): Removed tests.
("spawn", "spawn: with output"): Added tests.
* test-suite/tests/posix.test ("http://bugs.gnu.org/13166";, "exit code
for nonexistent file", "https://bugs.gnu.org/55596";): Remove obsolete
tests.
("exception for nonexistent file"): Add test.
---
 libguile/posix.c| 144 
 module/ice-9/popen.scm  |  87 +++---
 test-suite/tests/popen.test |  14 ++--
 test-suite/tests/posix.test |  36 -
 4 files changed, 118 insertions(+), 163 deletions(-)

diff --git a/libguile/posix.c b/libguile/posix.c
index f9c36d7ac..1401a9118 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -64,6 +64,7 @@
 #include "fports.h"
 #include "gettext.h"
 #include "gsubr.h"
+#include "ioext.h"
 #include "list.h"
 #include "modules.h"
 #include "numbers.h"
@@ -1388,98 +1389,6 @@ SCM_DEFINE (scm_spawn_process, "spawn*", 5, 0, 0,
 }
 #undef FUNC_NAME
 
-#ifdef HAVE_FORK
-static SCM
-scm_piped_process (SCM prog, SCM args, SCM from, SCM to)
-#define FUNC_NAME "piped-process"
-{
-  int reading, writing;
-  int c2p[2]; /* Child to parent.  */
-  int p2c[2]; /* Parent to child.  */
-  int in = -1, out = -1, err = -1;
-  int pid;
-  char *exec_file;
-  char **exec_argv;
-  char **exec_env = environ;
-
-  exec_file = scm_to_locale_string (prog);
-  exec_argv = scm_i_allocate_string_pointers (scm_cons (prog, args));
-
-  reading = scm_is_pair (from);
-  writing = scm_is_pair (to);
-
-  if (reading)
-{
-  c2p[0] = scm_to_int (scm_car (from));
-  c2p[1] = scm_to_int (scm_cdr (from));
-  out = c2p[1];
-}
-
-  if (writing)
-{
-  p2c[0] = scm_to_int (scm_car (to));
-  p2c[1] = scm_to_int (scm_cdr (to));
-  in = p2c[0];
-}
-
-  {
-SCM port;
-
-if (SCM_OPOUTFPORTP ((port = scm_current_error_port (
-  err = SCM_FPORT_FDES (port);
-if (out == -1 && SCM_OPOUTFPORTP ((port = scm_current_output_port (
-  out = SCM_FPORT_FDES (port);
-if (in == -1 && SCM_OPINFPORTP ((port = scm_current_input_port (
-  in = SCM_FPORT_FDES (port);
-  }
-
-  pid = do_spawn (exec_file, exec_argv, exec_env, in, out, err);
-  int errno_save = errno;
-
-  if (pid == -1)
-{
-  /* TODO This is a compatibility shim until the next major release */
-  switch (errno) {
-  /* If the error seemingly comes from fork */
-  case EAGAIN:
-  case ENOMEM:
-  case ENOSYS:
-free (exec_file);
-
-if (reading)
-  {
-close (c2p[0]);
-  }
-if (writing)
-  {
-close (p2c[1]);
-  }
-errno = errno_save;
-SCM_SYSERROR;
-break;
-  /* Else create a dummy process that exits with value 127 */
-  default:
-dprintf (err, "In execvp of %s: %s\n", exec_file,
- strerror (errno_save));
-pid = fork ();
-if (pid == -1)
-  SCM_SYSERROR;
-if (pid == 0)
-  _exit (127);
-  }
-}
-
-  free (exec_file);
-
-  if (reading)
-close (c2p[1]);
-  if (writing)
-close (p2c[0]);
-
-  return scm_from_int (pid);
-}
-#undef FUNC_NAME
-
 static void
 restore_sigaction (SCM pair)
 {
@@ -1501,6 +1410,15 @@ scm_dynwind_sigaction (int sig, SCM handler, SCM flags)
SCM_F_WIND_EXPLICITLY);
 }
 
+static int
+port_to_fd_with_default (SCM port, int mode)
+{
+  if (!SCM_FPORTP (port))
+return  open_or_open64 ("/dev/null", mode);
+  return SCM_FPORT_FDES (port);
+
+}
+
 SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
(SCM args),
 "Execute the command indicated by @var{args}.  The first element must\n"
@@ -1521,13 +1439,14 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
 "Example: (system* \"echo\" \"foo\" \"bar\")")
 #define FUNC_NAME s_scm_system_star
 {
-  SCM prog, pid;
-  int status, wait_result;
+  int pid, status, wait_result;
+
+  int in, out, err;
+  char *exec_file;
+  char **exec_argv;
 
   if (scm_is_null (args))
 SCM_WRONG_NUM_ARGS ();
-  prog = scm_car (args);
-  args = scm_cdr (args);
 
   scm_dynwind_begin (0);
   /* Make sure the child can't kill us (as per normal system call).  */
@@ -1540,8 +1459,23 @@ SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
  SCM_UNDEFINED);
 #endif
 
-  pid = scm_piped_process (prog, args, SCM_UNDEFINED, SCM_UNDEFINED);
-  SCM_SYSCALL (wait_result = waitpid (scm_to_int (pid), &status, 0));
+  exec_file = scm

bug#52835: [PATCH v6 2/3] Make system* and piped-process internally use spawn.

2022-12-22 Thread Bug reports for GUILE, GNU's Ubiquitous Extension Language
* libguile/posix.c (scm_system_star, scm_piped_process): Use do_spawn.
(start_child): Remove function.
---
 libguile/posix.c | 181 ++-
 1 file changed, 39 insertions(+), 142 deletions(-)

diff --git a/libguile/posix.c b/libguile/posix.c
index e92625483..f9c36d7ac 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1308,125 +1308,6 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_FORK */
 
-#ifdef HAVE_FORK
-/* 'renumber_file_descriptor' is a helper function for 'start_child'
-   below, and is specialized for that particular environment where it
-   doesn't make sense to report errors via exceptions.  It uses dup(2)
-   to duplicate the file descriptor FD, closes the original FD, and
-   returns the new descriptor.  If dup(2) fails, print an error message
-   to ERR and abort.  */
-static int
-renumber_file_descriptor (int fd, int err)
-{
-  int new_fd;
-
-  do
-new_fd = dup (fd);
-  while (new_fd == -1 && errno == EINTR);
-
-  if (new_fd == -1)
-{
-  /* At this point we are in the child process before exec.  We
- cannot safely raise an exception in this environment.  */
-  const char *msg = strerror (errno);
-  fprintf (fdopen (err, "a"), "start_child: dup failed: %s\n", msg);
-  _exit (127);  /* Use exit status 127, as with other exec errors. */
-}
-
-  close (fd);
-  return new_fd;
-}
-#endif /* HAVE_FORK */
-
-#ifdef HAVE_FORK
-#define HAVE_START_CHILD 1
-/* Since Guile uses threads, we have to be very careful to avoid calling
-   functions that are not async-signal-safe in the child.  That's why
-   this function is implemented in C.  */
-static pid_t
-start_child (const char *exec_file, char **exec_argv,
-int reading, int c2p[2], int writing, int p2c[2],
- int in, int out, int err)
-{
-  int pid;
-  int max_fd = 1024;
-
-#if defined (HAVE_GETRLIMIT) && defined (RLIMIT_NOFILE)
-  {
-struct rlimit lim = { 0, 0 };
-if (getrlimit (RLIMIT_NOFILE, &lim) == 0)
-  max_fd = lim.rlim_cur;
-  }
-#endif
-
-  pid = fork ();
-
-  if (pid != 0)
-/* The parent, with either and error (pid == -1), or the PID of the
-   child.  Return directly in either case.  */
-return pid;
-
-  /* The child.  */
-  if (reading)
-close (c2p[0]);
-  if (writing)
-close (p2c[1]);
-
-  /* Close all file descriptors in ports inherited from the parent
- except for in, out, and err.  Heavy-handed, but robust.  */
-  while (max_fd--)
-if (max_fd != in && max_fd != out && max_fd != err)
-  close (max_fd);
-
-  /* Ignore errors on these open() calls.  */
-  if (in == -1)
-in = open ("/dev/null", O_RDONLY);
-  if (out == -1)
-out = open ("/dev/null", O_WRONLY);
-  if (err == -1)
-err = open ("/dev/null", O_WRONLY);
-
-  if (in > 0)
-{
-  if (out == 0)
-out = renumber_file_descriptor (out, err);
-  if (err == 0)
-err = renumber_file_descriptor (err, err);
-  do dup2 (in, 0); while (errno == EINTR);
-  close (in);
-}
-  if (out > 1)
-{
-  if (err == 1)
-err = renumber_file_descriptor (err, err);
-  do dup2 (out, 1); while (errno == EINTR);
-  if (out > 2)
-close (out);
-}
-  if (err > 2)
-{
-  do dup2 (err, 2); while (errno == EINTR);
-  close (err);
-}
-
-  execvp (exec_file, exec_argv);
-
-  /* The exec failed!  There is nothing sensible to do.  */
-  {
-const char *msg = strerror (errno);
-fprintf (fdopen (2, "a"), "In execvp of %s: %s\n",
- exec_file, msg);
-  }
-
-  /* Use exit status 127, like shells in this case, as per POSIX
- 
.
  */
-  _exit (127);
-
-  /* Not reached.  */
-  return -1;
-}
-#endif
-
 static int
 do_spawn (char *exec_file, char **exec_argv, char **exec_env, int in, int out, 
int err)
 {
@@ -1507,7 +1388,7 @@ SCM_DEFINE (scm_spawn_process, "spawn*", 5, 0, 0,
 }
 #undef FUNC_NAME
 
-#ifdef HAVE_START_CHILD
+#ifdef HAVE_FORK
 static SCM
 scm_piped_process (SCM prog, SCM args, SCM from, SCM to)
 #define FUNC_NAME "piped-process"
@@ -1519,6 +1400,7 @@ scm_piped_process (SCM prog, SCM args, SCM from, SCM to)
   int pid;
   char *exec_file;
   char **exec_argv;
+  char **exec_env = environ;
 
   exec_file = scm_to_locale_string (prog);
   exec_argv = scm_i_allocate_string_pointers (scm_cons (prog, args));
@@ -1551,27 +1433,44 @@ scm_piped_process (SCM prog, SCM args, SCM from, SCM to)
   in = SCM_FPORT_FDES (port);
   }
 
-  pid = start_child (exec_file, exec_argv, reading, c2p, writing, p2c,
- in, out, err);
+  pid = do_spawn (exec_file, exec_argv, exec_env, in, out, err);
+  int errno_save = errno;
 
   if (pid == -1)
 {
-  int errno_save = errno;
-  free (exec_file);
-  if (reading)
-{
-  close (c2p[0]);
-  close (c2p[1]);
-}
-  if (writing)
-   

bug#52835: [PATCH v6 0/3] Move spawning procedures to posix_spawn.

2022-12-22 Thread Bug reports for GUILE, GNU's Ubiquitous Extension Language
Hello Ludo,

Here is hopefully the last reroll of this patchset.  First of all, I did not
include the gnulib patch again because it still applies cleanly and it is
extremely large, but it should be applied before those 3 patches.

The first two patches should be applied on the current major release, while the
third one should be applied on the next major release to finish the migration to
spawn.

The first patch adds the new spawn* procedure, using an internal do_spawn
function.  The second patch changes system* and piped-process to use this new
function, but it still tries to mimick the old behavior of start_child by
inspecting the possible errnos, and spawning a dummy child that instantly exits
with code 127 in some cases.

The third patch gets rid of those special cases, which makes system* and friends
throw more exceptions instead of having the child fail with exit code 127 (note
that YMMV depending on how spawn is implemented for your system).

I've added docstrings to user-facing Guile procedures, and also did the
micro-optimization we talked about, since I had already factorized do_spawn.

The tests seem to pass both with and without 3.

One nice thing I've noticed is that gnulib has posix_spawn for WinNT as well,
which means it might be okay to remove the dependency on having fork for
system*, among others!

WDYT?

Josselin Poiret (3):
  Add spawn*.
  Make system* and piped-process internally use spawn.
  Move popen and posix procedures to spawn*.

 libguile/posix.c| 248 +++-
 libguile/posix.h|   2 +
 module/ice-9/popen.scm  |  87 +
 test-suite/tests/popen.test |  14 +-
 test-suite/tests/posix.test |  36 +++---
 5 files changed, 161 insertions(+), 226 deletions(-)


base-commit: f3ea8f7fa1d84a559c7bf834fe5b675abe0ae7b8
prerequisite-patch-id: 71184f71260952109165ec62c588c2b646e238f6
-- 
2.38.1






bug#27782: patch to add support for mmap and friends

2022-12-22 Thread Matt Wette

Please disregard previous patch.  I have more to do.
I'll try to catch the next release cycle.