[Guile-commits] 01/01: Move system* to posix.c, impl on open-process

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit ad4fe88ffb9193e7b5da8350d71334be525eed84
Author: Andy Wingo <address@hidden>
Date:   Wed Aug 31 10:42:21 2016 +0200

    Move system* to posix.c, impl on open-process
    
    * libguile/simpos.c: Trim includes.
      (scm_system_star): Move to posix.c.
    * libguile/simpos.h (scm_system_star): Remove.
    * libguile/posix.h (scm_system_star): Add.
    * libguile/posix.c (scm_system_star): Move here and implement in terms
      of open-process.  This lets system* work on Windows.  Inspired by a
      patch by Eli Zaretskii.
      (start_child): Exit with 127 if the command isn't found.
---
 libguile/posix.c  |   72 ++++++++++++++++++++++++++++-
 libguile/posix.h  |    1 +
 libguile/simpos.c |  130 ++---------------------------------------------------
 libguile/simpos.h |    1 -
 4 files changed, 75 insertions(+), 129 deletions(-)

diff --git a/libguile/posix.c b/libguile/posix.c
index 3383808..5d0b1ed 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1322,7 +1322,9 @@ start_child (const char *exec_file, char **exec_argv,
                exec_file, msg);
     }
 
-  _exit (EXIT_FAILURE);
+  /* Use exit status 127, like shells in this case, as per POSIX
+     
<http://pubs.opengroup.org/onlinepubs/007904875/utilities/xcu_chap02.html#tag_02_09_01_01>.
  */
+  _exit (127);
 
   /* Not reached.  */
   return -1;
@@ -1429,6 +1431,74 @@ scm_open_process (SCM mode, SCM prog, SCM args)
                                  scm_from_int (pid)));
 }
 #undef FUNC_NAME
+
+static void
+restore_sigaction (SCM pair)
+{
+  SCM sig, handler, flags;
+  sig = scm_car (pair);
+  handler = scm_cadr (pair);
+  flags = scm_cddr (pair);
+  scm_sigaction (sig, handler, flags);
+}
+
+static void
+scm_dynwind_sigaction (int sig, SCM handler, SCM flags)
+{
+  SCM old, scm_sig;
+  scm_sig = scm_from_int (sig);
+  old = scm_sigaction (scm_sig, handler, flags);
+  scm_dynwind_unwind_handler_with_scm (restore_sigaction,
+                                       scm_cons (scm_sig, old),
+                                       SCM_F_WIND_EXPLICITLY);
+}
+
+SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
+           (SCM args),
+"Execute the command indicated by @var{args}.  The first element must\n"
+"be a string indicating the command to be executed, and the remaining\n"
+"items must be strings representing each of the arguments to that\n"
+"command.\n"
+"\n"
+"This function returns the exit status of the command as provided by\n"
+"@code{waitpid}.  This value can be handled with @code{status:exit-val}\n"
+"and the related functions.\n"
+"\n"
+"@code{system*} is similar to @code{system}, but accepts only one\n"
+"string per-argument, and performs no shell interpretation.  The\n"
+"command is executed using fork and execlp.  Accordingly this function\n"
+"may be safer than @code{system} in situations where shell\n"
+"interpretation is not required.\n"
+"\n"
+"Example: (system* \"echo\" \"foo\" \"bar\")")
+#define FUNC_NAME s_scm_system_star
+{
+  SCM prog, res;
+  int pid, status, wait_result;
+
+  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).  */
+  scm_dynwind_sigaction (SIGINT, scm_from_ulong (SIG_IGN), SCM_UNDEFINED);
+#ifdef SIGQUIT
+  scm_dynwind_sigaction (SIGQUIT, scm_from_ulong (SIG_IGN), SCM_UNDEFINED);
+#endif
+
+  res = scm_open_process (scm_nullstr, prog, args);
+  pid = scm_to_int (scm_c_value_ref (res, 2));
+  SCM_SYSCALL (wait_result = waitpid (pid, &status, 0));
+  if (wait_result == -1)
+    SCM_SYSERROR;
+
+  scm_dynwind_end ();
+
+  return scm_from_int (status);
+}
+#undef FUNC_NAME
 #endif /* HAVE_START_CHILD */
 
 #ifdef HAVE_UNAME
diff --git a/libguile/posix.h b/libguile/posix.h
index 92f8b35..078edf5 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -72,6 +72,7 @@ SCM_API SCM scm_mkstemp (SCM tmpl);
 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_system_star (SCM cmds);
 SCM_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime,
                        SCM actimens, SCM modtimens, SCM flags);
 SCM_API SCM scm_access (SCM path, SCM how);
diff --git a/libguile/simpos.c b/libguile/simpos.c
index 7005828..38d8dfd 100644
--- a/libguile/simpos.c
+++ b/libguile/simpos.c
@@ -24,35 +24,15 @@
 #endif
 
 #include <errno.h>
-#include <signal.h>  /* for SIG constants */
-#include <stdlib.h>  /* for getenv */
-#include <stdio.h>
+#include <stdlib.h>  /* for getenv, system, exit, free */
+#include <unistd.h>  /* for _exit */
 
 #include "libguile/_scm.h"
 
