39 |
#ifdef HAVE_UNISTD_H |
#ifdef HAVE_UNISTD_H |
40 |
#include <unistd.h> |
#include <unistd.h> |
41 |
#endif |
#endif |
42 |
|
#if HAVE_SYS_WAIT_H |
43 |
|
# include <sys/wait.h> |
44 |
|
#endif |
45 |
|
|
46 |
|
#include "posix.h" |
47 |
|
|
48 |
|
|
49 |
extern int system(); |
extern int system(); |
50 |
|
|
51 |
|
|
52 |
#ifdef HAVE_SYSTEM |
#ifdef HAVE_SYSTEM |
53 |
SCM_DEFINE (scm_system, "system", 0, 1, 0, |
SCM_DEFINE (scm_system, "system", 0, 1, 0, |
54 |
(SCM cmd), |
(SCM cmd), |
55 |
"Execute @var{cmd} using the operating system's \"command\n" |
"Execute @var{cmd} using the operating system's \"command\n" |
56 |
"processor\". Under Unix this is usually the default shell\n" |
"processor\". Under Unix this is usually the default shell\n" |
68 |
{ |
{ |
69 |
rv = system (NULL); |
rv = system (NULL); |
70 |
return SCM_BOOL(rv); |
return SCM_BOOL(rv); |
71 |
} |
} |
72 |
SCM_VALIDATE_STRING (1, cmd); |
SCM_VALIDATE_STRING (1, cmd); |
73 |
errno = 0; |
errno = 0; |
74 |
rv = system (SCM_STRING_CHARS (cmd)); |
rv = system (SCM_STRING_CHARS (cmd)); |
79 |
#undef FUNC_NAME |
#undef FUNC_NAME |
80 |
#endif /* HAVE_SYSTEM */ |
#endif /* HAVE_SYSTEM */ |
81 |
|
|
82 |
|
|
83 |
|
#ifdef HAVE_SYSTEM |
84 |
|
#ifdef HAVE_WAITPID |
85 |
|
|
86 |
|
/* return a newly allocated array of char pointers to each of the strings |
87 |
|
in args, with a terminating NULL pointer. */ |
88 |
|
/* Note: a similar function is defined in dynl.c, but we don't necessarily |
89 |
|
want to export it. */ |
90 |
|
static char ** |
91 |
|
allocate_string_pointers (SCM args) |
92 |
|
{ |
93 |
|
char **result; |
94 |
|
int n_args = scm_ilength (args); |
95 |
|
int i; |
96 |
|
|
97 |
|
SCM_ASSERT (n_args >= 0, args, SCM_ARGn, "allocate_string_pointers"); |
98 |
|
result = (char **) scm_malloc ((n_args + 1) * sizeof (char *)); |
99 |
|
result[n_args] = NULL; |
100 |
|
for (i = 0; i < n_args; i++) |
101 |
|
{ |
102 |
|
SCM car = SCM_CAR (args); |
103 |
|
|
104 |
|
if (!SCM_STRINGP (car)) |
105 |
|
{ |
106 |
|
free (result); |
107 |
|
scm_wrong_type_arg ("allocate_string_pointers", SCM_ARGn, car); |
108 |
|
} |
109 |
|
result[i] = SCM_STRING_CHARS (SCM_CAR (args)); |
110 |
|
args = SCM_CDR (args); |
111 |
|
} |
112 |
|
return result; |
113 |
|
} |
114 |
|
|
115 |
|
SCM_DEFINE (scm_system_star, "system*", 0, 0, 1, |
116 |
|
(SCM args), |
117 |
|
"Execute the command indicated by @var{args}. The first element must\n" |
118 |
|
"be a string indicating the command to be executed, and the remaining\n" |
119 |
|
"items must be strings representing each of the arguments to that\n" |
120 |
|
"command.\n" |
121 |
|
"\n" |
122 |
|
"This function returns the exit status of the command as provided by\n" |
123 |
|
"@code{waitpid}. This value can be handled with @code{status:exit-val}\n" |
124 |
|
"and the related functions.\n" |
125 |
|
"\n" |
126 |
|
"@code{system*} is similar to @code{system}, but accepts only one\n" |
127 |
|
"string per-argument, and performs no shell interpretation. The\n" |
128 |
|
"command is executed using fork and execlp. Accordingly this function\n" |
129 |
|
"may be safer than @code{system} in situations where shell\n" |
130 |
|
"interpretation is not required.\n" |
131 |
|
"\n" |
132 |
|
"Example: (system* \"echo\" \"foo\" \"bar\")") |
133 |
|
#define FUNC_NAME s_scm_system_star |
134 |
|
{ |
135 |
|
if (SCM_NULLP (args)) |
136 |
|
SCM_WRONG_NUM_ARGS (); |
137 |
|
|
138 |
|
if (SCM_CONSP (args)) |
139 |
|
{ |
140 |
|
SCM oldint; |
141 |
|
SCM oldquit; |
142 |
|
SCM sig_ign; |
143 |
|
SCM sigint; |
144 |
|
SCM sigquit; |
145 |
|
int pid; |
146 |
|
char **execargv; |
147 |
|
|
148 |
|
SCM_VALIDATE_STRING (1, SCM_CAR (args)); |
149 |
|
/* allocate before fork */ |
150 |
|
execargv = allocate_string_pointers (args); |
151 |
|
|
152 |
|
/* make sure the child can't kill us (as per normal system call) */ |
153 |
|
sig_ign = scm_long2num ((long) SIG_IGN); |
154 |
|
sigint = scm_long2num (SIGINT); |
155 |
|
sigquit = scm_long2num (SIGQUIT); |
156 |
|
oldint = scm_sigaction (sigint, sig_ign, SCM_UNDEFINED); |
157 |
|
oldquit = scm_sigaction (sigquit, sig_ign, SCM_UNDEFINED); |
158 |
|
|
159 |
|
pid = fork (); |
160 |
|
if (pid == -1) |
161 |
|
SCM_SYSERROR; |
162 |
|
else if (pid) |
163 |
|
{ |
164 |
|
int wait_result; |
165 |
|
int status; |
166 |
|
SCM_SYSCALL (wait_result = waitpid (pid, &status, 0)); |
167 |
|
if (wait_result == -1) SCM_SYSERROR; |
168 |
|
scm_sigaction (sigint, SCM_CAR (oldint), SCM_CDR (oldint)); |
169 |
|
scm_sigaction (sigquit, SCM_CAR (oldquit), SCM_CDR (oldquit)); |
170 |
|
scm_remember_upto_here_2 (oldint, oldquit); |
171 |
|
return SCM_MAKINUM (0L + status); |
172 |
|
} |
173 |
|
else |
174 |
|
{ |
175 |
|
execvp (SCM_STRING_CHARS (SCM_CAR (args)), execargv); |
176 |
|
scm_remember_upto_here_1 (args); |
177 |
|
SCM_SYSERROR; |
178 |
|
/* not reached. */ |
179 |
|
return SCM_BOOL_F; |
180 |
|
} |
181 |
|
} |
182 |
|
else |
183 |
|
SCM_WRONG_TYPE_ARG (1, SCM_CAR (args)); |
184 |
|
} |
185 |
|
#undef FUNC_NAME |
186 |
|
#endif /* HAVE_WAITPID */ |
187 |
|
#endif /* HAVE_SYSTEM */ |
188 |
|
|
189 |
|
|
190 |
SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, |
SCM_DEFINE (scm_getenv, "getenv", 1, 0, 0, |
191 |
(SCM nam), |
(SCM nam), |
192 |
"Looks up the string @var{name} in the current environment. The return\n" |
"Looks up the string @var{name} in the current environment. The return\n" |