/[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 25 - (hide annotations) (download)
Sat Oct 8 06:43:03 2016 UTC (7 years, 5 months 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 dashley 25 /* $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