diff --git a/libguile/posix.c b/libguile/posix.c index 33838089e..5d0b1ed8f 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 + . */ + _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 92f8b3514..078edf5eb 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 70058285a..38d8dfde1 100644 --- a/libguile/simpos.c +++ b/libguile/simpos.c @@ -24,35 +24,15 @@ #endif #include -#include /* for SIG constants */ -#include /* for getenv */ -#include +#include /* for getenv, system, exit, free */ +#include /* 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 -#endif -#include -#if HAVE_SYS_WAIT_H -# include -#endif - -#ifdef __MINGW32__ -# include /* 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 - . */ - _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 1e2076870..9ebb0c52b 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);