home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tcl8.0.5 / os2 / tclOS2FCmd.c < prev    next >
Encoding:
C/C++ Source or Header  |  2001-02-09  |  59.1 KB  |  1,886 lines
  1. /*
  2.  * tclOS2FCmd.c
  3.  *
  4.  *      This file implements the OS/2 specific portion of file manipulation 
  5.  *      subcommands of the "file" command. 
  6.  *
  7.  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
  8.  * Copyright (c) 1996-2001 Illya Vaes
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  */
  14.  
  15. #include "tclOS2Int.h"
  16.  
  17. /*
  18.  * The following constants specify the type of callback when
  19.  * TraverseOS2Tree() calls the traverseProc()
  20.  */
  21.  
  22. #define DOTREE_PRED   1     /* pre-order directory  */
  23. #define DOTREE_POSTD  2     /* post-order directory */
  24. #define DOTREE_F      3     /* regular file */
  25.  
  26. /*
  27.  * Callbacks for file attributes code.
  28.  */
  29.  
  30. static int              CopyFileAtts _ANSI_ARGS_((char *src, char *dst,
  31.                             FILESTATUS3 *fsSource));
  32. static int              GetOS2FileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
  33.                             int objIndex, char *fileName,
  34.                             Tcl_Obj **attributePtrPtr));
  35. #ifdef 0
  36. static int              GetOS2FileLongName _ANSI_ARGS_((Tcl_Interp *interp,
  37.                             int objIndex, char *fileName,
  38.                             Tcl_Obj **attributePtrPtr));
  39. static int              GetOS2FileShortName _ANSI_ARGS_((Tcl_Interp *interp,
  40.                             int objIndex, char *fileName,
  41.                             Tcl_Obj **attributePtrPtr));
  42. #endif
  43. static int              SetOS2FileAttributes _ANSI_ARGS_((Tcl_Interp *interp,
  44.                             int objIndex, char *fileName,
  45.                             Tcl_Obj *attributePtr));
  46. #if 0
  47. static int              CannotGetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
  48.                             int objIndex, char *fileName,
  49.                             Tcl_Obj **attributePtr));
  50. static int              CannotSetAttribute _ANSI_ARGS_((Tcl_Interp *interp,
  51.                             int objIndex, char *fileName,
  52.                             Tcl_Obj *attributePtr));
  53. #endif
  54.  
  55. /*
  56.  * Constants and variables necessary for file attributes subcommand.
  57.  */
  58.  
  59. /*
  60. enum {
  61.     OS2_ARCHIVE_ATTRIBUTE,
  62.     OS2_HIDDEN_ATTRIBUTE,
  63.     OS2_LONGNAME_ATTRIBUTE,
  64.     OS2_READONLY_ATTRIBUTE,
  65.     OS2_SHORTNAME_ATTRIBUTE,
  66.     OS2_SYSTEM_ATTRIBUTE
  67. };
  68.  
  69. static int attributeArray[] = {FILE_ARCHIVED, FILE_HIDDEN, 0, FILE_READONLY, 0,
  70.                                FILE_SYSTEM};
  71.  
  72. char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-longname", "-readonly",
  73.         "-shortname", "-system", (char *) NULL};
  74. CONST TclFileAttrProcs tclpFileAttrProcs[] = {
  75.         {GetOS2FileAttributes, SetOS2FileAttributes},
  76.         {GetOS2FileAttributes, SetOS2FileAttributes},
  77.         {GetOS2FileLongName, CannotSetAttribute},
  78.         {CannotGetAttribute, CannotSetAttribute},
  79.         {GetOS2FileAttributes, SetOS2FileAttributes},
  80.         {GetOS2FileShortName, CannotSetAttribute},
  81.         {CannotGetAttribute, CannotSetAttribute},
  82.         {GetOS2FileAttributes, SetOS2FileAttributes}
  83. };
  84. */
  85. enum {
  86.     OS2_ARCHIVE_ATTRIBUTE,
  87.     OS2_HIDDEN_ATTRIBUTE,
  88.     OS2_READONLY_ATTRIBUTE,
  89.     OS2_SYSTEM_ATTRIBUTE
  90. };
  91.  
  92. static int attributeArray[] = {FILE_ARCHIVED, FILE_HIDDEN, FILE_READONLY,
  93.                                FILE_SYSTEM};
  94.  
  95. char *tclpFileAttrStrings[] = {"-archive", "-hidden", "-readonly", "-system",
  96.                                (char *) NULL};
  97. CONST TclFileAttrProcs tclpFileAttrProcs[] = {
  98.         {GetOS2FileAttributes, SetOS2FileAttributes},
  99.         {GetOS2FileAttributes, SetOS2FileAttributes},
  100.         {GetOS2FileAttributes, SetOS2FileAttributes},
  101.         {GetOS2FileAttributes, SetOS2FileAttributes}
  102. };
  103.  
  104. /*
  105.  * Prototype for the TraverseOS2Tree callback function.
  106.  */
  107.  
  108. typedef int (TraversalProc)(char *src, char *dst, FILESTATUS3 *fsSource,
  109.                             int type, Tcl_DString *errorPtr);
  110.  
  111. /*
  112.  * Declarations for local procedures defined in this file:
  113.  */
  114.  
  115. static void             AttributesPosixError _ANSI_ARGS_((Tcl_Interp *interp,
  116.                             int objIndex, char *fileName, int getOrSet));
  117. #if 0
  118. static int              ConvertFileNameFormat _ANSI_ARGS_((Tcl_Interp *interp,
  119.                             int objIndex, char *fileName, int longShort,
  120.                             Tcl_Obj **attributePtrPtr));
  121. #endif
  122. static int        TraversalCopy(char *src, char *dst, FILESTATUS3 *fsSrc, 
  123.                 int type, Tcl_DString *errorPtr);
  124. static int        TraversalDelete(char *src, char *dst,
  125.                                 FILESTATUS3 *fsSrce, int type,
  126.                                 Tcl_DString *errorPtr);
  127. static int        TraverseOS2Tree(TraversalProc *traverseProc,
  128.                 Tcl_DString *sourcePtr, Tcl_DString *destPtr,
  129.                 Tcl_DString *errorPtr);
  130.  
  131.  
  132. /*
  133.  *---------------------------------------------------------------------------
  134.  *
  135.  * TclpRenameFile --
  136.  *
  137.  *      Changes the name of an existing file or directory, from src to dst.
  138.  *    If src and dst refer to the same file or directory, does nothing
  139.  *    and returns success.  Otherwise if dst already exists, it will be
  140.  *    deleted and replaced by src subject to the following conditions:
  141.  *        If src is a directory, dst may be an empty directory.
  142.  *        If src is a file, dst may be a file.
  143.  *    In any other situation where dst already exists, the rename will
  144.  *    fail.  
  145.  *
  146.  * Results:
  147.  *    If the directory was successfully created, returns TCL_OK.
  148.  *    Otherwise the return value is TCL_ERROR and errno is set to
  149.  *    indicate the error.  Some possible values for errno are:
  150.  *
  151.  *    EACCES:     src or dst parent directory can't be read and/or written.
  152.  *    EEXIST:        dst is a non-empty directory.
  153.  *    EINVAL:        src is a root directory or dst is a subdirectory of src.
  154.  *    EISDIR:        dst is a directory, but src is not.
  155.  *    ENOENT:        src doesn't exist.  src or dst is "".
  156.  *    ENOTDIR:    src is a directory, but dst is not.  
  157.  *    EXDEV:        src and dst are on different filesystems.
  158.  *
  159.  *    EACCES:     exists an open file already referring to src or dst.
  160.  *    EACCES:     src or dst specify the current working directory (NT).
  161.  *    EACCES:        src specifies a char device (nul:, com1:, etc.) 
  162.  *    EEXIST:        dst specifies a char device (nul:, com1:, etc.) (NT)
  163.  *    EACCES:        dst specifies a char device (nul:, com1:, etc.) (95)
  164.  *    
  165.  * Side effects:
  166.  *    The implementation supports cross-filesystem renames of files,
  167.  *    but the caller should be prepared to emulate cross-filesystem
  168.  *    renames of directories if errno is EXDEV.
  169.  *
  170.  *---------------------------------------------------------------------------
  171.  */
  172.  
  173. int
  174. TclpRenameFile(
  175.     char *src,            /* Pathname of file or dir to be renamed. */ 
  176.     char *dst)            /* New pathname for file or directory. */
  177. {
  178.     FILESTATUS3 filestatSrc, filestatDst;
  179.     ULONG srcAttr = 0, dstAttr = 0;
  180.     Tcl_PathType srcPathType, dstPathType;
  181.     
  182.     rc = DosMove(src, dst);
  183.     if (rc == NO_ERROR) {
  184.         return TCL_OK;
  185. #ifdef VERBOSE
  186.         printf("TclpRenameFile DosMove [%s] -> [%s] OK", src, dst);
  187.         fflush(stdout);
  188. #endif
  189.     }
  190. #ifdef VERBOSE
  191.     printf("TclpRenameFile DosMove [%s] -> [%s] ERROR %d\n", src, dst, rc);
  192.     fflush(stdout);
  193. #endif
  194.  
  195.     TclOS2ConvertError(rc);
  196.  
  197.     rc = DosQueryPathInfo(src, FIL_STANDARD, &filestatSrc, sizeof(FILESTATUS3));
  198.     if (rc == NO_ERROR) {
  199.         srcAttr = filestatSrc.attrFile;
  200.     }
  201. #ifdef VERBOSE
  202.       else {
  203.         printf("TclpRenameFile DosQueryPathInfo src %s ERROR %d\n", src, rc);
  204.         fflush(stdout);
  205.     }
  206. #endif
  207.     srcPathType = Tcl_GetPathType(src);
  208.     rc = DosQueryPathInfo(dst, FIL_STANDARD, &filestatDst, sizeof(FILESTATUS3));
  209.     if (rc == NO_ERROR) {
  210.         dstAttr = filestatDst.attrFile;
  211.     }
  212. #ifdef VERBOSE
  213.       else {
  214.         printf("TclpRenameFile DosQueryPathInfo dst %s ERROR %d\n", dst, rc);
  215.         fflush(stdout);
  216.     }
  217. #endif
  218.     dstPathType = Tcl_GetPathType(dst);
  219.  
  220. #ifdef VERBOSE
  221.     printf("   srcAttr %x, dstAttr %x, errno %s\n", srcAttr, dstAttr,
  222.            errno == EBADF ? "EBADF" : (errno==EACCES ? "EACCES" : "?"));
  223. #endif
  224.     if (errno == EBADF) {
  225.     errno = EACCES;
  226.     return TCL_ERROR;
  227.     }
  228.     if (errno == EACCES) {
  229.     decode:
  230.     if (srcAttr & FILE_DIRECTORY) {
  231.         char srcPath[MAX_PATH], dstPath[MAX_PATH];
  232.         int srcArgc, dstArgc, len;
  233.         char **srcArgv, **dstArgv;
  234.  
  235.         /* Get full paths */
  236.         if (srcPathType == TCL_PATH_ABSOLUTE) {
  237.             strcpy(srcPath, src);
  238.         } else {
  239.             /* TCL_PATH_RELATIVE or TCL_PATH_VOLUME_RELATIVE */
  240.             ULONG len = MAX_PATH - 3;
  241.             ULONG diskNum = 3;
  242.             if (srcPathType == TCL_PATH_VOLUME_RELATIVE) {
  243.                 srcPath[0] = src[0];
  244.                 srcPath[1] = src[1];
  245.                 srcPath[2] = '\\';
  246.                 diskNum = src[0] - 'A' + 1;
  247.                 if (src[0] >= 'a') {
  248.                     diskNum -= ('a' - 'A');
  249.                 }
  250.                 rc = DosQueryCurrentDir(diskNum, srcPath+3, &len);
  251.                 if (rc != NO_ERROR) {
  252. #ifdef VERBOSE
  253.                         printf("   DosQueryCurrentDir src ERROR %d\n", rc);
  254.                         fflush(stdout);
  255. #endif
  256.                     return TCL_ERROR;
  257.                 }
  258. #ifdef VERBOSE
  259.                     printf("   DosQueryCurrentDir src [%s] OK\n", srcPath);
  260.                     fflush(stdout);
  261. #endif
  262.                 strcat(srcPath, "\\");
  263.                 strcat(srcPath, src);
  264.             } else {
  265.                 ULONG logical;
  266.                 rc = DosQueryCurrentDisk(&diskNum, &logical);
  267.                 if (rc != NO_ERROR) {
  268. #ifdef VERBOSE
  269.                         printf("   DosQueryCurrentDisk src ERROR %d\n", rc);
  270.                         fflush(stdout);
  271. #endif
  272.                     return TCL_ERROR;
  273.                 }
  274. #ifdef VERBOSE
  275.                     printf("   DosQueryCurrentDisk src OK %d\n", diskNum);
  276.                     fflush(stdout);
  277. #endif
  278.                 srcPath[0] = diskNum + 'A' - 1;
  279.                 srcPath[1] = ':';
  280.                 srcPath[2] = '\\';
  281.                 rc = DosQueryCurrentDir(0, srcPath+3, &len);
  282.                 if (rc != NO_ERROR) {
  283. #ifdef VERBOSE
  284.                         printf("   DosQueryCurrentDir src ERROR %d\n", rc);
  285.                         fflush(stdout);
  286. #endif
  287.                     return TCL_ERROR;
  288.                 }
  289. #ifdef VERBOSE
  290.                     printf("   DosQueryCurrentDir src [%s] OK\n", srcPath);
  291.                     fflush(stdout);
  292. #endif
  293.                 strcat(srcPath, "\\");
  294.                 strcat(srcPath, src);
  295.             }
  296.         }
  297.         if (dstPathType == TCL_PATH_ABSOLUTE) {
  298.             strcpy(dstPath, dst);
  299.         } else {
  300.             /* TCL_PATH_RELATIVE or TCL_PATH_VOLUME_RELATIVE */
  301.             ULONG len = MAX_PATH - 3;
  302.             ULONG diskNum = 3;
  303.             if (dstPathType == TCL_PATH_VOLUME_RELATIVE) {
  304.                 dstPath[0] = dst[0];
  305.                 dstPath[1] = dst[1];
  306.                 dstPath[2] = '\\';
  307.                 diskNum = dst[0] - 'A' + 1;
  308.                 if (dst[0] >= 'a') {
  309.                     diskNum -= ('a' - 'A');
  310.                 }
  311.                 rc = DosQueryCurrentDir(diskNum, dstPath+3, &len);
  312.                 if (rc != NO_ERROR) {
  313. #ifdef VERBOSE
  314.                         printf("   DosQueryCurrentDir dst ERROR %d\n", rc);
  315.                         fflush(stdout);
  316. #endif
  317.                     return TCL_ERROR;
  318.                 }
  319. #ifdef VERBOSE
  320.                     printf("   DosQueryCurrentDir dst [%s] OK\n", dstPath);
  321.                     fflush(stdout);
  322. #endif
  323.                 strcat(dstPath, "\\");
  324.                 strcat(dstPath, dst);
  325.             } else {
  326.                 ULONG logical;
  327.                 rc = DosQueryCurrentDisk(&diskNum, &logical);
  328.                 if (rc != NO_ERROR) {
  329. #ifdef VERBOSE
  330.                         printf("   DosQueryCurrentDisk dst ERROR %d\n", rc);
  331.                         fflush(stdout);
  332. #endif
  333.                     return TCL_ERROR;
  334.                 }
  335. #ifdef VERBOSE
  336.                     printf("   DosQueryCurrentDisk dst OK %d\n", diskNum);
  337.                     fflush(stdout);
  338. #endif
  339.                 dstPath[0] = diskNum + 'A' - 1;
  340.                 dstPath[1] = ':';
  341.                 dstPath[2] = '\\';
  342.                 rc = DosQueryCurrentDir(0, dstPath+3, &len);
  343.                 if (rc != NO_ERROR) {
  344. #ifdef VERBOSE
  345.                         printf("   DosQueryCurrentDir dst ERROR %d\n", rc);
  346.                         fflush(stdout);
  347. #endif
  348.                     return TCL_ERROR;
  349.                 }
  350. #ifdef VERBOSE
  351.                     printf("   DosQueryCurrentDir dst [%s] OK\n", dstPath);
  352.                     fflush(stdout);
  353. #endif
  354.                 strcat(dstPath, "\\");
  355.                 strcat(dstPath, dst);
  356.             }
  357.         }
  358.         len = strlen(srcPath);
  359.         if (strnicmp(srcPath, dstPath, len) == 0 &&
  360.             (*(dstPath+len) == '\0' || *(dstPath+len) == '\\' )) {
  361.         /*
  362.          * Trying to move a directory into itself.
  363.          */
  364.  
  365. #ifdef VERBOSE
  366.                 printf("   strnicmp(%s,%s)==0 ==> EINVAL\n", srcPath, dstPath);
  367.                 fflush(stdout);
  368. #endif
  369.         errno = EINVAL;
  370.         return TCL_ERROR;
  371.         }
  372.         Tcl_SplitPath(srcPath, &srcArgc, &srcArgv);
  373. #ifdef VERBOSE
  374.             printf("   strnicmp(%s,%s) != 0\n", srcPath, dstPath);
  375.             fflush(stdout);
  376. #endif
  377.         Tcl_SplitPath(dstPath, &dstArgc, &dstArgv);
  378.         if (srcArgc == 1) {
  379.         /*
  380.          * They are trying to move a root directory.  Whether
  381.          * or not it is across filesystems, this cannot be
  382.          * done.
  383.          */
  384.  
  385. #ifdef VERBOSE
  386.                 printf("   srcArgc == 1 ==> EINVAL\n");
  387.                 fflush(stdout);
  388. #endif
  389.  
  390.         errno = EINVAL;
  391.         return TCL_ERROR;
  392.         } else if ((srcArgc > 0) && (dstArgc > 0) &&
  393.             (stricmp(srcArgv[0], dstArgv[0]) != 0)) {
  394.         /*
  395.          * If src is a directory and dst filesystem != src
  396.          * filesystem, errno should be EXDEV.  It is very
  397.          * important to get this behavior, so that the caller
  398.          * can respond to a cross filesystem rename by
  399.          * simulating it with copy and delete.  The DosMove
  400.          * system call already returns EXDEV (ERROR_NOT_SAME_DEVICE)
  401.          * when moving a file between filesystems.
  402.          */
  403.  
  404. #ifdef VERBOSE
  405.                 printf("   EXDEV\n");
  406.                 fflush(stdout);
  407. #endif
  408.  
  409.         errno = EXDEV;
  410.         }
  411.  
  412.         ckfree((char *) srcArgv);
  413.         ckfree((char *) dstArgv);
  414.     }
  415.     if (!(dstAttr & FILE_DIRECTORY)) {
  416.         /* Destination exists and is not a directory */
  417. #ifdef VERBOSE
  418.             printf("   dst exists, not a directory ==> EEXIST\n");
  419.             fflush(stdout);
  420. #endif
  421.         errno = EEXIST;
  422.     }
  423.         errno = EEXIST;
  424.  
  425.     /*
  426.      * Other types of access failure is that dst is a read-only
  427.      * filesystem, that an open file referred to src or dest, or that
  428.      * src or dest specified the current working directory on the
  429.      * current filesystem.  EACCES is returned for those cases.
  430.      */
  431.  
  432.     }
  433.     if (errno == EEXIST) {
  434.     /*
  435.      * Reports EEXIST any time the target already exists.  If it makes
  436.      * sense, remove the old file and try renaming again.
  437.      */
  438. #ifdef VERBOSE
  439.         printf("   EEXIST\n");
  440.         fflush(stdout);
  441. #endif
  442.  
  443.     if (srcAttr & FILE_DIRECTORY) {
  444.         if (dstAttr & FILE_DIRECTORY) {
  445.         /*
  446.          * Overwrite empty dst directory with src directory.  The
  447.          * following call will remove an empty directory.  If it
  448.          * fails, it's because it wasn't empty.
  449.          */
  450.  
  451.         if (TclpRemoveDirectory(dst, 0, NULL) == TCL_OK) {
  452.             /*
  453.              * Now that that empty directory is gone, we can try
  454.              * renaming again.  If that fails, we'll put this empty
  455.              * directory back, for completeness.
  456.              */
  457.  
  458.                     rc = DosMove(src, dst);
  459.                     if (rc == NO_ERROR) {
  460. #ifdef VERBOSE
  461.                         printf("   retry DosMove [%s]->[%s] OK\n", src, dst);
  462.                         fflush(stdout);
  463. #endif
  464.             return TCL_OK;
  465.             }
  466. #ifdef VERBOSE
  467.                     printf("   retry DosMove [%s]->[%s] ERROR %d\n", src, dst,
  468.                            rc);
  469.                     fflush(stdout);
  470. #endif
  471.  
  472.             /*
  473.              * Some new error has occurred.  Don't know what it
  474.              * could be, but report this one.
  475.              */
  476.  
  477.             TclOS2ConvertError(rc);
  478.             rc = DosCreateDir(dst, (PEAOP2)NULL);
  479. #ifdef VERBOSE
  480.                     printf("   DosCreateDir %s returns %d\n", dst, rc);
  481.                     fflush(stdout);
  482. #endif
  483.                     rc = DosSetPathInfo(dst, FIL_STANDARD, &filestatDst,
  484.                                         sizeof(FILESTATUS3), (ULONG)0);
  485. #ifdef VERBOSE
  486.                     printf("   DosSetPathInfo %s returns %d\n", dst, rc);
  487.                     fflush(stdout);
  488. #endif
  489.             if (errno == EACCES) {
  490.             /*
  491.              * Decode the EACCES to a more meaningful error.
  492.              */
  493.  
  494.             goto decode;
  495.             }
  496.         }
  497.         } else {    /* (dstAttr & FILE_DIRECTORY) == 0 */
  498.         errno = ENOTDIR;
  499.         }
  500.     } else {    /* (srcAttr & FILE_DIRECTORY) == 0 */
  501.         if (dstAttr & FILE_DIRECTORY) {
  502.         errno = EISDIR;
  503.         } else {
  504.         /*
  505.          * Overwrite existing file by:
  506.          * 
  507.          * 1. Rename existing file to temp name.
  508.          * 2. Rename old file to new name.
  509.          * 3. If success, delete temp file.  If failure,
  510.          *    put temp file back to old name.
  511.          */
  512.  
  513.         char tempName[MAX_PATH];
  514.         int result;
  515.         ULONG timeVal[2];
  516.         
  517.             if (dstPathType == TCL_PATH_ABSOLUTE) {
  518.                 strcpy(tempName, dst);
  519.             } else {
  520.                 /* TCL_PATH_RELATIVE or TCL_PATH_VOLUME_RELATIVE */
  521.                 ULONG len = MAX_PATH - 3;
  522.                 ULONG diskNum = 3;
  523.                 if (dstPathType == TCL_PATH_VOLUME_RELATIVE) {
  524. #ifdef VERBOSE
  525.                         printf("   dst TCL_PATH_VOLUME_RELATIVE\n");
  526. #endif
  527.                     tempName[0] = dst[0];
  528.                     tempName[1] = dst[1];
  529.                     tempName[2] = '\\';
  530.                     diskNum = dst[0] - 'A' + 1;
  531.                     if (dst[0] >= 'a') {
  532.                         diskNum -= ('a' - 'A');
  533.                     }
  534.                     rc = DosQueryCurrentDir(diskNum, tempName+3, &len);
  535.                     if (rc != NO_ERROR) {
  536.                         return TCL_ERROR;
  537.                     }
  538.                 } else {
  539.                     ULONG logical;
  540. #ifdef VERBOSE
  541.                         printf("   dst != TCL_PATH_VOLUME_RELATIVE\n");
  542. #endif
  543.                     rc = DosQueryCurrentDisk(&diskNum, &logical);
  544.                     if (rc != NO_ERROR) {
  545.                         return TCL_ERROR;
  546.                     }
  547.                     tempName[0] = diskNum + 'A' - 1;
  548.                     tempName[1] = ':';
  549.                     tempName[2] = '\\';
  550.                     rc = DosQueryCurrentDir(0, tempName+3, &len);
  551.                     if (rc != NO_ERROR) {
  552.                         return TCL_ERROR;
  553.                     }
  554.                 }
  555.             }
  556.         result = TCL_ERROR;
  557.                 /* Determine unique value from time */
  558.                 rc = DosQuerySysInfo(QSV_TIME_LOW - 1, QSV_TIME_HIGH - 1,
  559.                                      (PVOID)timeVal, sizeof(timeVal));
  560.         if (rc == NO_ERROR) {
  561.                     /* Add unique name to path */
  562.                     sprintf(tempName, "%s\\tclr%04hx.TMP", tempName,
  563.                             (SHORT)timeVal[0]);
  564.             /*
  565.              * Strictly speaking, need the following DosDelete and
  566.              * DosMove to be joined as an atomic operation so no
  567.              * other app comes along in the meantime and creates the
  568.              * same temp file.
  569.              */
  570.              
  571.             DosDelete(tempName);
  572.                     rc = DosMove(dst, tempName);
  573. #ifdef VERBOSE
  574.                     printf("   DosMove %s->%s returns %d\n", dst, tempName, rc);
  575. #endif
  576.                     if (rc == NO_ERROR) {
  577.                         rc = DosMove(src, dst);
  578. #ifdef VERBOSE
  579.                         printf("   DosMove %s->%s returns %d\n", src, dst, rc);
  580. #endif
  581.                         if (rc == NO_ERROR) {
  582.                             filestatDst.attrFile = FILE_NORMAL;
  583.                             rc = DosSetPathInfo(tempName, FIL_STANDARD,
  584.                                                 &filestatDst,
  585.                                                 sizeof(FILESTATUS3), (ULONG)0);
  586.                 DosDelete(tempName);
  587.                 return TCL_OK;
  588.             } else {
  589.                 DosDelete(dst);
  590.                             rc = DosMove(tempName, dst);
  591. #ifdef VERBOSE
  592.                             printf("   DosMove %s->%s (restore) returns %d\n",
  593.                                    tempName, dst, rc);
  594. #endif
  595.             }
  596.             } 
  597.  
  598.             /*
  599.              * Can't backup dst file or move src file.  Return that
  600.              * error.  Could happen if an open file refers to dst.
  601.              */
  602.  
  603.             TclOS2ConvertError(rc);
  604.             if (errno == EACCES) {
  605.             /*
  606.              * Decode the EACCES to a more meaningful error.
  607.              */
  608.  
  609.             goto decode;
  610.             }
  611.         }
  612.         return result;
  613.         }
  614.     }
  615.     }
  616.     return TCL_ERROR;
  617. }
  618.  
  619. /*
  620.  *---------------------------------------------------------------------------
  621.  *
  622.  * TclpCopyFile --
  623.  *
  624.  *      Copy a single file (not a directory).  If dst already exists and
  625.  *    is not a directory, it is removed.
  626.  *
  627.  * Results:
  628.  *    If the file was successfully copied, returns TCL_OK.  Otherwise
  629.  *    the return value is TCL_ERROR and errno is set to indicate the
  630.  *    error.  Some possible values for errno are:
  631.  *
  632.  *    EACCES:     src or dst parent directory can't be read and/or written.
  633.  *    EISDIR:        src or dst is a directory.
  634.  *    ENOENT:        src doesn't exist.  src or dst is "".
  635.  *
  636.  *    EACCES:     exists an open file already referring to dst (95).
  637.  *    EACCES:        src specifies a char device (nul:, com1:, etc.) (NT)
  638.  *    ENOENT:        src specifies a char device (nul:, com1:, etc.) (95)
  639.  *
  640.  * Side effects:
  641.  *    It is not an error to copy to a char device.
  642.  *
  643.  *---------------------------------------------------------------------------
  644.  */
  645.  
  646. int 
  647. TclpCopyFile(
  648.     char *src,            /* Pathname of file to be copied. */
  649.     char *dst)            /* Pathname of file to copy to. */
  650. {
  651.     FILESTATUS3 filestatSrc, filestatDst;
  652. #ifdef VERBOSE
  653.     printf("TclpCopyFile [%s] -> [%s]\n", src, dst);
  654.     fflush(stdout);
  655. #endif
  656.  
  657.     rc = DosCopy(src, dst, DCPY_EXISTING);
  658.     if (rc == NO_ERROR) {
  659.         return TCL_OK;
  660.     }
  661. #ifdef VERBOSE
  662.     printf("TclpCopyFile DosCopy %s->%s ERROR %d\n", src, dst, rc);
  663.     fflush(stdout);
  664. #endif
  665.  
  666.     TclOS2ConvertError(rc);
  667. #ifdef VERBOSE
  668.     printf("   errno %s\n",
  669.            errno == EBADF ? "EBADF" : (errno==EACCES ? "EACCES" : "?"));
  670. #endif
  671.     if (errno == EBADF) {
  672.     errno = EACCES;
  673.     return TCL_ERROR;
  674.     }
  675.     if (errno == EACCES) {
  676.     ULONG srcAttr = 0, dstAttr = 0;
  677.  
  678.         rc = DosQueryPathInfo(src, FIL_STANDARD, &filestatSrc,
  679.                               sizeof(FILESTATUS3));
  680. #ifdef VERBOSE
  681.         printf("   DosQueryPathInfo src [%s] returns %d\n", src, rc);
  682.         fflush(stdout);
  683. #endif
  684.         if (rc == NO_ERROR) {
  685.             srcAttr = filestatSrc.attrFile;
  686.             rc = DosQueryPathInfo(dst, FIL_STANDARD, &filestatDst,
  687.                                   sizeof(FILESTATUS3));
  688. #ifdef VERBOSE
  689.             printf("   DosQueryPathInfo dst [%s] returns %d\n", dst, rc);
  690.             fflush(stdout);
  691. #endif
  692.             if (rc == NO_ERROR) {
  693.                 dstAttr = filestatDst.attrFile;
  694.         }
  695.         if ((srcAttr & FILE_DIRECTORY) ||
  696.             (dstAttr & FILE_DIRECTORY)) {
  697. #ifdef VERBOSE
  698.                 printf("   errno => EISDIR\n");
  699.                 fflush(stdout);
  700. #endif
  701.         errno = EISDIR;
  702.         }
  703.         if (dstAttr & FILE_READONLY) {
  704.                 filestatDst.attrFile = dstAttr & ~FILE_READONLY;
  705.                 rc = DosSetPathInfo(dst, FIL_STANDARD, &filestatDst,
  706.                                     sizeof(FILESTATUS3), (ULONG)0);
  707. #ifdef VERBOSE
  708.                 printf("   DosSetPathInfo dst [%s] returns %d\n", dst, rc);
  709.                 fflush(stdout);
  710. #endif
  711.                 rc = DosCopy(src, dst, DCPY_EXISTING);
  712. #ifdef VERBOSE
  713.                 printf("   DosCopy [%s]->[%s] returns %d\n", src, dst, rc);
  714.                 fflush(stdout);
  715. #endif
  716.                 if (rc == NO_ERROR) {
  717.             return TCL_OK;
  718.         }
  719.         /*
  720.          * Still can't copy onto dst.  Return that error, and
  721.          * restore attributes of dst.
  722.          */
  723.  
  724.         TclOS2ConvertError(rc);
  725.                 filestatDst.attrFile = dstAttr;
  726.                 rc = DosSetPathInfo(dst, FIL_STANDARD, &filestatDst,
  727.                                     sizeof(FILESTATUS3), (ULONG)0);
  728.         }
  729.     }
  730.     }
  731.     return TCL_ERROR;
  732. }
  733.  
  734. /*
  735.  *---------------------------------------------------------------------------
  736.  *
  737.  * TclpDeleteFile --
  738.  *
  739.  *      Removes a single file (not a directory).
  740.  *
  741.  * Results:
  742.  *    If the file was successfully deleted, returns TCL_OK.  Otherwise
  743.  *    the return value is TCL_ERROR and errno is set to indicate the
  744.  *    error.  Some possible values for errno are:
  745.  *
  746.  *    EACCES:     a parent directory can't be read and/or written.
  747.  *    EISDIR:        path is a directory.
  748.  *    ENOENT:        path doesn't exist or is "".
  749.  *
  750.  *    EACCES:     exists an open file already referring to path.
  751.  *    EACCES:        path is a char device (nul:, com1:, etc.)
  752.  *
  753.  * Side effects:
  754.  *      The file is deleted, even if it is read-only.
  755.  *
  756.  *---------------------------------------------------------------------------
  757.  */
  758.  
  759. int
  760. TclpDeleteFile(
  761.     char *path)            /* Pathname of file to be removed. */
  762. {
  763.     FILESTATUS3 filestat;
  764.     ULONG attr = 0;
  765. #ifdef VERBOSE
  766.     printf("TclpDeleteFile [%s]\n", path);
  767.     fflush(stdout);
  768. #endif
  769.  
  770.     rc = DosDelete(path);
  771.     if (rc == NO_ERROR) {
  772.     return TCL_OK;
  773.     }
  774. #ifdef VERBOSE
  775.     printf("TclpDeleteFile DosDelete %s ERROR %d\n", path, rc);
  776.     fflush(stdout);
  777. #endif
  778.     TclOS2ConvertError(rc);
  779.     if (errno == EACCES) {
  780.         rc = DosQueryPathInfo(path, FIL_STANDARD, &filestat,
  781.                               sizeof(FILESTATUS3));
  782. #ifdef VERBOSE
  783.         printf("   DosQueryPathInfo [%s] returns %d\n", path, rc);
  784.         fflush(stdout);
  785. #endif
  786.         if (rc == NO_ERROR) {
  787.             attr = filestat.attrFile;
  788.         if (attr & FILE_DIRECTORY) {
  789.         /*
  790.          * OS/2 reports removing a directory (with DosDelete) as
  791.          * EACCES instead of EISDIR.
  792.          */
  793.  
  794.         errno = EISDIR;
  795.         } else if (attr & FILE_READONLY) {
  796.                 filestat.attrFile = attr & ~FILE_READONLY;
  797.                 rc = DosSetPathInfo(path, FIL_STANDARD, &filestat,
  798.                                     sizeof(FILESTATUS3), (ULONG)0);
  799. #ifdef VERBOSE
  800.                 printf("   DosSetPathInfo [%s] returns %d\n", path, rc);
  801.                 fflush(stdout);
  802. #endif
  803.                 rc = DosDelete(path);
  804. #ifdef VERBOSE
  805.                 printf("   DosDelete [%s] returns %d\n", path, rc);
  806.                 fflush(stdout);
  807. #endif
  808.                 if (rc == NO_ERROR) {
  809.             return TCL_OK;
  810.         }
  811.         TclOS2ConvertError(rc);
  812.                 filestat.attrFile = attr;
  813.                 rc = DosSetPathInfo(path, FIL_STANDARD, &filestat,
  814.                                     sizeof(FILESTATUS3), (ULONG)0);
  815. #ifdef VERBOSE
  816.                 printf("   DosSetPathInfo [%s] returns %d\n", path, rc);
  817.                 fflush(stdout);
  818. #endif
  819.         }
  820.     }
  821.     }
  822.  
  823.     return TCL_ERROR;
  824. }
  825.  
  826. /*
  827.  *---------------------------------------------------------------------------
  828.  *
  829.  * TclpCreateDirectory --
  830.  *
  831.  *      Creates the specified directory.  All parent directories of the
  832.  *    specified directory must already exist.  The directory is
  833.  *    automatically created with permissions so that user can access
  834.  *    the new directory and create new files or subdirectories in it.
  835.  *
  836.  * Results:
  837.  *    If the directory was successfully created, returns TCL_OK.
  838.  *    Otherwise the return value is TCL_ERROR and errno is set to
  839.  *    indicate the error.  Some possible values for errno are:
  840.  *
  841.  *    EACCES:     a parent directory can't be read and/or written.
  842.  *    EEXIST:        path already exists.
  843.  *    ENOENT:        a parent directory doesn't exist.
  844.  *
  845.  * Side effects:
  846.  *      A directory is created.
  847.  *
  848.  *---------------------------------------------------------------------------
  849.  */
  850.  
  851. int
  852. TclpCreateDirectory(
  853.     char *path)            /* Pathname of directory to create */
  854. {
  855.     FILESTATUS3 filestat;
  856. #ifdef VERBOSE
  857.     printf("TclpCreateDirectory [%s]\n", path);
  858.     fflush(stdout);
  859. #endif
  860.     rc = DosCreateDir(path, (PEAOP2)NULL);
  861.     if (rc != NO_ERROR) {
  862. #ifdef VERBOSE
  863.         printf("TclpCreateDirectory DosCreateDir %s ERROR %d\n", path, rc);
  864.         fflush(stdout);
  865. #endif
  866.     TclOS2ConvertError(rc);
  867.     /*
  868.      * fCmd.test 10.5 shows we have to generate an EEXIST in case this
  869.      * directory already exists (OS/2 generates EACCES).
  870.      */
  871.         if (errno == EACCES) {
  872.             rc = DosQueryPathInfo(path, FIL_STANDARD, &filestat,
  873.                                   sizeof(FILESTATUS3));
  874. #ifdef VERBOSE
  875.             printf("   DosQueryPathInfo [%s] returns %d\n", path, rc);
  876.             fflush(stdout);
  877. #endif
  878.             if (rc == NO_ERROR) {
  879.                 errno = EEXIST;
  880. #ifdef VERBOSE
  881.                 printf("   errno => EEXIST\n");
  882.                 fflush(stdout);
  883. #endif
  884.         }
  885.     }
  886.     return TCL_ERROR;
  887.     }   
  888.     return TCL_OK;
  889. }
  890.  
  891. /*
  892.  *---------------------------------------------------------------------------
  893.  *
  894.  * TclpCopyDirectory --
  895.  *
  896.  *      Recursively copies a directory.  The target directory dst must
  897.  *    not already exist.  Note that this function does not merge two
  898.  *    directory hierarchies, even if the target directory is an an
  899.  *    empty directory.
  900.  *
  901.  * Results:
  902.  *    If the directory was successfully copied, returns TCL_OK.
  903.  *    Otherwise the return value is TCL_ERROR, errno is set to indicate
  904.  *    the error, and the pathname of the file that caused the error
  905.  *    is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
  906.  *    for a description of possible values for errno.
  907.  *
  908.  * Side effects:
  909.  *      An exact copy of the directory hierarchy src will be created
  910.  *    with the name dst.  If an error occurs, the error will
  911.  *      be returned immediately, and remaining files will not be
  912.  *    processed.
  913.  *
  914.  *---------------------------------------------------------------------------
  915.  */
  916.  
  917. int
  918. TclpCopyDirectory(
  919.     char *src,            /* Pathname of directory to be copied. */
  920.     char *dst,            /* Pathname of target directory. */
  921.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  922.                  * error reporting. */
  923. {
  924.     int result;
  925.     Tcl_DString srcBuffer;
  926.     Tcl_DString dstBuffer;
  927. #ifdef VERBOSE
  928.     printf("TclpCopyDirectory [%s] -> [%s]\n", src, dst);
  929.     fflush(stdout);
  930. #endif
  931.  
  932.     Tcl_DStringInit(&srcBuffer);
  933.     Tcl_DStringInit(&dstBuffer);
  934.     Tcl_DStringAppend(&srcBuffer, src, -1);
  935.     Tcl_DStringAppend(&dstBuffer, dst, -1);
  936.     result = TraverseOS2Tree(TraversalCopy, &srcBuffer, &dstBuffer, 
  937.         errorPtr);
  938.     Tcl_DStringFree(&srcBuffer);
  939.     Tcl_DStringFree(&dstBuffer);
  940.     return result;
  941. }
  942.  
  943. /*
  944.  *----------------------------------------------------------------------
  945.  *
  946.  * TclpRemoveDirectory -- 
  947.  *
  948.  *    Removes directory (and its contents, if the recursive flag is set).
  949.  *
  950.  * Results:
  951.  *    If the directory was successfully removed, returns TCL_OK.
  952.  *    Otherwise the return value is TCL_ERROR, errno is set to indicate
  953.  *    the error, and the pathname of the file that caused the error
  954.  *    is stored in errorPtr.  Some possible values for errno are:
  955.  *
  956.  *    EACCES:     path directory can't be read and/or written.
  957.  *    EEXIST:        path is a non-empty directory.
  958.  *    EINVAL:        path is root directory or current directory.
  959.  *    ENOENT:        path doesn't exist or is "".
  960.  *     ENOTDIR:    path is not a directory.
  961.  *
  962.  *    EACCES:        path is a char device (nul:, com1:, etc.) (95)
  963.  *    EINVAL:        path is a char device (nul:, com1:, etc.) (NT)
  964.  *
  965.  * Side effects:
  966.  *    Directory removed.  If an error occurs, the error will be returned
  967.  *    immediately, and remaining files will not be deleted.
  968.  *
  969.  *----------------------------------------------------------------------
  970.  */
  971.  
  972. int
  973. TclpRemoveDirectory(
  974.     char *path,            /* Pathname of directory to be removed. */
  975.     int recursive,        /* If non-zero, removes directories that
  976.                  * are nonempty.  Otherwise, will only remove
  977.                  * empty directories. */
  978.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  979.                  * error reporting. */
  980. {
  981.     int result;
  982.     Tcl_DString buffer;
  983.     FILESTATUS3 filestat;
  984.     ULONG attr = 0;
  985. #ifdef VERBOSE
  986.     printf("TclpRemoveDirectory [%s] (recursive %d)\n", path, recursive);
  987.     fflush(stdout);
  988. #endif
  989.  
  990.     rc = DosDeleteDir(path);
  991.     if (rc == NO_ERROR) {
  992.     return TCL_OK;
  993.     }
  994. #ifdef VERBOSE
  995.     printf("TclpRemoveDirectory DosDeleteDir %s ERROR %d\n", path, rc);
  996.     fflush(stdout);
  997. #endif
  998.     TclOS2ConvertError(rc);
  999.     if (errno == EACCES) {
  1000.         rc = DosQueryPathInfo(path, FIL_STANDARD, &filestat,
  1001.                               sizeof(FILESTATUS3));
  1002. #ifdef VERBOSE
  1003.         printf("   DosQueryPathInfo [%s] returns %d\n", path, rc);
  1004.         fflush(stdout);
  1005. #endif
  1006.         if (rc == NO_ERROR) {
  1007.             Tcl_DString buffer;
  1008.             char *find;
  1009.             int len;
  1010.             HDIR handle;
  1011.             FILEFINDBUF3 data;
  1012.             ULONG filesAtATime = 1;
  1013.  
  1014.             attr = filestat.attrFile;
  1015.         if ((attr & FILE_DIRECTORY) == 0) {
  1016.         /* 
  1017.          * OS/2 reports calling DosDeleteDir on a file as an 
  1018.          * EACCES, not an ENOTDIR.
  1019.          */
  1020.         
  1021.         errno = ENOTDIR;
  1022.         goto end;
  1023.         }
  1024.  
  1025.         if (attr & FILE_READONLY) {
  1026.                 filestat.attrFile = attr & ~FILE_READONLY;
  1027.                 rc = DosSetPathInfo(path, FIL_STANDARD, &filestat,
  1028.                                     sizeof(FILESTATUS3), (ULONG)0);
  1029.                 rc = DosDeleteDir(path);
  1030.                 if (rc == NO_ERROR) {
  1031.             return TCL_OK;
  1032.         }
  1033.         TclOS2ConvertError(rc);
  1034.                 filestat.attrFile = attr;
  1035.                 rc = DosSetPathInfo(path, FIL_STANDARD, &filestat,
  1036.                                     sizeof(FILESTATUS3), (ULONG)0);
  1037.         }
  1038.  
  1039.         /* 
  1040.          * OS/2 reports removing a non-empty directory as
  1041.          * an EACCES, not an EEXIST.  If the directory is not empty,
  1042.          * change errno so caller knows what's going on.
  1043.          */
  1044.  
  1045.             Tcl_DStringInit(&buffer);
  1046.             find = Tcl_DStringAppend(&buffer, path, -1);
  1047.             len = Tcl_DStringLength(&buffer);
  1048.             if ((len > 0) && (find[len - 1] != '\\')) {
  1049.                 Tcl_DStringAppend(&buffer, "\\", 1);
  1050.             }
  1051.             find = Tcl_DStringAppend(&buffer, "*.*", 3);
  1052.             /* Use a new handle since we don't know if another find is active */
  1053.             handle = HDIR_CREATE;
  1054.             rc = DosFindFirst(find, &handle, FILE_NORMAL | FILE_DIRECTORY,
  1055.                               &data, sizeof(data), &filesAtATime, FIL_STANDARD);
  1056. #ifdef VERBOSE
  1057.             printf("   DosFindFirst %s returns %x (%s) (%d)\n", find, rc,
  1058.                    data.achName, filesAtATime);
  1059. #endif
  1060.             if (rc == NO_ERROR) {
  1061.                 while (1) {
  1062.                     if ((strcmp(data.achName, ".") != 0)
  1063.                     && (strcmp(data.achName, "..") != 0)) {
  1064.                         /*
  1065.                          * Found something in this directory.
  1066.                          */
  1067.             
  1068.                         errno = EEXIST;
  1069.                         break;
  1070.                     }
  1071.                     rc = DosFindNext(handle, &data, sizeof(data),
  1072.                                      &filesAtATime);
  1073. #ifdef VERBOSE
  1074.                     printf("   DosFindNext returns %x (%s) (%d)\n", rc,
  1075.                            data.achName, filesAtATime);
  1076. #endif
  1077.                     if (rc != NO_ERROR) {
  1078.                         break;
  1079.                     }
  1080.                 }
  1081.                 DosFindClose(handle);
  1082.             }
  1083.             Tcl_DStringFree(&buffer);
  1084.     }
  1085.     }
  1086.     if (errno == ENOTEMPTY) {
  1087.     /* 
  1088.      * The caller depends on EEXIST to signify that the directory is
  1089.      * not empty, not ENOTEMPTY. 
  1090.      */
  1091.  
  1092.     errno = EEXIST;
  1093.     }
  1094.     if ((recursive != 0) && (errno == EEXIST)) {
  1095.     /*
  1096.      * The directory is nonempty, but the recursive flag has been
  1097.      * specified, so we recursively remove all the files in the directory.
  1098.      */
  1099.  
  1100.     Tcl_DStringInit(&buffer);
  1101.     Tcl_DStringAppend(&buffer, path, -1);
  1102.     result = TraverseOS2Tree(TraversalDelete, &buffer, NULL, errorPtr);
  1103.     Tcl_DStringFree(&buffer);
  1104.     return result;
  1105.     }
  1106.  
  1107.     end:
  1108.     if (errorPtr != NULL) {
  1109.         Tcl_DStringAppend(errorPtr, path, -1);
  1110.     }
  1111.     return TCL_ERROR;
  1112. }
  1113.  
  1114. /*
  1115.  *---------------------------------------------------------------------------
  1116.  *
  1117.  * TraverseOS2Tree --
  1118.  *
  1119.  *      Traverse directory tree specified by sourcePtr, calling the function 
  1120.  *    traverseProc for each file and directory encountered.  If destPtr 
  1121.  *    is non-null, each of name in the sourcePtr directory is appended to 
  1122.  *    the directory specified by destPtr and passed as the second argument 
  1123.  *    to traverseProc() .
  1124.  *
  1125.  * Results:
  1126.  *      Standard Tcl result.
  1127.  *
  1128.  * Side effects:
  1129.  *      None caused by TraverseOS2Tree, however the user specified 
  1130.  *    traverseProc() may change state.  If an error occurs, the error will
  1131.  *      be returned immediately, and remaining files will not be processed.
  1132.  *
  1133.  *---------------------------------------------------------------------------
  1134.  */
  1135.  
  1136. static int 
  1137. TraverseOS2Tree(
  1138.     TraversalProc *traverseProc,/* Function to call for every file and
  1139.                  * directory in source hierarchy. */
  1140.     Tcl_DString *sourcePtr,    /* Pathname of source directory to be
  1141.                  * traversed. */
  1142.     Tcl_DString *targetPtr,    /* Pathname of directory to traverse in
  1143.                  * parallel with source directory. */
  1144.     Tcl_DString *errorPtr)    /* If non-NULL, an initialized DString for
  1145.                  * error reporting. */
  1146. {
  1147.     FILESTATUS3 filestatSrc;
  1148.     ULONG sourceAttr = 0;
  1149.     char *source, *target, *errfile;
  1150.     int result, sourceLen, targetLen = 0, sourceLenOriginal, targetLenOriginal;
  1151.     HDIR handle;
  1152.     FILEFINDBUF3 data;
  1153.     ULONG filesAtATime = 1;
  1154. #ifdef VERBOSE
  1155.     printf("TraverseOS2Tree [%s] -> [%s]\n", Tcl_DStringValue(sourcePtr),
  1156.            targetPtr ? Tcl_DStringValue(targetPtr) : "NULL");
  1157.     fflush(stdout);
  1158. #endif
  1159.  
  1160.     result = TCL_OK;
  1161.     source = Tcl_DStringValue(sourcePtr);
  1162.     sourceLenOriginal = Tcl_DStringLength(sourcePtr);
  1163.     if (targetPtr != NULL) {
  1164.     target = Tcl_DStringValue(targetPtr);
  1165.     targetLenOriginal = Tcl_DStringLength(targetPtr);
  1166.     } else {
  1167.     target = NULL;
  1168.     targetLenOriginal = 0;
  1169.     }
  1170.  
  1171.     errfile = NULL;
  1172.  
  1173.     rc = DosQueryPathInfo(source, FIL_STANDARD, &filestatSrc,
  1174.                           sizeof(FILESTATUS3));
  1175. #ifdef VERBOSE
  1176.     printf("   DosQueryPathInfo source [%s] returns %d\n", source, rc);
  1177.     fflush(stdout);
  1178. #endif
  1179.     if (rc == NO_ERROR) {
  1180.         sourceAttr = filestatSrc.attrFile;
  1181.     } else {
  1182.     errfile = source;
  1183.     goto end;
  1184.     }
  1185.     if ((sourceAttr & FILE_DIRECTORY) == 0) {
  1186.     /*
  1187.      * Process the regular file
  1188.      */
  1189.  
  1190.     return (*traverseProc)(source, target, &filestatSrc, DOTREE_F,
  1191.                                errorPtr);
  1192.     }
  1193.  
  1194.     /*
  1195.      * When given the pathname of the form "c:\" (one that already ends
  1196.      * with a backslash), must make sure not to add another "\" to the end
  1197.      * otherwise it will try to access a network drive.  
  1198.      */
  1199.  
  1200.     sourceLen = sourceLenOriginal;
  1201.     if ((sourceLen > 0) && (source[sourceLen - 1] != '\\')) {
  1202.     Tcl_DStringAppend(sourcePtr, "\\", 1);
  1203.     sourceLen++;
  1204.     }
  1205.     source = Tcl_DStringAppend(sourcePtr, "*.*", 3); 
  1206.     /* Use a new handle since we can be doing this recursively */
  1207.     handle = HDIR_CREATE;
  1208.     rc = DosFindFirst(source, &handle, FILE_NORMAL | FILE_DIRECTORY,
  1209.                       &data, sizeof(data), &filesAtATime, FIL_STANDARD);
  1210. #ifdef VERBOSE
  1211.     printf("   DosFindFirst %s returns %x (%s) (%d)\n", source, rc,
  1212.            data.achName, filesAtATime);
  1213. #endif
  1214.     Tcl_DStringSetLength(sourcePtr, sourceLen);
  1215.     if (rc != NO_ERROR) {
  1216.     /* 
  1217.      * Can't read directory
  1218.      */
  1219.  
  1220.     TclOS2ConvertError(rc);
  1221.     errfile = source;
  1222.     goto end;
  1223.     }
  1224.  
  1225.     result = (*traverseProc)(source, target, &filestatSrc, DOTREE_PRED,
  1226.                              errorPtr);
  1227.     if (result != TCL_OK) {
  1228.     DosFindClose(handle);
  1229.     return result;
  1230.     }
  1231.  
  1232.     if (targetPtr != NULL) {
  1233.     targetLen = targetLenOriginal;
  1234.     if ((targetLen > 0) && (target[targetLen - 1] != '\\')) {
  1235.         target = Tcl_DStringAppend(targetPtr, "\\", 1);
  1236.         targetLen++;
  1237.     }
  1238.     }
  1239.  
  1240.     while (1) {
  1241.     if ((strcmp(data.achName, ".") != 0)
  1242.             && (strcmp(data.achName, "..") != 0)) {
  1243.         /* 
  1244.          * Append name after slash, and recurse on the file. 
  1245.          */
  1246.  
  1247.         Tcl_DStringAppend(sourcePtr, data.achName, -1);
  1248.         if (targetPtr != NULL) {
  1249.         Tcl_DStringAppend(targetPtr, data.achName, -1);
  1250.         }
  1251.         result = TraverseOS2Tree(traverseProc, sourcePtr, targetPtr, 
  1252.             errorPtr);
  1253.         if (result != TCL_OK) {
  1254.         break;
  1255.         }
  1256.  
  1257.         /*
  1258.          * Remove name after slash.
  1259.          */
  1260.  
  1261.         Tcl_DStringSetLength(sourcePtr, sourceLen);
  1262.         if (targetPtr != NULL) {
  1263.         Tcl_DStringSetLength(targetPtr, targetLen);
  1264.         }
  1265.     }
  1266.         rc = DosFindNext(handle, &data, sizeof(data), &filesAtATime);
  1267. #ifdef VERBOSE
  1268.         printf("   DosFindNext returns %x (%s) (%d)\n", rc, data.achName,
  1269.                filesAtATime);
  1270. #endif
  1271.         if (rc != NO_ERROR) {
  1272.         break;
  1273.     }
  1274.     }
  1275.     DosFindClose(handle);
  1276.  
  1277.     /*
  1278.      * Strip off the trailing slash we added
  1279.      */
  1280.  
  1281.     Tcl_DStringSetLength(sourcePtr, sourceLenOriginal);
  1282.     source = Tcl_DStringValue(sourcePtr);
  1283.     if (targetPtr != NULL) {
  1284.     Tcl_DStringSetLength(targetPtr, targetLenOriginal);
  1285.     target = Tcl_DStringValue(targetPtr);
  1286.     }
  1287.  
  1288.     if (result == TCL_OK) {
  1289.     /*
  1290.      * Call traverseProc() on a directory after visiting all the
  1291.      * files in that directory.
  1292.      */
  1293.  
  1294.     result = (*traverseProc)(source, target, &filestatSrc, DOTREE_POSTD,
  1295.                   errorPtr);
  1296.     }
  1297.     end:
  1298.     if (errfile != NULL) {
  1299.     TclOS2ConvertError(rc);
  1300.     if (errorPtr != NULL) {
  1301.         Tcl_DStringAppend(errorPtr, errfile, -1);
  1302.     }
  1303.     result = TCL_ERROR;
  1304.     }
  1305.         
  1306.     return result;
  1307. }
  1308.  
  1309. /*
  1310.  *----------------------------------------------------------------------
  1311.  *
  1312.  * TraversalCopy
  1313.  *
  1314.  *      Called from TraverseOS2Tree in order to execute a recursive
  1315.  *      copy of a directory.
  1316.  *
  1317.  * Results:
  1318.  *      Standard Tcl result.
  1319.  *
  1320.  * Side effects:
  1321.  *      Depending on the value of type, src may be copied to dst.
  1322.  *      
  1323.  *----------------------------------------------------------------------
  1324.  */
  1325.  
  1326. static int 
  1327. TraversalCopy(
  1328.     char *src,            /* Source pathname to copy. */
  1329.     char *dst,            /* Destination pathname of copy. */
  1330.     FILESTATUS3 *fsSource,    /* File status for src. */
  1331.     int type,            /* Reason for call - see TraverseOS2Tree() */
  1332.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  1333.                  * error return. */
  1334. {
  1335. #ifdef VERBOSE
  1336.     printf("TraversalCopy [%s] -> [%s] (type %s)\n", src, dst,
  1337.            type == DOTREE_PRED ? "DOTREE_PRED"
  1338.                    : (type == DOTREE_POSTD ? "DOTREE_POSTD"
  1339.                               : (type == DOTREE_F ? "DOTREE_F"
  1340.                                          : "???")));
  1341.     fflush(stdout);
  1342. #endif
  1343.     switch (type) {
  1344.     case DOTREE_F:
  1345.         if (TclpCopyFile(src, dst) == TCL_OK) {
  1346.         return TCL_OK;
  1347.         }
  1348.         break;
  1349.  
  1350.     case DOTREE_PRED:
  1351.         if (TclpCreateDirectory(dst) == TCL_OK) {
  1352.                 return TCL_OK;
  1353.         }
  1354.         break;
  1355.  
  1356.         case DOTREE_POSTD:
  1357.         if (CopyFileAtts(src, dst, fsSource) == TCL_OK) {
  1358.             return TCL_OK;
  1359.         }
  1360.         break;
  1361.  
  1362.     }
  1363.  
  1364.     /*
  1365.      * There shouldn't be a problem with src, because we already
  1366.      * checked it to get here.
  1367.      */
  1368.  
  1369.     if (errorPtr != NULL) {
  1370.     Tcl_DStringAppend(errorPtr, dst, -1);
  1371.     }
  1372.     return TCL_ERROR;
  1373. }
  1374.  
  1375. /*
  1376.  *----------------------------------------------------------------------
  1377.  *
  1378.  * TraversalDelete --
  1379.  *
  1380.  *      Called by procedure TraverseOS2Tree for every file and
  1381.  *      directory that it encounters in a directory hierarchy. This
  1382.  *      procedure unlinks files, and removes directories after all the
  1383.  *      containing files have been processed.
  1384.  *
  1385.  * Results:
  1386.  *      Standard Tcl result.
  1387.  *
  1388.  * Side effects:
  1389.  *      Files or directory specified by src will be deleted. If an
  1390.  *      error occurs, the windows error is converted to a Posix error
  1391.  *      and errno is set accordingly.
  1392.  *
  1393.  *----------------------------------------------------------------------
  1394.  */
  1395.  
  1396. static int
  1397. TraversalDelete( 
  1398.     char *src,            /* Source pathname. */
  1399.     char *ignore,        /* Destination pathname (not used). */
  1400.     FILESTATUS3 *fsSource,    /* File status for src (not used). */
  1401.     int type,            /* Reason for call - see TraverseOS2Tree(). */
  1402.     Tcl_DString *errorPtr)    /* If non-NULL, initialized DString for
  1403.                  * error return. */
  1404. {
  1405. #ifdef VERBOSE
  1406.     printf("TraversalDelete [%s] -> [%s] (type %s)\n", src, ignore,
  1407.            type == DOTREE_PRED ? "DOTREE_PRED"
  1408.                    : (type == DOTREE_POSTD ? "DOTREE_POSTD"
  1409.                               : (type == DOTREE_F ? "DOTREE_F"
  1410.                                          : "???")));
  1411.     fflush(stdout);
  1412. #endif
  1413.     switch (type) {
  1414.     case DOTREE_F:
  1415.         if (TclpDeleteFile(src) == TCL_OK) {
  1416.         return TCL_OK;
  1417.         }
  1418.         break;
  1419.  
  1420.     case DOTREE_PRED:
  1421.         return TCL_OK;
  1422.  
  1423.     case DOTREE_POSTD:
  1424.         if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
  1425.         return TCL_OK;
  1426.         }
  1427.         break;
  1428.  
  1429.     }
  1430.  
  1431.     if (errorPtr != NULL) {
  1432.     Tcl_DStringAppend(errorPtr, src, -1);
  1433.     }
  1434.     return TCL_ERROR;
  1435. }
  1436.  
  1437. /*
  1438.  *----------------------------------------------------------------------
  1439.  *
  1440.  * AttributesPosixError --
  1441.  *
  1442.  *      Sets the object result with the appropriate error.
  1443.  *
  1444.  * Results:
  1445.  *      None.
  1446.  *
  1447.  * Side effects:
  1448.  *      The interp's object result is set with an error message
  1449.  *      based on the objIndex, fileName and errno.
  1450.  *
  1451.  *----------------------------------------------------------------------
  1452.  */
  1453.  
  1454. static void
  1455. AttributesPosixError(
  1456.     Tcl_Interp *interp,         /* The interp that has the error */
  1457.     int objIndex,               /* The attribute which caused the problem. */
  1458.     char *fileName,             /* The name of the file which caused the
  1459.                                  * error. */
  1460.     int getOrSet)               /* 0 for get; 1 for set */
  1461. {
  1462.     TclOS2ConvertError(rc);
  1463.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1464.             "cannot ", getOrSet ? "set" : "get", " attribute \"",
  1465.             tclpFileAttrStrings[objIndex], "\" for file \"", fileName,
  1466.             "\": ", Tcl_PosixError(interp), (char *) NULL);
  1467. }
  1468.  
  1469. /*
  1470.  *----------------------------------------------------------------------
  1471.  *
  1472.  * GetOS2FileAttributes --
  1473.  *
  1474.  *      Returns a Tcl_Obj containing the value of a file attribute.
  1475.  *      This routine gets the -hidden, -readonly or -system attribute.
  1476.  *
  1477.  * Results:
  1478.  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
  1479.  *      will have ref count 0. If the return value is not TCL_OK,
  1480.  *      attributePtrPtr is not touched.
  1481.  *
  1482.  * Side effects:
  1483.  *      A new object is allocated if the file is valid.
  1484.  *
  1485.  *----------------------------------------------------------------------
  1486.  */
  1487.  
  1488. static int
  1489. GetOS2FileAttributes(
  1490.     Tcl_Interp *interp,             /* The interp we are using for errors. */
  1491.     int objIndex,                   /* The index of the attribute. */
  1492.     char *fileName,                 /* The name of the file. */
  1493.     Tcl_Obj **attributePtrPtr)      /* A pointer to return the object with. */
  1494. {
  1495.     FILESTATUS3 fileStatus;
  1496.  
  1497.     rc = DosQueryPathInfo(fileName, FIL_STANDARD, &fileStatus,
  1498.                           sizeof(FILESTATUS3));
  1499. #ifdef VERBOSE
  1500.     printf("GetOS2FileAttributes [%s] returns %d\n", fileName, rc);
  1501. #endif
  1502.     if (rc != NO_ERROR) {
  1503.         AttributesPosixError(interp, objIndex, fileName, 0);
  1504.         return TCL_ERROR;
  1505.     }
  1506.  
  1507.     *attributePtrPtr = Tcl_NewBooleanObj(fileStatus.attrFile
  1508.                                          & attributeArray[objIndex]);
  1509.     return TCL_OK;
  1510. }
  1511.  
  1512. #if 0
  1513. /*
  1514.  *----------------------------------------------------------------------
  1515.  *
  1516.  * ConvertFileNameFormat --
  1517.  *
  1518.  *      Returns a Tcl_Obj containing either the long or short version of the
  1519.  *      file name.
  1520.  *
  1521.  * Results:
  1522.  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
  1523.  *      will have ref count 0. If the return value is not TCL_OK,
  1524.  *      attributePtrPtr is not touched.
  1525.  *
  1526.  * Side effects:
  1527.  *      A new object is allocated if the file is valid.
  1528.  *
  1529.  *----------------------------------------------------------------------
  1530.  */
  1531.  
  1532. static int
  1533. ConvertFileNameFormat(
  1534.     Tcl_Interp *interp,             /* The interp we are using for errors. */
  1535.     int objIndex,                   /* The index of the attribute. */
  1536.     char *fileName,                 /* The name of the file. */
  1537.     int longShort,                  /* 0 to short name, 1 to long name. */
  1538.     Tcl_Obj **attributePtrPtr)      /* A pointer to return the object with. */
  1539. {
  1540.     HDIR findHandle;
  1541.     FILEFINDBUF3 findData;
  1542.     ULONG filesAtATime = 1;
  1543.     int pathArgc, i;
  1544.     char **pathArgv, **newPathArgv;
  1545.     char *currentElement, *resultStr;
  1546.     Tcl_DString resultDString;
  1547.     int result = TCL_OK;
  1548.  
  1549.     Tcl_SplitPath(fileName, &pathArgc, &pathArgv);
  1550.     newPathArgv = (char **) ckalloc(pathArgc * sizeof(char *));
  1551.  
  1552.     i = 0;
  1553.     if ((pathArgv[0][0] == '/')
  1554.             || ((strlen(pathArgv[0]) == 3) && (pathArgv[0][1] == ':'))) {
  1555.         newPathArgv[0] = (char *) ckalloc(strlen(pathArgv[0]) + 1);
  1556.         strcpy(newPathArgv[0], pathArgv[0]);
  1557.         i = 1;
  1558.     }
  1559.     for ( ; i < pathArgc; i++) {
  1560.         if (strcmp(pathArgv[i], ".") == 0) {
  1561.             currentElement = ckalloc(2);
  1562.             strcpy(currentElement, ".");
  1563.         } else if (strcmp(pathArgv[i], "..") == 0) {
  1564.             currentElement = ckalloc(3);
  1565.             strcpy(currentElement, "..");
  1566.         } else {
  1567.             int useLong;
  1568.  
  1569.             Tcl_DStringInit(&resultDString);
  1570.             resultStr = Tcl_JoinPath(i + 1, pathArgv, &resultDString);
  1571.             /* Use a new handle since we don't know if another find is active */
  1572.             findHandle = HDIR_CREATE;
  1573.             rc = DosFindFirst(resultStr, &findHandle,
  1574.                               FILE_NORMAL | FILE_DIRECTORY,
  1575.                               &findData, sizeof(findData), &filesAtATime,
  1576.                               FIL_STANDARD);
  1577.             if (rc != NO_ERROR && rc != ERROR_NO_MORE_FILES) {
  1578.                 pathArgc = i - 1;
  1579.                 AttributesPosixError(interp, objIndex, fileName, 0);
  1580.                 result = TCL_ERROR;
  1581.                 Tcl_DStringFree(&resultDString);
  1582.                 goto cleanup;
  1583.             }
  1584.             /*
  1585.              * If rc == ERROR_NO_MORE_FILES, we might have a case where we're
  1586.              * trying to find a long-name file on a short-name File System
  1587.              * such as DOS, where the long name is kept in the .LONGNAME
  1588.              * extended attribute by the WPS and EA-aware applications.
  1589.              * This is the only thing comparable to the Windows 95/NT long
  1590.              * name-to-alternate name mapping.
  1591.              * In that case, retrieve/set the long name from/in the EA.
  1592.              */
  1593.             if (longShort) {
  1594.                 if (findData.achName[0] != '\0') {
  1595.                     useLong = 1;
  1596.                 } else {
  1597.                     useLong = 0;
  1598.                 }
  1599.             } else {
  1600.                 if (findData.cAlternateFileName[0] == '\0') {
  1601.                     useLong = 1;
  1602.                 } else {
  1603.                     useLong = 0;
  1604.                 }
  1605.             }
  1606.             if (useLong) {
  1607.                 currentElement = ckalloc(strlen(findData.achName) + 1);
  1608.                 strcpy(currentElement, findData.achName);
  1609.             } else {
  1610.                 currentElement = ckalloc(strlen(findData.cAlternateFileName)
  1611.                         + 1);
  1612.                 strcpy(currentElement, findData.cAlternateFileName);
  1613.             }
  1614.             Tcl_DStringFree(&resultDString);
  1615.             FindClose(findHandle);
  1616.         }
  1617.         newPathArgv[i] = currentElement;
  1618.     }
  1619.  
  1620.     Tcl_DStringInit(&resultDString);
  1621.     resultStr = Tcl_JoinPath(pathArgc, newPathArgv, &resultDString);
  1622.     *attributePtrPtr = Tcl_NewStringObj(resultStr,
  1623.                                         Tcl_DStringLength(&resultDString));
  1624.     Tcl_DStringFree(&resultDString);
  1625.  
  1626. cleanup:
  1627.     for (i = 0; i < pathArgc; i++) {
  1628.         ckfree(newPathArgv[i]);
  1629.     }
  1630.     ckfree((char *) newPathArgv);
  1631.     return result;
  1632. }
  1633.  
  1634. /*
  1635.  *----------------------------------------------------------------------
  1636.  *
  1637.  * GetOS2FileLongName --
  1638.  *
  1639.  *      Returns a Tcl_Obj containing the long version of the file name.
  1640.  *
  1641.  * Results:
  1642.  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
  1643.  *      will have ref count 0. If the return value is not TCL_OK,
  1644.  *      attributePtrPtr is not touched.
  1645.  *
  1646.  * Side effects:
  1647.  *      A new object is allocated if the file is valid.
  1648.  *
  1649.  *----------------------------------------------------------------------
  1650.  */
  1651.  
  1652. static int
  1653. GetOS2FileLongName(
  1654.     Tcl_Interp *interp,             /* The interp we are using for errors. */
  1655.     int objIndex,                   /* The index of the attribute. */
  1656.     char *fileName,                 /* The name of the file. */
  1657.     Tcl_Obj **attributePtrPtr)      /* A pointer to return the object with. */
  1658. {
  1659.     return ConvertFileNameFormat(interp, objIndex, fileName, 1,
  1660.                                  attributePtrPtr);
  1661. }
  1662.  
  1663. /*
  1664.  *----------------------------------------------------------------------
  1665.  *
  1666.  * GetOS2FileShortName --
  1667.  *
  1668.  *      Returns a Tcl_Obj containing the short version of the file
  1669.  *      name.
  1670.  *
  1671.  * Results:
  1672.  *      Standard Tcl result and a Tcl_Obj in attributePtrPtr. The object
  1673.  *      will have ref count 0. If the return value is not TCL_OK,
  1674.  *      attributePtrPtr is not touched.
  1675.  *
  1676.  * Side effects:
  1677.  *      A new object is allocated if the file is valid.
  1678.  *
  1679.  *----------------------------------------------------------------------
  1680.  */
  1681.  
  1682. static int
  1683. GetOS2FileShortName(
  1684.     Tcl_Interp *interp,             /* The interp we are using for errors. */
  1685.     int objIndex,                   /* The index of the attribute. */
  1686.     char *fileName,                 /* The name of the file. */
  1687.     Tcl_Obj **attributePtrPtr)      /* A pointer to return the object with. */
  1688. {
  1689.     return ConvertFileNameFormat(interp, objIndex, fileName, 0,
  1690.                                  attributePtrPtr);
  1691. }
  1692. #endif
  1693.  
  1694. /*
  1695.  *----------------------------------------------------------------------
  1696.  *
  1697.  * SetOS2FileAttributes --
  1698.  *
  1699.  *      Set the file attributes to the value given by attributePtr.
  1700.  *      This routine sets the -hidden, -readonly, or -system attributes.
  1701.  *
  1702.  * Results:
  1703.  *      Standard TCL error.
  1704.  *
  1705.  * Side effects:
  1706.  *      The file's attribute is set.
  1707.  *
  1708.  *----------------------------------------------------------------------
  1709.  */
  1710.  
  1711. static int
  1712. SetOS2FileAttributes(
  1713.     Tcl_Interp *interp,             /* The interp we are using for errors. */
  1714.     int objIndex,                   /* The index of the attribute. */
  1715.     char *fileName,                 /* The name of the file. */
  1716.     Tcl_Obj *attributePtr)          /* The new value of the attribute. */
  1717. {
  1718.     FILESTATUS3 fileStatus;
  1719.     int yesNo;
  1720.     int result;
  1721.  
  1722.     rc = DosQueryPathInfo(fileName, FIL_STANDARD, &fileStatus,
  1723.                           sizeof(FILESTATUS3));
  1724.     if (rc != NO_ERROR) {
  1725.         AttributesPosixError(interp, objIndex, fileName, 1);
  1726.         return TCL_ERROR;
  1727.     }
  1728.  
  1729.     result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
  1730.     if (result != TCL_OK) {
  1731.         return result;
  1732.     }
  1733.  
  1734.     if (yesNo) {
  1735.         fileStatus.attrFile |= (attributeArray[objIndex]);
  1736.     } else {
  1737.         fileStatus.attrFile &= ~(attributeArray[objIndex]);
  1738.     }
  1739.  
  1740.     rc = DosSetPathInfo(fileName, FIL_STANDARD, &fileStatus,
  1741.                         sizeof(FILESTATUS3), (ULONG)0);
  1742.     if (rc != NO_ERROR) {
  1743.         AttributesPosixError(interp, objIndex, fileName, 1);
  1744.         return TCL_ERROR;
  1745.     }
  1746.     return TCL_OK;
  1747. }
  1748.  
  1749. #if 0
  1750. /*
  1751.  *----------------------------------------------------------------------
  1752.  *
  1753.  * CannotGetAttribute --
  1754.  *
  1755.  *      The attribute in question cannot be gotten.
  1756.  *
  1757.  * Results:
  1758.  *      TCL_ERROR
  1759.  *
  1760.  * Side effects:
  1761.  *      The object result is set to a pertinent error message.
  1762.  *
  1763.  *----------------------------------------------------------------------
  1764.  */
  1765.  
  1766. static int
  1767. CannotGetAttribute(
  1768.     Tcl_Interp *interp,             /* The interp we are using for errors. */
  1769.     int objIndex,                   /* The index of the attribute. */
  1770.     char *fileName,                 /* The name of the file. */
  1771.     Tcl_Obj **attributePtr)         /* The value of the attribute. */
  1772. {
  1773.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1774.             "cannot get attribute \"", tclpFileAttrStrings[objIndex],
  1775.             "\" for file \"", fileName, "\" : attribute is unavailable",
  1776.             (char *) NULL);
  1777.     return TCL_ERROR;
  1778. }
  1779.  
  1780. /*
  1781.  *----------------------------------------------------------------------
  1782.  *
  1783.  * CannotSetAttribute --
  1784.  *
  1785.  *      The attribute in question cannot be set.
  1786.  *
  1787.  * Results:
  1788.  *      TCL_ERROR
  1789.  *
  1790.  * Side effects:
  1791.  *      The object result is set to a pertinent error message.
  1792.  *
  1793.  *----------------------------------------------------------------------
  1794.  */
  1795.  
  1796. static int
  1797. CannotSetAttribute(
  1798.     Tcl_Interp *interp,             /* The interp we are using for errors. */
  1799.     int objIndex,                   /* The index of the attribute. */
  1800.     char *fileName,                 /* The name of the file. */
  1801.     Tcl_Obj *attributePtr)          /* The new value of the attribute. */
  1802. {
  1803.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1804.             "cannot set attribute \"", tclpFileAttrStrings[objIndex],
  1805.             "\" for file \"", fileName, "\" : attribute is unavailable",
  1806.             (char *) NULL);
  1807.     return TCL_ERROR;
  1808. }
  1809.  
  1810. #endif
  1811. /*
  1812.  *---------------------------------------------------------------------------
  1813.  *
  1814.  * TclpListVolumes --
  1815.  *
  1816.  *      Lists the currently mounted volumes
  1817.  *
  1818.  * Results:
  1819.  *      A standard Tcl result.  Will always be TCL_OK, since there is no way
  1820.  *      that this command can fail.  Also, the interpreter's result is set to
  1821.  *      the list of volumes.
  1822.  *
  1823.  * Side effects:
  1824.  *      None
  1825.  *
  1826.  *---------------------------------------------------------------------------
  1827.  */
  1828.  
  1829. int
  1830. TclpListVolumes(
  1831.     Tcl_Interp *interp)    /* Interpreter to which to pass the volume list */
  1832. {
  1833.     Tcl_Obj *resultPtr, *elemPtr;
  1834.     char buf[4];
  1835.     int i;
  1836.     FSINFO infoBuf;
  1837.  
  1838.     resultPtr = Tcl_GetObjResult(interp);
  1839.  
  1840.     buf[1] = ':';
  1841.     buf[2] = '/';
  1842.     buf[3] = '\0';
  1843.  
  1844.     for (i = 0; i < 26; i++) {
  1845.         buf[0] = (char) ('a' + i);
  1846.         rc = DosQueryFSInfo(i+1, FSIL_VOLSER, &infoBuf, sizeof(infoBuf));
  1847.         if ( rc == NO_ERROR || rc == ERROR_NOT_READY) {
  1848.             elemPtr = Tcl_NewStringObj(buf, -1);
  1849.             Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
  1850.         }
  1851.     }
  1852.     return TCL_OK;
  1853. }
  1854.  
  1855. /*
  1856.  *----------------------------------------------------------------------
  1857.  *
  1858.  * CopyFileAtts
  1859.  *
  1860.  *      Copy the file attributes such as owner, group, permissions, and
  1861.  *      modification date from one file to another.
  1862.  *
  1863.  * Results:
  1864.  *      Standard Tcl result.
  1865.  *
  1866.  * Side effects:
  1867.  *      user id, group id, permission bits, last modification time, and
  1868.  *      last access time are updated in the new file to reflect the old
  1869.  *      file.
  1870.  *
  1871.  *----------------------------------------------------------------------
  1872.  */
  1873.  
  1874. int
  1875. CopyFileAtts (
  1876.     char *src,            /* Path name of source file */
  1877.     char *dst,            /* Path name of target file */
  1878.     FILESTATUS3 *fsSource)    /* File status of source file */
  1879. {
  1880.     rc = DosSetPathInfo(dst, FIL_STANDARD, fsSource, sizeof (*fsSource), 0L);
  1881.     if (rc != NO_ERROR) {
  1882.         return TCL_ERROR;
  1883.     }
  1884.     return TCL_OK;
  1885. }
  1886.