-#include "libguile/scmsigs.h"
 #include "libguile/strings.h"
-
 #include "libguile/validate.h"
 #include "libguile/simpos.h"
-#include "libguile/dynwind.h"
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-#include <unistd.h>
-#if HAVE_SYS_WAIT_H
-# include <sys/wait.h>
-#endif
 
-#ifdef __MINGW32__
-# include <process.h>  /* for spawnvp and friends */
-#endif
-
-#include "posix.h"
-
-
-extern int system();
 
 
 #ifdef HAVE_SYSTEM
@@ -74,7 +54,7 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
   if (SCM_UNBNDP (cmd))
     {
       rv = system (NULL);
-      return scm_from_bool(rv);
+      return scm_from_bool (rv);
     }  
   SCM_VALIDATE_STRING (1, cmd);
   errno = 0;
@@ -89,110 +69,6 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
 #endif /* HAVE_SYSTEM */
 
 
-#ifdef HAVE_SYSTEM
-
-SCM_DEFINE (scm_system_star, "system*", 0, 0, 1,
-           (SCM args),
-"Execute the command indicated by @var{args}.  The first element must\n"
-"be a string indicating the command to be executed, and the remaining\n"
-"items must be strings representing each of the arguments to that\n"
-"command.\n"
-"\n"
-"This function returns the exit status of the command as provided by\n"
-"@code{waitpid}.  This value can be handled with @code{status:exit-val}\n"
-"and the related functions.\n"
-"\n"
-"@code{system*} is similar to @code{system}, but accepts only one\n"
-"string per-argument, and performs no shell interpretation.  The\n"
-"command is executed using fork and execlp.  Accordingly this function\n"
-"may be safer than @code{system} in situations where shell\n"
-"interpretation is not required.\n"
-"\n"
-"Example: (system* \"echo\" \"foo\" \"bar\")")
-#define FUNC_NAME s_scm_system_star
-{
-  if (scm_is_null (args))
-    SCM_WRONG_NUM_ARGS ();
-
-  if (scm_is_pair (args))
-    {
-      SCM oldint;
-      SCM sig_ign;
-      SCM sigint;
-      /* SIGQUIT is undefined on MS-Windows.  */
-#ifdef SIGQUIT
-      SCM oldquit;
-      SCM sigquit;
-#endif
-#ifdef HAVE_FORK
-      int pid;
-#else
-      int status;
-#endif
-      char **execargv;
-
-      /* allocate before fork */
-      execargv = scm_i_allocate_string_pointers (args);
-
-      /* make sure the child can't kill us (as per normal system call) */
-      sig_ign = scm_from_ulong ((unsigned long) SIG_IGN);
-      sigint = scm_from_int (SIGINT);
-      oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED);
-#ifdef SIGQUIT
-      sigquit = scm_from_int (SIGQUIT);
-      oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED);
-#endif
-
-#ifdef HAVE_FORK
-      pid = fork ();
-      if (pid == 0)
-        {
-          /* child */
-         execvp (execargv[0], execargv);
-
-         /* Something went wrong.  */
-         fprintf (stderr, "In execvp of %s: %s\n",
-                  execargv[0], strerror (errno));
-
-         /* Exit directly instead of throwing, because otherwise this
-            process may keep on running.  Use exit status 127, like
-            shells in this case, as per POSIX
-            
<http://pubs.opengroup.org/onlinepubs/007904875/utilities/xcu_chap02.html#tag_02_09_01_01>.
  */
-         _exit (127);
-        }
-      else
-        {
-          /* parent */
-          int wait_result, status;
-
-          if (pid == -1)
-            SCM_SYSERROR;
-
-          SCM_SYSCALL (wait_result = waitpid (pid, &status, 0));
-          if (wait_result == -1)
-           SCM_SYSERROR;
-          scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint));
-          scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit));
-
-          return scm_from_int (status);
-        }
-#else  /* !HAVE_FORK */
-      status = spawnvp (P_WAIT, execargv[0], (const char * const *)execargv);
-      scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint));
-#ifdef SIGQUIT
-      scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit));
-#endif
-
-      return scm_from_int (status);
-#endif /* !HAVE_FORK */
-    }
-  else
-    SCM_WRONG_TYPE_ARG (1, args);
-}
-#undef FUNC_NAME
-#endif /* HAVE_SYSTEM */
-
-
 SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, 
             (SCM nam),
            "Looks up the string @var{nam} in the current environment.  The 
return\n"
diff --git a/libguile/simpos.h b/libguile/simpos.h
index 1e20768..9ebb0c5 100644
--- a/libguile/simpos.h
+++ b/libguile/simpos.h
@@ -28,7 +28,6 @@
 
 
 SCM_API SCM scm_system (SCM cmd);
-SCM_API SCM scm_system_star (SCM cmds);
 SCM_API SCM scm_getenv (SCM nam);
 SCM_API SCM scm_primitive_exit (SCM status);
 SCM_API SCM scm_primitive__exit (SCM status);