1 /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, 2009,
2 * 2010, 2012, 2013, 2014 Free Software Foundation, Inc.
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public License
6 * as published by the Free Software Foundation; either version 3 of
7 * the License, or (at your option) any later version.
9 * This library is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27 #include <signal.h> /* for SIG constants */
28 #include <stdlib.h> /* for getenv */
31 #include "libguile/_scm.h"
33 #include "libguile/scmsigs.h"
34 #include "libguile/strings.h"
36 #include "libguile/validate.h"
37 #include "libguile/simpos.h"
38 #include "libguile/dynwind.h"
45 # include <sys/wait.h>
49 # include <process.h> /* for spawnvp and friends */
59 SCM_DEFINE (scm_system
, "system", 0, 1, 0,
61 "Execute @var{cmd} using the operating system's \"command\n"
62 "processor\". Under Unix this is usually the default shell\n"
63 "@code{sh}. The value returned is @var{cmd}'s exit status as\n"
64 "returned by @code{waitpid}, which can be interpreted using\n"
65 "@code{status:exit-val} and friends.\n"
67 "If @code{system} is called without arguments, return a boolean\n"
68 "indicating whether the command processor is available.")
69 #define FUNC_NAME s_scm_system
77 return scm_from_bool(rv
);
79 SCM_VALIDATE_STRING (1, cmd
);
81 c_cmd
= scm_to_locale_string (cmd
);
83 eno
= errno
; free (c_cmd
); errno
= eno
;
84 if (rv
== -1 || (rv
== 127 && errno
!= 0))
86 return scm_from_int (rv
);
89 #endif /* HAVE_SYSTEM */
94 SCM_DEFINE (scm_system_star
, "system*", 0, 0, 1,
96 "Execute the command indicated by @var{args}. The first element must\n"
97 "be a string indicating the command to be executed, and the remaining\n"
98 "items must be strings representing each of the arguments to that\n"
101 "This function returns the exit status of the command as provided by\n"
102 "@code{waitpid}. This value can be handled with @code{status:exit-val}\n"
103 "and the related functions.\n"
105 "@code{system*} is similar to @code{system}, but accepts only one\n"
106 "string per-argument, and performs no shell interpretation. The\n"
107 "command is executed using fork and execlp. Accordingly this function\n"
108 "may be safer than @code{system} in situations where shell\n"
109 "interpretation is not required.\n"
111 "Example: (system* \"echo\" \"foo\" \"bar\")")
112 #define FUNC_NAME s_scm_system_star
114 if (scm_is_null (args
))
115 SCM_WRONG_NUM_ARGS ();
117 if (scm_is_pair (args
))
122 /* SIGQUIT is undefined on MS-Windows. */
134 /* allocate before fork */
135 execargv
= scm_i_allocate_string_pointers (args
);
137 /* make sure the child can't kill us (as per normal system call) */
138 sig_ign
= scm_from_ulong ((unsigned long) SIG_IGN
);
139 sigint
= scm_from_int (SIGINT
);
140 oldint
= scm_sigaction (sigint
, sig_ign
, SCM_UNDEFINED
);
142 sigquit
= scm_from_int (SIGQUIT
);
143 oldquit
= scm_sigaction (sigquit
, sig_ign
, SCM_UNDEFINED
);
151 execvp (execargv
[0], execargv
);
153 /* Something went wrong. */
154 fprintf (stderr
, "In execvp of %s: %s\n",
155 execargv
[0], strerror (errno
));
157 /* Exit directly instead of throwing, because otherwise this
158 process may keep on running. Use exit status 127, like
159 shells in this case, as per POSIX
160 <http://pubs.opengroup.org/onlinepubs/007904875/utilities/xcu_chap02.html#tag_02_09_01_01>. */
166 int wait_result
, status
;
171 SCM_SYSCALL (wait_result
= waitpid (pid
, &status
, 0));
172 if (wait_result
== -1)
174 scm_sigaction (sigint
, SCM_CAR (oldint
), SCM_CDR (oldint
));
175 scm_sigaction (sigquit
, SCM_CAR (oldquit
), SCM_CDR (oldquit
));
177 return scm_from_int (status
);
179 #else /* !HAVE_FORK */
180 status
= spawnvp (P_WAIT
, execargv
[0], (const char * const *)execargv
);
181 scm_sigaction (sigint
, SCM_CAR (oldint
), SCM_CDR (oldint
));
183 scm_sigaction (sigquit
, SCM_CAR (oldquit
), SCM_CDR (oldquit
));
186 return scm_from_int (status
);
187 #endif /* !HAVE_FORK */
190 SCM_WRONG_TYPE_ARG (1, args
);
193 #endif /* HAVE_SYSTEM */
196 SCM_DEFINE (scm_getenv
, "getenv", 1, 0, 0,
198 "Looks up the string @var{nam} in the current environment. The return\n"
199 "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n"
200 "found, in which case the string @code{VALUE} is returned.")
201 #define FUNC_NAME s_scm_getenv
204 char *var
= scm_to_locale_string (nam
);
207 return val
? scm_from_locale_string (val
) : SCM_BOOL_F
;
211 /* Get an integer from an environment variable. */
213 scm_getenv_int (const char *var
, int def
)
216 char *val
= getenv (var
);
220 res
= strtol (val
, &end
, 10);
226 /* simple exit, without unwinding the scheme stack or flushing ports. */
227 SCM_DEFINE (scm_primitive_exit
, "primitive-exit", 0, 1, 0,
229 "Terminate the current process without unwinding the Scheme\n"
230 "stack. The exit status is @var{status} if supplied, otherwise\n"
232 #define FUNC_NAME s_scm_primitive_exit
235 if (!SCM_UNBNDP (status
))
236 cstatus
= scm_to_int (status
);
241 SCM_DEFINE (scm_primitive__exit
, "primitive-_exit", 0, 1, 0,
243 "Terminate the current process using the _exit() system call and\n"
244 "without unwinding the Scheme stack. The exit status is\n"
245 "@var{status} if supplied, otherwise zero.\n"
247 "This function is typically useful after a fork, to ensure no\n"
248 "Scheme cleanups or @code{atexit} handlers are run (those\n"
249 "usually belonging in the parent rather than the child).")
250 #define FUNC_NAME s_scm_primitive__exit
253 if (!SCM_UNBNDP (status
))
254 cstatus
= scm_to_int (status
);
264 #include "libguile/simpos.x"