user/tinytcl/tclunxaz.c

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