home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tcl8.0.5 / os2 / tclOS2File.c < prev    next >
C/C++ Source or Header  |  2001-02-09  |  24KB  |  778 lines
  1. /* 
  2.  * tclOS2File.c --
  3.  *
  4.  *      This file contains temporary wrappers around UNIX file handling
  5.  *      functions. These wrappers map the UNIX functions to OS/2 HFILE-style
  6.  *      files, which can be manipulated through the OS/2 console redirection
  7.  *      interfaces.
  8.  *
  9.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  10.  * Copyright (c) 1996-2001 Illya Vaes
  11.  *
  12.  * See the file "license.terms" for information on usage and redistribution
  13.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14.  */
  15.  
  16.  
  17. #include "tclOS2Int.h"
  18.  
  19. /*
  20.  * The variable below caches the name of the current working directory
  21.  * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
  22.  * NULL means the cache needs to be refreshed.
  23.  */
  24.  
  25. static char *currentDir =  NULL;
  26.  
  27. /*
  28.  * Mapping of drive numbers to drive letters
  29.  */
  30. static char drives[] = {'0', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',
  31.                         'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U',
  32.                         'V', 'W', 'X', 'Y', 'Z'};
  33.  
  34.  
  35. /*
  36.  *----------------------------------------------------------------------
  37.  *
  38.  * Tcl_FindExecutable --
  39.  *
  40.  *    This procedure computes the absolute path name of the current
  41.  *    application, given its argv[0] value.
  42.  *
  43.  * Results:
  44.  *    None.
  45.  *
  46.  * Side effects:
  47.  *    The variable tclExecutableName gets filled in with the file
  48.  *    name for the application, if we figured it out.  If we couldn't
  49.  *    figure it out, Tcl_FindExecutable is set to NULL.
  50.  *
  51.  *----------------------------------------------------------------------
  52.  */
  53.  
  54. void
  55. Tcl_FindExecutable(argv0)
  56.     char *argv0;        /* The value of the application's argv[0]. */
  57. {
  58.     char *p;
  59.  
  60.     if (tclExecutableName != NULL) {
  61.     ckfree(tclExecutableName);
  62.     tclExecutableName = NULL;
  63.     }
  64.  
  65.     tclExecutableName = (char *) ckalloc((unsigned) (strlen(argv0) + 1));
  66.     strcpy(tclExecutableName, argv0);
  67.     /* Convert backslahes to slashes */
  68.     for (p= tclExecutableName; *p != '\0'; p++) {
  69.         if (*p == '\\') *p = '/';
  70.     }
  71. }
  72.  
  73. /*
  74.  *----------------------------------------------------------------------
  75.  *
  76.  * TclMatchFiles --
  77.  *
  78.  *      This routine is used by the globbing code to search a
  79.  *      directory for all files which match a given pattern.
  80.  *
  81.  * Results:
  82.  *      If the tail argument is NULL, then the matching files are
  83.  *      added to the interp->result.  Otherwise, TclDoGlob is called
  84.  *      recursively for each matching subdirectory.  The return value
  85.  *      is a standard Tcl result indicating whether an error occurred
  86.  *      in globbing.
  87.  *
  88.  * Side effects:
  89.  *      None.
  90.  *
  91.  *---------------------------------------------------------------------- */
  92.  
  93. int
  94. TclMatchFiles(interp, separators, dirPtr, pattern, tail)
  95.     Tcl_Interp *interp;         /* Interpreter to receive results. */
  96.     char *separators;           /* Directory separators to pass to TclDoGlob. */
  97.     Tcl_DString *dirPtr;        /* Contains path to directory to search. */
  98.     char *pattern;              /* Pattern to match against. */
  99.     char *tail;                 /* Pointer to end of pattern.  Tail must
  100.                                  * point to a location in pattern. */
  101. {
  102.     char drivePattern[4] = "?:\\";
  103.     char *newPattern, *p, *dir, *root, c;
  104.     int length, matchDotFiles;
  105.     int result = TCL_OK;
  106.     int baseLength = Tcl_DStringLength(dirPtr);
  107.     Tcl_DString buffer;
  108.     ULONG volFlags;
  109.     HDIR handle;
  110.     FILESTATUS3 infoBuf;
  111.     FILEFINDBUF3 data;
  112.     ULONG filesAtATime = 1;
  113.     ULONG diskNum = 3;        /* Assume C: for errors */
  114.     BYTE fsBuf[1024];        /* Info about file system */
  115.     ULONG bufSize;
  116.  
  117. #ifdef VERBOSE
  118.     printf("TclMatchFiles path [%s], pat [%s]\n", Tcl_DStringValue(dirPtr),
  119.            pattern);
  120. #endif
  121.  
  122.     /*
  123.      * Convert the path to normalized form since some interfaces only
  124.      * accept backslashes.  Also, ensure that the directory ends with a
  125.      * separator character.
  126.      */
  127.  
  128.     Tcl_DStringInit(&buffer);
  129.     if (baseLength == 0) {
  130.         Tcl_DStringAppend(&buffer, ".", 1);
  131.     } else {
  132.         Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
  133.                 Tcl_DStringLength(dirPtr));
  134.     }
  135.     for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
  136.         if (*p == '/') {
  137.             *p = '\\';
  138.         }
  139.     }
  140. /*
  141.     p--;
  142.     if (*p != '\\' && (strcmp(Tcl_DStringValue(&buffer), ".") != 0)) {
  143.         Tcl_DStringAppend(&buffer, "\\", 1);
  144.         p++;
  145.     }
  146. */
  147.     p--;
  148.     /*
  149.      * DosQueryPathInfo can only handle a trailing (back)slash for the root
  150.      * of a drive, so cut it off in other case.
  151.      */
  152.     if ((*p == '\\') && (*(p-1) != ':') && (*p != '.')) {
  153.         Tcl_DStringSetLength(&buffer, Tcl_DStringLength(&buffer)-1);
  154.         p--;
  155.     }
  156.     /*
  157.      * In cases of eg. "c:filespec", we need to put the current dir for that
  158.      * disk after the drive specification.
  159.      */
  160.     if (*p == ':') {
  161.         char wd[256];
  162.         ULONG len = 256;
  163.         ULONG drive;
  164.  
  165.         if (*(p-1) > 'Z') drive = *(p-1) - 'a' + 1;
  166.         else drive = *(p-1) - 'A' + 1;
  167.         rc = DosQueryCurrentDir(drive, (PBYTE)wd, &len);
  168. #ifdef VERBOSE
  169.         printf("DosQueryCurrentDir drive %c (%d) returns %d [%s] (len %d)\n",
  170.                *(p-1), drive, rc, wd, len);
  171. #endif
  172.         if (rc == NO_ERROR) {
  173.             Tcl_DStringAppend(&buffer, "\\", 1);
  174.             len = strlen(wd);
  175.             Tcl_DStringAppend(&buffer, wd, len);
  176.             p += len+1;
  177.         }
  178. #ifdef VERBOSE
  179.         printf("    *p now %c\n", *p);
  180. #endif
  181.     }
  182.  
  183.     /*
  184.      * First verify that the specified path is actually a directory.
  185.      */
  186.  
  187.     dir = Tcl_DStringValue(&buffer);
  188.     rc = DosQueryPathInfo(dir, FIL_STANDARD, &infoBuf, sizeof(infoBuf));
  189. #ifdef VERBOSE
  190.     printf("DosQueryPathInfo [%s] returned [%d]\n", dir, rc);
  191.     fflush(stdout);
  192. #endif
  193.     if ( (rc != NO_ERROR) || ((infoBuf.attrFile & FILE_DIRECTORY) == 0)) {
  194.         Tcl_DStringFree(&buffer);
  195.         return TCL_OK;
  196.     }
  197.  
  198.     if (*p != '\\') {
  199.         Tcl_DStringAppend(&buffer, "\\", 1);
  200.     }
  201.     dir = Tcl_DStringValue(&buffer);
  202.  
  203.     /*
  204.      * Next check the volume information for the directory to see whether
  205.      * comparisons should be case sensitive or not.  If the root is null, then
  206.      * we use the root of the current directory.  If the root is just a drive
  207.      * specifier, we use the root directory of the given drive.
  208.      * There's no API for determining case sensitivity and preservation (that
  209.      * I've found) perse. We can determine the File System Driver though, and
  210.      * assume correct values for some file systems we know, eg. FAT, HPFS,
  211.      * NTFS, ext2fs.
  212.      */
  213.  
  214.     switch (Tcl_GetPathType(dir)) {
  215.         case TCL_PATH_RELATIVE: {
  216.             ULONG logical;
  217.             /* Determine current drive */
  218.             DosQueryCurrentDisk(&diskNum, &logical);
  219. #ifdef VERBOSE
  220.             printf("TCL_PATH_RELATIVE, disk %d\n", diskNum);
  221. #endif
  222.  
  223.             break;
  224.         }
  225.         case TCL_PATH_VOLUME_RELATIVE: {
  226.             ULONG logical;
  227.             /* Determine current drive */
  228.             DosQueryCurrentDisk(&diskNum, &logical);
  229. #ifdef VERBOSE
  230.             printf("TCL_PATH_VOLUME_RELATIVE, disk %d\n", diskNum);
  231. #endif
  232.  
  233.             if (*dir == '\\') {
  234.                 root = NULL;
  235.             } else {
  236.                 root = drivePattern;
  237.                 *root = *dir;
  238.             }
  239.             break;
  240.         }
  241.         case TCL_PATH_ABSOLUTE:
  242.             /* Use given drive */
  243.             diskNum = (ULONG) dir[0] - 'A' + 1;
  244.             if (dir[0] >= 'a') {
  245.                 diskNum -= ('a' - 'A');
  246.             }
  247. #ifdef VERBOSE
  248.             printf("TCL_PATH_ABSOLUTE, disk %d\n", diskNum);
  249. #endif
  250.  
  251.             if (dir[1] == ':') {
  252.                 root = drivePattern;
  253.                 *root = *dir;
  254.             } else if (dir[1] == '\\') {
  255.                 p = strchr(dir+2, '\\');
  256.                 p = strchr(p+1, '\\');
  257.                 p++;
  258.                 c = *p;
  259.                 *p = 0;
  260.                 *p = c;
  261.             }
  262.             break;
  263.     }
  264.     /* Now determine file system driver name and hack the case stuff */
  265.     bufSize = sizeof(fsBuf);
  266.     rc = DosQueryFSAttach(NULL, diskNum, FSAIL_DRVNUMBER, ((PFSQBUFFER2)fsBuf),
  267.                           &bufSize);
  268.     if (rc != NO_ERROR) {
  269.         /* Error, assume FAT */
  270. #ifdef VERBOSE
  271.         printf("DosQueryFSAttach %d ERROR %d (bufsize %d)\n", diskNum, rc,
  272.                bufSize);
  273. #endif
  274.         volFlags = 0;
  275.     } else {
  276.         USHORT cbName = ((PFSQBUFFER2) fsBuf)->cbName;
  277. #ifdef VERBOSE
  278.         printf("DosQueryFSAttach %d OK, szN [%s], szFSDN [%s] (bufsize %d)\n",
  279.                diskNum, ((PFSQBUFFER2)fsBuf)->szName,
  280.                ((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, bufSize);
  281. #endif
  282.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "FAT") == 0) {
  283.             volFlags = 0;
  284.         } else
  285.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "HPFS") == 0) {
  286.             volFlags = FS_CASE_IS_PRESERVED;
  287.         } else
  288.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "NFS") == 0) {
  289.             volFlags = FS_CASE_SENSITIVE | FS_CASE_IS_PRESERVED;
  290.         } else
  291.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "EXT2FS") == 0) {
  292.             volFlags = FS_CASE_SENSITIVE | FS_CASE_IS_PRESERVED;
  293.         } else
  294.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "VINES") == 0) {
  295.             volFlags = 0;
  296.         } else
  297.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "NTFS") == 0) {
  298.             volFlags = FS_CASE_IS_PRESERVED;
  299.         } else {
  300.             volFlags = 0;
  301.         }
  302.     }
  303.  
  304.     /*
  305.      * If the volume is not case sensitive, then we need to convert the pattern
  306.      * to lower case.
  307.      */
  308.  
  309.     length = tail - pattern;
  310.     newPattern = ckalloc(length+1);
  311.     if (volFlags & FS_CASE_SENSITIVE) {
  312.         strncpy(newPattern, pattern, length);
  313.         newPattern[length] = '\0';
  314.     } else {
  315.         char *src, *dest;
  316.         for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
  317.             *dest = (char) tolower(*src);
  318.         }
  319.         *dest = '\0';
  320.     }
  321.  
  322.     /*
  323.      * We need to check all files in the directory, so append a *
  324.      * to the path. Not "*.*".
  325.      */
  326.  
  327.  
  328.     dir = Tcl_DStringAppend(&buffer, "*", 3);
  329.  
  330.     /*
  331.      * Now open the directory for reading and iterate over the contents.
  332.      */
  333.  
  334.     handle = HDIR_SYSTEM;
  335.     rc = DosFindFirst(dir, &handle, FILE_NORMAL | FILE_DIRECTORY, &data,
  336.                       sizeof(data), &filesAtATime, FIL_STANDARD);
  337. #ifdef VERBOSE
  338.     printf("DosFindFirst %s returns %x (%s)\n", dir, rc, data.achName);
  339. #endif
  340.     Tcl_DStringFree(&buffer);
  341.  
  342.     if (rc != NO_ERROR) {
  343.         TclOS2ConvertError(rc);
  344.         Tcl_ResetResult(interp);
  345.         Tcl_AppendResult(interp, "couldn't read directory \"",
  346.                 dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
  347.         ckfree(newPattern);
  348.         return TCL_ERROR;
  349.     }
  350.  
  351.     /*
  352.      * Clean up the tail pointer.  Leave the tail pointing to the
  353.      * first character after the path separator or NULL.
  354.      */
  355.  
  356.     if (*tail == '\\') {
  357.         tail++;
  358.     }
  359.     if (*tail == '\0') {
  360.         tail = NULL;
  361.     } else {
  362.         tail++;
  363.     }
  364.  
  365.     /*
  366.      * Check to see if the pattern needs to compare with dot files.
  367.      */
  368.  
  369.     if ((newPattern[0] == '.')
  370.             || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
  371.         matchDotFiles = 1;
  372.     } else {
  373.         matchDotFiles = 0;
  374.     }
  375.  
  376.     /*
  377.      * Now iterate over all of the files in the directory.
  378.      */
  379.  
  380.     Tcl_DStringInit(&buffer);
  381. #ifdef VERBOSE
  382.     for ( rc = NO_ERROR;
  383.           rc == NO_ERROR;
  384.           printf("DosFindNext returns %x (%s)\n",
  385.                  rc = DosFindNext(handle, &data, sizeof(data), &filesAtATime),
  386.                  data.achName)) {
  387. #else
  388.     for (   rc = NO_ERROR;
  389.             rc == NO_ERROR;
  390.             rc = DosFindNext(handle, &data, sizeof(data), &filesAtATime)) {
  391. #endif
  392.         char *matchResult;
  393.  
  394.         /*
  395.          * Ignore hidden files.
  396.          * NB. The Windows port has removed the ignoring of files with
  397.          * attribute FILE_HIDDEN from 7.6 to 8.0 and therefore only considers
  398.          * dot files hidden. So why have we made all those files hidden?
  399.          * Remove '(data.attrFile & FILE_HIDDEN) ||' if you want that.
  400.          */
  401.  
  402.         if ((data.attrFile & FILE_HIDDEN)
  403.                 || (!matchDotFiles && (data.achName[0] == '.'))) {
  404.             continue;
  405.         }
  406.  
  407.         /*
  408.          * Check to see if the file matches the pattern.  If the volume is not
  409.          * case sensitive, we need to convert the file name to lower case.  If
  410.          * the volume also doesn't preserve case, then we return the lower case
  411.          * form of the name, otherwise we return the system form.
  412.          */
  413.  
  414.         matchResult = NULL;
  415.         if (!(volFlags & FS_CASE_SENSITIVE)) {
  416.             Tcl_DStringSetLength(&buffer, 0);
  417.             Tcl_DStringAppend(&buffer, data.achName, -1);
  418.             for (p = buffer.string; *p != '\0'; p++) {
  419.                 *p = (char) tolower(*p);
  420.             }
  421.             if (Tcl_StringMatch(buffer.string, newPattern)) {
  422.                 if (volFlags & FS_CASE_IS_PRESERVED) {
  423.                     matchResult = data.achName;
  424.                 } else {
  425.                     matchResult = buffer.string;
  426.                 }
  427.             }
  428.         } else {
  429.             if (Tcl_StringMatch(data.achName, newPattern)) {
  430.                 matchResult = data.achName;
  431.             }
  432.         }
  433.  
  434.         if (matchResult == NULL) {
  435.             continue;
  436.         }
  437.  
  438.         /*
  439.          * If the file matches, then we need to process the remainder of the
  440.          * path.  If there are more characters to process, then ensure matching
  441.          * files are directories and call TclDoGlob. Otherwise, just add the
  442.          * file to the result.
  443.          */
  444.  
  445.         Tcl_DStringSetLength(dirPtr, baseLength);
  446.         Tcl_DStringAppend(dirPtr, matchResult, -1);
  447.         if (tail == NULL) {
  448.             Tcl_AppendElement(interp, dirPtr->string);
  449.         } else {
  450.             if ((DosQueryPathInfo(dirPtr->string, FIL_STANDARD, &infoBuf,
  451.                     sizeof(infoBuf)) == NO_ERROR) &&
  452.                     (infoBuf.attrFile & FILE_DIRECTORY)) {
  453.                 Tcl_DStringAppend(dirPtr, "/", 1);
  454.                 result = TclDoGlob(interp, separators, dirPtr, tail);
  455.                 if (result != TCL_OK) {
  456.                     break;
  457.                 }
  458.             }
  459.         }
  460.     }
  461.  
  462.     Tcl_DStringFree(&buffer);
  463.     DosFindClose(handle);
  464.     ckfree(newPattern);
  465.     return result;
  466. }
  467.  
  468. /*
  469.  *----------------------------------------------------------------------
  470.  *
  471.  * TclChdir --
  472.  *
  473.  *      Change the current working directory.
  474.  *
  475.  * Results:
  476.  *      The result is a standard Tcl result.  If an error occurs and
  477.  *      interp isn't NULL, an error message is left in interp->result.
  478.  *
  479.  * Side effects:
  480.  *      The working directory for this application is changed.  Also
  481.  *      the cache maintained used by TclGetCwd is deallocated and
  482.  *      set to NULL.
  483.  *
  484.  *----------------------------------------------------------------------
  485.  */
  486.  
  487. int
  488. TclChdir(interp, dirName)
  489.     Tcl_Interp *interp;         /* If non NULL, used for error reporting. */
  490.     char *dirName;              /* Path to new working directory. */
  491. {
  492.  
  493. #ifdef VERBOSE
  494.     printf("TclChDir %s\n", dirName);
  495. #endif
  496.     if (currentDir != NULL) {
  497.         ckfree(currentDir);
  498.         currentDir = NULL;
  499.     }
  500.     /* Set drive, if present */
  501.     if (dirName[1] == ':') {
  502.         ULONG ulDriveNum;
  503.  
  504.         /* Determine disk number */
  505.         for (ulDriveNum=1;
  506.              ulDriveNum < 27 && strnicmp(&drives[ulDriveNum], dirName, 1) != 0;
  507.              ulDriveNum++)
  508.             /* do nothing */;
  509.         if (ulDriveNum == 27) {
  510.             if (interp != NULL) {
  511.                 Tcl_AppendResult(interp, "invalid drive specification \'",
  512.                         dirName[0], "\': ",
  513.                         Tcl_PosixError(interp), (char *) NULL);
  514.             }
  515.             return TCL_ERROR;
  516.         }
  517.         rc = DosSetDefaultDisk(ulDriveNum);
  518. #ifdef VERBOSE
  519.         printf("DosSetDefaultDisk %c (%d) returned [%d]\n", dirName[0],
  520.                ulDriveNum, rc);
  521. #endif
  522.         dirName += 2;
  523.     }
  524.     /* Set directory if specified (not just a drive spec) */
  525.     if (strcmp(dirName, "") != 0) {
  526.         rc = DosSetCurrentDir(dirName);
  527. #ifdef VERBOSE
  528.         printf("DosSetCurrentDir [%s] returned [%d]\n", dirName, rc);
  529. #endif
  530.         if (rc != NO_ERROR) {
  531.             TclOS2ConvertError(rc);
  532.             if (interp != NULL) {
  533.                 Tcl_AppendResult(interp,
  534.                         "couldn't change working directory to \"",
  535.                         dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
  536.             }
  537.             return TCL_ERROR;
  538.         }
  539.     }
  540.     return TCL_OK;
  541. }
  542.  
  543. /*
  544.  *----------------------------------------------------------------------
  545.  *
  546.  * TclGetCwd --
  547.  *
  548.  *      Return the path name of the current working directory.
  549.  *
  550.  * Results:
  551.  *      The result is the full path name of the current working
  552.  *      directory, or NULL if an error occurred while figuring it
  553.  *      out.  If an error occurs and interp isn't NULL, an error
  554.  *      message is left in interp->result.
  555.  *
  556.  * Side effects:
  557.  *      The path name is cached to avoid having to recompute it
  558.  *      on future calls;  if it is already cached, the cached
  559.  *      value is returned.
  560.  *
  561.  *----------------------------------------------------------------------
  562.  */
  563.  
  564. char *
  565. TclGetCwd(interp)
  566.     Tcl_Interp *interp;         /* If non NULL, used for error reporting. */
  567. {
  568. #define DRIVEPART    3    /* Drive letter, ':' and '/' */
  569.     static char buffer[MAXPATHLEN+1+DRIVEPART];
  570.     char *bufPtr = NULL, *p;
  571.     ULONG length = MAXPATHLEN+1;
  572.     ULONG ulDriveNum = 0;    /* A=1, B=2, ... */
  573.     ULONG ulDriveMap = 0;    /* Bitmap of valid drives */
  574.  
  575. #ifdef VERBOSE
  576.     printf("TclGetCwd\n");
  577. #endif
  578.     if (currentDir == NULL) {
  579.         rc = DosQueryCurrentDisk(&ulDriveNum, &ulDriveMap);
  580. #ifdef VERBOSE
  581.         printf("DosQueryCurrentDisk returned [%d], drive %d (%c)\n", rc,
  582.                ulDriveNum, drives[ulDriveNum]);
  583. #endif
  584.         if (rc != NO_ERROR) {
  585.             TclOS2ConvertError(rc);
  586.             if (interp != NULL) {
  587.                 Tcl_AppendResult(interp,
  588.                         "error getting default drive: ",
  589.                         Tcl_PosixError(interp), (char *) NULL);
  590.             }
  591.             return NULL;
  592.         }
  593.         /* OS/2 returns pwd *without* leading slash!, so add it */
  594.         buffer[0] = drives[ulDriveNum];
  595.         buffer[1] = ':';
  596.         buffer[2] = '/';
  597.         rc = DosQueryCurrentDir(0, buffer+3, &length);
  598. #ifdef VERBOSE
  599.         printf("DosQueryCurrentDir returned [%d], dir %s\n", rc, buffer);
  600. #endif
  601.         if (rc != NO_ERROR) {
  602.             TclOS2ConvertError(rc);
  603.             if (interp != NULL) {
  604.                 if (errno == ERANGE) {
  605.                     Tcl_SetResult(interp,
  606.                             "working directory name is too long",
  607.                             TCL_STATIC);
  608.                 } else {
  609.                     Tcl_AppendResult(interp,
  610.                             "error getting working directory name: ",
  611.                             Tcl_PosixError(interp), (char *) NULL);
  612.                 }
  613.             }
  614.             return NULL;
  615.         }
  616.         bufPtr = buffer;
  617.  
  618.         /*
  619.          * Convert to forward slashes for easier use in scripts.
  620.          */
  621.  
  622.         for (p = bufPtr; *p != '\0'; p++) {
  623.             if (*p == '\\') {
  624.                 *p = '/';
  625.             }
  626.         }
  627.     }
  628.     return bufPtr;
  629. }
  630.  
  631. /*
  632.  *----------------------------------------------------------------------
  633.  *
  634.  * TclpStat, TclpLstat --
  635.  *
  636.  *      These functions replace the library versions of stat and lstat.
  637.  *
  638.  *      The stat and lstat functions provided by some compilers
  639.  *      are incomplete.  Ideally, a complete rewrite of stat would go
  640.  *      here; now, the only fix is that stat("c:") used to return an
  641.  *      error instead infor for current dir on specified drive.
  642.  *
  643.  * Results:
  644.  *      See stat documentation.
  645.  *
  646.  * Side effects:
  647.  *      See stat documentation.
  648.  *
  649.  *----------------------------------------------------------------------
  650.  */
  651.  
  652. int
  653. TclpStat(path, buf)
  654.     CONST char *path;           /* Path of file to stat (in current CP). */
  655.     struct stat *buf;           /* Filled with results of stat call. */
  656. {
  657.     char name[4];
  658.     int result;
  659.  
  660.     if ((strlen(path) == 2) && (path[1] == ':')) {
  661.         strcpy(name, path);
  662.         name[2] = '.';
  663.         name[3] = '\0';
  664.         path = name;
  665.     }
  666.  
  667. #undef stat
  668.  
  669.     result = stat(path, buf);
  670.  
  671.     return result;
  672. }
  673.  
  674. /*
  675.  *---------------------------------------------------------------------------
  676.  *
  677.  * TclpAccess --
  678.  *
  679.  *      This function replaces the library version of access.
  680.  *
  681.  *      The library version of access returns that all files have execute
  682.  *      permission.
  683.  *
  684.  * Results:
  685.  *      See access documentation.
  686.  *
  687.  * Side effects:
  688.  *      See access documentation.
  689.  *
  690.  *---------------------------------------------------------------------------
  691.  */
  692.  
  693. int
  694. TclpAccess(
  695.     CONST char *path,           /* Path of file to access (in current CP). */
  696.     int mode)                   /* Permission setting. */
  697. {
  698.     int result;
  699.     CONST char *p;
  700.  
  701. #undef access
  702.  
  703.     result = access(path, mode);
  704. #ifdef VERBOSE
  705.     printf("TclpAccess [%s] [%d] returns %d\n", path, mode, result);
  706.     if (result == -1) {
  707.         printf("    errno %d\n", errno);
  708.     }
  709.     fflush(stdout);
  710. #endif
  711.     if (result == 0) {
  712. /*
  713.     FILESTATUS3 infoBuf;
  714.     rc = DosQueryPathInfo (path, FIL_STANDARD, &infoBuf, sizeof (infoBuf));
  715. */
  716. #ifdef VERBOSE
  717.     printf("TclpAccess [%s] [%d] returns %d\n", path, mode, result);
  718. /*
  719.     printf("TclpAccess [%s] [%d] returns %d\n", path, mode, rc);
  720.     if (rc != NO_ERROR) {
  721.         printf("    ERROR %d\n", rc);
  722.     } else {
  723.         printf("    infoBuf.attrFile %x\n", infoBuf.attrFile);
  724.     }
  725. */
  726.     fflush(stdout);
  727. #endif
  728.  
  729. /*
  730.     if (rc == NO_ERROR) {
  731. */
  732.         if (mode & X_OK) {
  733.             FILESTATUS3 infoBuf;
  734.             if ((DosQueryPathInfo(path, FIL_STANDARD, &infoBuf,
  735.                     sizeof(infoBuf)) == NO_ERROR) &&
  736.                     (infoBuf.attrFile & FILE_DIRECTORY)) {
  737.                 /*
  738.                  * Directories are always executable.
  739.                  */
  740.  
  741.                 return 0;
  742.             }
  743.             p = strrchr(path, '.');
  744.             if (p != NULL) {
  745.                 p++;
  746.                 if ((stricmp(p, "exe") == 0)
  747.                         || (stricmp(p, "com") == 0)
  748.                         || (stricmp(p, "cmd") == 0)
  749.                         || (stricmp(p, "bat") == 0)) {
  750.                     /*
  751.                      * File that ends with .exe, .com, .cmd, or .bat
  752.                      * is executable.
  753.                      */
  754.  
  755.                     return 0;
  756.                 }
  757.             }
  758.             errno = EACCES;
  759.             return -1;
  760.         }
  761. /*
  762.         if (mode & W_OK) {
  763.         if (infoBuf.attrFile & FILE_READONLY) {
  764.                 errno = EACCES;
  765.             return -1;
  766.         }
  767.     }
  768.         if (mode & F_OK) {
  769.         if (infoBuf.attrFile & FILE_HIDDEN) {
  770.                 errno = EACCES;
  771.             return -1;
  772.         }
  773.     }
  774. */
  775.     }
  776.     return result;
  777. }
  778.