Return to tclunxaz.c CVS log

Up to [Micropolis - Activity] / micropolis / src / tcl

Annotation of micropolis/src/tcl/tclunxaz.c, revision 1.1

1.1     ! root        1: /* 
        !             2:  * tclUnixAZ.c --
        !             3:  *
        !             4:  *     This file contains the top-level command procedures for
        !             5:  *     commands in the Tcl core that require UNIX facilities
        !             6:  *     such as files and process execution.  Much of the code
        !             7:  *     in this file is based on earlier versions contributed
        !             8:  *     by Karl Lehenbauer, Mark Diekhans and Peter da Silva.
        !             9:  *
        !            10:  * Copyright 1991 Regents of the University of California
        !            11:  * Permission to use, copy, modify, and distribute this
        !            12:  * software and its documentation for any purpose and without
        !            13:  * fee is hereby granted, provided that this copyright
        !            14:  * notice appears in all copies.  The University of California
        !            15:  * makes no representations about the suitability of this
        !            16:  * software for any purpose.  It is provided "as is" without
        !            17:  * express or implied warranty.
        !            18:  */
        !            19: 
        !            20: #ifndef lint
        !            21: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixAZ.c,v 1.36 92/04/16 13:32:02 ouster Exp $ sprite (Berkeley)";
        !            22: #endif /* not lint */
        !            23: 
        !            24: #include "tclint.h"
        !            25: #include "tclunix.h"
        !            26: 
        !            27: /*
        !            28:  * The variable below caches the name of the current working directory
        !            29:  * in order to avoid repeated calls to getwd.  The string is malloc-ed.
        !            30:  * NULL means the cache needs to be refreshed.
        !            31:  */
        !            32: 
        !            33: static char *currentDir =  NULL;
        !            34: 
        !            35: /*
        !            36:  * Prototypes for local procedures defined in this file:
        !            37:  */
        !            38: 
        !            39: static int             CleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
        !            40:                            int numPids, int *pidPtr, int errorId));
        !            41: static char *          GetFileType _ANSI_ARGS_((int mode));
        !            42: static int             StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
        !            43:                            char *varName, struct stat *statPtr));
        !            44: 
        !            45: /*
        !            46:  *----------------------------------------------------------------------
        !            47:  *
        !            48:  * Tcl_CdCmd --
        !            49:  *
        !            50:  *     This procedure is invoked to process the "cd" Tcl command.
        !            51:  *     See the user documentation for details on what it does.
        !            52:  *
        !            53:  * Results:
        !            54:  *     A standard Tcl result.
        !            55:  *
        !            56:  * Side effects:
        !            57:  *     See the user documentation.
        !            58:  *
        !            59:  *----------------------------------------------------------------------
        !            60:  */
        !            61: 
        !            62:        /* ARGSUSED */
        !            63: int
        !            64: Tcl_CdCmd(dummy, interp, argc, argv)
        !            65:     ClientData dummy;                  /* Not used. */
        !            66:     Tcl_Interp *interp;                        /* Current interpreter. */
        !            67:     int argc;                          /* Number of arguments. */
        !            68:     char **argv;                       /* Argument strings. */
        !            69: {
        !            70:     char *dirName;
        !            71: 
        !            72:     if (argc > 2) {
        !            73:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !            74:                " dirName\"", (char *) NULL);
        !            75:        return TCL_ERROR;
        !            76:     }
        !            77: 
        !            78:     if (argc == 2) {
        !            79:        dirName = argv[1];
        !            80:     } else {
        !            81:        dirName = "~";
        !            82:     }
        !            83:     dirName = Tcl_TildeSubst(interp, dirName);
        !            84:     if (dirName == NULL) {
        !            85:        return TCL_ERROR;
        !            86:     }
        !            87:     if (currentDir != NULL) {
        !            88:        ckfree(currentDir);
        !            89:        currentDir = NULL;
        !            90:     }
        !            91:     if (chdir(dirName) != 0) {
        !            92:        Tcl_AppendResult(interp, "couldn't change working directory to \"",
        !            93:                dirName, "\": ", Tcl_UnixError(interp), (char *) NULL);
        !            94:        return TCL_ERROR;
        !            95:     }
        !            96:     return TCL_OK;
        !            97: }
        !            98: 
        !            99: /*
        !           100:  *----------------------------------------------------------------------
        !           101:  *
        !           102:  * Tcl_CloseCmd --
        !           103:  *
        !           104:  *     This procedure is invoked to process the "close" Tcl command.
        !           105:  *     See the user documentation for details on what it does.
        !           106:  *
        !           107:  * Results:
        !           108:  *     A standard Tcl result.
        !           109:  *
        !           110:  * Side effects:
        !           111:  *     See the user documentation.
        !           112:  *
        !           113:  *----------------------------------------------------------------------
        !           114:  */
        !           115: 
        !           116:        /* ARGSUSED */
        !           117: int
        !           118: Tcl_CloseCmd(dummy, interp, argc, argv)
        !           119:     ClientData dummy;                  /* Not used. */
        !           120:     Tcl_Interp *interp;                        /* Current interpreter. */
        !           121:     int argc;                          /* Number of arguments. */
        !           122:     char **argv;                       /* Argument strings. */
        !           123: {
        !           124:     OpenFile *filePtr;
        !           125:     int result = TCL_OK;
        !           126: 
        !           127:     if (argc != 2) {
        !           128:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           129:                " fileId\"", (char *) NULL);
        !           130:        return TCL_ERROR;
        !           131:     }
        !           132:     if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
        !           133:        return TCL_ERROR;
        !           134:     }
        !           135:     ((Interp *) interp)->filePtrArray[fileno(filePtr->f)] = NULL;
        !           136: 
        !           137:     /*
        !           138:      * First close the file (in the case of a process pipeline, there may
        !           139:      * be two files, one for the pipe at each end of the pipeline).
        !           140:      */
        !           141: 
        !           142:     if (filePtr->f2 != NULL) {
        !           143:        if (fclose(filePtr->f2) == EOF) {
        !           144:            Tcl_AppendResult(interp, "error closing \"", argv[1],
        !           145:                    "\": ", Tcl_UnixError(interp), "\n", (char *) NULL);
        !           146:            result = TCL_ERROR;
        !           147:        }
        !           148:     }
        !           149:     if (fclose(filePtr->f) == EOF) {
        !           150:        Tcl_AppendResult(interp, "error closing \"", argv[1],
        !           151:                "\": ", Tcl_UnixError(interp), "\n", (char *) NULL);
        !           152:        result = TCL_ERROR;
        !           153:     }
        !           154: 
        !           155:     /*
        !           156:      * If the file was a connection to a pipeline, clean up everything
        !           157:      * associated with the child processes.
        !           158:      */
        !           159: 
        !           160:     if (filePtr->numPids > 0) {
        !           161:        if (CleanupChildren(interp, filePtr->numPids, filePtr->pidPtr,
        !           162:                filePtr->errorId) != TCL_OK) {
        !           163:            result = TCL_ERROR;
        !           164:        }
        !           165:     }
        !           166: 
        !           167:     ckfree((char *) filePtr);
        !           168:     return result;
        !           169: }
        !           170: 
        !           171: /*
        !           172:  *----------------------------------------------------------------------
        !           173:  *
        !           174:  * Tcl_EofCmd --
        !           175:  *
        !           176:  *     This procedure is invoked to process the "eof" Tcl command.
        !           177:  *     See the user documentation for details on what it does.
        !           178:  *
        !           179:  * Results:
        !           180:  *     A standard Tcl result.
        !           181:  *
        !           182:  * Side effects:
        !           183:  *     See the user documentation.
        !           184:  *
        !           185:  *----------------------------------------------------------------------
        !           186:  */
        !           187: 
        !           188:        /* ARGSUSED */
        !           189: int
        !           190: Tcl_EofCmd(notUsed, interp, argc, argv)
        !           191:     ClientData notUsed;                        /* Not used. */
        !           192:     Tcl_Interp *interp;                        /* Current interpreter. */
        !           193:     int argc;                          /* Number of arguments. */
        !           194:     char **argv;                       /* Argument strings. */
        !           195: {
        !           196:     OpenFile *filePtr;
        !           197: 
        !           198:     if (argc != 2) {
        !           199:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           200:                " fileId\"", (char *) NULL);
        !           201:        return TCL_ERROR;
        !           202:     }
        !           203:     if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
        !           204:        return TCL_ERROR;
        !           205:     }
        !           206:     if (feof(filePtr->f)) {
        !           207:        interp->result = "1";
        !           208:     } else {
        !           209:        interp->result = "0";
        !           210:     }
        !           211:     return TCL_OK;
        !           212: }
        !           213: 
        !           214: /*
        !           215:  *----------------------------------------------------------------------
        !           216:  *
        !           217:  * Tcl_ExecCmd --
        !           218:  *
        !           219:  *     This procedure is invoked to process the "exec" Tcl command.
        !           220:  *     See the user documentation for details on what it does.
        !           221:  *
        !           222:  * Results:
        !           223:  *     A standard Tcl result.
        !           224:  *
        !           225:  * Side effects:
        !           226:  *     See the user documentation.
        !           227:  *
        !           228:  *----------------------------------------------------------------------
        !           229:  */
        !           230: 
        !           231:        /* ARGSUSED */
        !           232: int
        !           233: Tcl_ExecCmd(dummy, interp, argc, argv)
        !           234:     ClientData dummy;                  /* Not used. */
        !           235:     Tcl_Interp *interp;                        /* Current interpreter. */
        !           236:     int argc;                          /* Number of arguments. */
        !           237:     char **argv;                       /* Argument strings. */
        !           238: {
        !           239:     int outputId;                      /* File id for output pipe.  -1
        !           240:                                         * means command overrode. */
        !           241:     int errorId;                       /* File id for temporary file
        !           242:                                         * containing error output. */
        !           243:     int *pidPtr;
        !           244:     int numPids, result;
        !           245: 
        !           246:     /*
        !           247:      * See if the command is to be run in background;  if so, create
        !           248:      * the command, detach it, and return.
        !           249:      */
        !           250: 
        !           251:     if ((argv[argc-1][0] == '&') && (argv[argc-1][1] == 0)) {
        !           252:        argc--;
        !           253:        argv[argc] = NULL;
        !           254:        numPids = Tcl_CreatePipeline(interp, argc-1, argv+1, &pidPtr,
        !           255:                (int *) NULL, (int *) NULL, (int *) NULL);
        !           256:        if (numPids < 0) {
        !           257:            return TCL_ERROR;
        !           258:        }
        !           259:        Tcl_DetachPids(numPids, pidPtr);
        !           260:        ckfree((char *) pidPtr);
        !           261:        return TCL_OK;
        !           262:     }
        !           263: 
        !           264:     /*
        !           265:      * Create the command's pipeline.
        !           266:      */
        !           267: 
        !           268:     numPids = Tcl_CreatePipeline(interp, argc-1, argv+1, &pidPtr,
        !           269:            (int *) NULL, &outputId, &errorId);
        !           270:     if (numPids < 0) {
        !           271:        return TCL_ERROR;
        !           272:     }
        !           273: 
        !           274:     /*
        !           275:      * Read the child's output (if any) and put it into the result.
        !           276:      */
        !           277: 
        !           278:     result = TCL_OK;
        !           279:     if (outputId != -1) {
        !           280:        while (1) {
        !           281: #          define BUFFER_SIZE 1000
        !           282:            char buffer[BUFFER_SIZE+1];
        !           283:            int count;
        !           284:     
        !           285:            count = read(outputId, buffer, BUFFER_SIZE);
        !           286:     
        !           287:            if (count == 0) {
        !           288:                break;
        !           289:            }
        !           290:            if (count < 0) {
        !           291:                Tcl_ResetResult(interp);
        !           292:                Tcl_AppendResult(interp,
        !           293:                        "error reading from output pipe: ",
        !           294:                        Tcl_UnixError(interp), (char *) NULL);
        !           295:                result = TCL_ERROR;
        !           296:                break;
        !           297:            }
        !           298:            buffer[count] = 0;
        !           299:            Tcl_AppendResult(interp, buffer, (char *) NULL);
        !           300:        }
        !           301:        close(outputId);
        !           302:     }
        !           303: 
        !           304:     if (CleanupChildren(interp, numPids, pidPtr, errorId) != TCL_OK) {
        !           305:        result = TCL_ERROR;
        !           306:     }
        !           307:     return result;
        !           308: }
        !           309: 
        !           310: /*
        !           311:  *----------------------------------------------------------------------
        !           312:  *
        !           313:  * Tcl_ExitCmd --
        !           314:  *
        !           315:  *     This procedure is invoked to process the "exit" Tcl command.
        !           316:  *     See the user documentation for details on what it does.
        !           317:  *
        !           318:  * Results:
        !           319:  *     A standard Tcl result.
        !           320:  *
        !           321:  * Side effects:
        !           322:  *     See the user documentation.
        !           323:  *
        !           324:  *----------------------------------------------------------------------
        !           325:  */
        !           326: 
        !           327:        /* ARGSUSED */
        !           328: int
        !           329: Tcl_ExitCmd(dummy, interp, argc, argv)
        !           330:     ClientData dummy;                  /* Not used. */
        !           331:     Tcl_Interp *interp;                        /* Current interpreter. */
        !           332:     int argc;                          /* Number of arguments. */
        !           333:     char **argv;                       /* Argument strings. */
        !           334: {
        !           335:     int value;
        !           336: 
        !           337:     if ((argc != 1) && (argc != 2)) {
        !           338:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           339:                " ?returnCode?\"", (char *) NULL);
        !           340:        return TCL_ERROR;
        !           341:     }
        !           342:     if (argc == 1) {
        !           343:        exit(0);
        !           344:     }
        !           345:     if (Tcl_GetInt(interp, argv[1], &value) != TCL_OK) {
        !           346:        return TCL_ERROR;
        !           347:     }
        !           348:     exit(value);
        !           349: #if 0
        !           350:     return TCL_OK;                     /* Better not ever reach this! */
        !           351: #endif
        !           352: }
        !           353: 
        !           354: /*
        !           355:  *----------------------------------------------------------------------
        !           356:  *
        !           357:  * Tcl_FileCmd --
        !           358:  *
        !           359:  *     This procedure is invoked to process the "file" Tcl command.
        !           360:  *     See the user documentation for details on what it does.
        !           361:  *
        !           362:  * Results:
        !           363:  *     A standard Tcl result.
        !           364:  *
        !           365:  * Side effects:
        !           366:  *     See the user documentation.
        !           367:  *
        !           368:  *----------------------------------------------------------------------
        !           369:  */
        !           370: 
        !           371:        /* ARGSUSED */
        !           372: int
        !           373: Tcl_FileCmd(dummy, interp, argc, argv)
        !           374:     ClientData dummy;                  /* Not used. */
        !           375:     Tcl_Interp *interp;                        /* Current interpreter. */
        !           376:     int argc;                          /* Number of arguments. */
        !           377:     char **argv;                       /* Argument strings. */
        !           378: {
        !           379:     char *p;
        !           380:     int length, statOp;
        !           381:     int mode = 0;                      /* Initialized only to prevent
        !           382:                                         * compiler warning message. */
        !           383:     struct stat statBuf;
        !           384:     char *fileName, c;
        !           385: 
        !           386:     if (argc < 3) {
        !           387:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           388:                " option name ?arg ...?\"", (char *) NULL);
        !           389:        return TCL_ERROR;
        !           390:     }
        !           391:     c = argv[1][0];
        !           392:     length = strlen(argv[1]);
        !           393: 
        !           394:     /*
        !           395:      * First handle operations on the file name.
        !           396:      */
        !           397: 
        !           398:     fileName = Tcl_TildeSubst(interp, argv[2]);
        !           399:     if (fileName == NULL) {
        !           400:        return TCL_ERROR;
        !           401:     }
        !           402:     if ((c == 'd') && (strncmp(argv[1], "dirname", length) == 0)) {
        !           403:        if (argc != 3) {
        !           404:            argv[1] = "dirname";
        !           405:            not3Args:
        !           406:            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           407:                    " ", argv[1], " name\"", (char *) NULL);
        !           408:            return TCL_ERROR;
        !           409:        }
        !           410: #ifdef MSDOS
        !           411:        p = strrchr(fileName, '\\');
        !           412: #else
        !           413:        p = strrchr(fileName, '/');
        !           414: #endif
        !           415:        if (p == NULL) {
        !           416:            interp->result = ".";
        !           417:        } else if (p == fileName) {
        !           418: #ifdef MSDOS
        !           419:            interp->result = "\\";
        !           420: #else
        !           421:            interp->result = "/";
        !           422: #endif
        !           423:        } else {
        !           424:            *p = 0;
        !           425:            Tcl_SetResult(interp, fileName, TCL_VOLATILE);
        !           426:            *p = '/';
        !           427:        }
        !           428:        return TCL_OK;
        !           429:     } else if ((c == 'r') && (strncmp(argv[1], "rootname", length) == 0)
        !           430:            && (length >= 2)) {
        !           431:        char *lastSlash;
        !           432: 
        !           433:        if (argc != 3) {
        !           434:            argv[1] = "rootname";
        !           435:            goto not3Args;
        !           436:        }
        !           437:        p = strrchr(fileName, '.');
        !           438: #ifdef MSDOS
        !           439:        lastSlash = strrchr(fileName, '\\');
        !           440: #else
        !           441:        lastSlash = strrchr(fileName, '/');
        !           442: #endif
        !           443:        if ((p == NULL) || ((lastSlash != NULL) && (lastSlash > p))) {
        !           444:            Tcl_SetResult(interp, fileName, TCL_VOLATILE);
        !           445:        } else {
        !           446:            *p = 0;
        !           447:            Tcl_SetResult(interp, fileName, TCL_VOLATILE);
        !           448:            *p = '.';
        !           449:        }
        !           450:        return TCL_OK;
        !           451:     } else if ((c == 'e') && (strncmp(argv[1], "extension", length) == 0)
        !           452:            && (length >= 3)) {
        !           453:        char *lastSlash;
        !           454: 
        !           455:        if (argc != 3) {
        !           456:            argv[1] = "extension";
        !           457:            goto not3Args;
        !           458:        }
        !           459:        p = strrchr(fileName, '.');
        !           460: #ifdef MSDOS
        !           461:        lastSlash = strrchr(fileName, '\\');
        !           462: #else
        !           463:        lastSlash = strrchr(fileName, '/');
        !           464: #endif
        !           465:        if ((p != NULL) && ((lastSlash == NULL) || (lastSlash < p))) {
        !           466:            Tcl_SetResult(interp, p, TCL_VOLATILE);
        !           467:        }
        !           468:        return TCL_OK;
        !           469:     } else if ((c == 't') && (strncmp(argv[1], "tail", length) == 0)
        !           470:            && (length >= 2)) {
        !           471:        if (argc != 3) {
        !           472:            argv[1] = "tail";
        !           473:            goto not3Args;
        !           474:        }
        !           475: #ifdef MSDOS
        !           476:        p = strrchr(fileName, '\\');
        !           477: #else
        !           478:        p = strrchr(fileName, '/');
        !           479: #endif
        !           480:        if (p != NULL) {
        !           481:            Tcl_SetResult(interp, p+1, TCL_VOLATILE);
        !           482:        } else {
        !           483:            Tcl_SetResult(interp, fileName, TCL_VOLATILE);
        !           484:        }
        !           485:        return TCL_OK;
        !           486:     }
        !           487: 
        !           488:     /*
        !           489:      * Next, handle operations that can be satisfied with the "access"
        !           490:      * kernel call.
        !           491:      */
        !           492: 
        !           493:     if (fileName == NULL) {
        !           494:        return TCL_ERROR;
        !           495:     }
        !           496:     if ((c == 'r') && (strncmp(argv[1], "readable", length) == 0)
        !           497:            && (length >= 5)) {
        !           498:        if (argc != 3) {
        !           499:            argv[1] = "readable";
        !           500:            goto not3Args;
        !           501:        }
        !           502:        mode = R_OK;
        !           503:        checkAccess:
        !           504:        if (access(fileName, mode) == -1) {
        !           505:            interp->result = "0";
        !           506:        } else {
        !           507:            interp->result = "1";
        !           508:        }
        !           509:        return TCL_OK;
        !           510:     } else if ((c == 'w') && (strncmp(argv[1], "writable", length) == 0)) {
        !           511:        if (argc != 3) {
        !           512:            argv[1] = "writable";
        !           513:            goto not3Args;
        !           514:        }
        !           515:        mode = W_OK;
        !           516:        goto checkAccess;
        !           517:     } else if ((c == 'e') && (strncmp(argv[1], "executable", length) == 0)
        !           518:            && (length >= 3)) {
        !           519:        if (argc != 3) {
        !           520:            argv[1] = "executable";
        !           521:            goto not3Args;
        !           522:        }
        !           523:        mode = X_OK;
        !           524:        goto checkAccess;
        !           525:     } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)
        !           526:            && (length >= 3)) {
        !           527:        if (argc != 3) {
        !           528:            argv[1] = "exists";
        !           529:            goto not3Args;
        !           530:        }
        !           531:        mode = F_OK;
        !           532:        goto checkAccess;
        !           533:     }
        !           534: 
        !           535:     /*
        !           536:      * Lastly, check stuff that requires the file to be stat-ed.
        !           537:      */
        !           538: 
        !           539:     if ((c == 'a') && (strncmp(argv[1], "atime", length) == 0)) {
        !           540:        if (argc != 3) {
        !           541:            argv[1] = "atime";
        !           542:            goto not3Args;
        !           543:        }
        !           544:        if (stat(fileName, &statBuf) == -1) {
        !           545:            goto badStat;
        !           546:        }
        !           547:        sprintf(interp->result, "%ld", statBuf.st_atime);
        !           548:        return TCL_OK;
        !           549:     } else if ((c == 'i') && (strncmp(argv[1], "isdirectory", length) == 0)
        !           550:            && (length >= 3)) {
        !           551:        if (argc != 3) {
        !           552:            argv[1] = "isdirectory";
        !           553:            goto not3Args;
        !           554:        }
        !           555:        statOp = 2;
        !           556:     } else if ((c == 'i') && (strncmp(argv[1], "isfile", length) == 0)
        !           557:            && (length >= 3)) {
        !           558:        if (argc != 3) {
        !           559:            argv[1] = "isfile";
        !           560:            goto not3Args;
        !           561:        }
        !           562:        statOp = 1;
        !           563:     } else if ((c == 'l') && (strncmp(argv[1], "lstat", length) == 0)) {
        !           564:        if (argc != 4) {
        !           565:            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           566:                    " lstat name varName\"", (char *) NULL);
        !           567:            return TCL_ERROR;
        !           568:        }
        !           569: 
        !           570:        if (lstat(fileName, &statBuf) == -1) {
        !           571:            Tcl_AppendResult(interp, "couldn't lstat \"", argv[2],
        !           572:                    "\": ", Tcl_UnixError(interp), (char *) NULL);
        !           573:            return TCL_ERROR;
        !           574:        }
        !           575:        return StoreStatData(interp, argv[3], &statBuf);
        !           576:     } else if ((c == 'm') && (strncmp(argv[1], "mtime", length) == 0)) {
        !           577:        if (argc != 3) {
        !           578:            argv[1] = "mtime";
        !           579:            goto not3Args;
        !           580:        }
        !           581:        if (stat(fileName, &statBuf) == -1) {
        !           582:            goto badStat;
        !           583:        }
        !           584:        sprintf(interp->result, "%ld", statBuf.st_mtime);
        !           585:        return TCL_OK;
        !           586:     } else if ((c == 'o') && (strncmp(argv[1], "owned", length) == 0)) {
        !           587:        if (argc != 3) {
        !           588:            argv[1] = "owned";
        !           589:            goto not3Args;
        !           590:        }
        !           591:        statOp = 0;
        !           592: #ifdef S_IFLNK
        !           593:     /*
        !           594:      * This option is only included if symbolic links exist on this system
        !           595:      * (in which case S_IFLNK should be defined).
        !           596:      */
        !           597:     } else if ((c == 'r') && (strncmp(argv[1], "readlink", length) == 0)
        !           598:            && (length >= 5)) {
        !           599:        char linkValue[MAXPATHLEN+1];
        !           600:        int linkLength;
        !           601: 
        !           602:        if (argc != 3) {
        !           603:            argv[1] = "readlink";
        !           604:            goto not3Args;
        !           605:        }
        !           606:        linkLength = readlink(fileName, linkValue, sizeof(linkValue) - 1);
        !           607:        if (linkLength == -1) {
        !           608:            Tcl_AppendResult(interp, "couldn't readlink \"", argv[2],
        !           609:                    "\": ", Tcl_UnixError(interp), (char *) NULL);
        !           610:            return TCL_ERROR;
        !           611:        }
        !           612:        linkValue[linkLength] = 0;
        !           613:        Tcl_SetResult(interp, linkValue, TCL_VOLATILE);
        !           614:        return TCL_OK;
        !           615: #endif
        !           616:     } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)
        !           617:            && (length >= 2)) {
        !           618:        if (argc != 3) {
        !           619:            argv[1] = "size";
        !           620:            goto not3Args;
        !           621:        }
        !           622:        if (stat(fileName, &statBuf) == -1) {
        !           623:            goto badStat;
        !           624:        }
        !           625:        sprintf(interp->result, "%ld", statBuf.st_size);
        !           626:        return TCL_OK;
        !           627:     } else if ((c == 's') && (strncmp(argv[1], "stat", length) == 0)
        !           628:            && (length >= 2)) {
        !           629:        if (argc != 4) {
        !           630:            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           631:                    " stat name varName\"", (char *) NULL);
        !           632:            return TCL_ERROR;
        !           633:        }
        !           634: 
        !           635:        if (stat(fileName, &statBuf) == -1) {
        !           636:            badStat:
        !           637:            Tcl_AppendResult(interp, "couldn't stat \"", argv[2],
        !           638:                    "\": ", Tcl_UnixError(interp), (char *) NULL);
        !           639:            return TCL_ERROR;
        !           640:        }
        !           641:        return StoreStatData(interp, argv[3], &statBuf);
        !           642:     } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)
        !           643:            && (length >= 2)) {
        !           644:        if (argc != 3) {
        !           645:            argv[1] = "type";
        !           646:            goto not3Args;
        !           647:        }
        !           648:        if (lstat(fileName, &statBuf) == -1) {
        !           649:            goto badStat;
        !           650:        }
        !           651:        interp->result = GetFileType((int) statBuf.st_mode);
        !           652:        return TCL_OK;
        !           653:     } else {
        !           654:        Tcl_AppendResult(interp, "bad option \"", argv[1],
        !           655:                "\": should be atime, dirname, executable, exists, ",
        !           656:                "extension, isdirectory, isfile, lstat, mtime, owned, ",
        !           657:                "readable, ",
        !           658: #ifdef S_IFLNK
        !           659:                "readlink, ",
        !           660: #endif
        !           661:                "root, size, stat, tail, type, ",
        !           662:                "or writable",
        !           663:                (char *) NULL);
        !           664:        return TCL_ERROR;
        !           665:     }
        !           666:     if (stat(fileName, &statBuf) == -1) {
        !           667:        interp->result = "0";
        !           668:        return TCL_OK;
        !           669:     }
        !           670:     switch (statOp) {
        !           671:        case 0:
        !           672:            mode = (geteuid() == statBuf.st_uid);
        !           673:            break;
        !           674:        case 1:
        !           675:            mode = S_ISREG(statBuf.st_mode);
        !           676:            break;
        !           677:        case 2:
        !           678:            mode = S_ISDIR(statBuf.st_mode);
        !           679:            break;
        !           680:     }
        !           681:     if (mode) {
        !           682:        interp->result = "1";
        !           683:     } else {
        !           684:        interp->result = "0";
        !           685:     }
        !           686:     return TCL_OK;
        !           687: }
        !           688: 
        !           689: /*
        !           690:  *----------------------------------------------------------------------
        !           691:  *
        !           692:  * StoreStatData --
        !           693:  *
        !           694:  *     This is a utility procedure that breaks out the fields of a
        !           695:  *     "stat" structure and stores them in textual form into the
        !           696:  *     elements of an associative array.
        !           697:  *
        !           698:  * Results:
        !           699:  *     Returns a standard Tcl return value.  If an error occurs then
        !           700:  *     a message is left in interp->result.
        !           701:  *
        !           702:  * Side effects:
        !           703:  *     Elements of the associative array given by "varName" are modified.
        !           704:  *
        !           705:  *----------------------------------------------------------------------
        !           706:  */
        !           707: 
        !           708: static int
        !           709: StoreStatData(interp, varName, statPtr)
        !           710:     Tcl_Interp *interp;                        /* Interpreter for error reports. */
        !           711:     char *varName;                     /* Name of associative array variable
        !           712:                                         * in which to store stat results. */
        !           713:     struct stat *statPtr;              /* Pointer to buffer containing
        !           714:                                         * stat data to store in varName. */
        !           715: {
        !           716:     char string[30];
        !           717: 
        !           718:     sprintf(string, "%d", statPtr->st_dev);
        !           719:     if (Tcl_SetVar2(interp, varName, "dev", string, TCL_LEAVE_ERR_MSG)
        !           720:            == NULL) {
        !           721:        return TCL_ERROR;
        !           722:     }
        !           723:     sprintf(string, "%d", statPtr->st_ino);
        !           724:     if (Tcl_SetVar2(interp, varName, "ino", string, TCL_LEAVE_ERR_MSG)
        !           725:            == NULL) {
        !           726:        return TCL_ERROR;
        !           727:     }
        !           728:     sprintf(string, "%d", statPtr->st_mode);
        !           729:     if (Tcl_SetVar2(interp, varName, "mode", string, TCL_LEAVE_ERR_MSG)
        !           730:            == NULL) {
        !           731:        return TCL_ERROR;
        !           732:     }
        !           733:     sprintf(string, "%d", statPtr->st_nlink);
        !           734:     if (Tcl_SetVar2(interp, varName, "nlink", string, TCL_LEAVE_ERR_MSG)
        !           735:            == NULL) {
        !           736:        return TCL_ERROR;
        !           737:     }
        !           738:     sprintf(string, "%d", statPtr->st_uid);
        !           739:     if (Tcl_SetVar2(interp, varName, "uid", string, TCL_LEAVE_ERR_MSG)
        !           740:            == NULL) {
        !           741:        return TCL_ERROR;
        !           742:     }
        !           743:     sprintf(string, "%d", statPtr->st_gid);
        !           744:     if (Tcl_SetVar2(interp, varName, "gid", string, TCL_LEAVE_ERR_MSG)
        !           745:            == NULL) {
        !           746:        return TCL_ERROR;
        !           747:     }
        !           748:     sprintf(string, "%ld", statPtr->st_size);
        !           749:     if (Tcl_SetVar2(interp, varName, "size", string, TCL_LEAVE_ERR_MSG)
        !           750:            == NULL) {
        !           751:        return TCL_ERROR;
        !           752:     }
        !           753:     sprintf(string, "%ld", statPtr->st_atime);
        !           754:     if (Tcl_SetVar2(interp, varName, "atime", string, TCL_LEAVE_ERR_MSG)
        !           755:            == NULL) {
        !           756:        return TCL_ERROR;
        !           757:     }
        !           758:     sprintf(string, "%ld", statPtr->st_mtime);
        !           759:     if (Tcl_SetVar2(interp, varName, "mtime", string, TCL_LEAVE_ERR_MSG)
        !           760:            == NULL) {
        !           761:        return TCL_ERROR;
        !           762:     }
        !           763:     sprintf(string, "%ld", statPtr->st_ctime);
        !           764:     if (Tcl_SetVar2(interp, varName, "ctime", string, TCL_LEAVE_ERR_MSG)
        !           765:            == NULL) {
        !           766:        return TCL_ERROR;
        !           767:     }
        !           768:     if (Tcl_SetVar2(interp, varName, "type",
        !           769:            GetFileType((int) statPtr->st_mode), TCL_LEAVE_ERR_MSG) == NULL) {
        !           770:        return TCL_ERROR;
        !           771:     }
        !           772:     return TCL_OK;
        !           773: }
        !           774: 
        !           775: /*
        !           776:  *----------------------------------------------------------------------
        !           777:  *
        !           778:  * GetFileType --
        !           779:  *
        !           780:  *     Given a mode word, returns a string identifying the type of a
        !           781:  *     file.
        !           782:  *
        !           783:  * Results:
        !           784:  *     A static text string giving the file type from mode.
        !           785:  *
        !           786:  * Side effects:
        !           787:  *     None.
        !           788:  *
        !           789:  *----------------------------------------------------------------------
        !           790:  */
        !           791: 
        !           792: static char *
        !           793: GetFileType(mode)
        !           794:     int mode;
        !           795: {
        !           796:     if (S_ISREG(mode)) {
        !           797:        return "file";
        !           798:     } else if (S_ISDIR(mode)) {
        !           799:        return "directory";
        !           800:     } else if (S_ISCHR(mode)) {
        !           801:        return "characterSpecial";
        !           802:     } else if (S_ISBLK(mode)) {
        !           803:        return "blockSpecial";
        !           804:     } else if (S_ISFIFO(mode)) {
        !           805:        return "fifo";
        !           806:     } else if (S_ISLNK(mode)) {
        !           807:        return "link";
        !           808:     } else if (S_ISSOCK(mode)) {
        !           809:        return "socket";
        !           810:     }
        !           811:     return "unknown";
        !           812: }
        !           813: 
        !           814: /*
        !           815:  *----------------------------------------------------------------------
        !           816:  *
        !           817:  * Tcl_FlushCmd --
        !           818:  *
        !           819:  *     This procedure is invoked to process the "flush" Tcl command.
        !           820:  *     See the user documentation for details on what it does.
        !           821:  *
        !           822:  * Results:
        !           823:  *     A standard Tcl result.
        !           824:  *
        !           825:  * Side effects:
        !           826:  *     See the user documentation.
        !           827:  *
        !           828:  *----------------------------------------------------------------------
        !           829:  */
        !           830: 
        !           831:        /* ARGSUSED */
        !           832: int
        !           833: Tcl_FlushCmd(notUsed, interp, argc, argv)
        !           834:     ClientData notUsed;                        /* Not used. */
        !           835:     Tcl_Interp *interp;                        /* Current interpreter. */
        !           836:     int argc;                          /* Number of arguments. */
        !           837:     char **argv;                       /* Argument strings. */
        !           838: {
        !           839:     OpenFile *filePtr;
        !           840:     FILE *f;
        !           841: 
        !           842:     if (argc != 2) {
        !           843:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           844:                " fileId\"", (char *) NULL);
        !           845:        return TCL_ERROR;
        !           846:     }
        !           847:     if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
        !           848:        return TCL_ERROR;
        !           849:     }
        !           850:     if (!filePtr->writable) {
        !           851:        Tcl_AppendResult(interp, "\"", argv[1],
        !           852:                "\" wasn't opened for writing", (char *) NULL);
        !           853:        return TCL_ERROR;
        !           854:     }
        !           855:     f = filePtr->f2;
        !           856:     if (f == NULL) {
        !           857:        f = filePtr->f;
        !           858:     }
        !           859:     if (fflush(f) == EOF) {
        !           860:        Tcl_AppendResult(interp, "error flushing \"", argv[1],
        !           861:                "\": ", Tcl_UnixError(interp), (char *) NULL);
        !           862:        clearerr(f);
        !           863:        return TCL_ERROR;
        !           864:     }
        !           865:     return TCL_OK;
        !           866: }
        !           867: 
        !           868: /*
        !           869:  *----------------------------------------------------------------------
        !           870:  *
        !           871:  * Tcl_GetsCmd --
        !           872:  *
        !           873:  *     This procedure is invoked to process the "gets" Tcl command.
        !           874:  *     See the user documentation for details on what it does.
        !           875:  *
        !           876:  * Results:
        !           877:  *     A standard Tcl result.
        !           878:  *
        !           879:  * Side effects:
        !           880:  *     See the user documentation.
        !           881:  *
        !           882:  *----------------------------------------------------------------------
        !           883:  */
        !           884: 
        !           885:        /* ARGSUSED */
        !           886: int
        !           887: Tcl_GetsCmd(notUsed, interp, argc, argv)
        !           888:     ClientData notUsed;                        /* Not used. */
        !           889:     Tcl_Interp *interp;                        /* Current interpreter. */
        !           890:     int argc;                          /* Number of arguments. */
        !           891:     char **argv;                       /* Argument strings. */
        !           892: {
        !           893: #   define BUF_SIZE 200
        !           894:     char buffer[BUF_SIZE+1];
        !           895:     int totalCount, done, flags;
        !           896:     OpenFile *filePtr;
        !           897:     register FILE *f;
        !           898: 
        !           899:     if ((argc != 2) && (argc != 3)) {
        !           900:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !           901:                " fileId ?varName?\"", (char *) NULL);
        !           902:        return TCL_ERROR;
        !           903:     }
        !           904:     if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
        !           905:        return TCL_ERROR;
        !           906:     }
        !           907:     if (!filePtr->readable) {
        !           908:        Tcl_AppendResult(interp, "\"", argv[1],
        !           909:                "\" wasn't opened for reading", (char *) NULL);
        !           910:        return TCL_ERROR;
        !           911:     }
        !           912: 
        !           913:     /*
        !           914:      * We can't predict how large a line will be, so read it in
        !           915:      * pieces, appending to the current result or to a variable.
        !           916:      */
        !           917: 
        !           918:     totalCount = 0;
        !           919:     done = 0;
        !           920:     flags = 0;
        !           921:     f = filePtr->f;
        !           922:     while (!done) {
        !           923:        register int c, count;
        !           924:        register char *p;
        !           925: 
        !           926:        for (p = buffer, count = 0; count < BUF_SIZE-1; count++, p++) {
        !           927:            c = getc(f);
        !           928:            if (c == EOF) {
        !           929:                if (ferror(filePtr->f)) {
        !           930:                    Tcl_ResetResult(interp);
        !           931:                    Tcl_AppendResult(interp, "error reading \"", argv[1],
        !           932:                            "\": ", Tcl_UnixError(interp), (char *) NULL);
        !           933:                    clearerr(filePtr->f);
        !           934:                    return TCL_ERROR;
        !           935:                } else if (feof(filePtr->f)) {
        !           936:                    if ((totalCount == 0) && (count == 0)) {
        !           937:                        totalCount = -1;
        !           938:                    }
        !           939:                    done = 1;
        !           940:                    break;
        !           941:                }
        !           942:            }
        !           943:            if (c == '\n') {
        !           944:                done = 1;
        !           945:                break;
        !           946:            }
        !           947:            *p = c;
        !           948:        }
        !           949:        *p = 0;
        !           950:        if (argc == 2) {
        !           951:            Tcl_AppendResult(interp, buffer, (char *) NULL);
        !           952:        } else {
        !           953:            if (Tcl_SetVar(interp, argv[2], buffer, flags|TCL_LEAVE_ERR_MSG)
        !           954:                    == NULL) {
        !           955:                return TCL_ERROR;
        !           956:            }
        !           957:            flags = TCL_APPEND_VALUE;
        !           958:        }
        !           959:        totalCount += count;
        !           960:     }
        !           961: 
        !           962:     if (argc == 3) {
        !           963:        sprintf(interp->result, "%d", totalCount);
        !           964:     }
        !           965:     return TCL_OK;
        !           966: }
        !           967: 
        !           968: /*
        !           969:  *----------------------------------------------------------------------
        !           970:  *
        !           971:  * Tcl_OpenCmd --
        !           972:  *
        !           973:  *     This procedure is invoked to process the "open" Tcl command.
        !           974:  *     See the user documentation for details on what it does.
        !           975:  *
        !           976:  * Results:
        !           977:  *     A standard Tcl result.
        !           978:  *
        !           979:  * Side effects:
        !           980:  *     See the user documentation.
        !           981:  *
        !           982:  *----------------------------------------------------------------------
        !           983:  */
        !           984: 
        !           985:        /* ARGSUSED */
        !           986: int
        !           987: Tcl_OpenCmd(notUsed, interp, argc, argv)
        !           988:     ClientData notUsed;                        /* Not used. */
        !           989:     Tcl_Interp *interp;                        /* Current interpreter. */
        !           990:     int argc;                          /* Number of arguments. */
        !           991:     char **argv;                       /* Argument strings. */
        !           992: {
        !           993:     Interp *iPtr = (Interp *) interp;
        !           994:     int pipeline, fd;
        !           995:     char *access;
        !           996:     register OpenFile *filePtr;
        !           997: 
        !           998:     if (argc == 2) {
        !           999:        access = "r";
        !          1000:     } else if (argc == 3) {
        !          1001:        access = argv[2];
        !          1002:     } else {
        !          1003:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !          1004:                " filename ?access?\"", (char *) NULL);
        !          1005:        return TCL_ERROR;
        !          1006:     }
        !          1007: 
        !          1008:     filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
        !          1009:     filePtr->f = NULL;
        !          1010:     filePtr->f2 = NULL;
        !          1011:     filePtr->readable = 0;
        !          1012:     filePtr->writable = 0;
        !          1013:     filePtr->numPids = 0;
        !          1014:     filePtr->pidPtr = NULL;
        !          1015:     filePtr->errorId = -1;
        !          1016: 
        !          1017:     /*
        !          1018:      * Verify the requested form of access.
        !          1019:      */
        !          1020: 
        !          1021:     pipeline = 0;
        !          1022:     if (argv[1][0] == '|') {
        !          1023:        pipeline = 1;
        !          1024:     }
        !          1025:     switch (access[0]) {
        !          1026:        case 'r':
        !          1027:            filePtr->readable = 1;
        !          1028:            break;
        !          1029:        case 'w':
        !          1030:            filePtr->writable = 1;
        !          1031:            break;
        !          1032:        case 'a':
        !          1033:            filePtr->writable = 1;
        !          1034:            break;
        !          1035:        default:
        !          1036:            badAccess:
        !          1037:            Tcl_AppendResult(interp, "illegal access mode \"", access,
        !          1038:                    "\"", (char *) NULL);
        !          1039:            goto error;
        !          1040:     }
        !          1041:     if (access[1] == '+') {
        !          1042:        filePtr->readable = filePtr->writable = 1;
        !          1043:        if (access[2] != 0) {
        !          1044:            goto badAccess;
        !          1045:        }
        !          1046:     } else if (access[1] != 0) {
        !          1047:        goto badAccess;
        !          1048:     }
        !          1049: 
        !          1050:     /*
        !          1051:      * Open the file or create a process pipeline.
        !          1052:      */
        !          1053: 
        !          1054:     if (!pipeline) {
        !          1055:        char *fileName = argv[1];
        !          1056: 
        !          1057:        if (fileName[0] == '~') {
        !          1058:            fileName = Tcl_TildeSubst(interp, fileName);
        !          1059:            if (fileName == NULL) {
        !          1060:                goto error;
        !          1061:            }
        !          1062:        }
        !          1063:        filePtr->f = fopen(fileName, access);
        !          1064:        if (filePtr->f == NULL) {
        !          1065:            Tcl_AppendResult(interp, "couldn't open \"", argv[1],
        !          1066:                    "\": ", Tcl_UnixError(interp), (char *) NULL);
        !          1067:            goto error;
        !          1068:        }
        !          1069:     } else {
        !          1070:        int *inPipePtr, *outPipePtr;
        !          1071:        int cmdArgc, inPipe, outPipe;
        !          1072:        char **cmdArgv;
        !          1073: 
        !          1074:        if (Tcl_SplitList(interp, argv[1]+1, &cmdArgc, &cmdArgv) != TCL_OK) {
        !          1075:            goto error;
        !          1076:        }
        !          1077:        inPipePtr = (filePtr->writable) ? &inPipe : NULL;
        !          1078:        outPipePtr = (filePtr->readable) ? &outPipe : NULL;
        !          1079:        inPipe = outPipe = -1;
        !          1080:        filePtr->numPids = Tcl_CreatePipeline(interp, cmdArgc, cmdArgv,
        !          1081:                &filePtr->pidPtr, inPipePtr, outPipePtr, &filePtr->errorId);
        !          1082:        ckfree((char *) cmdArgv);
        !          1083:        if (filePtr->numPids < 0) {
        !          1084:            goto error;
        !          1085:        }
        !          1086:        if (filePtr->readable) {
        !          1087:            if (outPipe == -1) {
        !          1088:                if (inPipe != -1) {
        !          1089:                    close(inPipe);
        !          1090:                }
        !          1091:                Tcl_AppendResult(interp, "can't read output from command:",
        !          1092:                        " standard output was redirected", (char *) NULL);
        !          1093:                goto error;
        !          1094:            }
        !          1095:            filePtr->f = fdopen(outPipe, "r");
        !          1096:        }
        !          1097:        if (filePtr->writable) {
        !          1098:            if (inPipe == -1) {
        !          1099:                Tcl_AppendResult(interp, "can't write input to command:",
        !          1100:                        " standard input was redirected", (char *) NULL);
        !          1101:                goto error;
        !          1102:            }
        !          1103:            if (filePtr->f != NULL) {
        !          1104:                filePtr->f2 = fdopen(inPipe, "w");
        !          1105:            } else {
        !          1106:                filePtr->f = fdopen(inPipe, "w");
        !          1107:            }
        !          1108:        }
        !          1109:     }
        !          1110: 
        !          1111:     /*
        !          1112:      * Enter this new OpenFile structure in the table for the
        !          1113:      * interpreter.  May have to expand the table to do this.
        !          1114:      */
        !          1115: 
        !          1116:     fd = fileno(filePtr->f);
        !          1117:     TclMakeFileTable(iPtr, fd);
        !          1118:     if (iPtr->filePtrArray[fd] != NULL) {
        !          1119:        panic("Tcl_OpenCmd found file already open");
        !          1120:     }
        !          1121:     iPtr->filePtrArray[fd] = filePtr;
        !          1122:     sprintf(interp->result, "file%d", fd);
        !          1123:     return TCL_OK;
        !          1124: 
        !          1125:     error:
        !          1126:     if (filePtr->f != NULL) {
        !          1127:        fclose(filePtr->f);
        !          1128:     }
        !          1129:     if (filePtr->f2 != NULL) {
        !          1130:        fclose(filePtr->f2);
        !          1131:     }
        !          1132:     if (filePtr->numPids > 0) {
        !          1133:        Tcl_DetachPids(filePtr->numPids, filePtr->pidPtr);
        !          1134:        ckfree((char *) filePtr->pidPtr);
        !          1135:     }
        !          1136:     if (filePtr->errorId != -1) {
        !          1137:        close(filePtr->errorId);
        !          1138:     }
        !          1139:     ckfree((char *) filePtr);
        !          1140:     return TCL_ERROR;
        !          1141: }
        !          1142: 
        !          1143: /*
        !          1144:  *----------------------------------------------------------------------
        !          1145:  *
        !          1146:  * Tcl_PwdCmd --
        !          1147:  *
        !          1148:  *     This procedure is invoked to process the "pwd" Tcl command.
        !          1149:  *     See the user documentation for details on what it does.
        !          1150:  *
        !          1151:  * Results:
        !          1152:  *     A standard Tcl result.
        !          1153:  *
        !          1154:  * Side effects:
        !          1155:  *     See the user documentation.
        !          1156:  *
        !          1157:  *----------------------------------------------------------------------
        !          1158:  */
        !          1159: 
        !          1160:        /* ARGSUSED */
        !          1161: int
        !          1162: Tcl_PwdCmd(dummy, interp, argc, argv)
        !          1163:     ClientData dummy;                  /* Not used. */
        !          1164:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1165:     int argc;                          /* Number of arguments. */
        !          1166:     char **argv;                       /* Argument strings. */
        !          1167: {
        !          1168:     char buffer[MAXPATHLEN+1];
        !          1169: 
        !          1170:     if (argc != 1) {
        !          1171:        Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1172:                argv[0], "\"", (char *) NULL);
        !          1173:        return TCL_ERROR;
        !          1174:     }
        !          1175:     if (currentDir == NULL) {
        !          1176: #if TCL_GETWD
        !          1177:        if (getwd(buffer) == NULL) {
        !          1178:            Tcl_AppendResult(interp, "error getting working directory name: ",
        !          1179:                    buffer, (char *) NULL);
        !          1180:            return TCL_ERROR;
        !          1181:        }
        !          1182: #else
        !          1183:        if (getcwd(buffer, MAXPATHLEN) == 0) {
        !          1184:            if (errno == ERANGE) {
        !          1185:                interp->result = "working directory name is too long";
        !          1186:            } else {
        !          1187:                Tcl_AppendResult(interp,
        !          1188:                        "error getting working directory name: ",
        !          1189:                        Tcl_UnixError(interp), (char *) NULL);
        !          1190:            }
        !          1191:            return TCL_ERROR;
        !          1192:        }
        !          1193: #endif
        !          1194:        currentDir = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
        !          1195:        strcpy(currentDir, buffer);
        !          1196:     }
        !          1197:     interp->result = currentDir;
        !          1198:     return TCL_OK;
        !          1199: }
        !          1200: 
        !          1201: /*
        !          1202:  *----------------------------------------------------------------------
        !          1203:  *
        !          1204:  * Tcl_PutsCmd --
        !          1205:  *
        !          1206:  *     This procedure is invoked to process the "puts" Tcl command.
        !          1207:  *     See the user documentation for details on what it does.
        !          1208:  *
        !          1209:  * Results:
        !          1210:  *     A standard Tcl result.
        !          1211:  *
        !          1212:  * Side effects:
        !          1213:  *     See the user documentation.
        !          1214:  *
        !          1215:  *----------------------------------------------------------------------
        !          1216:  */
        !          1217: 
        !          1218:        /* ARGSUSED */
        !          1219: int
        !          1220: Tcl_PutsCmd(dummy, interp, argc, argv)
        !          1221:     ClientData dummy;                  /* Not used. */
        !          1222:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1223:     int argc;                          /* Number of arguments. */
        !          1224:     char **argv;                       /* Argument strings. */
        !          1225: {
        !          1226:     OpenFile *filePtr;
        !          1227:     FILE *f;
        !          1228: 
        !          1229:     if (argc == 4) {
        !          1230:        if (strncmp(argv[3], "nonewline", strlen(argv[3])) != 0) {
        !          1231:            Tcl_AppendResult(interp, "bad argument \"", argv[3],
        !          1232:                    "\": should be \"nonewline\"", (char *) NULL);
        !          1233:            return TCL_ERROR;
        !          1234:        }
        !          1235:     } else if (argc != 3) {
        !          1236:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !          1237:                " fileId string ?nonewline?\"", (char *) NULL);
        !          1238:        return TCL_ERROR;
        !          1239:     }
        !          1240:     if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
        !          1241:        return TCL_ERROR;
        !          1242:     }
        !          1243:     if (!filePtr->writable) {
        !          1244:        Tcl_AppendResult(interp, "\"", argv[1],
        !          1245:                "\" wasn't opened for writing", (char *) NULL);
        !          1246:        return TCL_ERROR;
        !          1247:     }
        !          1248: 
        !          1249:     f = filePtr->f2;
        !          1250:     if (f == NULL) {
        !          1251:        f = filePtr->f;
        !          1252:     }
        !          1253:     fputs(argv[2], f);
        !          1254:     if (argc == 3) {
        !          1255:        fputc('\n', f);
        !          1256:     }
        !          1257:     if (ferror(f)) {
        !          1258:        Tcl_AppendResult(interp, "error writing \"", argv[1],
        !          1259:                "\": ", Tcl_UnixError(interp), (char *) NULL);
        !          1260:        clearerr(f);
        !          1261:        return TCL_ERROR;
        !          1262:     }
        !          1263:     return TCL_OK;
        !          1264: }
        !          1265: 
        !          1266: /*
        !          1267:  *----------------------------------------------------------------------
        !          1268:  *
        !          1269:  * Tcl_ReadCmd --
        !          1270:  *
        !          1271:  *     This procedure is invoked to process the "read" Tcl command.
        !          1272:  *     See the user documentation for details on what it does.
        !          1273:  *
        !          1274:  * Results:
        !          1275:  *     A standard Tcl result.
        !          1276:  *
        !          1277:  * Side effects:
        !          1278:  *     See the user documentation.
        !          1279:  *
        !          1280:  *----------------------------------------------------------------------
        !          1281:  */
        !          1282: 
        !          1283:        /* ARGSUSED */
        !          1284: int
        !          1285: Tcl_ReadCmd(dummy, interp, argc, argv)
        !          1286:     ClientData dummy;                  /* Not used. */
        !          1287:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1288:     int argc;                          /* Number of arguments. */
        !          1289:     char **argv;                       /* Argument strings. */
        !          1290: {
        !          1291:     OpenFile *filePtr;
        !          1292:     int bytesLeft, bytesRead, count;
        !          1293: #define READ_BUF_SIZE 4096
        !          1294:     char buffer[READ_BUF_SIZE+1];
        !          1295:     int newline;
        !          1296: 
        !          1297:     if ((argc != 2) && (argc != 3)) {
        !          1298:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !          1299:                " fileId ?numBytes|nonewline?\"", (char *) NULL);
        !          1300:        return TCL_ERROR;
        !          1301:     }
        !          1302:     if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
        !          1303:        return TCL_ERROR;
        !          1304:     }
        !          1305:     if (!filePtr->readable) {
        !          1306:        Tcl_AppendResult(interp, "\"", argv[1],
        !          1307:                "\" wasn't opened for reading", (char *) NULL);
        !          1308:        return TCL_ERROR;
        !          1309:     }
        !          1310: 
        !          1311:     /*
        !          1312:      * Compute how many bytes to read, and see whether the final
        !          1313:      * newline should be dropped.
        !          1314:      */
        !          1315: 
        !          1316:     newline = 1;
        !          1317:     if ((argc > 2) && isdigit(argv[2][0])) {
        !          1318:        if (Tcl_GetInt(interp, argv[2], &bytesLeft) != TCL_OK) {
        !          1319:            return TCL_ERROR;
        !          1320:        }
        !          1321:     } else {
        !          1322:        bytesLeft = 1<<30;
        !          1323:        if (argc > 2) {
        !          1324:            if (strncmp(argv[2], "nonewline", strlen(argv[2])) == 0) {
        !          1325:                newline = 0;
        !          1326:            } else {
        !          1327:                Tcl_AppendResult(interp, "bad argument \"", argv[2],
        !          1328:                        "\": should be \"nonewline\"", (char *) NULL);
        !          1329:                return TCL_ERROR;
        !          1330:            }
        !          1331:        }
        !          1332:     }
        !          1333: 
        !          1334:     /*
        !          1335:      * Read the file in one or more chunks.
        !          1336:      */
        !          1337: 
        !          1338:     bytesRead = 0;
        !          1339:     while (bytesLeft > 0) {
        !          1340:        count = READ_BUF_SIZE;
        !          1341:        if (bytesLeft < READ_BUF_SIZE) {
        !          1342:            count = bytesLeft;
        !          1343:        }
        !          1344:        count = fread(buffer, 1, count, filePtr->f);
        !          1345:        if (ferror(filePtr->f)) {
        !          1346:            Tcl_ResetResult(interp);
        !          1347:            Tcl_AppendResult(interp, "error reading \"", argv[1],
        !          1348:                    "\": ", Tcl_UnixError(interp), (char *) NULL);
        !          1349:            clearerr(filePtr->f);
        !          1350:            return TCL_ERROR;
        !          1351:        }
        !          1352:        if (count == 0) {
        !          1353:            break;
        !          1354:        }
        !          1355:        buffer[count] = 0;
        !          1356:        Tcl_AppendResult(interp, buffer, (char *) NULL);
        !          1357:        bytesLeft -= count;
        !          1358:        bytesRead += count;
        !          1359:     }
        !          1360:     if ((newline == 0) && (interp->result[bytesRead-1] == '\n')) {
        !          1361:        interp->result[bytesRead-1] = 0;
        !          1362:     }
        !          1363:     return TCL_OK;
        !          1364: }
        !          1365: 
        !          1366: /*
        !          1367:  *----------------------------------------------------------------------
        !          1368:  *
        !          1369:  * Tcl_SeekCmd --
        !          1370:  *
        !          1371:  *     This procedure is invoked to process the "seek" Tcl command.
        !          1372:  *     See the user documentation for details on what it does.
        !          1373:  *
        !          1374:  * Results:
        !          1375:  *     A standard Tcl result.
        !          1376:  *
        !          1377:  * Side effects:
        !          1378:  *     See the user documentation.
        !          1379:  *
        !          1380:  *----------------------------------------------------------------------
        !          1381:  */
        !          1382: 
        !          1383:        /* ARGSUSED */
        !          1384: int
        !          1385: Tcl_SeekCmd(notUsed, interp, argc, argv)
        !          1386:     ClientData notUsed;                        /* Not used. */
        !          1387:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1388:     int argc;                          /* Number of arguments. */
        !          1389:     char **argv;                       /* Argument strings. */
        !          1390: {
        !          1391:     OpenFile *filePtr;
        !          1392:     int offset, mode;
        !          1393: 
        !          1394:     if ((argc != 3) && (argc != 4)) {
        !          1395:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !          1396:                " fileId offset ?origin?\"", (char *) NULL);
        !          1397:        return TCL_ERROR;
        !          1398:     }
        !          1399:     if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
        !          1400:        return TCL_ERROR;
        !          1401:     }
        !          1402:     if (Tcl_GetInt(interp, argv[2], &offset) != TCL_OK) {
        !          1403:        return TCL_ERROR;
        !          1404:     }
        !          1405:     mode = SEEK_SET;
        !          1406:     if (argc == 4) {
        !          1407:        int length;
        !          1408:        char c;
        !          1409: 
        !          1410:        length = strlen(argv[3]);
        !          1411:        c = argv[3][0];
        !          1412:        if ((c == 's') && (strncmp(argv[3], "start", length) == 0)) {
        !          1413:            mode = SEEK_SET;
        !          1414:        } else if ((c == 'c') && (strncmp(argv[3], "current", length) == 0)) {
        !          1415:            mode = SEEK_CUR;
        !          1416:        } else if ((c == 'e') && (strncmp(argv[3], "end", length) == 0)) {
        !          1417:            mode = SEEK_END;
        !          1418:        } else {
        !          1419:            Tcl_AppendResult(interp, "bad origin \"", argv[3],
        !          1420:                    "\": should be start, current, or end", (char *) NULL);
        !          1421:            return TCL_ERROR;
        !          1422:        }
        !          1423:     }
        !          1424:     if (fseek(filePtr->f, offset, mode) == -1) {
        !          1425:        Tcl_AppendResult(interp, "error during seek: ",
        !          1426:                Tcl_UnixError(interp), (char *) NULL);
        !          1427:        clearerr(filePtr->f);
        !          1428:        return TCL_ERROR;
        !          1429:     }
        !          1430: 
        !          1431:     return TCL_OK;
        !          1432: }
        !          1433: 
        !          1434: /*
        !          1435:  *----------------------------------------------------------------------
        !          1436:  *
        !          1437:  * Tcl_SourceCmd --
        !          1438:  *
        !          1439:  *     This procedure is invoked to process the "source" Tcl command.
        !          1440:  *     See the user documentation for details on what it does.
        !          1441:  *
        !          1442:  * Results:
        !          1443:  *     A standard Tcl result.
        !          1444:  *
        !          1445:  * Side effects:
        !          1446:  *     See the user documentation.
        !          1447:  *
        !          1448:  *----------------------------------------------------------------------
        !          1449:  */
        !          1450: 
        !          1451:        /* ARGSUSED */
        !          1452: int
        !          1453: Tcl_SourceCmd(dummy, interp, argc, argv)
        !          1454:     ClientData dummy;                  /* Not used. */
        !          1455:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1456:     int argc;                          /* Number of arguments. */
        !          1457:     char **argv;                       /* Argument strings. */
        !          1458: {
        !          1459:     if (argc != 2) {
        !          1460:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !          1461:                " fileName\"", (char *) NULL);
        !          1462:        return TCL_ERROR;
        !          1463:     }
        !          1464:     return Tcl_EvalFile(interp, argv[1]);
        !          1465: }
        !          1466: 
        !          1467: /*
        !          1468:  *----------------------------------------------------------------------
        !          1469:  *
        !          1470:  * Tcl_TellCmd --
        !          1471:  *
        !          1472:  *     This procedure is invoked to process the "tell" Tcl command.
        !          1473:  *     See the user documentation for details on what it does.
        !          1474:  *
        !          1475:  * Results:
        !          1476:  *     A standard Tcl result.
        !          1477:  *
        !          1478:  * Side effects:
        !          1479:  *     See the user documentation.
        !          1480:  *
        !          1481:  *----------------------------------------------------------------------
        !          1482:  */
        !          1483: 
        !          1484:        /* ARGSUSED */
        !          1485: int
        !          1486: Tcl_TellCmd(notUsed, interp, argc, argv)
        !          1487:     ClientData notUsed;                        /* Not used. */
        !          1488:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1489:     int argc;                          /* Number of arguments. */
        !          1490:     char **argv;                       /* Argument strings. */
        !          1491: {
        !          1492:     OpenFile *filePtr;
        !          1493: 
        !          1494:     if (argc != 2) {
        !          1495:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !          1496:                " fileId\"", (char *) NULL);
        !          1497:        return TCL_ERROR;
        !          1498:     }
        !          1499:     if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
        !          1500:        return TCL_ERROR;
        !          1501:     }
        !          1502:     sprintf(interp->result, "%d", ftell(filePtr->f));
        !          1503:     return TCL_OK;
        !          1504: }
        !          1505: 
        !          1506: /*
        !          1507:  *----------------------------------------------------------------------
        !          1508:  *
        !          1509:  * Tcl_TimeCmd --
        !          1510:  *
        !          1511:  *     This procedure is invoked to process the "time" Tcl command.
        !          1512:  *     See the user documentation for details on what it does.
        !          1513:  *
        !          1514:  * Results:
        !          1515:  *     A standard Tcl result.
        !          1516:  *
        !          1517:  * Side effects:
        !          1518:  *     See the user documentation.
        !          1519:  *
        !          1520:  *----------------------------------------------------------------------
        !          1521:  */
        !          1522: 
        !          1523:        /* ARGSUSED */
        !          1524: int
        !          1525: Tcl_TimeCmd(dummy, interp, argc, argv)
        !          1526:     ClientData dummy;                  /* Not used. */
        !          1527:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1528:     int argc;                          /* Number of arguments. */
        !          1529:     char **argv;                       /* Argument strings. */
        !          1530: {
        !          1531:     int count, i, result;
        !          1532:     double timePer;
        !          1533: #if TCL_GETTOD
        !          1534:     struct timeval start, stop;
        !          1535:     struct timezone tz;
        !          1536:     int micros;
        !          1537: #else
        !          1538:     struct tms dummy2;
        !          1539:     long start, stop;
        !          1540: #endif
        !          1541: 
        !          1542:     if (argc == 2) {
        !          1543:        count = 1;
        !          1544:     } else if (argc == 3) {
        !          1545:        if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
        !          1546:            return TCL_ERROR;
        !          1547:        }
        !          1548:     } else {
        !          1549:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !          1550:                " command ?count?\"", (char *) NULL);
        !          1551:        return TCL_ERROR;
        !          1552:     }
        !          1553: #if TCL_GETTOD
        !          1554:     gettimeofday(&start, &tz);
        !          1555: #else
        !          1556:     start = times(&dummy2);
        !          1557: #endif
        !          1558:     for (i = count ; i > 0; i--) {
        !          1559:        result = Tcl_Eval(interp, argv[1], 0, (char **) NULL);
        !          1560:        if (result != TCL_OK) {
        !          1561:            if (result == TCL_ERROR) {
        !          1562:                char msg[60];
        !          1563:                sprintf(msg, "\n    (\"time\" body line %d)",
        !          1564:                        interp->errorLine);
        !          1565:                Tcl_AddErrorInfo(interp, msg);
        !          1566:            }
        !          1567:            return result;
        !          1568:        }
        !          1569:     }
        !          1570: #if TCL_GETTOD
        !          1571:     gettimeofday(&stop, &tz);
        !          1572:     micros = (stop.tv_sec - start.tv_sec)*1000000
        !          1573:            + (stop.tv_usec - start.tv_usec);
        !          1574:     timePer = micros;
        !          1575: #else
        !          1576:     stop = times(&dummy2);
        !          1577:     timePer = (((double) (stop - start))*1000000.0)/CLK_TCK;
        !          1578: #endif
        !          1579:     Tcl_ResetResult(interp);
        !          1580:     sprintf(interp->result, "%.0f microseconds per iteration", timePer/count);
        !          1581:     return TCL_OK;
        !          1582: }
        !          1583: 
        !          1584: /*
        !          1585:  *----------------------------------------------------------------------
        !          1586:  *
        !          1587:  * CleanupChildren --
        !          1588:  *
        !          1589:  *     This is a utility procedure used to wait for child processes
        !          1590:  *     to exit, record information about abnormal exits, and then
        !          1591:  *     collect any stderr output generated by them.
        !          1592:  *
        !          1593:  * Results:
        !          1594:  *     The return value is a standard Tcl result.  If anything at
        !          1595:  *     weird happened with the child processes, TCL_ERROR is returned
        !          1596:  *     and a message is left in interp->result.
        !          1597:  *
        !          1598:  * Side effects:
        !          1599:  *     If the last character of interp->result is a newline, then it
        !          1600:  *     is removed.  File errorId gets closed, and pidPtr is freed
        !          1601:  *     back to the storage allocator.
        !          1602:  *
        !          1603:  *----------------------------------------------------------------------
        !          1604:  */
        !          1605: 
        !          1606: static int
        !          1607: CleanupChildren(interp, numPids, pidPtr, errorId)
        !          1608:     Tcl_Interp *interp;                /* Used for error messages. */
        !          1609:     int numPids;               /* Number of entries in pidPtr array. */
        !          1610:     int *pidPtr;               /* Array of process ids of children. */
        !          1611:     int errorId;               /* File descriptor index for file containing
        !          1612:                                 * stderr output from pipeline.  -1 means
        !          1613:                                 * there isn't any stderr output. */
        !          1614: {
        !          1615:     int result = TCL_OK;
        !          1616:     int i, pid, length;
        !          1617:     WAIT_STATUS_TYPE waitStatus;
        !          1618: 
        !          1619:     for (i = 0; i < numPids; i++) {
        !          1620:        pid = Tcl_WaitPids(1, &pidPtr[i], (int *) &waitStatus);
        !          1621:        if (pid == -1) {
        !          1622:            Tcl_AppendResult(interp, "error waiting for process to exit: ",
        !          1623:                    Tcl_UnixError(interp), (char *) NULL);
        !          1624:            continue;
        !          1625:        }
        !          1626: 
        !          1627:        /*
        !          1628:         * Create error messages for unusual process exits.  An
        !          1629:         * extra newline gets appended to each error message, but
        !          1630:         * it gets removed below (in the same fashion that an
        !          1631:         * extra newline in the command's output is removed).
        !          1632:         */
        !          1633: 
        !          1634:        if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
        !          1635:            char msg1[20], msg2[20];
        !          1636: 
        !          1637:            result = TCL_ERROR;
        !          1638:            sprintf(msg1, "%d", pid);
        !          1639:            if (WIFEXITED(waitStatus)) {
        !          1640:                sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
        !          1641:                Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
        !          1642:                        (char *) NULL);
        !          1643:            } else if (WIFSIGNALED(waitStatus)) {
        !          1644:                char *p;
        !          1645:        
        !          1646:                p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
        !          1647:                Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
        !          1648:                        Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
        !          1649:                        (char *) NULL);
        !          1650:                Tcl_AppendResult(interp, "child killed: ", p, "\n",
        !          1651:                        (char *) NULL);
        !          1652:            } else if (WIFSTOPPED(waitStatus)) {
        !          1653:                char *p;
        !          1654: 
        !          1655:                p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
        !          1656:                Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
        !          1657:                        Tcl_SignalId((int) (WSTOPSIG(waitStatus))), p, (char *) NULL);
        !          1658:                Tcl_AppendResult(interp, "child suspended: ", p, "\n",
        !          1659:                        (char *) NULL);
        !          1660:            } else {
        !          1661:                Tcl_AppendResult(interp,
        !          1662:                        "child wait status didn't make sense\n",
        !          1663:                        (char *) NULL);
        !          1664:            }
        !          1665:        }
        !          1666:     }
        !          1667:     ckfree((char *) pidPtr);
        !          1668: 
        !          1669:     /*
        !          1670:      * Read the standard error file.  If there's anything there,
        !          1671:      * then return an error and add the file's contents to the result
        !          1672:      * string.
        !          1673:      */
        !          1674: 
        !          1675:     if (errorId >= 0) {
        !          1676:        while (1) {
        !          1677: #          define BUFFER_SIZE 1000
        !          1678:            char buffer[BUFFER_SIZE+1];
        !          1679:            int count;
        !          1680:     
        !          1681:            count = read(errorId, buffer, BUFFER_SIZE);
        !          1682:     
        !          1683:            if (count == 0) {
        !          1684:                break;
        !          1685:            }
        !          1686:            if (count < 0) {
        !          1687:                Tcl_AppendResult(interp,
        !          1688:                        "error reading stderr output file: ",
        !          1689:                        Tcl_UnixError(interp), (char *) NULL);
        !          1690:                break;
        !          1691:            }
        !          1692:            buffer[count] = 0;
        !          1693:            Tcl_AppendResult(interp, buffer, (char *) NULL);
        !          1694:        }
        !          1695:        close(errorId);
        !          1696:     }
        !          1697: 
        !          1698:     /*
        !          1699:      * If the last character of interp->result is a newline, then remove
        !          1700:      * the newline character (the newline would just confuse things).
        !          1701:      */
        !          1702: 
        !          1703:     length = strlen(interp->result);
        !          1704:     if ((length > 0) && (interp->result[length-1] == '\n')) {
        !          1705:        interp->result[length-1] = '\0';
        !          1706:     }
        !          1707: 
        !          1708:     return result;
        !          1709: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.