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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25