]> git.zerfleddert.de Git - micropolis/blame - src/tcl/tclunxut.c
XINCLUDE: use /usr/X11R6/include everywhere
[micropolis] / src / tcl / tclunxut.c
CommitLineData
6a5fa4e0
MG
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
24static 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
35typedef 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
57static WaitInfo *waitTable = NULL;
58static int waitTableSize = 0; /* Total number of entries available in
59 * waitTable. */
60static 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
84int
85Tcl_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\f
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
178int
179Tcl_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\f
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
255int
256Tcl_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\f
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
365void
366Tcl_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\f
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
433int
434Tcl_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
776cleanup:
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\f
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
845char *
846Tcl_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\f
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
877void
878TclMakeFileTable(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\f
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
972int
973TclGetOpenFile(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
1027int
1028filename2DOS(name)
1029 char *name;
1030{
1031 for ( ; *name; name++) if (*name == '/') *name = '\\';
1032}
1033#endif
Impressum, Datenschutz