home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclOS2File.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-08-07  |  30.6 KB  |  1,057 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-1997 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 "tclInt.h"
  18. #include "tclPort.h"
  19.  
  20. /*
  21.  * Local functions
  22.  */
  23. void      TclOS2DeleteTempFile _ANSI_ARGS_((ClientData name));
  24.  
  25. /*
  26.  * The variable below caches the name of the current working directory
  27.  * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
  28.  * NULL means the cache needs to be refreshed.
  29.  */
  30.  
  31. static char *currentDir =  NULL;
  32.  
  33. /*
  34.  * Mapping of drive numbers to drive letters
  35.  */
  36. static char drives[] = {'0', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J',
  37.                         'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U',
  38.                         'V', 'W', 'X', 'Y', 'Z'};
  39.  
  40.  
  41. /*
  42.  *----------------------------------------------------------------------
  43.  *
  44.  * TclCreateTempFile --
  45.  *
  46.  *    This function opens a unique file with the property that it
  47.  *    will be deleted when its file handle is closed.  The temporary
  48.  *    file is created in the system temporary directory.
  49.  *
  50.  * Results:
  51.  *    Returns a valid C file descriptor, or -1 on failure.
  52.  *
  53.  * Side effects:
  54.  *    Creates a new temporary file.
  55.  *
  56.  *----------------------------------------------------------------------
  57.  */
  58.  
  59. Tcl_File
  60. TclCreateTempFile(char *contents)
  61.     /* string to write into tempfile, or NULL */
  62. {
  63.     unsigned char *name;
  64.     PSZ tmpVal;
  65.     HFILE handle;
  66.     APIRET rc;
  67.     ULONG timeVal[2], action;
  68.     ULONG result, length;
  69.     Tcl_File tclFile;
  70.  
  71.     /* Determine TEMP-path */
  72.     rc = DosScanEnv("TEMP", &tmpVal);
  73. #ifdef DEBUG
  74.     printf("DosScanEnv TEMP returned [%d]\n", rc);
  75. #endif
  76.     if ( rc != NO_ERROR ) {
  77.         /* Try TMP instead */
  78.         rc = DosScanEnv("TMP", &tmpVal);
  79. #ifdef DEBUG
  80.         printf("DosScanEnv TMP returned [%d]\n", rc);
  81. #endif
  82.         if ( rc != NO_ERROR ) {
  83.             TclOS2ConvertError(rc);
  84.             return NULL;
  85.         }
  86.     }
  87.     /* Determine unique value from time */
  88.     rc = DosQuerySysInfo(QSV_TIME_LOW, QSV_TIME_HIGH, (PVOID)timeVal,
  89.                          sizeof(timeVal));
  90.     /* Alloc space for name, free in TclOS2DeleteTempFile */
  91.     name = (unsigned char *)ckalloc(maxPath);
  92.     if (name == (unsigned char *)NULL) return NULL;
  93.     /* Add unique name to path */
  94.     sprintf(name, "%s\\Tcl%04hx.TMP", tmpVal, (SHORT)timeVal[0]);
  95.  
  96.     rc = DosOpen(name, &handle, &action, 0, FILE_NORMAL,
  97.                  OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_REPLACE_IF_EXISTS,
  98.                  OPEN_SHARE_DENYNONE | OPEN_ACCESS_READWRITE, NULL);
  99.  
  100. #ifdef DEBUG
  101.     printf("TclCreateTempFile: DosOpen [%s] handle [%x] rc [%d]\n",
  102.            name, handle, rc);
  103. #endif
  104.     if (rc != NO_ERROR) {
  105.         goto error;
  106.     }
  107.  
  108.     /*
  109.      * Write the file out, doing line translations on the way.
  110.      */
  111.  
  112.     if (contents != NULL) {
  113.         char *p;
  114.  
  115.         for (p = contents; *p != '\0'; p++) {
  116.             if (*p == '\n') {
  117.                 length = p - contents;
  118.                 if (length > 0) {
  119.                     rc = DosWrite(handle, (PVOID)contents, length, &result);
  120. #ifdef DEBUG
  121.                     printf("DosWrite handle %x [%s] returned [%d]\n",
  122.                            handle, contents, rc);
  123. #endif
  124.                     if (rc != NO_ERROR) {
  125.                         goto error;
  126.                     }
  127.                 }
  128.                 if (DosWrite(handle, "\r\n", 2, &result) != NO_ERROR) {
  129.                     goto error;
  130.                 }
  131.                 contents = p+1;
  132.             }
  133.         }
  134.         length = p - contents;
  135.         if (length > 0) {
  136.             rc = DosWrite(handle, (PVOID)contents, length, &result);
  137. #ifdef DEBUG
  138.             printf("DosWrite handle %x [%s] returned [%d]\n",
  139.                    handle, contents, rc);
  140. #endif
  141.             if (rc != NO_ERROR) {
  142.                 goto error;
  143.             }
  144.         }
  145.     }
  146.     rc = DosSetFilePtr(handle, 0, FILE_BEGIN, &result);
  147. #ifdef DEBUG
  148.     printf("DosSetFilePtr handle [%x] returned [%d]\n", handle, rc);
  149. #endif
  150.     if (rc != NO_ERROR) {
  151.         goto error;
  152.     }
  153.     tclFile = Tcl_GetFile((ClientData) handle, TCL_OS2_FILE);
  154.     /* Set up deletion procedure for the file */
  155.     Tcl_SetNotifierData(tclFile, (Tcl_FileFreeProc *)TclOS2DeleteTempFile,
  156.                         (ClientData)name);
  157.  
  158.     return tclFile;
  159.  
  160.   error:
  161.     TclOS2ConvertError(rc);
  162.     rc = DosClose(handle);
  163.     DosDelete(name);
  164.     ckfree((char *)name);;
  165.     return NULL;
  166. }
  167.  
  168. /*
  169.  *----------------------------------------------------------------------
  170.  *
  171.  * TclOpenFile --
  172.  *
  173.  *      This function wraps the normal system open() to ensure that
  174.  *      files are opened with the _O_NOINHERIT flag set.
  175.  *
  176.  * Results:
  177.  *      Same as open().
  178.  *
  179.  * Side effects:
  180.  *      Same as open().
  181.  *
  182.  *----------------------------------------------------------------------
  183.  */
  184.  
  185. Tcl_File
  186. TclOpenFile(path, mode)
  187.     char *path;
  188.     int mode;
  189. {
  190.     HFILE handle;
  191.     ULONG accessMode, createMode, flags, exist;
  192.     APIRET rc;
  193.  
  194.     /*
  195.      * Map the access bits to the OS/2 access mode.
  196.      */
  197.  
  198.     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
  199.         case O_RDONLY:
  200.            accessMode = OPEN_ACCESS_READONLY;
  201.            break;
  202.        case O_WRONLY:
  203.            accessMode = OPEN_ACCESS_WRITEONLY;
  204.            break;
  205.        case O_RDWR:
  206.            accessMode = OPEN_ACCESS_READWRITE;
  207.            break;
  208.        default:
  209.            TclOS2ConvertError(ERROR_INVALID_FUNCTION);
  210.            return NULL;
  211.     }
  212.     /*
  213.      * Map the creation flags to the OS/2 open mode.
  214.      */
  215.  
  216.     switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
  217.         case (O_CREAT | O_EXCL):
  218.         case (O_CREAT | O_EXCL | O_TRUNC):
  219.             createMode = OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_REPLACE_IF_EXISTS;
  220.             break;
  221.         case (O_CREAT | O_TRUNC):
  222.             createMode = OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_REPLACE_IF_EXISTS;
  223.             break;
  224.         case O_CREAT:
  225.             createMode = OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_OPEN_IF_EXISTS;
  226.             break;
  227.         case O_TRUNC:
  228.         case (O_TRUNC | O_EXCL):
  229.             createMode = OPEN_ACTION_CREATE_IF_NEW | OPEN_ACTION_REPLACE_IF_EXISTS;
  230.             break;
  231.         default:
  232.             createMode = OPEN_ACTION_FAIL_IF_NEW | OPEN_ACTION_OPEN_IF_EXISTS;
  233.             break;
  234.     }
  235.  
  236.     /*
  237.      * If the file is not being created, use the existing file attributes.
  238.      */
  239.  
  240.     flags = 0;
  241.     if (!(mode & O_CREAT)) {
  242.         FILESTATUS3 infoBuf;
  243.  
  244.         rc = DosQueryPathInfo(path, FIL_STANDARD, &infoBuf, sizeof(infoBuf));
  245.         if (rc == NO_ERROR) {
  246.             flags = infoBuf.attrFile;
  247.         } else {
  248.             flags = 0;
  249.         }
  250.     }
  251.  
  252.  
  253.    /*
  254.     * Set up the attributes so this file is not inherited by child processes.
  255.     */
  256.  
  257.    accessMode |= OPEN_FLAGS_NOINHERIT;
  258.  
  259.    /*
  260.     * Set up the file sharing mode.  We want to allow simultaneous access.
  261.     */
  262.  
  263.    accessMode |= OPEN_SHARE_DENYNONE;
  264.  
  265.    /*
  266.     * Now we get to create the file.
  267.     */
  268.  
  269.    rc = DosOpen(path, &handle, &exist, 0, flags, createMode, accessMode,
  270.                  (PEAOP2)NULL);
  271. #ifdef DEBUG
  272.    printf("TclOpenFile: DosOpen [%s] returns [%d]\n", path, rc);
  273. #endif
  274.    if (rc != NO_ERROR) {
  275.        ULONG err = 0;
  276.  
  277.        switch (rc) {
  278.            case ERROR_FILE_NOT_FOUND:
  279.            case ERROR_PATH_NOT_FOUND:
  280.                err = ERROR_FILE_NOT_FOUND;
  281.                break;
  282.            case ERROR_ACCESS_DENIED:
  283.            case ERROR_INVALID_ACCESS:
  284.            case ERROR_SHARING_VIOLATION:
  285.            case ERROR_CANNOT_MAKE:
  286.                err = (mode & O_CREAT) ? ERROR_FILE_EXISTS
  287.                                       : ERROR_FILE_NOT_FOUND;
  288.                break;
  289.        }
  290.        TclOS2ConvertError(err);
  291.        return NULL;
  292.     }
  293.  
  294.     return Tcl_GetFile((ClientData) handle, TCL_OS2_FILE);
  295. }
  296.  
  297. /*
  298.  *----------------------------------------------------------------------
  299.  *
  300.  * TclCloseFile --
  301.  *
  302.  *      Closes a file on OS/2.
  303.  *
  304.  * Results:
  305.  *      0 on success, -1 on failure.
  306.  *
  307.  * Side effects:
  308.  *      The file is closed.
  309.  *
  310.  *----------------------------------------------------------------------
  311.  */
  312.  
  313. int
  314. TclCloseFile(file)
  315.     Tcl_File file;      /* The file to close. */
  316. {
  317.     HFILE handle;
  318.     int type;
  319.     APIRET rc;
  320.  
  321.     handle = (HFILE) Tcl_GetFileInfo(file, &type);
  322.  
  323.     if (type == TCL_OS2_FILE || type == TCL_OS2_PIPE) {
  324.         rc = DosClose(handle);
  325. #ifdef DEBUG
  326.         printf("TclCloseFile: DosClose handle [%x] returned [%d]\n",
  327.                handle, rc);
  328. #endif
  329.         if (rc != NO_ERROR) {
  330.             TclOS2ConvertError(rc);
  331.             return -1;
  332.         }
  333.     } else {
  334. #ifdef DEBUG
  335.         printf("TclCloseFile: unexpected file type %x for handle %x\n",
  336.                type, handle);
  337. #endif
  338.         panic("Tcl_CloseFile: unexpected file type");
  339.     }
  340.  
  341.     Tcl_FreeFile(file);
  342.     return 0;
  343. }
  344.  
  345. /*
  346.  *----------------------------------------------------------------------
  347.  *
  348.  * TclSeekFile --
  349.  *
  350.  *      Sets the file pointer on a file indicated by the file.
  351.  *
  352.  * Results:
  353.  *      The new position at which the file pointer is after it was
  354.  *      moved, or -1 on failure.
  355.  *
  356.  * Side effects:
  357.  *      May move the position at which subsequent operations on the
  358.  *      file access it.
  359.  *
  360.  *----------------------------------------------------------------------
  361.  */
  362.  
  363. int
  364. TclSeekFile(file, offset, whence)
  365.     Tcl_File file;      /* File to seek on. */
  366.     int offset;                 /* How much to move. */
  367.     int whence;                 /* Relative to where? */
  368. {
  369.     ULONG moveMethod;
  370.     ULONG newPos;
  371.     HFILE handle;
  372.     int type;
  373.     APIRET rc;
  374.  
  375.     handle = (HFILE) Tcl_GetFileInfo(file, &type);
  376.     if (type != TCL_OS2_FILE) {
  377.         panic("TclSeekFile: unexpected file type");
  378.     }
  379.  
  380.     if (whence == SEEK_SET) {
  381.         moveMethod = FILE_BEGIN;
  382.     } else if (whence == SEEK_CUR) {
  383.         moveMethod = FILE_CURRENT;
  384.     } else {
  385.         moveMethod = FILE_END;
  386.     }
  387.  
  388.     rc = DosSetFilePtr(handle, offset, moveMethod, &newPos);
  389. #ifdef DEBUG
  390.     printf("DosSetFilePtr handle [%x] returned [%d]\n", handle, rc);
  391. #endif
  392.     if (rc != NO_ERROR) {
  393.         TclOS2ConvertError(rc);
  394.         return -1;
  395.     }
  396.     return newPos;
  397. }
  398.  
  399. /*
  400.  *----------------------------------------------------------------------
  401.  *
  402.  * Tcl_FindExecutable --
  403.  *
  404.  *    This procedure computes the absolute path name of the current
  405.  *    application, given its argv[0] value.
  406.  *
  407.  * Results:
  408.  *    None.
  409.  *
  410.  * Side effects:
  411.  *    The variable tclExecutableName gets filled in with the file
  412.  *    name for the application, if we figured it out.  If we couldn't
  413.  *    figure it out, Tcl_FindExecutable is set to NULL.
  414.  *
  415.  *----------------------------------------------------------------------
  416.  */
  417.  
  418. void
  419. Tcl_FindExecutable(argv0)
  420.     char *argv0;        /* The value of the application's argv[0]. */
  421. {
  422.     char *p;
  423.  
  424.     if (tclExecutableName != NULL) {
  425.     ckfree(tclExecutableName);
  426.     tclExecutableName = NULL;
  427.     }
  428.  
  429.     tclExecutableName = (char *) ckalloc((unsigned) (strlen(argv0) + 1));
  430.     strcpy(tclExecutableName, argv0);
  431.     /* Convert backslahes to slashes */
  432.     for (p= tclExecutableName; *p != '\0'; p++) {
  433.         if (*p == '\\') *p = '/';
  434.     }
  435. }
  436.  
  437. /*
  438.  *----------------------------------------------------------------------
  439.  *
  440.  * TclMatchFiles --
  441.  *
  442.  *      This routine is used by the globbing code to search a
  443.  *      directory for all files which match a given pattern.
  444.  *
  445.  * Results:
  446.  *      If the tail argument is NULL, then the matching files are
  447.  *      added to the interp->result.  Otherwise, TclDoGlob is called
  448.  *      recursively for each matching subdirectory.  The return value
  449.  *      is a standard Tcl result indicating whether an error occurred
  450.  *      in globbing.
  451.  *
  452.  * Side effects:
  453.  *      None.
  454.  *
  455.  *---------------------------------------------------------------------- */
  456.  
  457. int
  458. TclMatchFiles(interp, separators, dirPtr, pattern, tail)
  459.     Tcl_Interp *interp;         /* Interpreter to receive results. */
  460.     char *separators;           /* Directory separators to pass to TclDoGlob. */
  461.     Tcl_DString *dirPtr;        /* Contains path to directory to search. */
  462.     char *pattern;              /* Pattern to match against. */
  463.     char *tail;                 /* Pointer to end of pattern.  Tail must
  464.                                  * point to a location in pattern. */
  465. {
  466.     char drivePattern[4] = "?:\\";
  467.     char *newPattern, *p, *dir, *root, c;
  468.     int length, matchDotFiles;
  469.     int result = TCL_OK;
  470.     int baseLength = Tcl_DStringLength(dirPtr);
  471.     Tcl_DString buffer;
  472.     ULONG volFlags;
  473.     HDIR handle;
  474.     FILESTATUS3 infoBuf;
  475.     FILEFINDBUF3 data;
  476.     ULONG filesAtATime = 1;
  477.     APIRET rc;
  478.     ULONG diskNum = 3;        /* Assume C: for errors */
  479.     BYTE fsBuf[1024];        /* Info about file system */
  480.     ULONG bufSize;
  481.  
  482. #ifdef DEBUG
  483.     printf("TclMatchFiles path [%s], pat [%s]\n", Tcl_DStringValue(dirPtr),
  484.            pattern);
  485. #endif
  486.  
  487.     /*
  488.      * Convert the path to normalized form since some interfaces only
  489.      * accept backslashes.  Also, ensure that the directory ends with a
  490.      * separator character.
  491.      */
  492.  
  493.     Tcl_DStringInit(&buffer);
  494.     if (baseLength == 0) {
  495.         Tcl_DStringAppend(&buffer, ".", 1);
  496.     } else {
  497.         Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
  498.                 Tcl_DStringLength(dirPtr));
  499.     }
  500.     for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
  501.         if (*p == '/') {
  502.             *p = '\\';
  503.         }
  504.     }
  505. /*
  506.     p--;
  507.     if (*p != '\\' && (strcmp(Tcl_DStringValue(&buffer), ".") != 0)) {
  508.         Tcl_DStringAppend(&buffer, "\\", 1);
  509.         p++;
  510.     }
  511. */
  512.     p--;
  513.     /*
  514.      * DosQueryPathInfo can only handle a trailing (back)slash for the root
  515.      * of a drive, so cut it off in other case.
  516.      */
  517.     if ((*p == '\\') && (*(p-1) != ':') && (*p != '.')) {
  518.         Tcl_DStringSetLength(&buffer, Tcl_DStringLength(&buffer)-1);
  519.         p--;
  520.     }
  521.     /*
  522.      * In cases of eg. "c:filespec", we need to put the current dir for that
  523.      * disk after the drive specification.
  524.      */
  525.     if (*p == ':') {
  526.         char wd[256];
  527.         ULONG len = 256;
  528.         ULONG drive;
  529.  
  530.         if (*(p-1) > 'Z') drive = *(p-1) - 'a' + 1;
  531.         else drive = *(p-1) - 'A' + 1;
  532.         rc = DosQueryCurrentDir(drive, (PBYTE)wd, &len);
  533. #ifdef DEBUG
  534.         printf("DosQueryCurrentDir drive %c (%d) returns %d [%s] (len %d)\n",
  535.                *(p-1), drive, rc, wd, len);
  536. #endif
  537.         if (rc == NO_ERROR) {
  538.             Tcl_DStringAppend(&buffer, "\\", 1);
  539.             len = strlen(wd);
  540.             Tcl_DStringAppend(&buffer, wd, len);
  541.             p += len+1;
  542.         }
  543. #ifdef DEBUG
  544.         printf("    *p now %c\n", *p);
  545. #endif
  546.     }
  547.  
  548.     /*
  549.      * First verify that the specified path is actually a directory.
  550.      */
  551.  
  552.     dir = Tcl_DStringValue(&buffer);
  553.     rc = DosQueryPathInfo(dir, FIL_STANDARD, &infoBuf, sizeof(infoBuf));
  554. #ifdef DEBUG
  555.     printf("DosQueryPathInfo [%s] returned [%d]\n", dir, rc);
  556.     fflush(stdout);
  557. #endif
  558.     if ( (rc != NO_ERROR) || ((infoBuf.attrFile & FILE_DIRECTORY) == 0)) {
  559.         Tcl_DStringFree(&buffer);
  560.         return TCL_OK;
  561.     }
  562.  
  563.     if (*p != '\\') {
  564.         Tcl_DStringAppend(&buffer, "\\", 1);
  565.     }
  566.     dir = Tcl_DStringValue(&buffer);
  567.  
  568.     /*
  569.      * Next check the volume information for the directory to see whether
  570.      * comparisons should be case sensitive or not.  If the root is null, then
  571.      * we use the root of the current directory.  If the root is just a drive
  572.      * specifier, we use the root directory of the given drive.
  573.      * There's no API for determining case sensitivity and preservation (that
  574.      * I've found) perse. We can determine the File System Driver though, and
  575.      * assume correct values for some file systems we know, eg. FAT, HPFS,
  576.      * NTFS, ext2fs.
  577.      */
  578.  
  579.     switch (Tcl_GetPathType(dir)) {
  580.         case TCL_PATH_RELATIVE: {
  581.             ULONG logical;
  582.             /* Determine current drive */
  583.             DosQueryCurrentDisk(&diskNum, &logical);
  584. #ifdef DEBUG
  585.             printf("TCL_PATH_RELATIVE, disk %d\n", diskNum);
  586. #endif
  587.  
  588.             break;
  589.         }
  590.         case TCL_PATH_VOLUME_RELATIVE: {
  591.             ULONG logical;
  592.             /* Determine current drive */
  593.             DosQueryCurrentDisk(&diskNum, &logical);
  594. #ifdef DEBUG
  595.             printf("TCL_PATH_VOLUME_RELATIVE, disk %d\n", diskNum);
  596. #endif
  597.  
  598.             if (*dir == '\\') {
  599.                 root = NULL;
  600.             } else {
  601.                 root = drivePattern;
  602.                 *root = *dir;
  603.             }
  604.             break;
  605.         }
  606.         case TCL_PATH_ABSOLUTE:
  607.             /* Use given drive */
  608.             diskNum = (ULONG) dir[0] - 'A' + 1;
  609.             if (dir[0] >= 'a') {
  610.                 diskNum -= ('a' - 'A');
  611.             }
  612. #ifdef DEBUG
  613.             printf("TCL_PATH_ABSOLUTE, disk %d\n", diskNum);
  614. #endif
  615.  
  616.             if (dir[1] == ':') {
  617.                 root = drivePattern;
  618.                 *root = *dir;
  619.             } else if (dir[1] == '\\') {
  620.                 p = strchr(dir+2, '\\');
  621.                 p = strchr(p+1, '\\');
  622.                 p++;
  623.                 c = *p;
  624.                 *p = 0;
  625.                 *p = c;
  626.             }
  627.             break;
  628.     }
  629.     /* Now determine file system driver name and hack the case stuff */
  630.     bufSize = sizeof(fsBuf);
  631.     rc = DosQueryFSAttach(NULL, diskNum, FSAIL_DRVNUMBER, ((PFSQBUFFER2)fsBuf),
  632.                           &bufSize);
  633.     if (rc != NO_ERROR) {
  634.         /* Error, assume FAT */
  635. #ifdef DEBUG
  636.         printf("DosQueryFSAttach %d ERROR %d (bufsize %d)\n", diskNum, rc,
  637.                bufSize);
  638. #endif
  639.         volFlags = 0;
  640.     } else {
  641.         USHORT cbName = ((PFSQBUFFER2) fsBuf)->cbName;
  642. #ifdef DEBUG
  643.         printf("DosQueryFSAttach %d OK, szN [%s], szFSDN [%s] (bufsize %d)\n",
  644.                diskNum, ((PFSQBUFFER2)fsBuf)->szName,
  645.                ((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, bufSize);
  646. #endif
  647.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "FAT") == 0) {
  648.             volFlags = 0;
  649.         } else
  650.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "HPFS") == 0) {
  651.             volFlags = FS_CASE_IS_PRESERVED;
  652.         } else
  653.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "NFS") == 0) {
  654.             volFlags = FS_CASE_SENSITIVE | FS_CASE_IS_PRESERVED;
  655.         } else
  656.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "EXT2FS") == 0) {
  657.             volFlags = FS_CASE_SENSITIVE | FS_CASE_IS_PRESERVED;
  658.         } else
  659.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "VINES") == 0) {
  660.             volFlags = 0;
  661.         } else
  662.         if (strcmp(((PFSQBUFFER2)(fsBuf+cbName))->szFSDName, "NTFS") == 0) {
  663.             volFlags = FS_CASE_IS_PRESERVED;
  664.         } else {
  665.             volFlags = 0;
  666.         }
  667.     }
  668.  
  669.     /*
  670.      * If the volume is not case sensitive, then we need to convert the pattern
  671.      * to lower case.
  672.      */
  673.  
  674.     length = tail - pattern;
  675.     newPattern = ckalloc(length+1);
  676.     if (volFlags & FS_CASE_SENSITIVE) {
  677.         strncpy(newPattern, pattern, length);
  678.         newPattern[length] = '\0';
  679.     } else {
  680.         char *src, *dest;
  681.         for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
  682.             *dest = (char) tolower(*src);
  683.         }
  684.         *dest = '\0';
  685.     }
  686.  
  687.     /*
  688.      * We need to check all files in the directory, so append a *
  689.      * to the path. Not "*.*".
  690.      */
  691.  
  692.  
  693.     dir = Tcl_DStringAppend(&buffer, "*", 3);
  694.  
  695.     /*
  696.      * Now open the directory for reading and iterate over the contents.
  697.      */
  698.  
  699.     handle = HDIR_SYSTEM;
  700.     rc = DosFindFirst(dir, &handle, FILE_NORMAL | FILE_DIRECTORY, &data, sizeof(data),
  701.                        &filesAtATime, FIL_STANDARD);
  702. #ifdef DEBUG
  703.     printf("DosFindFirst %s returns %x (%s)\n", dir, rc, data.achName);
  704. #endif
  705.     Tcl_DStringFree(&buffer);
  706.  
  707.     if (rc != NO_ERROR) {
  708.         TclOS2ConvertError(rc);
  709.         Tcl_ResetResult(interp);
  710.         Tcl_AppendResult(interp, "couldn't read directory \"",
  711.                 dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
  712.         ckfree(newPattern);
  713.         return TCL_ERROR;
  714.     }
  715.  
  716.     /*
  717.      * Clean up the tail pointer.  Leave the tail pointing to the
  718.      * first character after the path separator or NULL.
  719.      */
  720.  
  721.     if (*tail == '\\') {
  722.         tail++;
  723.     }
  724.     if (*tail == '\0') {
  725.         tail = NULL;
  726.     } else {
  727.         tail++;
  728.     }
  729.  
  730.     /*
  731.      * Check to see if the pattern needs to compare with dot files.
  732.      */
  733.  
  734.     if ((newPattern[0] == '.')
  735.             || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
  736.         matchDotFiles = 1;
  737.     } else {
  738.         matchDotFiles = 0;
  739.     }
  740.  
  741.     /*
  742.      * Now iterate over all of the files in the directory.
  743.      */
  744.  
  745.     Tcl_DStringInit(&buffer);
  746. #ifdef DEBUG
  747.     for ( rc = NO_ERROR;
  748.           rc == NO_ERROR;
  749.           printf("DosFindNext returns %x (%s)\n",
  750.                  rc = DosFindNext(handle, &data, sizeof(data), &filesAtATime),
  751.                  data.achName)) {
  752. #else
  753.     for (   rc = NO_ERROR;
  754.             rc == NO_ERROR;
  755.             rc = DosFindNext(handle, &data, sizeof(data), &filesAtATime)) {
  756. #endif
  757.         char *matchResult;
  758.  
  759.         /*
  760.          * Ignore hidden files.
  761.          */
  762.  
  763.         if ((data.attrFile & FILE_HIDDEN)
  764.                 || (!matchDotFiles && (data.achName[0] == '.'))) {
  765.             continue;
  766.         }
  767.  
  768.         /*
  769.          * Check to see if the file matches the pattern.  If the volume is not
  770.          * case sensitive, we need to convert the file name to lower case.  If
  771.          * the volume also doesn't preserve case, then we return the lower case
  772.          * form of the name, otherwise we return the system form.
  773.          */
  774.  
  775.         matchResult = NULL;
  776.         if (!(volFlags & FS_CASE_SENSITIVE)) {
  777.             Tcl_DStringSetLength(&buffer, 0);
  778.             Tcl_DStringAppend(&buffer, data.achName, -1);
  779.             for (p = buffer.string; *p != '\0'; p++) {
  780.                 *p = (char) tolower(*p);
  781.             }
  782.             if (Tcl_StringMatch(buffer.string, newPattern)) {
  783.                 if (volFlags & FS_CASE_IS_PRESERVED) {
  784.                     matchResult = data.achName;
  785.                 } else {
  786.                     matchResult = buffer.string;
  787.                 }
  788.             }
  789.         } else {
  790.             if (Tcl_StringMatch(data.achName, newPattern)) {
  791.                 matchResult = data.achName;
  792.             }
  793.         }
  794.  
  795.         if (matchResult == NULL) {
  796.             continue;
  797.         }
  798.  
  799.         /*
  800.          * If the file matches, then we need to process the remainder of the
  801.          * path.  If there are more characters to process, then ensure matching
  802.          * files are directories and call TclDoGlob. Otherwise, just add the
  803.          * file to the result.
  804.          */
  805.  
  806.         Tcl_DStringSetLength(dirPtr, baseLength);
  807.         Tcl_DStringAppend(dirPtr, matchResult, -1);
  808.         if (tail == NULL) {
  809.             Tcl_AppendElement(interp, dirPtr->string);
  810.         } else {
  811.             if ((DosQueryPathInfo(dirPtr->string, FIL_STANDARD, &infoBuf,
  812.                     sizeof(infoBuf)) == NO_ERROR) &&
  813.                     (infoBuf.attrFile & FILE_DIRECTORY)) {
  814.                 Tcl_DStringAppend(dirPtr, "/", 1);
  815.                 result = TclDoGlob(interp, separators, dirPtr, tail);
  816.                 if (result != TCL_OK) {
  817.                     break;
  818.                 }
  819.             }
  820.         }
  821.     }
  822.  
  823.     Tcl_DStringFree(&buffer);
  824.     DosFindClose(handle);
  825.     ckfree(newPattern);
  826.     return result;
  827. }
  828.  
  829. /*
  830.  *----------------------------------------------------------------------
  831.  *
  832.  * TclGetStdHandles --
  833.  *
  834.  *      This function returns the file handles for standard I/O.
  835.  *
  836.  * Results:
  837.  *      Sets the arguments to the standard file handles.
  838.  *
  839.  * Side effects:
  840.  *      None.
  841.  *
  842.  *----------------------------------------------------------------------
  843.  */
  844.  
  845. void
  846. TclGetStdHandles(stdinPtr, stdoutPtr, stderrPtr)
  847.     Tcl_File *stdinPtr;
  848.     Tcl_File *stdoutPtr;
  849.     Tcl_File *stderrPtr;
  850. {
  851.     HFILE hStdInput = (HFILE) 0;
  852.     HFILE hStdOutput = (HFILE) 1;
  853.     HFILE hStdError = (HFILE) 2;
  854.  
  855.     *stdinPtr = Tcl_GetFile((ClientData) hStdInput, TCL_OS2_FILE);
  856.     *stdoutPtr = Tcl_GetFile((ClientData) hStdOutput, TCL_OS2_FILE);
  857.     *stderrPtr = Tcl_GetFile((ClientData) hStdError, TCL_OS2_FILE);
  858. }
  859.  
  860. /*
  861.  *----------------------------------------------------------------------
  862.  *
  863.  * TclChdir --
  864.  *
  865.  *      Change the current working directory.
  866.  *
  867.  * Results:
  868.  *      The result is a standard Tcl result.  If an error occurs and
  869.  *      interp isn't NULL, an error message is left in interp->result.
  870.  *
  871.  * Side effects:
  872.  *      The working directory for this application is changed.  Also
  873.  *      the cache maintained used by TclGetCwd is deallocated and
  874.  *      set to NULL.
  875.  *
  876.  *----------------------------------------------------------------------
  877.  */
  878.  
  879. int
  880. TclChdir(interp, dirName)
  881.     Tcl_Interp *interp;         /* If non NULL, used for error reporting. */
  882.     char *dirName;              /* Path to new working directory. */
  883. {
  884.     APIRET rc;
  885.  
  886. #ifdef DEBUG
  887.     printf("TclChDir %s\n", dirName);
  888. #endif
  889.     if (currentDir != NULL) {
  890.         ckfree(currentDir);
  891.         currentDir = NULL;
  892.     }
  893.     /* Set drive, if present */
  894.     if (dirName[1] == ':') {
  895.         ULONG ulDriveNum;
  896.  
  897.         /* Determine disk number */
  898.         for (ulDriveNum=1;
  899.              ulDriveNum < 27 && strnicmp(&drives[ulDriveNum], dirName, 1) != 0;
  900.              ulDriveNum++)
  901.             /* do nothing */;
  902.         if (ulDriveNum == 27) {
  903.             if (interp != NULL) {
  904.                 Tcl_AppendResult(interp, "invalid drive specification \'",
  905.                         dirName[0], "\': ",
  906.                         Tcl_PosixError(interp), (char *) NULL);
  907.             }
  908.             return TCL_ERROR;
  909.         }
  910.         rc = DosSetDefaultDisk(ulDriveNum);
  911. #ifdef DEBUG
  912.         printf("DosSetDefaultDisk %c (%d) returned [%d]\n", dirName[0],
  913.                ulDriveNum, rc);
  914. #endif
  915.         dirName += 2;
  916.     }
  917.     /* Set directory if specified (not just a drive spec) */
  918.     if (strcmp(dirName, "") != 0) {
  919.         rc = DosSetCurrentDir(dirName);
  920. #ifdef DEBUG
  921.         printf("DosSetCurrentDir [%s] returned [%d]\n", dirName, rc);
  922. #endif
  923.         if (rc != NO_ERROR) {
  924.             TclOS2ConvertError(rc);
  925.             if (interp != NULL) {
  926.                 Tcl_AppendResult(interp,
  927.                         "couldn't change working directory to \"",
  928.                         dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
  929.             }
  930.             return TCL_ERROR;
  931.         }
  932.     }
  933.     return TCL_OK;
  934. }
  935.  
  936. /*
  937.  *----------------------------------------------------------------------
  938.  *
  939.  * TclGetCwd --
  940.  *
  941.  *      Return the path name of the current working directory.
  942.  *
  943.  * Results:
  944.  *      The result is the full path name of the current working
  945.  *      directory, or NULL if an error occurred while figuring it
  946.  *      out.  If an error occurs and interp isn't NULL, an error
  947.  *      message is left in interp->result.
  948.  *
  949.  * Side effects:
  950.  *      The path name is cached to avoid having to recompute it
  951.  *      on future calls;  if it is already cached, the cached
  952.  *      value is returned.
  953.  *
  954.  *----------------------------------------------------------------------
  955.  */
  956.  
  957. char *
  958. TclGetCwd(interp)
  959.     Tcl_Interp *interp;         /* If non NULL, used for error reporting. */
  960. {
  961.     char buffer[MAXPATHLEN+1], *bufPtr;
  962.     ULONG length = MAXPATHLEN+1;
  963.     ULONG ulDriveNum = 0;    /* A=1, B=2, ... */
  964.     ULONG ulDriveMap = 0;    /* Bitmap of valid drives */
  965.     APIRET rc;
  966.  
  967. #ifdef DEBUG
  968.     printf("TclGetCwd\n");
  969. #endif
  970.     if (currentDir == NULL) {
  971.         rc = DosQueryCurrentDisk(&ulDriveNum, &ulDriveMap);
  972. #ifdef DEBUG
  973.         printf("DosQueryCurrentDir returned [%d], drive %d (%c)\n", rc,
  974.                ulDriveNum, drives[ulDriveNum]);
  975. #endif
  976.         if (rc != NO_ERROR) {
  977.             TclOS2ConvertError(rc);
  978.             if (interp != NULL) {
  979.                 Tcl_AppendResult(interp,
  980.                         "error getting default drive: ",
  981.                         Tcl_PosixError(interp), (char *) NULL);
  982.             }
  983.             return NULL;
  984.         }
  985.         rc = DosQueryCurrentDir(0, buffer, &length);
  986. #ifdef DEBUG
  987.         printf("DosQueryCurrentDir returned [%d], dir %s\n", rc, buffer);
  988. #endif
  989.         if (rc != NO_ERROR) {
  990.             TclOS2ConvertError(rc);
  991.             if (interp != NULL) {
  992.                 if (length > MAXPATHLEN+1) {
  993.                     interp->result = "working directory name is too long";
  994.                 } else {
  995.                     Tcl_AppendResult(interp,
  996.                             "error getting working directory name: ",
  997.                             Tcl_PosixError(interp), (char *) NULL);
  998.                 }
  999.             }
  1000.             return NULL;
  1001.         }
  1002.         bufPtr = buffer;
  1003.         /* OS/2 returns pwd *without* leading slash!, so add it */
  1004.         currentDir = (char *) ckalloc((unsigned) (strlen(bufPtr) + 4));
  1005.         currentDir[0] = drives[ulDriveNum];
  1006.         currentDir[1] = ':';
  1007.         currentDir[2] = '/';
  1008.         strcpy(currentDir+3, bufPtr);
  1009.  
  1010.         /*
  1011.          * Convert to forward slashes for easier use in scripts.
  1012.          */
  1013.  
  1014.         for (bufPtr = currentDir; *bufPtr != '\0'; bufPtr++) {
  1015.             if (*bufPtr == '\\') {
  1016.                 *bufPtr = '/';
  1017.             }
  1018.         }
  1019.     }
  1020.     return currentDir;
  1021. }
  1022.  
  1023. /*
  1024.  *----------------------------------------------------------------------
  1025.  *
  1026.  * TclOS2DeleteTempFile --
  1027.  *
  1028.  *      Callback for deleting a temporary file when closing it.
  1029.  *
  1030.  * Results:
  1031.  *      The named file is deleted.
  1032.  *
  1033.  * Side effects:
  1034.  *      None.
  1035.  *
  1036.  *----------------------------------------------------------------------
  1037.  */
  1038.  
  1039. void
  1040. TclOS2DeleteTempFile(name)
  1041.     ClientData name;         /* Name of file to be deleted. */
  1042. {
  1043.     APIRET rc;
  1044. #ifdef DEBUG
  1045.     printf("TclOS2DeleteTempFile %s\n", (PSZ)name);
  1046. #endif
  1047.     rc = DosDelete((PSZ)name);
  1048. #ifdef DEBUG
  1049.     if (rc != NO_ERROR) {
  1050.         printf("    DosDelete ERROR %d\n", rc);
  1051.     } else {
  1052.         printf("    DosDelete OK\n");
  1053.     }
  1054. #endif
  1055.     ckfree((char *)name);
  1056. }
  1057.