1 |
/* $Header$ */
|
2 |
/*
|
3 |
* tclPipe.c --
|
4 |
*
|
5 |
* This file contains the generic portion of the command channel
|
6 |
* driver as well as various utility routines used in managing
|
7 |
* subprocesses.
|
8 |
*
|
9 |
* Copyright (c) 1997 by Sun Microsystems, Inc.
|
10 |
*
|
11 |
* See the file "license.terms" for information on usage and redistribution
|
12 |
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
13 |
*
|
14 |
* RCS: @(#) $Id: tclpipe.c,v 1.1.1.1 2001/06/13 04:44:53 dtashley Exp $
|
15 |
*/
|
16 |
|
17 |
#include "tclInt.h"
|
18 |
#include "tclPort.h"
|
19 |
|
20 |
/*
|
21 |
* A linked list of the following structures is used to keep track
|
22 |
* of child processes that have been detached but haven't exited
|
23 |
* yet, so we can make sure that they're properly "reaped" (officially
|
24 |
* waited for) and don't lie around as zombies cluttering the
|
25 |
* system.
|
26 |
*/
|
27 |
|
28 |
typedef struct Detached {
|
29 |
Tcl_Pid pid; /* Id of process that's been detached
|
30 |
* but isn't known to have exited. */
|
31 |
struct Detached *nextPtr; /* Next in list of all detached
|
32 |
* processes. */
|
33 |
} Detached;
|
34 |
|
35 |
static Detached *detList = NULL; /* List of all detached proceses. */
|
36 |
TCL_DECLARE_MUTEX(pipeMutex) /* Guard access to detList. */
|
37 |
|
38 |
/*
|
39 |
* Declarations for local procedures defined in this file:
|
40 |
*/
|
41 |
|
42 |
static TclFile FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
|
43 |
char *spec, int atOk, char *arg, char *nextArg,
|
44 |
int flags, int *skipPtr, int *closePtr, int *releasePtr));
|
45 |
|
46 |
/*
|
47 |
*----------------------------------------------------------------------
|
48 |
*
|
49 |
* FileForRedirect --
|
50 |
*
|
51 |
* This procedure does much of the work of parsing redirection
|
52 |
* operators. It handles "@" if specified and allowed, and a file
|
53 |
* name, and opens the file if necessary.
|
54 |
*
|
55 |
* Results:
|
56 |
* The return value is the descriptor number for the file. If an
|
57 |
* error occurs then NULL is returned and an error message is left
|
58 |
* in the interp's result. Several arguments are side-effected; see
|
59 |
* the argument list below for details.
|
60 |
*
|
61 |
* Side effects:
|
62 |
* None.
|
63 |
*
|
64 |
*----------------------------------------------------------------------
|
65 |
*/
|
66 |
|
67 |
static TclFile
|
68 |
FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
|
69 |
releasePtr)
|
70 |
Tcl_Interp *interp; /* Intepreter to use for error reporting. */
|
71 |
char *spec; /* Points to character just after
|
72 |
* redirection character. */
|
73 |
char *arg; /* Pointer to entire argument containing
|
74 |
* spec: used for error reporting. */
|
75 |
int atOK; /* Non-zero means that '@' notation can be
|
76 |
* used to specify a channel, zero means that
|
77 |
* it isn't. */
|
78 |
char *nextArg; /* Next argument in argc/argv array, if needed
|
79 |
* for file name or channel name. May be
|
80 |
* NULL. */
|
81 |
int flags; /* Flags to use for opening file or to
|
82 |
* specify mode for channel. */
|
83 |
int *skipPtr; /* Filled with 1 if redirection target was
|
84 |
* in spec, 2 if it was in nextArg. */
|
85 |
int *closePtr; /* Filled with one if the caller should
|
86 |
* close the file when done with it, zero
|
87 |
* otherwise. */
|
88 |
int *releasePtr;
|
89 |
{
|
90 |
int writing = (flags & O_WRONLY);
|
91 |
Tcl_Channel chan;
|
92 |
TclFile file;
|
93 |
|
94 |
*skipPtr = 1;
|
95 |
if ((atOK != 0) && (*spec == '@')) {
|
96 |
spec++;
|
97 |
if (*spec == '\0') {
|
98 |
spec = nextArg;
|
99 |
if (spec == NULL) {
|
100 |
goto badLastArg;
|
101 |
}
|
102 |
*skipPtr = 2;
|
103 |
}
|
104 |
chan = Tcl_GetChannel(interp, spec, NULL);
|
105 |
if (chan == (Tcl_Channel) NULL) {
|
106 |
return NULL;
|
107 |
}
|
108 |
file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
|
109 |
if (file == NULL) {
|
110 |
Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
|
111 |
"\" wasn't opened for ",
|
112 |
((writing) ? "writing" : "reading"), (char *) NULL);
|
113 |
return NULL;
|
114 |
}
|
115 |
*releasePtr = 1;
|
116 |
if (writing) {
|
117 |
|
118 |
/*
|
119 |
* Be sure to flush output to the file, so that anything
|
120 |
* written by the child appears after stuff we've already
|
121 |
* written.
|
122 |
*/
|
123 |
|
124 |
Tcl_Flush(chan);
|
125 |
}
|
126 |
} else {
|
127 |
char *name;
|
128 |
Tcl_DString nameString;
|
129 |
|
130 |
if (*spec == '\0') {
|
131 |
spec = nextArg;
|
132 |
if (spec == NULL) {
|
133 |
goto badLastArg;
|
134 |
}
|
135 |
*skipPtr = 2;
|
136 |
}
|
137 |
name = Tcl_TranslateFileName(interp, spec, &nameString);
|
138 |
if (name != NULL) {
|
139 |
file = TclpOpenFile(name, flags);
|
140 |
} else {
|
141 |
file = NULL;
|
142 |
}
|
143 |
Tcl_DStringFree(&nameString);
|
144 |
if (file == NULL) {
|
145 |
Tcl_AppendResult(interp, "couldn't ",
|
146 |
((writing) ? "write" : "read"), " file \"", spec, "\": ",
|
147 |
Tcl_PosixError(interp), (char *) NULL);
|
148 |
return NULL;
|
149 |
}
|
150 |
*closePtr = 1;
|
151 |
}
|
152 |
return file;
|
153 |
|
154 |
badLastArg:
|
155 |
Tcl_AppendResult(interp, "can't specify \"", arg,
|
156 |
"\" as last word in command", (char *) NULL);
|
157 |
return NULL;
|
158 |
}
|
159 |
|
160 |
/*
|
161 |
*----------------------------------------------------------------------
|
162 |
*
|
163 |
* Tcl_DetachPids --
|
164 |
*
|
165 |
* This procedure is called to indicate that one or more child
|
166 |
* processes have been placed in background and will never be
|
167 |
* waited for; they should eventually be reaped by
|
168 |
* Tcl_ReapDetachedProcs.
|
169 |
*
|
170 |
* Results:
|
171 |
* None.
|
172 |
*
|
173 |
* Side effects:
|
174 |
* None.
|
175 |
*
|
176 |
*----------------------------------------------------------------------
|
177 |
*/
|
178 |
|
179 |
void
|
180 |
Tcl_DetachPids(numPids, pidPtr)
|
181 |
int numPids; /* Number of pids to detach: gives size
|
182 |
* of array pointed to by pidPtr. */
|
183 |
Tcl_Pid *pidPtr; /* Array of pids to detach. */
|
184 |
{
|
185 |
register Detached *detPtr;
|
186 |
int i;
|
187 |
|
188 |
Tcl_MutexLock(&pipeMutex);
|
189 |
for (i = 0; i < numPids; i++) {
|
190 |
detPtr = (Detached *) ckalloc(sizeof(Detached));
|
191 |
detPtr->pid = pidPtr[i];
|
192 |
detPtr->nextPtr = detList;
|
193 |
detList = detPtr;
|
194 |
}
|
195 |
Tcl_MutexUnlock(&pipeMutex);
|
196 |
|
197 |
}
|
198 |
|
199 |
/*
|
200 |
*----------------------------------------------------------------------
|
201 |
*
|
202 |
* Tcl_ReapDetachedProcs --
|
203 |
*
|
204 |
* This procedure checks to see if any detached processes have
|
205 |
* exited and, if so, it "reaps" them by officially waiting on
|
206 |
* them. It should be called "occasionally" to make sure that
|
207 |
* all detached processes are eventually reaped.
|
208 |
*
|
209 |
* Results:
|
210 |
* None.
|
211 |
*
|
212 |
* Side effects:
|
213 |
* Processes are waited on, so that they can be reaped by the
|
214 |
* system.
|
215 |
*
|
216 |
*----------------------------------------------------------------------
|
217 |
*/
|
218 |
|
219 |
void
|
220 |
Tcl_ReapDetachedProcs()
|
221 |
{
|
222 |
register Detached *detPtr;
|
223 |
Detached *nextPtr, *prevPtr;
|
224 |
int status;
|
225 |
Tcl_Pid pid;
|
226 |
|
227 |
Tcl_MutexLock(&pipeMutex);
|
228 |
for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
|
229 |
pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
|
230 |
if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
|
231 |
prevPtr = detPtr;
|
232 |
detPtr = detPtr->nextPtr;
|
233 |
continue;
|
234 |
}
|
235 |
nextPtr = detPtr->nextPtr;
|
236 |
if (prevPtr == NULL) {
|
237 |
detList = detPtr->nextPtr;
|
238 |
} else {
|
239 |
prevPtr->nextPtr = detPtr->nextPtr;
|
240 |
}
|
241 |
ckfree((char *) detPtr);
|
242 |
detPtr = nextPtr;
|
243 |
}
|
244 |
Tcl_MutexUnlock(&pipeMutex);
|
245 |
}
|
246 |
|
247 |
/*
|
248 |
*----------------------------------------------------------------------
|
249 |
*
|
250 |
* TclCleanupChildren --
|
251 |
*
|
252 |
* This is a utility procedure used to wait for child processes
|
253 |
* to exit, record information about abnormal exits, and then
|
254 |
* collect any stderr output generated by them.
|
255 |
*
|
256 |
* Results:
|
257 |
* The return value is a standard Tcl result. If anything at
|
258 |
* weird happened with the child processes, TCL_ERROR is returned
|
259 |
* and a message is left in the interp's result.
|
260 |
*
|
261 |
* Side effects:
|
262 |
* If the last character of the interp's result is a newline, then it
|
263 |
* is removed unless keepNewline is non-zero. File errorId gets
|
264 |
* closed, and pidPtr is freed back to the storage allocator.
|
265 |
*
|
266 |
*----------------------------------------------------------------------
|
267 |
*/
|
268 |
|
269 |
int
|
270 |
TclCleanupChildren(interp, numPids, pidPtr, errorChan)
|
271 |
Tcl_Interp *interp; /* Used for error messages. */
|
272 |
int numPids; /* Number of entries in pidPtr array. */
|
273 |
Tcl_Pid *pidPtr; /* Array of process ids of children. */
|
274 |
Tcl_Channel errorChan; /* Channel for file containing stderr output
|
275 |
* from pipeline. NULL means there isn't any
|
276 |
* stderr output. */
|
277 |
{
|
278 |
int result = TCL_OK;
|
279 |
int i, abnormalExit, anyErrorInfo;
|
280 |
Tcl_Pid pid;
|
281 |
WAIT_STATUS_TYPE waitStatus;
|
282 |
char *msg;
|
283 |
|
284 |
abnormalExit = 0;
|
285 |
for (i = 0; i < numPids; i++) {
|
286 |
pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
|
287 |
if (pid == (Tcl_Pid) -1) {
|
288 |
result = TCL_ERROR;
|
289 |
if (interp != (Tcl_Interp *) NULL) {
|
290 |
msg = Tcl_PosixError(interp);
|
291 |
if (errno == ECHILD) {
|
292 |
/*
|
293 |
* This changeup in message suggested by Mark Diekhans
|
294 |
* to remind people that ECHILD errors can occur on
|
295 |
* some systems if SIGCHLD isn't in its default state.
|
296 |
*/
|
297 |
|
298 |
msg =
|
299 |
"child process lost (is SIGCHLD ignored or trapped?)";
|
300 |
}
|
301 |
Tcl_AppendResult(interp, "error waiting for process to exit: ",
|
302 |
msg, (char *) NULL);
|
303 |
}
|
304 |
continue;
|
305 |
}
|
306 |
|
307 |
/*
|
308 |
* Create error messages for unusual process exits. An
|
309 |
* extra newline gets appended to each error message, but
|
310 |
* it gets removed below (in the same fashion that an
|
311 |
* extra newline in the command's output is removed).
|
312 |
*/
|
313 |
|
314 |
if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
|
315 |
char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
|
316 |
|
317 |
result = TCL_ERROR;
|
318 |
TclFormatInt(msg1, (long) TclpGetPid(pid));
|
319 |
if (WIFEXITED(waitStatus)) {
|
320 |
if (interp != (Tcl_Interp *) NULL) {
|
321 |
TclFormatInt(msg2, WEXITSTATUS(waitStatus));
|
322 |
Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
|
323 |
(char *) NULL);
|
324 |
}
|
325 |
abnormalExit = 1;
|
326 |
} else if (WIFSIGNALED(waitStatus)) {
|
327 |
if (interp != (Tcl_Interp *) NULL) {
|
328 |
char *p;
|
329 |
|
330 |
p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
|
331 |
Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
|
332 |
Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
|
333 |
(char *) NULL);
|
334 |
Tcl_AppendResult(interp, "child killed: ", p, "\n",
|
335 |
(char *) NULL);
|
336 |
}
|
337 |
} else if (WIFSTOPPED(waitStatus)) {
|
338 |
if (interp != (Tcl_Interp *) NULL) {
|
339 |
char *p;
|
340 |
|
341 |
p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
|
342 |
Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
|
343 |
Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
|
344 |
p, (char *) NULL);
|
345 |
Tcl_AppendResult(interp, "child suspended: ", p, "\n",
|
346 |
(char *) NULL);
|
347 |
}
|
348 |
} else {
|
349 |
if (interp != (Tcl_Interp *) NULL) {
|
350 |
Tcl_AppendResult(interp,
|
351 |
"child wait status didn't make sense\n",
|
352 |
(char *) NULL);
|
353 |
}
|
354 |
}
|
355 |
}
|
356 |
}
|
357 |
|
358 |
/*
|
359 |
* Read the standard error file. If there's anything there,
|
360 |
* then return an error and add the file's contents to the result
|
361 |
* string.
|
362 |
*/
|
363 |
|
364 |
anyErrorInfo = 0;
|
365 |
if (errorChan != NULL) {
|
366 |
|
367 |
/*
|
368 |
* Make sure we start at the beginning of the file.
|
369 |
*/
|
370 |
|
371 |
if (interp != NULL) {
|
372 |
int count;
|
373 |
Tcl_Obj *objPtr;
|
374 |
|
375 |
Tcl_Seek(errorChan, 0L, SEEK_SET);
|
376 |
objPtr = Tcl_NewObj();
|
377 |
count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
|
378 |
if (count < 0) {
|
379 |
result = TCL_ERROR;
|
380 |
Tcl_DecrRefCount(objPtr);
|
381 |
Tcl_ResetResult(interp);
|
382 |
Tcl_AppendResult(interp, "error reading stderr output file: ",
|
383 |
Tcl_PosixError(interp), NULL);
|
384 |
} else if (count > 0) {
|
385 |
anyErrorInfo = 1;
|
386 |
Tcl_SetObjResult(interp, objPtr);
|
387 |
result = TCL_ERROR;
|
388 |
} else {
|
389 |
Tcl_DecrRefCount(objPtr);
|
390 |
}
|
391 |
}
|
392 |
Tcl_Close(NULL, errorChan);
|
393 |
}
|
394 |
|
395 |
/*
|
396 |
* If a child exited abnormally but didn't output any error information
|
397 |
* at all, generate an error message here.
|
398 |
*/
|
399 |
|
400 |
if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
|
401 |
Tcl_AppendResult(interp, "child process exited abnormally",
|
402 |
(char *) NULL);
|
403 |
}
|
404 |
return result;
|
405 |
}
|
406 |
|
407 |
/*
|
408 |
*----------------------------------------------------------------------
|
409 |
*
|
410 |
* TclCreatePipeline --
|
411 |
*
|
412 |
* Given an argc/argv array, instantiate a pipeline of processes
|
413 |
* as described by the argv.
|
414 |
*
|
415 |
* This procedure is unofficially exported for use by BLT.
|
416 |
*
|
417 |
* Results:
|
418 |
* The return value is a count of the number of new processes
|
419 |
* created, or -1 if an error occurred while creating the pipeline.
|
420 |
* *pidArrayPtr is filled in with the address of a dynamically
|
421 |
* allocated array giving the ids of all of the processes. It
|
422 |
* is up to the caller to free this array when it isn't needed
|
423 |
* anymore. If inPipePtr is non-NULL, *inPipePtr is filled in
|
424 |
* with the file id for the input pipe for the pipeline (if any):
|
425 |
* the caller must eventually close this file. If outPipePtr
|
426 |
* isn't NULL, then *outPipePtr is filled in with the file id
|
427 |
* for the output pipe from the pipeline: the caller must close
|
428 |
* this file. If errFilePtr isn't NULL, then *errFilePtr is filled
|
429 |
* with a file id that may be used to read error output after the
|
430 |
* pipeline completes.
|
431 |
*
|
432 |
* Side effects:
|
433 |
* Processes and pipes are created.
|
434 |
*
|
435 |
*----------------------------------------------------------------------
|
436 |
*/
|
437 |
|
438 |
int
|
439 |
TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
|
440 |
outPipePtr, errFilePtr)
|
441 |
Tcl_Interp *interp; /* Interpreter to use for error reporting. */
|
442 |
int argc; /* Number of entries in argv. */
|
443 |
char **argv; /* Array of strings describing commands in
|
444 |
* pipeline plus I/O redirection with <,
|
445 |
* <<, >, etc. Argv[argc] must be NULL. */
|
446 |
Tcl_Pid **pidArrayPtr; /* Word at *pidArrayPtr gets filled in with
|
447 |
* address of array of pids for processes
|
448 |
* in pipeline (first pid is first process
|
449 |
* in pipeline). */
|
450 |
TclFile *inPipePtr; /* If non-NULL, input to the pipeline comes
|
451 |
* from a pipe (unless overridden by
|
452 |
* redirection in the command). The file
|
453 |
* id with which to write to this pipe is
|
454 |
* stored at *inPipePtr. NULL means command
|
455 |
* specified its own input source. */
|
456 |
TclFile *outPipePtr; /* If non-NULL, output to the pipeline goes
|
457 |
* to a pipe, unless overriden by redirection
|
458 |
* in the command. The file id with which to
|
459 |
* read frome this pipe is stored at
|
460 |
* *outPipePtr. NULL means command specified
|
461 |
* its own output sink. */
|
462 |
TclFile *errFilePtr; /* If non-NULL, all stderr output from the
|
463 |
* pipeline will go to a temporary file
|
464 |
* created here, and a descriptor to read
|
465 |
* the file will be left at *errFilePtr.
|
466 |
* The file will be removed already, so
|
467 |
* closing this descriptor will be the end
|
468 |
* of the file. If this is NULL, then
|
469 |
* all stderr output goes to our stderr.
|
470 |
* If the pipeline specifies redirection
|
471 |
* then the file will still be created
|
472 |
* but it will never get any data. */
|
473 |
{
|
474 |
Tcl_Pid *pidPtr = NULL; /* Points to malloc-ed array holding all
|
475 |
* the pids of child processes. */
|
476 |
int numPids; /* Actual number of processes that exist
|
477 |
* at *pidPtr right now. */
|
478 |
int cmdCount; /* Count of number of distinct commands
|
479 |
* found in argc/argv. */
|
480 |
char *inputLiteral = NULL; /* If non-null, then this points to a
|
481 |
* string containing input data (specified
|
482 |
* via <<) to be piped to the first process
|
483 |
* in the pipeline. */
|
484 |
TclFile inputFile = NULL; /* If != NULL, gives file to use as input for
|
485 |
* first process in pipeline (specified via <
|
486 |
* or <@). */
|
487 |
int inputClose = 0; /* If non-zero, then inputFile should be
|
488 |
* closed when cleaning up. */
|
489 |
int inputRelease = 0;
|
490 |
TclFile outputFile = NULL; /* Writable file for output from last command
|
491 |
* in pipeline (could be file or pipe). NULL
|
492 |
* means use stdout. */
|
493 |
int outputClose = 0; /* If non-zero, then outputFile should be
|
494 |
* closed when cleaning up. */
|
495 |
int outputRelease = 0;
|
496 |
TclFile errorFile = NULL; /* Writable file for error output from all
|
497 |
* commands in pipeline. NULL means use
|
498 |
* stderr. */
|
499 |
int errorClose = 0; /* If non-zero, then errorFile should be
|
500 |
* closed when cleaning up. */
|
501 |
int errorRelease = 0;
|
502 |
char *p;
|
503 |
int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
|
504 |
Tcl_DString execBuffer;
|
505 |
TclFile pipeIn;
|
506 |
TclFile curInFile, curOutFile, curErrFile;
|
507 |
Tcl_Channel channel;
|
508 |
|
509 |
if (inPipePtr != NULL) {
|
510 |
*inPipePtr = NULL;
|
511 |
}
|
512 |
if (outPipePtr != NULL) {
|
513 |
*outPipePtr = NULL;
|
514 |
}
|
515 |
if (errFilePtr != NULL) {
|
516 |
*errFilePtr = NULL;
|
517 |
}
|
518 |
|
519 |
Tcl_DStringInit(&execBuffer);
|
520 |
|
521 |
pipeIn = NULL;
|
522 |
curInFile = NULL;
|
523 |
curOutFile = NULL;
|
524 |
numPids = 0;
|
525 |
|
526 |
/*
|
527 |
* First, scan through all the arguments to figure out the structure
|
528 |
* of the pipeline. Process all of the input and output redirection
|
529 |
* arguments and remove them from the argument list in the pipeline.
|
530 |
* Count the number of distinct processes (it's the number of "|"
|
531 |
* arguments plus one) but don't remove the "|" arguments because
|
532 |
* they'll be used in the second pass to seperate the individual
|
533 |
* child processes. Cannot start the child processes in this pass
|
534 |
* because the redirection symbols may appear anywhere in the
|
535 |
* command line -- e.g., the '<' that specifies the input to the
|
536 |
* entire pipe may appear at the very end of the argument list.
|
537 |
*/
|
538 |
|
539 |
lastBar = -1;
|
540 |
cmdCount = 1;
|
541 |
for (i = 0; i < argc; i++) {
|
542 |
skip = 0;
|
543 |
p = argv[i];
|
544 |
switch (*p++) {
|
545 |
case '|':
|
546 |
if (*p == '&') {
|
547 |
p++;
|
548 |
}
|
549 |
if (*p == '\0') {
|
550 |
if ((i == (lastBar + 1)) || (i == (argc - 1))) {
|
551 |
Tcl_SetResult(interp,
|
552 |
"illegal use of | or |& in command",
|
553 |
TCL_STATIC);
|
554 |
goto error;
|
555 |
}
|
556 |
}
|
557 |
lastBar = i;
|
558 |
cmdCount++;
|
559 |
break;
|
560 |
|
561 |
case '<':
|
562 |
if (inputClose != 0) {
|
563 |
inputClose = 0;
|
564 |
TclpCloseFile(inputFile);
|
565 |
}
|
566 |
if (inputRelease != 0) {
|
567 |
inputRelease = 0;
|
568 |
TclpReleaseFile(inputFile);
|
569 |
}
|
570 |
if (*p == '<') {
|
571 |
inputFile = NULL;
|
572 |
inputLiteral = p + 1;
|
573 |
skip = 1;
|
574 |
if (*inputLiteral == '\0') {
|
575 |
inputLiteral = argv[i + 1];
|
576 |
if (inputLiteral == NULL) {
|
577 |
Tcl_AppendResult(interp, "can't specify \"", argv[i],
|
578 |
"\" as last word in command", (char *) NULL);
|
579 |
goto error;
|
580 |
}
|
581 |
skip = 2;
|
582 |
}
|
583 |
} else {
|
584 |
inputLiteral = NULL;
|
585 |
inputFile = FileForRedirect(interp, p, 1, argv[i],
|
586 |
argv[i + 1], O_RDONLY, &skip, &inputClose, &inputRelease);
|
587 |
if (inputFile == NULL) {
|
588 |
goto error;
|
589 |
}
|
590 |
}
|
591 |
break;
|
592 |
|
593 |
case '>':
|
594 |
atOK = 1;
|
595 |
flags = O_WRONLY | O_CREAT | O_TRUNC;
|
596 |
errorToOutput = 0;
|
597 |
if (*p == '>') {
|
598 |
p++;
|
599 |
atOK = 0;
|
600 |
flags = O_WRONLY | O_CREAT;
|
601 |
}
|
602 |
if (*p == '&') {
|
603 |
if (errorClose != 0) {
|
604 |
errorClose = 0;
|
605 |
TclpCloseFile(errorFile);
|
606 |
}
|
607 |
errorToOutput = 1;
|
608 |
p++;
|
609 |
}
|
610 |
|
611 |
/*
|
612 |
* Close the old output file, but only if the error file is
|
613 |
* not also using it.
|
614 |
*/
|
615 |
|
616 |
if (outputClose != 0) {
|
617 |
outputClose = 0;
|
618 |
if (errorFile == outputFile) {
|
619 |
errorClose = 1;
|
620 |
} else {
|
621 |
TclpCloseFile(outputFile);
|
622 |
}
|
623 |
}
|
624 |
if (outputRelease != 0) {
|
625 |
outputRelease = 0;
|
626 |
if (errorFile == outputFile) {
|
627 |
errorRelease = 1;
|
628 |
} else {
|
629 |
TclpReleaseFile(outputFile);
|
630 |
}
|
631 |
}
|
632 |
outputFile = FileForRedirect(interp, p, atOK, argv[i],
|
633 |
argv[i + 1], flags, &skip, &outputClose, &outputRelease);
|
634 |
if (outputFile == NULL) {
|
635 |
goto error;
|
636 |
}
|
637 |
if (errorToOutput) {
|
638 |
if (errorClose != 0) {
|
639 |
errorClose = 0;
|
640 |
TclpCloseFile(errorFile);
|
641 |
}
|
642 |
if (errorRelease != 0) {
|
643 |
errorRelease = 0;
|
644 |
TclpReleaseFile(errorFile);
|
645 |
}
|
646 |
errorFile = outputFile;
|
647 |
}
|
648 |
break;
|
649 |
|
650 |
case '2':
|
651 |
if (*p != '>') {
|
652 |
break;
|
653 |
}
|
654 |
p++;
|
655 |
atOK = 1;
|
656 |
flags = O_WRONLY | O_CREAT | O_TRUNC;
|
657 |
if (*p == '>') {
|
658 |
p++;
|
659 |
atOK = 0;
|
660 |
flags = O_WRONLY | O_CREAT;
|
661 |
}
|
662 |
if (errorClose != 0) {
|
663 |
errorClose = 0;
|
664 |
TclpCloseFile(errorFile);
|
665 |
}
|
666 |
if (errorRelease != 0) {
|
667 |
errorRelease = 0;
|
668 |
TclpReleaseFile(errorFile);
|
669 |
}
|
670 |
errorFile = FileForRedirect(interp, p, atOK, argv[i],
|
671 |
argv[i + 1], flags, &skip, &errorClose, &errorRelease);
|
672 |
if (errorFile == NULL) {
|
673 |
goto error;
|
674 |
}
|
675 |
break;
|
676 |
}
|
677 |
|
678 |
if (skip != 0) {
|
679 |
for (j = i + skip; j < argc; j++) {
|
680 |
argv[j - skip] = argv[j];
|
681 |
}
|
682 |
argc -= skip;
|
683 |
i -= 1;
|
684 |
}
|
685 |
}
|
686 |
|
687 |
if (inputFile == NULL) {
|
688 |
if (inputLiteral != NULL) {
|
689 |
/*
|
690 |
* The input for the first process is immediate data coming from
|
691 |
* Tcl. Create a temporary file for it and put the data into the
|
692 |
* file.
|
693 |
*/
|
694 |
inputFile = TclpCreateTempFile(inputLiteral);
|
695 |
if (inputFile == NULL) {
|
696 |
Tcl_AppendResult(interp,
|
697 |
"couldn't create input file for command: ",
|
698 |
Tcl_PosixError(interp), (char *) NULL);
|
699 |
goto error;
|
700 |
}
|
701 |
inputClose = 1;
|
702 |
} else if (inPipePtr != NULL) {
|
703 |
/*
|
704 |
* The input for the first process in the pipeline is to
|
705 |
* come from a pipe that can be written from by the caller.
|
706 |
*/
|
707 |
|
708 |
if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
|
709 |
Tcl_AppendResult(interp,
|
710 |
"couldn't create input pipe for command: ",
|
711 |
Tcl_PosixError(interp), (char *) NULL);
|
712 |
goto error;
|
713 |
}
|
714 |
inputClose = 1;
|
715 |
} else {
|
716 |
/*
|
717 |
* The input for the first process comes from stdin.
|
718 |
*/
|
719 |
|
720 |
channel = Tcl_GetStdChannel(TCL_STDIN);
|
721 |
if (channel != NULL) {
|
722 |
inputFile = TclpMakeFile(channel, TCL_READABLE);
|
723 |
if (inputFile != NULL) {
|
724 |
inputRelease = 1;
|
725 |
}
|
726 |
}
|
727 |
}
|
728 |
}
|
729 |
|
730 |
if (outputFile == NULL) {
|
731 |
if (outPipePtr != NULL) {
|
732 |
/*
|
733 |
* Output from the last process in the pipeline is to go to a
|
734 |
* pipe that can be read by the caller.
|
735 |
*/
|
736 |
|
737 |
if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
|
738 |
Tcl_AppendResult(interp,
|
739 |
"couldn't create output pipe for command: ",
|
740 |
Tcl_PosixError(interp), (char *) NULL);
|
741 |
goto error;
|
742 |
}
|
743 |
outputClose = 1;
|
744 |
} else {
|
745 |
/*
|
746 |
* The output for the last process goes to stdout.
|
747 |
*/
|
748 |
|
749 |
channel = Tcl_GetStdChannel(TCL_STDOUT);
|
750 |
if (channel) {
|
751 |
outputFile = TclpMakeFile(channel, TCL_WRITABLE);
|
752 |
if (outputFile != NULL) {
|
753 |
outputRelease = 1;
|
754 |
}
|
755 |
}
|
756 |
}
|
757 |
}
|
758 |
|
759 |
if (errorFile == NULL) {
|
760 |
if (errFilePtr != NULL) {
|
761 |
/*
|
762 |
* Set up the standard error output sink for the pipeline, if
|
763 |
* requested. Use a temporary file which is opened, then deleted.
|
764 |
* Could potentially just use pipe, but if it filled up it could
|
765 |
* cause the pipeline to deadlock: we'd be waiting for processes
|
766 |
* to complete before reading stderr, and processes couldn't
|
767 |
* complete because stderr was backed up.
|
768 |
*/
|
769 |
|
770 |
errorFile = TclpCreateTempFile(NULL);
|
771 |
if (errorFile == NULL) {
|
772 |
Tcl_AppendResult(interp,
|
773 |
"couldn't create error file for command: ",
|
774 |
Tcl_PosixError(interp), (char *) NULL);
|
775 |
goto error;
|
776 |
}
|
777 |
*errFilePtr = errorFile;
|
778 |
} else {
|
779 |
/*
|
780 |
* Errors from the pipeline go to stderr.
|
781 |
*/
|
782 |
|
783 |
channel = Tcl_GetStdChannel(TCL_STDERR);
|
784 |
if (channel) {
|
785 |
errorFile = TclpMakeFile(channel, TCL_WRITABLE);
|
786 |
if (errorFile != NULL) {
|
787 |
errorRelease = 1;
|
788 |
}
|
789 |
}
|
790 |
}
|
791 |
}
|
792 |
|
793 |
/*
|
794 |
* Scan through the argc array, creating a process for each
|
795 |
* group of arguments between the "|" characters.
|
796 |
*/
|
797 |
|
798 |
Tcl_ReapDetachedProcs();
|
799 |
pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
|
800 |
|
801 |
curInFile = inputFile;
|
802 |
|
803 |
for (i = 0; i < argc; i = lastArg + 1) {
|
804 |
int result, joinThisError;
|
805 |
Tcl_Pid pid;
|
806 |
char *oldName;
|
807 |
|
808 |
/*
|
809 |
* Convert the program name into native form.
|
810 |
*/
|
811 |
|
812 |
if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) {
|
813 |
goto error;
|
814 |
}
|
815 |
|
816 |
/*
|
817 |
* Find the end of the current segment of the pipeline.
|
818 |
*/
|
819 |
|
820 |
joinThisError = 0;
|
821 |
for (lastArg = i; lastArg < argc; lastArg++) {
|
822 |
if (argv[lastArg][0] == '|') {
|
823 |
if (argv[lastArg][1] == '\0') {
|
824 |
break;
|
825 |
}
|
826 |
if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
|
827 |
joinThisError = 1;
|
828 |
break;
|
829 |
}
|
830 |
}
|
831 |
}
|
832 |
argv[lastArg] = NULL;
|
833 |
|
834 |
/*
|
835 |
* If this is the last segment, use the specified outputFile.
|
836 |
* Otherwise create an intermediate pipe. pipeIn will become the
|
837 |
* curInFile for the next segment of the pipe.
|
838 |
*/
|
839 |
|
840 |
if (lastArg == argc) {
|
841 |
curOutFile = outputFile;
|
842 |
} else {
|
843 |
if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
|
844 |
Tcl_AppendResult(interp, "couldn't create pipe: ",
|
845 |
Tcl_PosixError(interp), (char *) NULL);
|
846 |
goto error;
|
847 |
}
|
848 |
}
|
849 |
|
850 |
if (joinThisError != 0) {
|
851 |
curErrFile = curOutFile;
|
852 |
} else {
|
853 |
curErrFile = errorFile;
|
854 |
}
|
855 |
|
856 |
/*
|
857 |
* Restore argv[i], since a caller wouldn't expect the contents of
|
858 |
* argv to be modified.
|
859 |
*/
|
860 |
|
861 |
oldName = argv[i];
|
862 |
argv[i] = Tcl_DStringValue(&execBuffer);
|
863 |
result = TclpCreateProcess(interp, lastArg - i, argv + i,
|
864 |
curInFile, curOutFile, curErrFile, &pid);
|
865 |
argv[i] = oldName;
|
866 |
if (result != TCL_OK) {
|
867 |
goto error;
|
868 |
}
|
869 |
Tcl_DStringFree(&execBuffer);
|
870 |
|
871 |
pidPtr[numPids] = pid;
|
872 |
numPids++;
|
873 |
|
874 |
/*
|
875 |
* Close off our copies of file descriptors that were set up for
|
876 |
* this child, then set up the input for the next child.
|
877 |
*/
|
878 |
|
879 |
if ((curInFile != NULL) && (curInFile != inputFile)) {
|
880 |
TclpCloseFile(curInFile);
|
881 |
}
|
882 |
curInFile = pipeIn;
|
883 |
pipeIn = NULL;
|
884 |
|
885 |
if ((curOutFile != NULL) && (curOutFile != outputFile)) {
|
886 |
TclpCloseFile(curOutFile);
|
887 |
}
|
888 |
curOutFile = NULL;
|
889 |
}
|
890 |
|
891 |
*pidArrayPtr = pidPtr;
|
892 |
|
893 |
/*
|
894 |
* All done. Cleanup open files lying around and then return.
|
895 |
*/
|
896 |
|
897 |
cleanup:
|
898 |
Tcl_DStringFree(&execBuffer);
|
899 |
|
900 |
if (inputClose) {
|
901 |
TclpCloseFile(inputFile);
|
902 |
} else if (inputRelease) {
|
903 |
TclpReleaseFile(inputFile);
|
904 |
}
|
905 |
if (outputClose) {
|
906 |
TclpCloseFile(outputFile);
|
907 |
} else if (outputRelease) {
|
908 |
TclpReleaseFile(outputFile);
|
909 |
}
|
910 |
if (errorClose) {
|
911 |
TclpCloseFile(errorFile);
|
912 |
} else if (errorRelease) {
|
913 |
TclpReleaseFile(errorFile);
|
914 |
}
|
915 |
return numPids;
|
916 |
|
917 |
/*
|
918 |
* An error occurred. There could have been extra files open, such
|
919 |
* as pipes between children. Clean them all up. Detach any child
|
920 |
* processes that have been created.
|
921 |
*/
|
922 |
|
923 |
error:
|
924 |
if (pipeIn != NULL) {
|
925 |
TclpCloseFile(pipeIn);
|
926 |
}
|
927 |
if ((curOutFile != NULL) && (curOutFile != outputFile)) {
|
928 |
TclpCloseFile(curOutFile);
|
929 |
}
|
930 |
if ((curInFile != NULL) && (curInFile != inputFile)) {
|
931 |
TclpCloseFile(curInFile);
|
932 |
}
|
933 |
if ((inPipePtr != NULL) && (*inPipePtr != NULL)) {
|
934 |
TclpCloseFile(*inPipePtr);
|
935 |
*inPipePtr = NULL;
|
936 |
}
|
937 |
if ((outPipePtr != NULL) && (*outPipePtr != NULL)) {
|
938 |
TclpCloseFile(*outPipePtr);
|
939 |
*outPipePtr = NULL;
|
940 |
}
|
941 |
if ((errFilePtr != NULL) && (*errFilePtr != NULL)) {
|
942 |
TclpCloseFile(*errFilePtr);
|
943 |
*errFilePtr = NULL;
|
944 |
}
|
945 |
if (pidPtr != NULL) {
|
946 |
for (i = 0; i < numPids; i++) {
|
947 |
if (pidPtr[i] != (Tcl_Pid) -1) {
|
948 |
Tcl_DetachPids(1, &pidPtr[i]);
|
949 |
}
|
950 |
}
|
951 |
ckfree((char *) pidPtr);
|
952 |
}
|
953 |
numPids = -1;
|
954 |
goto cleanup;
|
955 |
}
|
956 |
|
957 |
/*
|
958 |
*----------------------------------------------------------------------
|
959 |
*
|
960 |
* Tcl_OpenCommandChannel --
|
961 |
*
|
962 |
* Opens an I/O channel to one or more subprocesses specified
|
963 |
* by argc and argv. The flags argument determines the
|
964 |
* disposition of the stdio handles. If the TCL_STDIN flag is
|
965 |
* set then the standard input for the first subprocess will
|
966 |
* be tied to the channel: writing to the channel will provide
|
967 |
* input to the subprocess. If TCL_STDIN is not set, then
|
968 |
* standard input for the first subprocess will be the same as
|
969 |
* this application's standard input. If TCL_STDOUT is set then
|
970 |
* standard output from the last subprocess can be read from the
|
971 |
* channel; otherwise it goes to this application's standard
|
972 |
* output. If TCL_STDERR is set, standard error output for all
|
973 |
* subprocesses is returned to the channel and results in an error
|
974 |
* when the channel is closed; otherwise it goes to this
|
975 |
* application's standard error. If TCL_ENFORCE_MODE is not set,
|
976 |
* then argc and argv can redirect the stdio handles to override
|
977 |
* TCL_STDIN, TCL_STDOUT, and TCL_STDERR; if it is set, then it
|
978 |
* is an error for argc and argv to override stdio channels for
|
979 |
* which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
|
980 |
*
|
981 |
* Results:
|
982 |
* A new command channel, or NULL on failure with an error
|
983 |
* message left in interp.
|
984 |
*
|
985 |
* Side effects:
|
986 |
* Creates processes, opens pipes.
|
987 |
*
|
988 |
*----------------------------------------------------------------------
|
989 |
*/
|
990 |
|
991 |
Tcl_Channel
|
992 |
Tcl_OpenCommandChannel(interp, argc, argv, flags)
|
993 |
Tcl_Interp *interp; /* Interpreter for error reporting. Can
|
994 |
* NOT be NULL. */
|
995 |
int argc; /* How many arguments. */
|
996 |
char **argv; /* Array of arguments for command pipe. */
|
997 |
int flags; /* Or'ed combination of TCL_STDIN, TCL_STDOUT,
|
998 |
* TCL_STDERR, and TCL_ENFORCE_MODE. */
|
999 |
{
|
1000 |
TclFile *inPipePtr, *outPipePtr, *errFilePtr;
|
1001 |
TclFile inPipe, outPipe, errFile;
|
1002 |
int numPids;
|
1003 |
Tcl_Pid *pidPtr;
|
1004 |
Tcl_Channel channel;
|
1005 |
|
1006 |
inPipe = outPipe = errFile = NULL;
|
1007 |
|
1008 |
inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
|
1009 |
outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
|
1010 |
errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
|
1011 |
|
1012 |
numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
|
1013 |
outPipePtr, errFilePtr);
|
1014 |
|
1015 |
if (numPids < 0) {
|
1016 |
goto error;
|
1017 |
}
|
1018 |
|
1019 |
/*
|
1020 |
* Verify that the pipes that were created satisfy the
|
1021 |
* readable/writable constraints.
|
1022 |
*/
|
1023 |
|
1024 |
if (flags & TCL_ENFORCE_MODE) {
|
1025 |
if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
|
1026 |
Tcl_AppendResult(interp, "can't read output from command:",
|
1027 |
" standard output was redirected", (char *) NULL);
|
1028 |
goto error;
|
1029 |
}
|
1030 |
if ((flags & TCL_STDIN) && (inPipe == NULL)) {
|
1031 |
Tcl_AppendResult(interp, "can't write input to command:",
|
1032 |
" standard input was redirected", (char *) NULL);
|
1033 |
goto error;
|
1034 |
}
|
1035 |
}
|
1036 |
|
1037 |
channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
|
1038 |
numPids, pidPtr);
|
1039 |
|
1040 |
if (channel == (Tcl_Channel) NULL) {
|
1041 |
Tcl_AppendResult(interp, "pipe for command could not be created",
|
1042 |
(char *) NULL);
|
1043 |
goto error;
|
1044 |
}
|
1045 |
return channel;
|
1046 |
|
1047 |
error:
|
1048 |
if (numPids > 0) {
|
1049 |
Tcl_DetachPids(numPids, pidPtr);
|
1050 |
ckfree((char *) pidPtr);
|
1051 |
}
|
1052 |
if (inPipe != NULL) {
|
1053 |
TclpCloseFile(inPipe);
|
1054 |
}
|
1055 |
if (outPipe != NULL) {
|
1056 |
TclpCloseFile(outPipe);
|
1057 |
}
|
1058 |
if (errFile != NULL) {
|
1059 |
TclpCloseFile(errFile);
|
1060 |
}
|
1061 |
return NULL;
|
1062 |
}
|
1063 |
|
1064 |
/* End of tclpipe.c */
|