mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 19:50:24 +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);
|
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. */
|
/* Not reached. */
|
||||||
return -1;
|
return -1;
|
||||||
|
|
@ -1429,6 +1431,74 @@ scm_open_process (SCM mode, SCM prog, SCM args)
|
||||||
scm_from_int (pid)));
|
scm_from_int (pid)));
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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 */
|
#endif /* HAVE_START_CHILD */
|
||||||
|
|
||||||
#ifdef HAVE_UNAME
|
#ifdef HAVE_UNAME
|
||||||
|
|
|
||||||
|
|
@ -72,6 +72,7 @@ SCM_API SCM scm_mkstemp (SCM tmpl);
|
||||||
SCM_API SCM scm_tmpfile (void);
|
SCM_API SCM scm_tmpfile (void);
|
||||||
SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
|
SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
|
||||||
SCM_API SCM scm_close_pipe (SCM port);
|
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_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime,
|
||||||
SCM actimens, SCM modtimens, SCM flags);
|
SCM actimens, SCM modtimens, SCM flags);
|
||||||
SCM_API SCM scm_access (SCM path, SCM how);
|
SCM_API SCM scm_access (SCM path, SCM how);
|
||||||
|
|
|
||||||
|
|
@ -24,35 +24,15 @@
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <errno.h>
|
#include <errno.h>
|
||||||
#include <signal.h> /* for SIG constants */
|
#include <stdlib.h> /* for getenv, system, exit, free */
|
||||||
#include <stdlib.h> /* for getenv */
|
#include <unistd.h> /* for _exit */
|
||||||
#include <stdio.h>
|
|
||||||
|
|
||||||
#include "libguile/_scm.h"
|
#include "libguile/_scm.h"
|
||||||
|
|
||||||
#include "libguile/scmsigs.h"
|
|
||||||
#include "libguile/strings.h"
|
#include "libguile/strings.h"
|
||||||
|
|
||||||
#include "libguile/validate.h"
|
#include "libguile/validate.h"
|
||||||
#include "libguile/simpos.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
|
#ifdef HAVE_SYSTEM
|
||||||
|
|
@ -74,7 +54,7 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
|
||||||
if (SCM_UNBNDP (cmd))
|
if (SCM_UNBNDP (cmd))
|
||||||
{
|
{
|
||||||
rv = system (NULL);
|
rv = system (NULL);
|
||||||
return scm_from_bool(rv);
|
return scm_from_bool (rv);
|
||||||
}
|
}
|
||||||
SCM_VALIDATE_STRING (1, cmd);
|
SCM_VALIDATE_STRING (1, cmd);
|
||||||
errno = 0;
|
errno = 0;
|
||||||
|
|
@ -89,110 +69,6 @@ SCM_DEFINE (scm_system, "system", 0, 1, 0,
|
||||||
#endif /* HAVE_SYSTEM */
|
#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_DEFINE (scm_getenv, "getenv", 1, 0, 0,
|
||||||
(SCM nam),
|
(SCM nam),
|
||||||
"Looks up the string @var{nam} in the current environment. The return\n"
|
"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 (SCM cmd);
|
||||||
SCM_API SCM scm_system_star (SCM cmds);
|
|
||||||
SCM_API SCM scm_getenv (SCM nam);
|
SCM_API SCM scm_getenv (SCM nam);
|
||||||
SCM_API SCM scm_primitive_exit (SCM status);
|
SCM_API SCM scm_primitive_exit (SCM status);
|
||||||
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