![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tclunxut.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tcl|
Return to tclunxut.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tcl |
1.1 root 1: /*
2: * tclUnixUtil.c --
3: *
4: * This file contains a collection of utility procedures that
5: * are present in the Tcl's UNIX core but not in the generic
6: * core. For example, they do file manipulation and process
7: * manipulation.
8: *
9: * The Tcl_Fork and Tcl_WaitPids procedures are based on code
10: * contributed by Karl Lehenbauer, Mark Diekhans and Peter
11: * da Silva.
12: *
13: * Copyright 1991 Regents of the University of California
14: * Permission to use, copy, modify, and distribute this
15: * software and its documentation for any purpose and without
16: * fee is hereby granted, provided that this copyright
17: * notice appears in all copies. The University of California
18: * makes no representations about the suitability of this
19: * software for any purpose. It is provided "as is" without
20: * express or implied warranty.
21: */
22:
23: #ifndef lint
24: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.18 91/11/21 14:53:46 ouster Exp $ SPRITE (Berkeley)";
25: #endif /* not lint */
26:
27: #include "tclint.h"
28: #include "tclunix.h"
29:
30: /*
31: * Data structures of the following type are used by Tcl_Fork and
32: * Tcl_WaitPids to keep track of child processes.
33: */
34:
35: typedef struct {
36: int pid; /* Process id of child. */
37: WAIT_STATUS_TYPE status; /* Status returned when child exited or
38: * suspended. */
39: int flags; /* Various flag bits; see below for
40: * definitions. */
41: } WaitInfo;
42:
43: /*
44: * Flag bits in WaitInfo structures:
45: *
46: * WI_READY - Non-zero means process has exited or
47: * suspended since it was forked or last
48: * returned by Tcl_WaitPids.
49: * WI_DETACHED - Non-zero means no-one cares about the
50: * process anymore. Ignore it until it
51: * exits, then forget about it.
52: */
53:
54: #define WI_READY 1
55: #define WI_DETACHED 2
56:
57: static WaitInfo *waitTable = NULL;
58: static int waitTableSize = 0; /* Total number of entries available in
59: * waitTable. */
60: static int waitTableUsed = 0; /* Number of entries in waitTable that
61: * are actually in use right now. Active
62: * entries are always at the beginning
63: * of the table. */
64: #define WAIT_TABLE_GROW_BY 4
65:
66: /*
67: *----------------------------------------------------------------------
68: *
69: * Tcl_EvalFile --
70: *
71: * Read in a file and process the entire file as one gigantic
72: * Tcl command.
73: *
74: * Results:
75: * A standard Tcl result, which is either the result of executing
76: * the file or an error indicating why the file couldn't be read.
77: *
78: * Side effects:
79: * Depends on the commands in the file.
80: *
81: *----------------------------------------------------------------------
82: */
83:
84: int
85: Tcl_EvalFile(interp, fileName)
86: Tcl_Interp *interp; /* Interpreter in which to process file. */
87: char *fileName; /* Name of file to process. Tilde-substitution
88: * will be performed on this name. */
89: {
90: int fileId, result;
91: struct stat statBuf;
92: char *cmdBuffer, *end, *oldScriptFile;
93: Interp *iPtr = (Interp *) interp;
94:
95: oldScriptFile = iPtr->scriptFile;
96: iPtr->scriptFile = fileName;
97: fileName = Tcl_TildeSubst(interp, fileName);
98: if (fileName == NULL) {
99: goto error;
100: }
101: #ifdef MSDOS
102: filename2DOS(fileName);
103: #endif
104: fileId = open(fileName, O_RDONLY, 0);
105:
106: if (fileId < 0) {
107: Tcl_AppendResult(interp, "couldn't read file \"", fileName,
108: "\": ", Tcl_UnixError(interp), (char *) NULL);
109: goto error;
110: }
111: if (fstat(fileId, &statBuf) == -1) {
112: Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
113: "\": ", Tcl_UnixError(interp), (char *) NULL);
114: close(fileId);
115: goto error;
116: }
117: cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
118: #ifdef MSDOS
119: if (read(fileId, cmdBuffer, (int) statBuf.st_size) < 0) {
120: #else
121: if (read(fileId, cmdBuffer, (int) statBuf.st_size) != statBuf.st_size) {
122: #endif
123: Tcl_AppendResult(interp, "error in reading file \"", fileName,
124: "\": ", Tcl_UnixError(interp), (char *) NULL);
125: close(fileId);
126: goto error;
127: }
128: if (close(fileId) != 0) {
129: Tcl_AppendResult(interp, "error closing file \"", fileName,
130: "\": ", Tcl_UnixError(interp), (char *) NULL);
131: goto error;
132: }
133: cmdBuffer[statBuf.st_size] = 0;
134: result = Tcl_Eval(interp, cmdBuffer, 0, &end);
135: if (result == TCL_RETURN) {
136: result = TCL_OK;
137: }
138: if (result == TCL_ERROR) {
139: char msg[200];
140:
141: /*
142: * Record information telling where the error occurred.
143: */
144:
145: sprintf(msg, "\n (file \"%.150s\" line %d)", fileName,
146: interp->errorLine);
147: Tcl_AddErrorInfo(interp, msg);
148: }
149: ckfree(cmdBuffer);
150: iPtr->scriptFile = oldScriptFile;
151: return result;
152:
153: error:
154: iPtr->scriptFile = oldScriptFile;
155: return TCL_ERROR;
156: }
157:
158: /*
159: *----------------------------------------------------------------------
160: *
161: * Tcl_Fork --
162: *
163: * Create a new process using the vfork system call, and keep
164: * track of it for "safe" waiting with Tcl_WaitPids.
165: *
166: * Results:
167: * The return value is the value returned by the vfork system
168: * call (0 means child, > 0 means parent (value is child id),
169: * < 0 means error).
170: *
171: * Side effects:
172: * A new process is created, and an entry is added to an internal
173: * table of child processes if the process is created successfully.
174: *
175: *----------------------------------------------------------------------
176: */
177:
178: int
179: Tcl_Fork()
180: {
181: WaitInfo *waitPtr;
182: pid_t pid;
183:
184: /*
185: * Disable SIGPIPE signals: if they were allowed, this process
186: * might go away unexpectedly if children misbehave. This code
187: * can potentially interfere with other application code that
188: * expects to handle SIGPIPEs; what's really needed is an
189: * arbiter for signals to allow them to be "shared".
190: */
191:
192: if (waitTable == NULL) {
193: (void) signal(SIGPIPE, SIG_IGN);
194: }
195:
196: /*
197: * Enlarge the wait table if there isn't enough space for a new
198: * entry.
199: */
200:
201: if (waitTableUsed == waitTableSize) {
202: int newSize;
203: WaitInfo *newWaitTable;
204:
205: newSize = waitTableSize + WAIT_TABLE_GROW_BY;
206: newWaitTable = (WaitInfo *) ckalloc((unsigned)
207: (newSize * sizeof(WaitInfo)));
208: memcpy((VOID *) newWaitTable, (VOID *) waitTable,
209: (waitTableSize * sizeof(WaitInfo)));
210: if (waitTable != NULL) {
211: ckfree((char *) waitTable);
212: }
213: waitTable = newWaitTable;
214: waitTableSize = newSize;
215: }
216:
217: /*
218: * Make a new process and enter it into the table if the fork
219: * is successful.
220: */
221:
222: waitPtr = &waitTable[waitTableUsed];
223: pid = fork();
224: if (pid > 0) {
225: waitPtr->pid = pid;
226: waitPtr->flags = 0;
227: waitTableUsed++;
228: }
229: return pid;
230: }
231:
232: /*
233: *----------------------------------------------------------------------
234: *
235: * Tcl_WaitPids --
236: *
237: * This procedure is used to wait for one or more processes created
238: * by Tcl_Fork to exit or suspend. It records information about
239: * all processes that exit or suspend, even those not waited for,
240: * so that later waits for them will be able to get the status
241: * information.
242: *
243: * Results:
244: * -1 is returned if there is an error in the wait kernel call.
245: * Otherwise the pid of an exited/suspended process from *pidPtr
246: * is returned and *statusPtr is set to the status value returned
247: * by the wait kernel call.
248: *
249: * Side effects:
250: * Doesn't return until one of the pids at *pidPtr exits or suspends.
251: *
252: *----------------------------------------------------------------------
253: */
254:
255: int
256: Tcl_WaitPids(numPids, pidPtr, statusPtr)
257: int numPids; /* Number of pids to wait on: gives size
258: * of array pointed to by pidPtr. */
259: int *pidPtr; /* Pids to wait on: return when one of
260: * these processes exits or suspends. */
261: int *statusPtr; /* Wait status is returned here. */
262: {
263: int i, count, pid;
264: register WaitInfo *waitPtr;
265: int anyProcesses;
266: WAIT_STATUS_TYPE status;
267:
268: while (1) {
269: /*
270: * Scan the table of child processes to see if one of the
271: * specified children has already exited or suspended. If so,
272: * remove it from the table and return its status.
273: */
274:
275: anyProcesses = 0;
276: for (waitPtr = waitTable, count = waitTableUsed;
277: count > 0; waitPtr++, count--) {
278: for (i = 0; i < numPids; i++) {
279: if (pidPtr[i] != waitPtr->pid) {
280: continue;
281: }
282: anyProcesses = 1;
283: if (waitPtr->flags & WI_READY) {
284: *statusPtr = *((int *) &waitPtr->status);
285: pid = waitPtr->pid;
286: if (WIFEXITED(waitPtr->status)
287: || WIFSIGNALED(waitPtr->status)) {
288: *waitPtr = waitTable[waitTableUsed-1];
289: waitTableUsed--;
290: } else {
291: waitPtr->flags &= ~WI_READY;
292: }
293: return pid;
294: }
295: }
296: }
297:
298: /*
299: * Make sure that the caller at least specified one valid
300: * process to wait for.
301: */
302:
303: if (!anyProcesses) {
304: errno = ECHILD;
305: return -1;
306: }
307:
308: /*
309: * Wait for a process to exit or suspend, then update its
310: * entry in the table and go back to the beginning of the
311: * loop to see if it's one of the desired processes.
312: */
313:
314: pid = wait(&status);
315: if (pid < 0) {
316: return pid;
317: }
318: for (waitPtr = waitTable, count = waitTableUsed; ;
319: waitPtr++, count--) {
320: if (count == 0) {
321: break; /* Ignore unknown processes. */
322: }
323: if (pid != waitPtr->pid) {
324: continue;
325: }
326:
327: /*
328: * If the process has been detached, then ignore anything
329: * other than an exit, and drop the entry on exit.
330: */
331:
332: if (waitPtr->flags & WI_DETACHED) {
333: if (WIFEXITED(status) || WIFSIGNALED(status)) {
334: *waitPtr = waitTable[waitTableUsed-1];
335: waitTableUsed--;
336: }
337: } else {
338: waitPtr->status = status;
339: waitPtr->flags |= WI_READY;
340: }
341: break;
342: }
343: }
344: }
345:
346: /*
347: *----------------------------------------------------------------------
348: *
349: * Tcl_DetachPids --
350: *
351: * This procedure is called to indicate that one or more child
352: * processes have been placed in background and are no longer
353: * cared about. They should be ignored in future calls to
354: * Tcl_WaitPids.
355: *
356: * Results:
357: * None.
358: *
359: * Side effects:
360: * None.
361: *
362: *----------------------------------------------------------------------
363: */
364:
365: void
366: Tcl_DetachPids(numPids, pidPtr)
367: int numPids; /* Number of pids to detach: gives size
368: * of array pointed to by pidPtr. */
369: int *pidPtr; /* Array of pids to detach: must have
370: * been created by Tcl_Fork. */
371: {
372: register WaitInfo *waitPtr;
373: int i, count, pid;
374:
375: for (i = 0; i < numPids; i++) {
376: pid = pidPtr[i];
377: for (waitPtr = waitTable, count = waitTableUsed;
378: count > 0; waitPtr++, count--) {
379: if (pid != waitPtr->pid) {
380: continue;
381: }
382:
383: /*
384: * If the process has already exited then destroy its
385: * table entry now.
386: */
387:
388: if ((waitPtr->flags & WI_READY) && (WIFEXITED(waitPtr->status)
389: || WIFSIGNALED(waitPtr->status))) {
390: *waitPtr = waitTable[waitTableUsed-1];
391: waitTableUsed--;
392: } else {
393: waitPtr->flags |= WI_DETACHED;
394: }
395: goto nextPid;
396: }
397: panic("Tcl_Detach couldn't find process");
398:
399: nextPid:
400: continue;
401: }
402: }
403:
404: /*
405: *----------------------------------------------------------------------
406: *
407: * Tcl_CreatePipeline --
408: *
409: * Given an argc/argv array, instantiate a pipeline of processes
410: * as described by the argv.
411: *
412: * Results:
413: * The return value is a count of the number of new processes
414: * created, or -1 if an error occurred while creating the pipeline.
415: * *pidArrayPtr is filled in with the address of a dynamically
416: * allocated array giving the ids of all of the processes. It
417: * is up to the caller to free this array when it isn't needed
418: * anymore. If inPipePtr is non-NULL, *inPipePtr is filled in
419: * with the file id for the input pipe for the pipeline (if any):
420: * the caller must eventually close this file. If outPipePtr
421: * isn't NULL, then *outPipePtr is filled in with the file id
422: * for the output pipe from the pipeline: the caller must close
423: * this file. If errFilePtr isn't NULL, then *errFilePtr is filled
424: * with a file id that may be used to read error output after the
425: * pipeline completes.
426: *
427: * Side effects:
428: * Processes and pipes are created.
429: *
430: *----------------------------------------------------------------------
431: */
432:
433: int
434: Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
435: outPipePtr, errFilePtr)
436: Tcl_Interp *interp; /* Interpreter to use for error reporting. */
437: int argc; /* Number of entries in argv. */
438: char **argv; /* Array of strings describing commands in
439: * pipeline plus I/O redirection with <,
440: * <<, and >. Argv[argc] must be NULL. */
441: int **pidArrayPtr; /* Word at *pidArrayPtr gets filled in with
442: * address of array of pids for processes
443: * in pipeline (first pid is first process
444: * in pipeline). */
445: int *inPipePtr; /* If non-NULL, input to the pipeline comes
446: * from a pipe (unless overridden by
447: * redirection in the command). The file
448: * id with which to write to this pipe is
449: * stored at *inPipePtr. -1 means command
450: * specified its own input source. */
451: int *outPipePtr; /* If non-NULL, output to the pipeline goes
452: * to a pipe, unless overriden by redirection
453: * in the command. The file id with which to
454: * read frome this pipe is stored at
455: * *outPipePtr. -1 means command specified
456: * its own output sink. */
457: int *errFilePtr; /* If non-NULL, all stderr output from the
458: * pipeline will go to a temporary file
459: * created here, and a descriptor to read
460: * the file will be left at *errFilePtr.
461: * The file will be removed already, so
462: * closing this descriptor will be the end
463: * of the file. If this is NULL, then
464: * all stderr output goes to our stderr. */
465: {
466: int *pidPtr = NULL; /* Points to malloc-ed array holding all
467: * the pids of child processes. */
468: int numPids = 0; /* Actual number of processes that exist
469: * at *pidPtr right now. */
470: int cmdCount; /* Count of number of distinct commands
471: * found in argc/argv. */
472: char *input = NULL; /* Describes input for pipeline, depending
473: * on "inputFile". NULL means take input
474: * from stdin/pipe. */
475: int inputFile = 0; /* Non-zero means input is name of input
476: * file. Zero means input holds actual
477: * text to be input to command. */
478: char *output = NULL; /* Holds name of output file to pipe to,
479: * or NULL if output goes to stdout/pipe. */
480: int inputId = -1; /* Readable file id input to current command in
481: * pipeline (could be file or pipe). -1
482: * means use stdin. */
483: int outputId = -1; /* Writable file id for output from current
484: * command in pipeline (could be file or pipe).
485: * -1 means use stdout. */
486: int errorId = -1; /* Writable file id for all standard error
487: * output from all commands in pipeline. -1
488: * means use stderr. */
489: int lastOutputId = -1; /* Write file id for output from last command
490: * in pipeline (could be file or pipe).
491: * -1 means use stdout. */
492: int pipeIds[2]; /* File ids for pipe that's being created. */
493: int firstArg, lastArg; /* Indexes of first and last arguments in
494: * current command. */
495: int lastBar;
496: char *execName;
497: int i, j, pid;
498:
499: if (inPipePtr != NULL) {
500: *inPipePtr = -1;
501: }
502: if (outPipePtr != NULL) {
503: *outPipePtr = -1;
504: }
505: if (errFilePtr != NULL) {
506: *errFilePtr = -1;
507: }
508: pipeIds[0] = pipeIds[1] = -1;
509:
510: /*
511: * First, scan through all the arguments to figure out the structure
512: * of the pipeline. Count the number of distinct processes (it's the
513: * number of "|" arguments). If there are "<", "<<", or ">" arguments
514: * then make note of input and output redirection and remove these
515: * arguments and the arguments that follow them.
516: */
517:
518: cmdCount = 1;
519: lastBar = -1;
520: for (i = 0; i < argc; i++) {
521: if ((argv[i][0] == '|') && ((argv[i][1] == 0))) {
522: if ((i == (lastBar+1)) || (i == (argc-1))) {
523: interp->result = "illegal use of | in command";
524: return -1;
525: }
526: lastBar = i;
527: cmdCount++;
528: continue;
529: } else if (argv[i][0] == '<') {
530: if (argv[i][1] == 0) {
531: input = argv[i+1];
532: inputFile = 1;
533: } else if ((argv[i][1] == '<') && (argv[i][2] == 0)) {
534: input = argv[i+1];
535: inputFile = 0;
536: } else {
537: continue;
538: }
539: } else if ((argv[i][0] == '>') && (argv[i][1] == 0)) {
540: output = argv[i+1];
541: } else {
542: continue;
543: }
544: if (i >= (argc-1)) {
545: Tcl_AppendResult(interp, "can't specify \"", argv[i],
546: "\" as last word in command", (char *) NULL);
547: return -1;
548: }
549: for (j = i+2; j < argc; j++) {
550: argv[j-2] = argv[j];
551: }
552: argc -= 2;
553: i--; /* Process new arg from same position. */
554: }
555: if (argc == 0) {
556: interp->result = "didn't specify command to execute";
557: return -1;
558: }
559:
560: /*
561: * Set up the redirected input source for the pipeline, if
562: * so requested.
563: */
564:
565: if (input != NULL) {
566: if (!inputFile) {
567: /*
568: * Immediate data in command. Create temporary file and
569: * put data into file.
570: */
571:
572: #ifdef MSDOS
573: # define TMP_STDIN_NAME "tcl.in"
574: #else
575: # define TMP_STDIN_NAME "/tmp/tcl.in.XXXXXX"
576: #endif
577: char inName[sizeof(TMP_STDIN_NAME) + 1];
578: int length;
579:
580: strcpy(inName, TMP_STDIN_NAME);
581: mkstemp(inName);
582: inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
583: if (inputId < 0) {
584: Tcl_AppendResult(interp,
585: "couldn't create input file for command: ",
586: Tcl_UnixError(interp), (char *) NULL);
587: goto error;
588: }
589: length = strlen(input);
590: #ifdef MSDOS
591: if (write(inputId, input, length) < 0) {
592: #else
593: if (write(inputId, input, length) != length) {
594: #endif
595: Tcl_AppendResult(interp,
596: "couldn't write file input for command: ",
597: Tcl_UnixError(interp), (char *) NULL);
598: goto error;
599: }
600: if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
601: Tcl_AppendResult(interp,
602: "couldn't reset or remove input file for command: ",
603: Tcl_UnixError(interp), (char *) NULL);
604: goto error;
605: }
606: } else {
607: /*
608: * File redirection. Just open the file.
609: */
610:
611: inputId = open(input, O_RDONLY, 0);
612: if (inputId < 0) {
613: Tcl_AppendResult(interp,
614: "couldn't read file \"", input, "\": ",
615: Tcl_UnixError(interp), (char *) NULL);
616: goto error;
617: }
618: }
619: } else if (inPipePtr != NULL) {
620: if (pipe(pipeIds) != 0) {
621: Tcl_AppendResult(interp,
622: "couldn't create input pipe for command: ",
623: Tcl_UnixError(interp), (char *) NULL);
624: goto error;
625: }
626: inputId = pipeIds[0];
627: *inPipePtr = pipeIds[1];
628: pipeIds[0] = pipeIds[1] = -1;
629: }
630:
631: /*
632: * Set up the redirected output sink for the pipeline from one
633: * of two places, if requested.
634: */
635:
636: if (output != NULL) {
637: /*
638: * Output is to go to a file.
639: */
640:
641: lastOutputId = open(output, O_WRONLY|O_CREAT|O_TRUNC, 0666);
642: if (lastOutputId < 0) {
643: Tcl_AppendResult(interp,
644: "couldn't write file \"", output, "\": ",
645: Tcl_UnixError(interp), (char *) NULL);
646: goto error;
647: }
648: } else if (outPipePtr != NULL) {
649: /*
650: * Output is to go to a pipe.
651: */
652:
653: if (pipe(pipeIds) != 0) {
654: Tcl_AppendResult(interp,
655: "couldn't create output pipe: ",
656: Tcl_UnixError(interp), (char *) NULL);
657: goto error;
658: }
659: lastOutputId = pipeIds[1];
660: *outPipePtr = pipeIds[0];
661: pipeIds[0] = pipeIds[1] = -1;
662: }
663:
664: /*
665: * Set up the standard error output sink for the pipeline, if
666: * requested. Use a temporary file which is opened, then deleted.
667: * Could potentially just use pipe, but if it filled up it could
668: * cause the pipeline to deadlock: we'd be waiting for processes
669: * to complete before reading stderr, and processes couldn't complete
670: * because stderr was backed up.
671: */
672:
673: if (errFilePtr != NULL) {
674: # define TMP_STDERR_NAME "/tmp/tcl.err.XXXXXX"
675: char errName[sizeof(TMP_STDERR_NAME) + 1];
676:
677: strcpy(errName, TMP_STDERR_NAME);
678: mkstemp(errName);
679: errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
680: if (errorId < 0) {
681: errFileError:
682: Tcl_AppendResult(interp,
683: "couldn't create error file for command: ",
684: Tcl_UnixError(interp), (char *) NULL);
685: goto error;
686: }
687: *errFilePtr = open(errName, O_RDONLY, 0);
688: if (*errFilePtr < 0) {
689: goto errFileError;
690: }
691: if (unlink(errName) == -1) {
692: Tcl_AppendResult(interp,
693: "couldn't remove error file for command: ",
694: Tcl_UnixError(interp), (char *) NULL);
695: goto error;
696: }
697: }
698:
699: /*
700: * Scan through the argc array, forking off a process for each
701: * group of arguments between "|" arguments.
702: */
703:
704: pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
705: for (i = 0; i < numPids; i++) {
706: pidPtr[i] = -1;
707: }
708: for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
709: for (lastArg = firstArg; lastArg < argc; lastArg++) {
710: if ((argv[lastArg][0] == '|') && (argv[lastArg][1] == 0)) {
711: break;
712: }
713: }
714: argv[lastArg] = NULL;
715: if (lastArg == argc) {
716: outputId = lastOutputId;
717: } else {
718: if (pipe(pipeIds) != 0) {
719: Tcl_AppendResult(interp, "couldn't create pipe: ",
720: Tcl_UnixError(interp), (char *) NULL);
721: goto error;
722: }
723: outputId = pipeIds[1];
724: }
725: execName = Tcl_TildeSubst(interp, argv[firstArg]);
726: pid = Tcl_Fork();
727: if (pid == -1) {
728: Tcl_AppendResult(interp, "couldn't fork child process: ",
729: Tcl_UnixError(interp), (char *) NULL);
730: goto error;
731: }
732: if (pid == 0) {
733: char errSpace[200];
734:
735: if (((inputId != -1) && (dup2(inputId, 0) == -1))
736: || ((outputId != -1) && (dup2(outputId, 1) == -1))
737: || ((errorId != -1) && (dup2(errorId, 2) == -1))) {
738: char *err;
739: err = "forked process couldn't set up input/output\n";
740: write(errorId < 0 ? 2 : errorId, err, strlen(err));
741: _exit(1);
742: }
743: for (i = 3; (i <= outputId) || (i <= inputId) || (i <= errorId);
744: i++) {
745: close(i);
746: }
747: execvp(execName, &argv[firstArg]);
748: sprintf(errSpace, "couldn't find \"%.150s\" to execute\n",
749: argv[firstArg]);
750: write(2, errSpace, strlen(errSpace));
751: _exit(1);
752: } else {
753: pidPtr[numPids] = pid;
754: }
755:
756: /*
757: * Close off our copies of file descriptors that were set up for
758: * this child, then set up the input for the next child.
759: */
760:
761: if (inputId != -1) {
762: close(inputId);
763: }
764: if (outputId != -1) {
765: close(outputId);
766: }
767: inputId = pipeIds[0];
768: pipeIds[0] = pipeIds[1] = -1;
769: }
770: *pidArrayPtr = pidPtr;
771:
772: /*
773: * All done. Cleanup open files lying around and then return.
774: */
775:
776: cleanup:
777: if (inputId != -1) {
778: close(inputId);
779: }
780: if (lastOutputId != -1) {
781: close(lastOutputId);
782: }
783: if (errorId != -1) {
784: close(errorId);
785: }
786: return numPids;
787:
788: /*
789: * An error occurred. There could have been extra files open, such
790: * as pipes between children. Clean them all up. Detach any child
791: * processes that have been created.
792: */
793:
794: error:
795: if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
796: close(*inPipePtr);
797: *inPipePtr = -1;
798: }
799: if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
800: close(*outPipePtr);
801: *outPipePtr = -1;
802: }
803: if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
804: close(*errFilePtr);
805: *errFilePtr = -1;
806: }
807: if (pipeIds[0] != -1) {
808: close(pipeIds[0]);
809: }
810: if (pipeIds[1] != -1) {
811: close(pipeIds[1]);
812: }
813: if (pidPtr != NULL) {
814: for (i = 0; i < numPids; i++) {
815: if (pidPtr[i] != -1) {
816: Tcl_DetachPids(1, &pidPtr[i]);
817: }
818: }
819: ckfree((char *) pidPtr);
820: }
821: numPids = -1;
822: goto cleanup;
823: }
824:
825: /*
826: *----------------------------------------------------------------------
827: *
828: * Tcl_UnixError --
829: *
830: * This procedure is typically called after UNIX kernel calls
831: * return errors. It stores machine-readable information about
832: * the error in $errorCode returns an information string for
833: * the caller's use.
834: *
835: * Results:
836: * The return value is a human-readable string describing the
837: * error, as returned by strerror.
838: *
839: * Side effects:
840: * The global variable $errorCode is reset.
841: *
842: *----------------------------------------------------------------------
843: */
844:
845: char *
846: Tcl_UnixError(interp)
847: Tcl_Interp *interp; /* Interpreter whose $errorCode variable
848: * is to be changed. */
849: {
850: char *id, *msg;
851:
852: id = Tcl_ErrnoId();
853: msg = strerror(errno);
854: Tcl_SetErrorCode(interp, "UNIX", id, msg, (char *) NULL);
855: return msg;
856: }
857:
858: /*
859: *----------------------------------------------------------------------
860: *
861: * TclMakeFileTable --
862: *
863: * Create or enlarge the file table for the interpreter, so that
864: * there is room for a given index.
865: *
866: * Results:
867: * None.
868: *
869: * Side effects:
870: * The file table for iPtr will be created if it doesn't exist
871: * (and entries will be added for stdin, stdout, and stderr).
872: * If it already exists, then it will be grown if necessary.
873: *
874: *----------------------------------------------------------------------
875: */
876:
877: void
878: TclMakeFileTable(iPtr, index)
879: Interp *iPtr; /* Interpreter whose table of files is
880: * to be manipulated. */
881: int index; /* Make sure table is large enough to
882: * hold at least this index. */
883: {
884: /*
885: * If the table doesn't even exist, then create it and initialize
886: * entries for standard files.
887: */
888:
889: if (iPtr->numFiles == 0) {
890: OpenFile *filePtr;
891: int i;
892:
893: if (index < 2) {
894: iPtr->numFiles = 3;
895: } else {
896: iPtr->numFiles = index+1;
897: }
898: iPtr->filePtrArray = (OpenFile **) ckalloc((unsigned)
899: ((iPtr->numFiles)*sizeof(OpenFile *)));
900: for (i = iPtr->numFiles-1; i >= 0; i--) {
901: iPtr->filePtrArray[i] = NULL;
902: }
903:
904: filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
905: filePtr->f = stdin;
906: filePtr->f2 = NULL;
907: filePtr->readable = 1;
908: filePtr->writable = 0;
909: filePtr->numPids = 0;
910: filePtr->pidPtr = NULL;
911: filePtr->errorId = -1;
912: iPtr->filePtrArray[0] = filePtr;
913:
914: filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
915: filePtr->f = stdout;
916: filePtr->f2 = NULL;
917: filePtr->readable = 0;
918: filePtr->writable = 1;
919: filePtr->numPids = 0;
920: filePtr->pidPtr = NULL;
921: filePtr->errorId = -1;
922: iPtr->filePtrArray[1] = filePtr;
923:
924: filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
925: filePtr->f = stderr;
926: filePtr->f2 = NULL;
927: filePtr->readable = 0;
928: filePtr->writable = 1;
929: filePtr->numPids = 0;
930: filePtr->pidPtr = NULL;
931: filePtr->errorId = -1;
932: iPtr->filePtrArray[2] = filePtr;
933: } else if (index >= iPtr->numFiles) {
934: int newSize;
935: OpenFile **newPtrArray;
936: int i;
937:
938: newSize = index+1;
939: newPtrArray = (OpenFile **) ckalloc((unsigned)
940: ((newSize)*sizeof(OpenFile *)));
941: memcpy((VOID *) newPtrArray, (VOID *) iPtr->filePtrArray,
942: iPtr->numFiles*sizeof(OpenFile *));
943: for (i = iPtr->numFiles; i < newSize; i++) {
944: newPtrArray[i] = NULL;
945: }
946: ckfree((char *) iPtr->filePtrArray);
947: iPtr->numFiles = newSize;
948: iPtr->filePtrArray = newPtrArray;
949: }
950: }
951:
952: /*
953: *----------------------------------------------------------------------
954: *
955: * TclGetOpenFile --
956: *
957: * Given a string identifier for an open file, find the corresponding
958: * open file structure, if there is one.
959: *
960: * Results:
961: * A standard Tcl return value. If the open file is successfully
962: * located, *filePtrPtr is modified to point to its structure.
963: * If TCL_ERROR is returned then interp->result contains an error
964: * message.
965: *
966: * Side effects:
967: * None.
968: *
969: *----------------------------------------------------------------------
970: */
971:
972: int
973: TclGetOpenFile(interp, string, filePtrPtr)
974: Tcl_Interp *interp; /* Interpreter in which to find file. */
975: char *string; /* String that identifies file. */
976: OpenFile **filePtrPtr; /* Address of word in which to store pointer
977: * to structure about open file. */
978: {
979: int fd = 0; /* Initial value needed only to stop compiler
980: * warnings. */
981: Interp *iPtr = (Interp *) interp;
982:
983: if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
984: & (string[3] == 'e')) {
985: char *end;
986:
987: fd = strtoul(string+4, &end, 10);
988: if ((end == string+4) || (*end != 0)) {
989: goto badId;
990: }
991: } else if ((string[0] == 's') && (string[1] == 't')
992: && (string[2] == 'd')) {
993: if (strcmp(string+3, "in") == 0) {
994: fd = 0;
995: } else if (strcmp(string+3, "out") == 0) {
996: fd = 1;
997: } else if (strcmp(string+3, "err") == 0) {
998: fd = 2;
999: } else {
1000: goto badId;
1001: }
1002: } else {
1003: badId:
1004: Tcl_AppendResult(interp, "bad file identifier \"", string,
1005: "\"", (char *) NULL);
1006: return TCL_ERROR;
1007: }
1008:
1009: if (fd >= iPtr->numFiles) {
1010: if ((iPtr->numFiles == 0) && (fd <= 2)) {
1011: TclMakeFileTable(iPtr, fd);
1012: } else {
1013: notOpen:
1014: Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
1015: (char *) NULL);
1016: return TCL_ERROR;
1017: }
1018: }
1019: if (iPtr->filePtrArray[fd] == NULL) {
1020: goto notOpen;
1021: }
1022: *filePtrPtr = iPtr->filePtrArray[fd];
1023: return TCL_OK;
1024: }
1025:
1026: #ifdef MSDOS
1027: int
1028: filename2DOS(name)
1029: char *name;
1030: {
1031: for ( ; *name; name++) if (*name == '/') *name = '\\';
1032: }
1033: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.