]>
Commit | Line | Data |
---|---|---|
1 | /* | |
2 | * tclXprocess.c -- | |
3 | * | |
4 | * Tcl command to create and manage processes. | |
5 | *----------------------------------------------------------------------------- | |
6 | * Copyright 1992 Karl Lehenbauer and Mark Diekhans. | |
7 | * | |
8 | * Permission to use, copy, modify, and distribute this software and its | |
9 | * documentation for any purpose and without fee is hereby granted, provided | |
10 | * that the above copyright notice appear in all copies. Karl Lehenbauer and | |
11 | * Mark Diekhans make no representations about the suitability of this | |
12 | * software for any purpose. It is provided "as is" without express or | |
13 | * implied warranty. | |
14 | *----------------------------------------------------------------------------- | |
15 | * $Id: tclXprocess.c,v 2.2 1992/10/30 03:53:30 markd Exp $ | |
16 | *----------------------------------------------------------------------------- | |
17 | */ | |
18 | ||
19 | #include "tclxint.h" | |
20 | ||
21 | /* | |
22 | * These are needed for wait command even if waitpid is not available. | |
23 | */ | |
24 | #ifndef WNOHANG | |
25 | # define WNOHANG 1 | |
26 | #endif | |
27 | #ifndef WUNTRACED | |
28 | # define WUNTRACED 2 | |
29 | #endif | |
30 | ||
31 | \f | |
32 | /* | |
33 | *----------------------------------------------------------------------------- | |
34 | * | |
35 | * Tcl_ExeclCmd -- | |
36 | * Implements the TCL execl command: | |
37 | * execl prog [argList] | |
38 | * | |
39 | * Results: | |
40 | * Standard TCL results, may return the UNIX system error message. | |
41 | * | |
42 | *----------------------------------------------------------------------------- | |
43 | */ | |
44 | int | |
45 | Tcl_ExeclCmd (clientData, interp, argc, argv) | |
46 | ClientData clientData; | |
47 | Tcl_Interp *interp; | |
48 | int argc; | |
49 | char **argv; | |
50 | { | |
51 | #define STATIC_ARG_SIZE 12 | |
52 | char *staticArgv [STATIC_ARG_SIZE]; | |
53 | char **argInList = NULL; | |
54 | char **argList = staticArgv; | |
55 | int argInCnt, idx; | |
56 | ||
57 | if ((argc < 2) || (argc > 3)) { | |
58 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], | |
59 | " prog [argList]", (char *) NULL); | |
60 | return TCL_ERROR; | |
61 | } | |
62 | ||
63 | /* | |
64 | * If arg list is supplied, split it and build up the arguments to pass. | |
65 | * otherwise, just supply argv[0]. Must be NULL terminated. | |
66 | */ | |
67 | if (argc > 2) { | |
68 | if (Tcl_SplitList (interp, argv [2], &argInCnt, &argInList) != TCL_OK) | |
69 | return TCL_ERROR; | |
70 | ||
71 | if (argInCnt > STATIC_ARG_SIZE - 2) | |
72 | argList = (char **) ckalloc ((argInCnt + 1) * sizeof (char **)); | |
73 | ||
74 | for (idx = 0; idx < argInCnt; idx++) | |
75 | argList [idx + 1] = argInList [idx]; | |
76 | ||
77 | argList [argInCnt + 1] = NULL; | |
78 | } else { | |
79 | argList [1] = NULL; | |
80 | } | |
81 | ||
82 | argList [0] = argv [1]; /* Program name */ | |
83 | ||
84 | if (execvp (argv[1], argList) < 0) { | |
85 | if (argInList != NULL) | |
86 | ckfree (argInList); | |
87 | if (argList != staticArgv) | |
88 | ckfree (argList); | |
89 | ||
90 | interp->result = Tcl_UnixError (interp); | |
91 | return TCL_ERROR; | |
92 | } | |
93 | ||
94 | } | |
95 | \f | |
96 | /* | |
97 | *----------------------------------------------------------------------------- | |
98 | * | |
99 | * Tcl_ForkCmd -- | |
100 | * Implements the TCL fork command: | |
101 | * fork | |
102 | * | |
103 | * Results: | |
104 | * Standard TCL results, may return the UNIX system error message. | |
105 | * | |
106 | *----------------------------------------------------------------------------- | |
107 | */ | |
108 | int | |
109 | Tcl_ForkCmd (clientData, interp, argc, argv) | |
110 | ClientData clientData; | |
111 | Tcl_Interp *interp; | |
112 | int argc; | |
113 | char **argv; | |
114 | { | |
115 | int pid; | |
116 | ||
117 | if (argc != 1) { | |
118 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], (char *) NULL); | |
119 | return TCL_ERROR; | |
120 | } | |
121 | ||
122 | pid = Tcl_Fork (); | |
123 | if (pid < 0) { | |
124 | interp->result = Tcl_UnixError (interp); | |
125 | return TCL_ERROR; | |
126 | } | |
127 | ||
128 | sprintf(interp->result, "%d", pid); | |
129 | return TCL_OK; | |
130 | } | |
131 | #ifndef TCL_HAVE_WAITPID | |
132 | \f | |
133 | /* | |
134 | *----------------------------------------------------------------------------- | |
135 | * | |
136 | * Tcl_WaitCmd -- | |
137 | * Implements the TCL wait command: | |
138 | * wait pid | |
139 | * | |
140 | * This version is for Tcl 6.4 that does not have the waitpid changes (which | |
141 | * have not yet been released). | |
142 | * | |
143 | * Results: | |
144 | * Standard TCL results, may return the UNIX system error message. | |
145 | * | |
146 | *----------------------------------------------------------------------------- | |
147 | */ | |
148 | int | |
149 | Tcl_WaitCmd (clientData, interp, argc, argv) | |
150 | ClientData clientData; | |
151 | Tcl_Interp *interp; | |
152 | int argc; | |
153 | char **argv; | |
154 | { | |
155 | WAIT_STATUS_TYPE status; | |
156 | int pid, returnedPid; | |
157 | ||
158 | ||
159 | if (argc != 2) { | |
160 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " pid", | |
161 | (char *) NULL); | |
162 | return TCL_ERROR; | |
163 | } | |
164 | ||
165 | if (Tcl_GetInt (interp, argv [1], &pid) != TCL_OK) | |
166 | return TCL_ERROR; | |
167 | ||
168 | returnedPid = Tcl_WaitPids (1, &pid, (WAIT_STATUS_TYPE *) &status); | |
169 | ||
170 | if (returnedPid < 0) { | |
171 | interp->result = Tcl_UnixError (interp); | |
172 | return TCL_ERROR; | |
173 | } | |
174 | ||
175 | if (WIFEXITED (status)) | |
176 | sprintf (interp->result, "%d %s %d", returnedPid, "EXIT", | |
177 | WEXITSTATUS (status)); | |
178 | else if (WIFSIGNALED (status)) | |
179 | sprintf (interp->result, "%d %s %s", returnedPid, "SIG", | |
180 | Tcl_SignalId (WTERMSIG (status))); | |
181 | else if (WIFSTOPPED (status)) | |
182 | sprintf (interp->result, "%d %s %s", returnedPid, "STOP", | |
183 | Tcl_SignalId (WSTOPSIG (status))); | |
184 | ||
185 | return TCL_OK; | |
186 | ||
187 | } | |
188 | #else | |
189 | \f | |
190 | /* | |
191 | *----------------------------------------------------------------------------- | |
192 | * | |
193 | * Tcl_WaitCmd -- | |
194 | * Implements the TCL wait command: | |
195 | * wait [-nohang] [-untraced] [-pgroup] [pid] | |
196 | * | |
197 | * Results: | |
198 | * Standard TCL results, may return the UNIX system error message. | |
199 | * | |
200 | *----------------------------------------------------------------------------- | |
201 | */ | |
202 | int | |
203 | Tcl_WaitCmd (clientData, interp, argc, argv) | |
204 | ClientData clientData; | |
205 | Tcl_Interp *interp; | |
206 | int argc; | |
207 | char **argv; | |
208 | { | |
209 | int pid, returnedPid, status, idx; | |
210 | int options = 0, pgroup = FALSE; | |
211 | ||
212 | for (idx = 1; idx < argc; idx++) { | |
213 | if (argv [idx][0] != '-') | |
214 | break; | |
215 | if (STREQU ("-nohang", argv [idx])) { | |
216 | if (options & WNOHANG) | |
217 | goto usage; | |
218 | options |= WNOHANG; | |
219 | continue; | |
220 | } | |
221 | if (STREQU ("-untraced", argv [idx])) { | |
222 | if (options & WUNTRACED) | |
223 | goto usage; | |
224 | options |= WUNTRACED; | |
225 | continue; | |
226 | } | |
227 | if (STREQU ("-pgroup", argv [idx])) { | |
228 | if (pgroup) | |
229 | goto usage; | |
230 | pgroup = TRUE; | |
231 | continue; | |
232 | } | |
233 | goto usage; /* None match */ | |
234 | } | |
235 | /* | |
236 | * Check for more than one non-minus argument. If ok, convert pid, | |
237 | * if supplied. | |
238 | */ | |
239 | if (idx < argc - 1) | |
240 | goto usage; | |
241 | if (idx < argc) { | |
242 | if (Tcl_GetInt (interp, argv [idx], &pid) != TCL_OK) | |
243 | return TCL_ERROR; | |
244 | if (pid <= 0) { | |
245 | Tcl_AppendResult (interp, "pid or process group must be greater ", | |
246 | "than zero", (char *) NULL); | |
247 | return TCL_ERROR; | |
248 | } | |
249 | } else { | |
250 | pid = -1; /* pid not supplied */ | |
251 | } | |
252 | ||
253 | #if !TCL_HAVE_WAITPID | |
254 | /* | |
255 | * Versions that don't have real waitpid have limited functionality. | |
256 | */ | |
257 | if ((options != 0) || pgroup) { | |
258 | Tcl_AppendResult (interp, "The \"-nohang\", \"-untraced\" and ", | |
259 | "\"-pgroup\" options are not available on this ", | |
260 | "system", (char *) NULL); | |
261 | return TCL_ERROR; | |
262 | } | |
263 | #endif | |
264 | ||
265 | if (pgroup) { | |
266 | if (pid > 0) | |
267 | pid = -pgroup; | |
268 | else | |
269 | pid = 0; | |
270 | } | |
271 | ||
272 | returnedPid = waitpid (pid, &status, options); | |
273 | ||
274 | if (returnedPid < 0) { | |
275 | interp->result = Tcl_UnixError (interp); | |
276 | return TCL_ERROR; | |
277 | } | |
278 | ||
279 | if (WIFEXITED (status)) | |
280 | sprintf (interp->result, "%d %s %d", returnedPid, "EXIT", | |
281 | WEXITSTATUS (status)); | |
282 | else if (WIFSIGNALED (status)) | |
283 | sprintf (interp->result, "%d %s %s", returnedPid, "SIG", | |
284 | Tcl_SignalId (WTERMSIG (status))); | |
285 | else if (WIFSTOPPED (status)) | |
286 | sprintf (interp->result, "%d %s %s", returnedPid, "STOP", | |
287 | Tcl_SignalId (WSTOPSIG (status))); | |
288 | ||
289 | return TCL_OK; | |
290 | ||
291 | usage: | |
292 | Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " ", | |
293 | "[-nohang] [-untraced] [-pgroup] [pid]", | |
294 | (char *) NULL); | |
295 | return TCL_ERROR; | |
296 | } | |
297 | #endif |