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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 66 - (hide annotations) (download)
Sun Oct 30 21:57:38 2016 UTC (7 years, 4 months ago) by dashley
File MIME type: text/plain
File size: 31615 byte(s)
Header and footer cleanup.
1 dashley 66 /* $Header$ */
2 dashley 25 /*
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 dashley 64 /* End of tclpipe.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25