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