/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclpipe.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclpipe.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 66 - (show annotations) (download)
Sun Oct 30 21:57:38 2016 UTC (7 years, 6 months ago) by dashley
File MIME type: text/plain
File size: 31615 byte(s)
Header and footer cleanup.
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 */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25