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