Commit | Line | Data |
---|---|---|
668ba7c9 | 1 | /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2003, 2004, 2009, |
bc8e6d7d | 2 | * 2010, 2012, 2014 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 | 43 | #include <unistd.h> |
0db17ef9 RB |
44 | #if HAVE_SYS_WAIT_H |
45 | # include <sys/wait.h> | |
46 | #endif | |
47 | ||
48 | #include "posix.h" | |
0f2d19dd JB |
49 | |
50 | \f | |
51 | extern int system(); | |
52 | \f | |
53 | ||
f25f761d | 54 | #ifdef HAVE_SYSTEM |
0db17ef9 | 55 | SCM_DEFINE (scm_system, "system", 0, 1, 0, |
1bbd0b84 | 56 | (SCM cmd), |
1e6808ea MG |
57 | "Execute @var{cmd} using the operating system's \"command\n" |
58 | "processor\". Under Unix this is usually the default shell\n" | |
59 | "@code{sh}. The value returned is @var{cmd}'s exit status as\n" | |
34b6177b KR |
60 | "returned by @code{waitpid}, which can be interpreted using\n" |
61 | "@code{status:exit-val} and friends.\n" | |
1e6808ea MG |
62 | "\n" |
63 | "If @code{system} is called without arguments, return a boolean\n" | |
d3818c29 | 64 | "indicating whether the command processor is available.") |
1bbd0b84 | 65 | #define FUNC_NAME s_scm_system |
0f2d19dd | 66 | { |
ddae9525 MV |
67 | int rv, eno; |
68 | char *c_cmd; | |
69 | ||
341eaef0 GH |
70 | if (SCM_UNBNDP (cmd)) |
71 | { | |
341eaef0 | 72 | rv = system (NULL); |
7888309b | 73 | return scm_from_bool(rv); |
0db17ef9 | 74 | } |
a6d9e5ab | 75 | SCM_VALIDATE_STRING (1, cmd); |
341eaef0 | 76 | errno = 0; |
ddae9525 MV |
77 | c_cmd = scm_to_locale_string (cmd); |
78 | rv = system (c_cmd); | |
79 | eno = errno; free (c_cmd); errno = eno; | |
341eaef0 | 80 | if (rv == -1 || (rv == 127 && errno != 0)) |
1bbd0b84 | 81 | SCM_SYSERROR; |
e11e83f3 | 82 | return scm_from_int (rv); |
341eaef0 | 83 | } |
1bbd0b84 | 84 | #undef FUNC_NAME |
f25f761d | 85 | #endif /* HAVE_SYSTEM */ |
0f2d19dd | 86 | |
0db17ef9 RB |
87 | |
88 | #ifdef HAVE_SYSTEM | |
89 | #ifdef HAVE_WAITPID | |
90 | ||
0db17ef9 RB |
91 | |
92 | SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, | |
93 | (SCM args), | |
94 | "Execute the command indicated by @var{args}. The first element must\n" | |
95 | "be a string indicating the command to be executed, and the remaining\n" | |
96 | "items must be strings representing each of the arguments to that\n" | |
97 | "command.\n" | |
98 | "\n" | |
99 | "This function returns the exit status of the command as provided by\n" | |
100 | "@code{waitpid}. This value can be handled with @code{status:exit-val}\n" | |
101 | "and the related functions.\n" | |
102 | "\n" | |
103 | "@code{system*} is similar to @code{system}, but accepts only one\n" | |
104 | "string per-argument, and performs no shell interpretation. The\n" | |
105 | "command is executed using fork and execlp. Accordingly this function\n" | |
106 | "may be safer than @code{system} in situations where shell\n" | |
107 | "interpretation is not required.\n" | |
108 | "\n" | |
109 | "Example: (system* \"echo\" \"foo\" \"bar\")") | |
110 | #define FUNC_NAME s_scm_system_star | |
111 | { | |
d2e53ed6 | 112 | if (scm_is_null (args)) |
0db17ef9 RB |
113 | SCM_WRONG_NUM_ARGS (); |
114 | ||
d2e53ed6 | 115 | if (scm_is_pair (args)) |
0db17ef9 RB |
116 | { |
117 | SCM oldint; | |
118 | SCM oldquit; | |
119 | SCM sig_ign; | |
120 | SCM sigint; | |
121 | SCM sigquit; | |
122 | int pid; | |
123 | char **execargv; | |
124 | ||
0db17ef9 | 125 | /* allocate before fork */ |
7f9994d9 | 126 | execargv = scm_i_allocate_string_pointers (args); |
0db17ef9 RB |
127 | |
128 | /* make sure the child can't kill us (as per normal system call) */ | |
d2aed81f | 129 | sig_ign = scm_from_ulong ((unsigned long) SIG_IGN); |
f070ba13 KR |
130 | sigint = scm_from_int (SIGINT); |
131 | sigquit = scm_from_int (SIGQUIT); | |
0db17ef9 RB |
132 | oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED); |
133 | oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED); | |
134 | ||
135 | pid = fork (); | |
eac8e0ef | 136 | if (pid == 0) |
0db17ef9 | 137 | { |
eac8e0ef | 138 | /* child */ |
668ba7c9 LC |
139 | execvp (execargv[0], execargv); |
140 | ||
141 | /* Something went wrong. */ | |
142 | fprintf (stderr, "In execvp of %s: %s\n", | |
143 | execargv[0], strerror (errno)); | |
144 | ||
145 | /* Exit directly instead of throwing, because otherwise this | |
146 | process may keep on running. Use exit status 127, like | |
147 | shells in this case, as per POSIX | |
148 | <http://pubs.opengroup.org/onlinepubs/007904875/utilities/xcu_chap02.html#tag_02_09_01_01>. */ | |
149 | _exit (127); | |
eac8e0ef KR |
150 | } |
151 | else | |
152 | { | |
153 | /* parent */ | |
7f9994d9 | 154 | int wait_result, status; |
eac8e0ef | 155 | |
eac8e0ef KR |
156 | if (pid == -1) |
157 | SCM_SYSERROR; | |
158 | ||
0db17ef9 | 159 | SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); |
7f9994d9 MV |
160 | if (wait_result == -1) |
161 | SCM_SYSERROR; | |
0db17ef9 RB |
162 | scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); |
163 | scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); | |
7f9994d9 | 164 | |
e11e83f3 | 165 | return scm_from_int (status); |
0db17ef9 | 166 | } |
0db17ef9 RB |
167 | } |
168 | else | |
7f9994d9 | 169 | SCM_WRONG_TYPE_ARG (1, args); |
0db17ef9 RB |
170 | } |
171 | #undef FUNC_NAME | |
172 | #endif /* HAVE_WAITPID */ | |
173 | #endif /* HAVE_SYSTEM */ | |
174 | ||
175 | ||
a1ec6916 | 176 | SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, |
1bbd0b84 | 177 | (SCM nam), |
b7e64f8b | 178 | "Looks up the string @var{nam} in the current environment. The return\n" |
d3818c29 | 179 | "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n" |
d46e4713 | 180 | "found, in which case the string @code{VALUE} is returned.") |
1bbd0b84 | 181 | #define FUNC_NAME s_scm_getenv |
0f2d19dd JB |
182 | { |
183 | char *val; | |
7f9994d9 MV |
184 | char *var = scm_to_locale_string (nam); |
185 | val = getenv (var); | |
186 | free (var); | |
187 | return val ? scm_from_locale_string (val) : SCM_BOOL_F; | |
0f2d19dd | 188 | } |
1bbd0b84 | 189 | #undef FUNC_NAME |
0f2d19dd | 190 | |
ee149d03 | 191 | /* simple exit, without unwinding the scheme stack or flushing ports. */ |
a1ec6916 | 192 | SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0, |
1bbd0b84 | 193 | (SCM status), |
23f2b9a3 KR |
194 | "Terminate the current process without unwinding the Scheme\n" |
195 | "stack. The exit status is @var{status} if supplied, otherwise\n" | |
196 | "zero.") | |
1bbd0b84 | 197 | #define FUNC_NAME s_scm_primitive_exit |
7ad3c1e7 GH |
198 | { |
199 | int cstatus = 0; | |
200 | if (!SCM_UNBNDP (status)) | |
a55c2b68 | 201 | cstatus = scm_to_int (status); |
7ad3c1e7 GH |
202 | exit (cstatus); |
203 | } | |
1bbd0b84 | 204 | #undef FUNC_NAME |
7ad3c1e7 | 205 | |
23f2b9a3 KR |
206 | SCM_DEFINE (scm_primitive__exit, "primitive-_exit", 0, 1, 0, |
207 | (SCM status), | |
208 | "Terminate the current process using the _exit() system call and\n" | |
209 | "without unwinding the Scheme stack. The exit status is\n" | |
210 | "@var{status} if supplied, otherwise zero.\n" | |
211 | "\n" | |
212 | "This function is typically useful after a fork, to ensure no\n" | |
213 | "Scheme cleanups or @code{atexit} handlers are run (those\n" | |
214 | "usually belonging in the parent rather than the child).") | |
215 | #define FUNC_NAME s_scm_primitive__exit | |
216 | { | |
217 | int cstatus = 0; | |
218 | if (!SCM_UNBNDP (status)) | |
219 | cstatus = scm_to_int (status); | |
220 | _exit (cstatus); | |
221 | } | |
222 | #undef FUNC_NAME | |
223 | ||
224 | ||
1cc91f1b | 225 | |
0f2d19dd JB |
226 | void |
227 | scm_init_simpos () | |
0f2d19dd | 228 | { |
a0599745 | 229 | #include "libguile/simpos.x" |
0f2d19dd JB |
230 | } |
231 | ||
89e00824 ML |
232 | |
233 | /* | |
234 | Local Variables: | |
235 | c-file-style: "gnu" | |
236 | End: | |
237 | */ |