Commit | Line | Data |
---|---|---|
eac8e0ef | 1 | /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004 Free Software |
c072c40c | 2 | * Foundation, Inc. |
0f2d19dd | 3 | * |
73be1d9e MV |
4 | * This library is free software; you can redistribute it and/or |
5 | * modify it under the terms of the GNU Lesser General Public | |
6 | * License as published by the Free Software Foundation; either | |
7 | * version 2.1 of the License, or (at your option) any later version. | |
0f2d19dd | 8 | * |
73be1d9e MV |
9 | * This library is distributed in the hope that it will be useful, |
10 | * but 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. | |
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 | |
16 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
17 | */ | |
1bbd0b84 | 18 | |
1bbd0b84 | 19 | |
0f2d19dd | 20 | \f |
c3f1a204 RB |
21 | #if HAVE_CONFIG_H |
22 | # include <config.h> | |
23 | #endif | |
0f2d19dd | 24 | |
e6e2e95a | 25 | #include <errno.h> |
bb94a503 | 26 | #include <signal.h> /* for SIG constants */ |
6a4d17af | 27 | #include <stdlib.h> /* for getenv */ |
e6e2e95a | 28 | |
a0599745 | 29 | #include "libguile/_scm.h" |
95b88819 | 30 | |
a0599745 MD |
31 | #include "libguile/scmsigs.h" |
32 | #include "libguile/strings.h" | |
1bbd0b84 | 33 | |
a0599745 MD |
34 | #include "libguile/validate.h" |
35 | #include "libguile/simpos.h" | |
20e6290e | 36 | |
95b88819 GH |
37 | #ifdef HAVE_STRING_H |
38 | #include <string.h> | |
39 | #endif | |
0f2d19dd JB |
40 | #ifdef HAVE_UNISTD_H |
41 | #include <unistd.h> | |
42 | #endif | |
0db17ef9 RB |
43 | #if HAVE_SYS_WAIT_H |
44 | # include <sys/wait.h> | |
45 | #endif | |
46 | ||
47 | #include "posix.h" | |
0f2d19dd JB |
48 | |
49 | \f | |
50 | extern int system(); | |
51 | \f | |
52 | ||
f25f761d | 53 | #ifdef HAVE_SYSTEM |
0db17ef9 | 54 | SCM_DEFINE (scm_system, "system", 0, 1, 0, |
1bbd0b84 | 55 | (SCM cmd), |
1e6808ea MG |
56 | "Execute @var{cmd} using the operating system's \"command\n" |
57 | "processor\". Under Unix this is usually the default shell\n" | |
58 | "@code{sh}. The value returned is @var{cmd}'s exit status as\n" | |
34b6177b KR |
59 | "returned by @code{waitpid}, which can be interpreted using\n" |
60 | "@code{status:exit-val} and friends.\n" | |
1e6808ea MG |
61 | "\n" |
62 | "If @code{system} is called without arguments, return a boolean\n" | |
d3818c29 | 63 | "indicating whether the command processor is available.") |
1bbd0b84 | 64 | #define FUNC_NAME s_scm_system |
0f2d19dd | 65 | { |
341eaef0 GH |
66 | int rv; |
67 | ||
68 | if (SCM_UNBNDP (cmd)) | |
69 | { | |
341eaef0 | 70 | rv = system (NULL); |
1bbd0b84 | 71 | return SCM_BOOL(rv); |
0db17ef9 | 72 | } |
a6d9e5ab | 73 | SCM_VALIDATE_STRING (1, cmd); |
341eaef0 | 74 | errno = 0; |
a6d9e5ab | 75 | rv = system (SCM_STRING_CHARS (cmd)); |
341eaef0 | 76 | if (rv == -1 || (rv == 127 && errno != 0)) |
1bbd0b84 | 77 | SCM_SYSERROR; |
341eaef0 | 78 | return SCM_MAKINUM (rv); |
341eaef0 | 79 | } |
1bbd0b84 | 80 | #undef FUNC_NAME |
f25f761d | 81 | #endif /* HAVE_SYSTEM */ |
0f2d19dd | 82 | |
0db17ef9 RB |
83 | |
84 | #ifdef HAVE_SYSTEM | |
85 | #ifdef HAVE_WAITPID | |
86 | ||
87 | /* return a newly allocated array of char pointers to each of the strings | |
88 | in args, with a terminating NULL pointer. */ | |
89 | /* Note: a similar function is defined in dynl.c, but we don't necessarily | |
90 | want to export it. */ | |
91 | static char ** | |
92 | allocate_string_pointers (SCM args) | |
93 | { | |
94 | char **result; | |
95 | int n_args = scm_ilength (args); | |
96 | int i; | |
97 | ||
98 | SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers"); | |
99 | result = (char **) scm_malloc ((n_args + 1) * sizeof (char *)); | |
100 | result[n_args] = NULL; | |
101 | for (i = 0; i < n_args; i++) | |
102 | { | |
103 | SCM car = SCM_CAR (args); | |
104 | ||
105 | if (!SCM_STRINGP (car)) | |
106 | { | |
107 | free (result); | |
108 | scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car); | |
109 | } | |
110 | result[i] = SCM_STRING_CHARS (SCM_CAR (args)); | |
111 | args = SCM_CDR (args); | |
112 | } | |
113 | return result; | |
114 | } | |
115 | ||
116 | SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, | |
117 | (SCM args), | |
118 | "Execute the command indicated by @var{args}. The first element must\n" | |
119 | "be a string indicating the command to be executed, and the remaining\n" | |
120 | "items must be strings representing each of the arguments to that\n" | |
121 | "command.\n" | |
122 | "\n" | |
123 | "This function returns the exit status of the command as provided by\n" | |
124 | "@code{waitpid}. This value can be handled with @code{status:exit-val}\n" | |
125 | "and the related functions.\n" | |
126 | "\n" | |
127 | "@code{system*} is similar to @code{system}, but accepts only one\n" | |
128 | "string per-argument, and performs no shell interpretation. The\n" | |
129 | "command is executed using fork and execlp. Accordingly this function\n" | |
130 | "may be safer than @code{system} in situations where shell\n" | |
131 | "interpretation is not required.\n" | |
132 | "\n" | |
133 | "Example: (system* \"echo\" \"foo\" \"bar\")") | |
134 | #define FUNC_NAME s_scm_system_star | |
135 | { | |
136 | if (SCM_NULLP (args)) | |
137 | SCM_WRONG_NUM_ARGS (); | |
138 | ||
139 | if (SCM_CONSP (args)) | |
140 | { | |
141 | SCM oldint; | |
142 | SCM oldquit; | |
143 | SCM sig_ign; | |
144 | SCM sigint; | |
145 | SCM sigquit; | |
146 | int pid; | |
147 | char **execargv; | |
148 | ||
149 | SCM_VALIDATE_STRING (1, SCM_CAR (args)); | |
150 | /* allocate before fork */ | |
151 | execargv = allocate_string_pointers (args); | |
152 | ||
153 | /* make sure the child can't kill us (as per normal system call) */ | |
154 | sig_ign = scm_long2num ((long) SIG_IGN); | |
155 | sigint = scm_long2num (SIGINT); | |
156 | sigquit = scm_long2num (SIGQUIT); | |
157 | oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED); | |
158 | oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED); | |
159 | ||
160 | pid = fork (); | |
eac8e0ef | 161 | if (pid == 0) |
0db17ef9 | 162 | { |
eac8e0ef KR |
163 | /* child */ |
164 | execvp (SCM_STRING_CHARS (SCM_CAR (args)), execargv); | |
165 | scm_remember_upto_here_1 (args); | |
166 | SCM_SYSERROR; | |
167 | /* not reached. */ | |
168 | return SCM_BOOL_F; | |
169 | } | |
170 | else | |
171 | { | |
172 | /* parent */ | |
173 | int wait_result, status, save_errno; | |
174 | ||
175 | save_errno = errno; | |
176 | free (execargv); | |
177 | errno = save_errno; | |
178 | if (pid == -1) | |
179 | SCM_SYSERROR; | |
180 | ||
0db17ef9 RB |
181 | SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); |
182 | if (wait_result == -1) SCM_SYSERROR; | |
183 | scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); | |
184 | scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); | |
185 | scm_remember_upto_here_2 (oldint, oldquit); | |
186 | return SCM_MAKINUM (0L + status); | |
187 | } | |
0db17ef9 RB |
188 | } |
189 | else | |
190 | SCM_WRONG_TYPE_ARG (1, SCM_CAR (args)); | |
191 | } | |
192 | #undef FUNC_NAME | |
193 | #endif /* HAVE_WAITPID */ | |
194 | #endif /* HAVE_SYSTEM */ | |
195 | ||
196 | ||
a1ec6916 | 197 | SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, |
1bbd0b84 | 198 | (SCM nam), |
d3818c29 MD |
199 | "Looks up the string @var{name} in the current environment. The return\n" |
200 | "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n" | |
d46e4713 | 201 | "found, in which case the string @code{VALUE} is returned.") |
1bbd0b84 | 202 | #define FUNC_NAME s_scm_getenv |
0f2d19dd JB |
203 | { |
204 | char *val; | |
a6d9e5ab | 205 | SCM_VALIDATE_STRING (1, nam); |
86c991c2 | 206 | val = getenv (SCM_STRING_CHARS (nam)); |
36284627 | 207 | return val ? scm_mem2string (val, strlen (val)) : SCM_BOOL_F; |
0f2d19dd | 208 | } |
1bbd0b84 | 209 | #undef FUNC_NAME |
0f2d19dd | 210 | |
ee149d03 | 211 | /* simple exit, without unwinding the scheme stack or flushing ports. */ |
a1ec6916 | 212 | SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0, |
1bbd0b84 | 213 | (SCM status), |
d3818c29 MD |
214 | "Terminate the current process without unwinding the Scheme stack.\n" |
215 | "This is would typically be useful after a fork. The exit status\n" | |
216 | "is @var{status} if supplied, otherwise zero.") | |
1bbd0b84 | 217 | #define FUNC_NAME s_scm_primitive_exit |
7ad3c1e7 GH |
218 | { |
219 | int cstatus = 0; | |
220 | if (!SCM_UNBNDP (status)) | |
221 | { | |
34d19ef6 | 222 | SCM_VALIDATE_INUM (1, status); |
7ad3c1e7 GH |
223 | cstatus = SCM_INUM (status); |
224 | } | |
225 | exit (cstatus); | |
226 | } | |
1bbd0b84 | 227 | #undef FUNC_NAME |
7ad3c1e7 | 228 | |
1cc91f1b | 229 | |
0f2d19dd JB |
230 | void |
231 | scm_init_simpos () | |
0f2d19dd | 232 | { |
a0599745 | 233 | #include "libguile/simpos.x" |
0f2d19dd JB |
234 | } |
235 | ||
89e00824 ML |
236 | |
237 | /* | |
238 | Local Variables: | |
239 | c-file-style: "gnu" | |
240 | End: | |
241 | */ |