mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 03:30:27 +02:00
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.
This commit is contained in:
Andy Wingo
parent
2fa2e50a0f
commit
ad4fe88ffb
4 changed files with 75 additions and 129 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue