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 | |
92205699 | 16 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
73be1d9e | 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" | |
7f9994d9 | 36 | #include "libguile/dynwind.h" |
20e6290e | 37 | |
95b88819 GH |
38 | #ifdef HAVE_STRING_H |
39 | #include <string.h> | |
40 | #endif | |
0f2d19dd JB |
41 | #ifdef HAVE_UNISTD_H |
42 | #include <unistd.h> | |
43 | #endif | |
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 | ||
7f9994d9 MV |
91 | static void |
92 | free_string_pointers (void *data) | |
0db17ef9 | 93 | { |
7f9994d9 | 94 | scm_i_free_string_pointers ((char **)data); |
0db17ef9 RB |
95 | } |
96 | ||
97 | SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, | |
98 | (SCM args), | |
99 | "Execute the command indicated by @var{args}. The first element must\n" | |
100 | "be a string indicating the command to be executed, and the remaining\n" | |
101 | "items must be strings representing each of the arguments to that\n" | |
102 | "command.\n" | |
103 | "\n" | |
104 | "This function returns the exit status of the command as provided by\n" | |
105 | "@code{waitpid}. This value can be handled with @code{status:exit-val}\n" | |
106 | "and the related functions.\n" | |
107 | "\n" | |
108 | "@code{system*} is similar to @code{system}, but accepts only one\n" | |
109 | "string per-argument, and performs no shell interpretation. The\n" | |
110 | "command is executed using fork and execlp. Accordingly this function\n" | |
111 | "may be safer than @code{system} in situations where shell\n" | |
112 | "interpretation is not required.\n" | |
113 | "\n" | |
114 | "Example: (system* \"echo\" \"foo\" \"bar\")") | |
115 | #define FUNC_NAME s_scm_system_star | |
116 | { | |
d2e53ed6 | 117 | if (scm_is_null (args)) |
0db17ef9 RB |
118 | SCM_WRONG_NUM_ARGS (); |
119 | ||
d2e53ed6 | 120 | if (scm_is_pair (args)) |
0db17ef9 RB |
121 | { |
122 | SCM oldint; | |
123 | SCM oldquit; | |
124 | SCM sig_ign; | |
125 | SCM sigint; | |
126 | SCM sigquit; | |
127 | int pid; | |
128 | char **execargv; | |
129 | ||
661ae7ab | 130 | scm_dynwind_begin (0); |
7f9994d9 | 131 | |
0db17ef9 | 132 | /* allocate before fork */ |
7f9994d9 | 133 | execargv = scm_i_allocate_string_pointers (args); |
661ae7ab MV |
134 | scm_dynwind_unwind_handler (free_string_pointers, execargv, |
135 | SCM_F_WIND_EXPLICITLY); | |
0db17ef9 RB |
136 | |
137 | /* make sure the child can't kill us (as per normal system call) */ | |
b9bd8526 | 138 | sig_ign = scm_from_long ((unsigned long) SIG_IGN); |
f070ba13 KR |
139 | sigint = scm_from_int (SIGINT); |
140 | sigquit = scm_from_int (SIGQUIT); | |
0db17ef9 RB |
141 | oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED); |
142 | oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED); | |
143 | ||
144 | pid = fork (); | |
eac8e0ef | 145 | if (pid == 0) |
0db17ef9 | 146 | { |
eac8e0ef | 147 | /* child */ |
7f9994d9 | 148 | execvp (execargv[0], execargv); |
eac8e0ef KR |
149 | SCM_SYSERROR; |
150 | /* not reached. */ | |
661ae7ab | 151 | scm_dynwind_end (); |
eac8e0ef KR |
152 | return SCM_BOOL_F; |
153 | } | |
154 | else | |
155 | { | |
156 | /* parent */ | |
7f9994d9 | 157 | int wait_result, status; |
eac8e0ef | 158 | |
eac8e0ef KR |
159 | if (pid == -1) |
160 | SCM_SYSERROR; | |
161 | ||
0db17ef9 | 162 | SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); |
7f9994d9 MV |
163 | if (wait_result == -1) |
164 | SCM_SYSERROR; | |
0db17ef9 RB |
165 | scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); |
166 | scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); | |
7f9994d9 | 167 | |
661ae7ab | 168 | scm_dynwind_end (); |
e11e83f3 | 169 | return scm_from_int (status); |
0db17ef9 | 170 | } |
0db17ef9 RB |
171 | } |
172 | else | |
7f9994d9 | 173 | SCM_WRONG_TYPE_ARG (1, args); |
0db17ef9 RB |
174 | } |
175 | #undef FUNC_NAME | |
176 | #endif /* HAVE_WAITPID */ | |
177 | #endif /* HAVE_SYSTEM */ | |
178 | ||
179 | ||
a1ec6916 | 180 | SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, |
1bbd0b84 | 181 | (SCM nam), |
d3818c29 MD |
182 | "Looks up the string @var{name} in the current environment. The return\n" |
183 | "value is @code{#f} unless a string of the form @code{NAME=VALUE} is\n" | |
d46e4713 | 184 | "found, in which case the string @code{VALUE} is returned.") |
1bbd0b84 | 185 | #define FUNC_NAME s_scm_getenv |
0f2d19dd JB |
186 | { |
187 | char *val; | |
7f9994d9 MV |
188 | char *var = scm_to_locale_string (nam); |
189 | val = getenv (var); | |
190 | free (var); | |
191 | return val ? scm_from_locale_string (val) : SCM_BOOL_F; | |
0f2d19dd | 192 | } |
1bbd0b84 | 193 | #undef FUNC_NAME |
0f2d19dd | 194 | |
ee149d03 | 195 | /* simple exit, without unwinding the scheme stack or flushing ports. */ |
a1ec6916 | 196 | SCM_DEFINE (scm_primitive_exit, "primitive-exit", 0, 1, 0, |
1bbd0b84 | 197 | (SCM status), |
d3818c29 MD |
198 | "Terminate the current process without unwinding the Scheme stack.\n" |
199 | "This is would typically be useful after a fork. The exit status\n" | |
200 | "is @var{status} if supplied, otherwise zero.") | |
1bbd0b84 | 201 | #define FUNC_NAME s_scm_primitive_exit |
7ad3c1e7 GH |
202 | { |
203 | int cstatus = 0; | |
204 | if (!SCM_UNBNDP (status)) | |
a55c2b68 | 205 | cstatus = scm_to_int (status); |
7ad3c1e7 GH |
206 | exit (cstatus); |
207 | } | |
1bbd0b84 | 208 | #undef FUNC_NAME |
7ad3c1e7 | 209 | |
1cc91f1b | 210 | |
0f2d19dd JB |
211 | void |
212 | scm_init_simpos () | |
0f2d19dd | 213 | { |
a0599745 | 214 | #include "libguile/simpos.x" |
0f2d19dd JB |
215 | } |
216 | ||
89e00824 ML |
217 | |
218 | /* | |
219 | Local Variables: | |
220 | c-file-style: "gnu" | |
221 | End: | |
222 | */ |