Commit | Line | Data |
---|---|---|
668ba7c9 | 1 | /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, 2009, |
87fc4596 | 2 | * 2010, 2012, 2013 Free Software Foundation, Inc. |
668ba7c9 | 3 | * |
73be1d9e | 4 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
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. | |
0f2d19dd | 8 | * |
53befeb7 NJ |
9 | * This library is distributed in the hope that it will be useful, but |
10 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | * Lesser General Public License for more details. | |
0f2d19dd | 13 | * |
73be1d9e MV |
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 | |
53befeb7 NJ |
16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
17 | * 02110-1301 USA | |
73be1d9e | 18 | */ |
1bbd0b84 | 19 | |
1bbd0b84 | 20 | |
0f2d19dd | 21 | \f |
dbb605f5 | 22 | #ifdef HAVE_CONFIG_H |
c3f1a204 RB |
23 | # include <config.h> |
24 | #endif | |
0f2d19dd | 25 | |
e6e2e95a | 26 | #include <errno.h> |
bb94a503 | 27 | #include <signal.h> /* for SIG constants */ |
6a4d17af | 28 | #include <stdlib.h> /* for getenv */ |
668ba7c9 | 29 | #include <stdio.h> |
e6e2e95a | 30 | |
a0599745 | 31 | #include "libguile/_scm.h" |
95b88819 | 32 | |
a0599745 MD |
33 | #include "libguile/scmsigs.h" |
34 | #include "libguile/strings.h" | |
1bbd0b84 | 35 | |
a0599745 MD |
36 | #include "libguile/validate.h" |
37 | #include "libguile/simpos.h" | |
7f9994d9 | 38 | #include "libguile/dynwind.h" |
20e6290e | 39 | |
95b88819 GH |
40 | #ifdef HAVE_STRING_H |
41 | #include <string.h> | |
42 | #endif | |
0f2d19dd JB |
43 | #ifdef HAVE_UNISTD_H |
44 | #include <unistd.h> | |
45 | #endif | |
0db17ef9 RB |
46 | #if HAVE_SYS_WAIT_H |
47 | # include <sys/wait.h> | |
48 | #endif | |
49 | ||
50 | #include "posix.h" | |
0f2d19dd JB |
51 | |
52 | \f | |
53 | extern int system(); | |
54 | \f | |
55 | ||
f25f761d | 56 | #ifdef HAVE_SYSTEM |
0db17ef9 | 57 | SCM_DEFINE (scm_system, "system", 0, 1, 0, |
1bbd0b84 | 58 | (SCM cmd), |
1e6808ea MG |
59 | "Execute @var{cmd} using the operating system's \"command\n" |
60 | "processor\". Under Unix this is usually the default shell\n" | |
61 | "@code{sh}. The value returned is @var{cmd}'s exit status as\n" | |
34b6177b KR |
62 | "returned by @code{waitpid}, which can be interpreted using\n" |
63 | "@code{status:exit-val} and friends.\n" | |
1e6808ea MG |
64 | "\n" |
65 | "If @code{system} is called without arguments, return a boolean\n" | |
d3818c29 | 66 | "indicating whether the command processor is available.") |
1bbd0b84 | 67 | #define FUNC_NAME s_scm_system |
0f2d19dd | 68 | { |
ddae9525 MV |
69 | int rv, eno; |
70 | char *c_cmd; | |
71 | ||
341eaef0 GH |
72 | if (SCM_UNBNDP (cmd)) |
73 | { | |
341eaef0 | 74 | rv = system (NULL); |
7888309b | 75 | return scm_from_bool(rv); |
0db17ef9 | 76 | } |
a6d9e5ab | 77 | SCM_VALIDATE_STRING (1, cmd); |
341eaef0 | 78 | errno = 0; |
ddae9525 MV |
79 | c_cmd = scm_to_locale_string (cmd); |
80 | rv = system (c_cmd); | |
81 | eno = errno; free (c_cmd); errno = eno; | |
341eaef0 | 82 | if (rv == -1 || (rv == 127 && errno != 0)) |
1bbd0b84 | 83 | SCM_SYSERROR; |
e11e83f3 | 84 | return scm_from_int (rv); |
341eaef0 | 85 | } |
1bbd0b84 | 86 | #undef FUNC_NAME |
f25f761d | 87 | #endif /* HAVE_SYSTEM */ |
0f2d19dd | 88 | |
0db17ef9 RB |
89 | |
90 | #ifdef HAVE_SYSTEM | |
91 | #ifdef HAVE_WAITPID | |
92 | ||
0db17ef9 RB |
93 | |
94 | SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, | |
95 | (SCM args), | |
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" | |
99 | "command.\n" | |
100 | "\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" | |
104 | "\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" | |
110 | "\n" | |
111 | "Example: (system* \"echo\" \"foo\" \"bar\")") | |
112 | #define FUNC_NAME s_scm_system_star | |
113 | { | |
d2e53ed6 | 114 | if (scm_is_null (args)) |
0db17ef9 RB |
115 | SCM_WRONG_NUM_ARGS (); |
116 | ||
d2e53ed6 | 117 | if (scm_is_pair (args)) |
0db17ef9 RB |
118 | { |
119 | SCM oldint; | |
120 | SCM oldquit; | |
121 | SCM sig_ign; | |
122 | SCM sigint; | |
123 | SCM sigquit; | |
124 | int pid; | |
125 | char **execargv; | |
126 | ||
0db17ef9 | 127 | /* allocate before fork */ |
7f9994d9 | 128 | execargv = scm_i_allocate_string_pointers (args); |
0db17ef9 RB |
129 | |
130 | /* make sure the child can't kill us (as per normal system call) */ | |
d2aed81f | 131 | sig_ign = scm_from_ulong ((unsigned long) SIG_IGN); |
f070ba13 KR |
132 | sigint = scm_from_int (SIGINT); |
133 | sigquit = scm_from_int (SIGQUIT); | |
0db17ef9 RB |
134 | oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED); |
135 | oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED); | |
136 | ||
137 | pid = fork (); | |
eac8e0ef | 138 | if (pid == 0) |
0db17ef9 | 139 | { |
eac8e0ef | 140 | /* child */ |
668ba7c9 LC |
141 | execvp (execargv[0], execargv); |
142 | ||
143 | /* Something went wrong. */ | |
144 | fprintf (stderr, "In execvp of %s: %s\n", | |
145 | execargv[0], strerror (errno)); | |
146 | ||
147 | /* Exit directly instead of throwing, because otherwise this | |
148 | process may keep on running. Use exit status 127, like | |
149 | shells in this case, as per POSIX | |
150 | <http://pubs.opengroup.org/onlinepubs/007904875/utilities/xcu_chap02.html#tag_02_09_01_01>. */ | |
151 | _exit (127); | |
eac8e0ef KR |
152 | } |
153 | else | |
154 | { | |
155 | /* parent */ | |
7f9994d9 | 156 | int wait_result, status; |
eac8e0ef | 157 | |
eac8e0ef KR |
158 | if (pid == -1) |
159 | SCM_SYSERROR; | |
160 | ||
0db17ef9 | 161 | SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); |
7f9994d9 MV |
162 | if (wait_result == -1) |
163 | SCM_SYSERROR; | |
0db17ef9 RB |
164 | scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); |
165 | scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); | |
7f9994d9 | 166 | |
e11e83f3 | 167 | return scm_from_int (status); |
0db17ef9 | 168 | } |
0db17ef9 RB |
169 | } |
170 | else | |
7f9994d9 | 171 | SCM_WRONG_TYPE_ARG (1, args); |
0db17ef9 RB |
172 | } |
173 | #undef FUNC_NAME | |
174 | #endif /* HAVE_WAITPID */ | |
175 | #endif /* HAVE_SYSTEM */ | |
176 | ||
177 | ||
a1ec6916 | 178 | SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, |
1bbd0b84 | 179 | (SCM nam), |
b7e64f8b | 180 | "Looks up the string @var{nam} in the current environment. The return\n" |
d3818c29 | 181 | "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n" |
d46e4713 | 182 | "found, in which case the string @code{VALUE} is returned.") |
1bbd0b84 | 183 | #define FUNC_NAME s_scm_getenv |
0f2d19dd JB |
184 | { |
185 | char *val; | |
7f9994d9 MV |
186 | char *var = scm_to_locale_string (nam); |
187 | val = getenv (var); | |
188 | free (var); | |
189 | return val ? scm_from_locale_string (val) : SCM_BOOL_F; | |
0f2d19dd | 190 | } |
1bbd0b84 | 191 | #undef FUNC_NAME |
0f2d19dd | 192 | |
87fc4596 AW |
193 | /* Get an integer from an environment variable. */ |
194 | int | |
195 | scm_getenv_int (const char *var, int def) | |
196 | { | |
197 | char *end = 0; | |
198 | char *val = getenv (var); | |
199 | long res = def; | |
200 | if (!val) | |
201 | return def; | |
202 | res = strtol (val, &end, 10); | |
203 | if (end == val) | |
204 | return def; | |
205 | return res; | |
206 | } | |
207 | ||
ee149d03 | 208 | /* simple exit, without unwinding the scheme stack or flushing ports. */ |
a1ec6916 | 209 | SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0, |
1bbd0b84 | 210 | (SCM status), |
23f2b9a3 KR |
211 | "Terminate the current process without unwinding the Scheme\n" |
212 | "stack. The exit status is @var{status} if supplied, otherwise\n" | |
213 | "zero.") | |
1bbd0b84 | 214 | #define FUNC_NAME s_scm_primitive_exit |
7ad3c1e7 GH |
215 | { |
216 | int cstatus = 0; | |
217 | if (!SCM_UNBNDP (status)) | |
a55c2b68 | 218 | cstatus = scm_to_int (status); |
7ad3c1e7 GH |
219 | exit (cstatus); |
220 | } | |
1bbd0b84 | 221 | #undef FUNC_NAME |
7ad3c1e7 | 222 | |
23f2b9a3 KR |
223 | SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0, |
224 | (SCM status), | |
225 | "Terminate the current process using the _exit() system call and\n" | |
226 | "without unwinding the Scheme stack. The exit status is\n" | |
227 | "@var{status} if supplied, otherwise zero.\n" | |
228 | "\n" | |
229 | "This function is typically useful after a fork, to ensure no\n" | |
230 | "Scheme cleanups or @code{atexit} handlers are run (those\n" | |
231 | "usually belonging in the parent rather than the child).") | |
232 | #define FUNC_NAME s_scm_primitive__exit | |
233 | { | |
234 | int cstatus = 0; | |
235 | if (!SCM_UNBNDP (status)) | |
236 | cstatus = scm_to_int (status); | |
237 | _exit (cstatus); | |
238 | } | |
239 | #undef FUNC_NAME | |
240 | ||
241 | ||
1cc91f1b | 242 | |
0f2d19dd JB |
243 | void |
244 | scm_init_simpos () | |
0f2d19dd | 245 | { |
a0599745 | 246 | #include "libguile/simpos.x" |
0f2d19dd JB |
247 | } |
248 | ||
89e00824 ML |
249 | |
250 | /* | |
251 | Local Variables: | |
252 | c-file-style: "gnu" | |
253 | End: | |
254 | */ |