tcl/mac/tclMacFCmd.c

   1 /*
   2  * tclMacFCmd.c --
   3  *
   4  * Implements the Macintosh specific portions of the file manipulation
   5  * subcommands of the "file" command.
   6  *
   7  * Copyright (c) 1996-1998 Sun Microsystems, Inc.
   8  *
   9  * See the file "license.terms" for information on usage and redistribution
  10  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11  *
  12  * RCS: @(#) $Id$
  13  */
  14
  15 #include "tclInt.h"
  16 #include "tclMac.h"
  17 #include "tclMacInt.h"
  18 #include "tclPort.h"
  19 #include <FSpCompat.h>
  20 #include <MoreFilesExtras.h>
  21 #include <Strings.h>
  22 #include <Errors.h>
  23 #include <FileCopy.h>
  24 #include <DirectoryCopy.h>
  25 #include <Script.h>
  26 #include <string.h>
  27 #include <Finder.h>
  28 #include <Aliases.h>
  29
  30 /*
  31  * Callback for the file attributes code.
  32  */
  33
  34 static int              GetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
  35                             int objIndex, Tcl_Obj *fileName,
  36                             Tcl_Obj **attributePtrPtr));
  37 static int              GetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
  38                             int objIndex, Tcl_Obj *fileName,
  39                             Tcl_Obj **readOnlyPtrPtr));
  40 static int              SetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
  41                             int objIndex, Tcl_Obj *fileName,
  42                             Tcl_Obj *attributePtr));
  43 static int              SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
  44                             int objIndex, Tcl_Obj *fileName,
  45                             Tcl_Obj *readOnlyPtr));
  46
  47 /*
  48  * These are indeces into the tclpFileAttrsStrings table below.
  49  */
  50
  51 #define MAC_CREATOR_ATTRIBUTE   0
  52 #define MAC_HIDDEN_ATTRIBUTE    1
  53 #define MAC_READONLY_ATTRIBUTE  2
  54 #define MAC_TYPE_ATTRIBUTE      3
  55
  56 /*
  57  * Global variables for the file attributes code.
  58  */
  59
  60 CONST char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
  61         "-type", (char *) NULL};
  62 CONST TclFileAttrProcs tclpFileAttrProcs[] = {
  63         {GetFileFinderAttributes, SetFileFinderAttributes},
  64         {GetFileFinderAttributes, SetFileFinderAttributes},
  65         {GetFileReadOnly, SetFileReadOnly},
  66         {GetFileFinderAttributes, SetFileFinderAttributes}};
  67
  68 /*
  69  * File specific static data
  70  */
  71
  72 static long startSeed = 248923489;
  73
  74 /*
  75  * Prototypes for procedure only used in this file
  76  */
  77
  78 static pascal Boolean   CopyErrHandler _ANSI_ARGS_((OSErr error,
  79                             short failedOperation,
  80                             short srcVRefNum, long srcDirID,
  81                             ConstStr255Param srcName, short dstVRefNum,
  82                             long dstDirID,ConstStr255Param dstName));
  83 static int              DoCopyDirectory _ANSI_ARGS_((CONST char *src,
  84                             CONST char *dst, Tcl_DString *errorPtr));
  85 static int              DoCopyFile _ANSI_ARGS_((CONST char *src,
  86                             CONST char *dst));
  87 static int              DoCreateDirectory _ANSI_ARGS_((CONST char *path));
  88 static int              DoDeleteFile _ANSI_ARGS_((CONST char *path));
  89 static int              DoRemoveDirectory _ANSI_ARGS_((CONST char *path,
  90                             int recursive, Tcl_DString *errorPtr));
  91 static int              DoRenameFile _ANSI_ARGS_((CONST char *src,
  92                             CONST char *dst));
  93 OSErr                   FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr,
  94                             Boolean *lockedPtr));
  95 static OSErr            GetFileSpecs _ANSI_ARGS_((CONST char *path,
  96                             FSSpec *pathSpecPtr, FSSpec *dirSpecPtr,
  97                             Boolean *pathExistsPtr,
  98                             Boolean *pathIsDirectoryPtr));
  99 static OSErr            MoveRename _ANSI_ARGS_((const FSSpec *srcSpecPtr,
 100                             const FSSpec *dstSpecPtr, StringPtr copyName));
 101 static int              Pstrequal _ANSI_ARGS_((ConstStr255Param stringA,
 102                             ConstStr255Param stringB));
 103 \f
 104 /*
 105  *---------------------------------------------------------------------------
 106  *
 107  * TclpObjRenameFile, DoRenameFile --
 108  *
 109  *      Changes the name of an existing file or directory, from src to dst.
 110  *      If src and dst refer to the same file or directory, does nothing
 111  *      and returns success.  Otherwise if dst already exists, it will be
 112  *      deleted and replaced by src subject to the following conditions:
 113  *          If src is a directory, dst may be an empty directory.
 114  *          If src is a file, dst may be a file.
 115  *      In any other situation where dst already exists, the rename will
 116  *      fail.
 117  *
 118  * Results:
 119  *      If the directory was successfully created, returns TCL_OK.
 120  *      Otherwise the return value is TCL_ERROR and errno is set to
 121  *      indicate the error.  Some possible values for errno are:
 122  *
 123  *      EACCES:     src or dst parent directory can't be read and/or written.
 124  *      EEXIST:     dst is a non-empty directory.
 125  *      EINVAL:     src is a root directory or dst is a subdirectory of src.
 126  *      EISDIR:     dst is a directory, but src is not.
 127  *      ENOENT:     src doesn't exist.  src or dst is "".
 128  *      ENOTDIR:    src is a directory, but dst is not.
 129  *      EXDEV:      src and dst are on different filesystems.
 130  *
 131  * Side effects:
 132  *      The implementation of rename may allow cross-filesystem renames,
 133  *      but the caller should be prepared to emulate it with copy and
 134  *      delete if errno is EXDEV.
 135  *
 136  *---------------------------------------------------------------------------
 137  */
 138
 139 int
 140 TclpObjRenameFile(srcPathPtr, destPathPtr)
 141     Tcl_Obj *srcPathPtr;
 142     Tcl_Obj *destPathPtr;
 143 {
 144     return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
 145                         Tcl_FSGetNativePath(destPathPtr));
 146 }
 147
 148 static int
 149 DoRenameFile(
 150     CONST char *src,            /* Pathname of file or dir to be renamed
 151                                  * (native). */
 152     CONST char *dst)            /* New pathname of file or directory
 153                                  * (native). */
 154 {
 155     FSSpec srcFileSpec, dstFileSpec, dstDirSpec;
 156     OSErr err;
 157     long srcID, dummy;
 158     Boolean srcIsDirectory, dstIsDirectory, dstExists, dstLocked;
 159
 160     err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
 161     if (err == noErr) {
 162         FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
 163     }
 164     if (err == noErr) {
 165         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
 166                 &dstIsDirectory);
 167     }
 168     if (err == noErr) {
 169         if (dstExists == 0) {
 170             err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
 171             goto end;
 172         }
 173         err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
 174         if (dstLocked) {
 175             FSpRstFLockCompat(&dstFileSpec);
 176         }
 177     }
 178     if (err == noErr) {
 179         if (srcIsDirectory) {
 180             if (dstIsDirectory) {
 181                 /*
 182                  * The following call will remove an empty directory.  If it
 183                  * fails, it's because it wasn't empty.
 184                  */
 185
 186                 if (DoRemoveDirectory(dst, 0, NULL) != TCL_OK) {
 187                     return TCL_ERROR;
 188                 }
 189
 190                 /*
 191                  * Now that that empty directory is gone, we can try
 192                  * renaming src.  If that fails, we'll put this empty
 193                  * directory back, for completeness.
 194                  */
 195
 196                 err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
 197                 if (err != noErr) {
 198                     FSpDirCreateCompat(&dstFileSpec, smSystemScript, &dummy);
 199                     if (dstLocked) {
 200                         FSpSetFLockCompat(&dstFileSpec);
 201                     }
 202                 }
 203             } else {
 204                 errno = ENOTDIR;
 205                 return TCL_ERROR;
 206             }
 207         } else {
 208             if (dstIsDirectory) {
 209                 errno = EISDIR;
 210                 return TCL_ERROR;
 211             } else {
 212                 /*
 213                  * Overwrite existing file by:
 214                  *
 215                  * 1. Rename existing file to temp name.
 216                  * 2. Rename old file to new name.
 217                  * 3. If success, delete temp file.  If failure,
 218                  *    put temp file back to old name.
 219                  */
 220
 221                 Str31 tmpName;
 222                 FSSpec tmpFileSpec;
 223
 224                 err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed,
 225                         dstFileSpec.parID, dstFileSpec.parID, tmpName);
 226                 if (err == noErr) {
 227                     err = FSpRenameCompat(&dstFileSpec, tmpName);
 228                 }
 229                 if (err == noErr) {
 230                     err = FSMakeFSSpecCompat(dstFileSpec.vRefNum,
 231                             dstFileSpec.parID, tmpName, &tmpFileSpec);
 232                 }
 233                 if (err == noErr) {
 234                     err = MoveRename(&srcFileSpec, &dstDirSpec,
 235                             dstFileSpec.name);
 236                 }
 237                 if (err == noErr) {
 238                     FSpDeleteCompat(&tmpFileSpec);
 239                 } else {
 240                     FSpDeleteCompat(&dstFileSpec);
 241                     FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
 242                     if (dstLocked) {
 243                         FSpSetFLockCompat(&dstFileSpec);
 244                     }
 245                 }
 246             }
 247         }
 248     }
 249
 250     end:
 251     if (err != noErr) {
 252         errno = TclMacOSErrorToPosixError(err);
 253         return TCL_ERROR;
 254     }
 255     return TCL_OK;
 256 }
 257 \f
 258 /*
 259  *--------------------------------------------------------------------------
 260  *
 261  * MoveRename --
 262  *
 263  *      Helper function for TclpRenameFile.  Renames a file or directory
 264  *      into the same directory or another directory.  The target name
 265  *      must not already exist in the destination directory.
 266  *
 267  *      Don't use FSpMoveRenameCompat because it doesn't work with
 268  *      directories or with locked files.
 269  *
 270  * Results:
 271  *      Returns a mac error indicating the cause of the failure.
 272  *
 273  * Side effects:
 274  *      Creates a temp file in the target directory to handle a rename
 275  *      between directories.
 276  *
 277  *--------------------------------------------------------------------------
 278  */
 279
 280 static OSErr
 281 MoveRename(
 282     const FSSpec *srcFileSpecPtr,   /* Source object. */
 283     const FSSpec *dstDirSpecPtr,    /* Destination directory. */
 284     StringPtr copyName)             /* New name for object in destination
 285                                      * directory. */
 286 {
 287     OSErr err;
 288     long srcID, dstID;
 289     Boolean srcIsDir, dstIsDir;
 290     Str31 tmpName;
 291     FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
 292     Boolean locked;
 293
 294     if (srcFileSpecPtr->parID == 1) {
 295         /*
 296          * Trying to rename a volume.
 297          */
 298
 299         return badMovErr;
 300     }
 301     if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
 302         /*
 303          * Renaming across volumes.
 304          */
 305
 306         return diffVolErr;
 307     }
 308     err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
 309     if (locked) {
 310         FSpRstFLockCompat(srcFileSpecPtr);
 311     }
 312     if (err == noErr) {
 313         err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
 314     }
 315     if (err == noErr) {
 316         if (srcFileSpecPtr->parID == dstID) {
 317             /*
 318              * Renaming object within directory.
 319              */
 320
 321             err = FSpRenameCompat(srcFileSpecPtr, copyName);
 322             goto done;
 323         }
 324         if (Pstrequal(srcFileSpecPtr->name, copyName)) {
 325             /*
 326              * Moving object to another directory (under same name).
 327              */
 328
 329             err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
 330             goto done;
 331         }
 332         err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
 333     }
 334     if (err == noErr) {
 335         /*
 336          * Fullblown: rename source object to temp name, move temp to
 337          * dest directory, and rename temp to target.
 338          */
 339
 340         err = GenerateUniqueName(srcFileSpecPtr->vRefNum, &startSeed,
 341                 srcFileSpecPtr->parID, dstID, tmpName);
 342         FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
 343                 tmpName, &tmpSrcFileSpec);
 344         FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
 345                 &tmpDstFileSpec);
 346     }
 347     if (err == noErr) {
 348         err = FSpRenameCompat(srcFileSpecPtr, tmpName);
 349     }
 350     if (err == noErr) {
 351         err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
 352         if (err == noErr) {
 353             err = FSpRenameCompat(&tmpDstFileSpec, copyName);
 354             if (err == noErr) {
 355                 goto done;
 356             }
 357             FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
 358                     NULL, &srcDirSpec);
 359             FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
 360         }
 361         FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
 362     }
 363
 364     done:
 365     if (locked != false) {
 366         if (err == noErr) {
 367             FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum,
 368                     dstID, copyName, &dstFileSpec);
 369             FSpSetFLockCompat(&dstFileSpec);
 370         } else {
 371             FSpSetFLockCompat(srcFileSpecPtr);
 372         }
 373     }
 374     return err;
 375 }
 376 \f
 377 /*
 378  *---------------------------------------------------------------------------
 379  *
 380  * TclpObjCopyFile, DoCopyFile --
 381  *
 382  *      Copy a single file (not a directory).  If dst already exists and
 383  *      is not a directory, it is removed.
 384  *
 385  * Results:
 386  *      If the file was successfully copied, returns TCL_OK.  Otherwise
 387  *      the return value is TCL_ERROR and errno is set to indicate the
 388  *      error.  Some possible values for errno are:
 389  *
 390  *      EACCES:     src or dst parent directory can't be read and/or written.
 391  *      EISDIR:     src or dst is a directory.
 392  *      ENOENT:     src doesn't exist.  src or dst is "".
 393  *
 394  * Side effects:
 395  *      This procedure will also copy symbolic links, block, and
 396  *      character devices, and fifos.  For symbolic links, the links
 397  *      themselves will be copied and not what they point to.  For the
 398  *      other special file types, the directory entry will be copied and
 399  *      not the contents of the device that it refers to.
 400  *
 401  *---------------------------------------------------------------------------
 402  */
 403
 404 int
 405 TclpObjCopyFile(srcPathPtr, destPathPtr)
 406     Tcl_Obj *srcPathPtr;
 407     Tcl_Obj *destPathPtr;
 408 {
 409     return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
 410                       Tcl_FSGetNativePath(destPathPtr));
 411 }
 412
 413 static int
 414 DoCopyFile(
 415     CONST char *src,            /* Pathname of file to be copied (native). */
 416     CONST char *dst)            /* Pathname of file to copy to (native). */
 417 {
 418     OSErr err, dstErr;
 419     Boolean dstExists, dstIsDirectory, dstLocked;
 420     FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpFileSpec;
 421     Str31 tmpName;
 422
 423     err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
 424     if (err == noErr) {
 425         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
 426                 &dstIsDirectory);
 427     }
 428     if (dstExists) {
 429         if (dstIsDirectory) {
 430             errno = EISDIR;
 431             return TCL_ERROR;
 432         }
 433         err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
 434         if (dstLocked) {
 435             FSpRstFLockCompat(&dstFileSpec);
 436         }
 437
 438         /*
 439          * Backup dest file.
 440          */
 441
 442         dstErr = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID,
 443                 dstFileSpec.parID, tmpName);
 444         if (dstErr == noErr) {
 445             dstErr = FSpRenameCompat(&dstFileSpec, tmpName);
 446         }
 447     }
 448     if (err == noErr) {
 449         err = FSpFileCopy(&srcFileSpec, &dstDirSpec,
 450                 (StringPtr) dstFileSpec.name, NULL, 0, true);
 451     }
 452     if ((dstExists != false) && (dstErr == noErr)) {
 453         FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
 454                 tmpName, &tmpFileSpec);
 455         if (err == noErr) {
 456             /*
 457              * Delete backup file.
 458              */
 459
 460             FSpDeleteCompat(&tmpFileSpec);
 461         } else {
 462
 463             /*
 464              * Restore backup file.
 465              */
 466
 467             FSpDeleteCompat(&dstFileSpec);
 468             FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
 469             if (dstLocked) {
 470                 FSpSetFLockCompat(&dstFileSpec);
 471             }
 472         }
 473     }
 474
 475     if (err != noErr) {
 476         errno = TclMacOSErrorToPosixError(err);
 477         return TCL_ERROR;
 478     }
 479     return TCL_OK;
 480 }
 481 \f
 482 /*
 483  *---------------------------------------------------------------------------
 484  *
 485  * TclpObjDeleteFile, DoDeleteFile --
 486  *
 487  *      Removes a single file (not a directory).
 488  *
 489  * Results:
 490  *      If the file was successfully deleted, returns TCL_OK.  Otherwise
 491  *      the return value is TCL_ERROR and errno is set to indicate the
 492  *      error.  Some possible values for errno are:
 493  *
 494  *      EACCES:     a parent directory can't be read and/or written.
 495  *      EISDIR:     path is a directory.
 496  *      ENOENT:     path doesn't exist or is "".
 497  *
 498  * Side effects:
 499  *      The file is deleted, even if it is read-only.
 500  *
 501  *---------------------------------------------------------------------------
 502  */
 503
 504 int
 505 TclpObjDeleteFile(pathPtr)
 506     Tcl_Obj *pathPtr;
 507 {
 508     return DoDeleteFile(Tcl_FSGetNativePath(pathPtr));
 509 }
 510
 511 static int
 512 DoDeleteFile(
 513     CONST char *path)           /* Pathname of file to be removed (native). */
 514 {
 515     OSErr err;
 516     FSSpec fileSpec;
 517     Boolean isDirectory;
 518     long dirID;
 519
 520     err = FSpLLocationFromPath(strlen(path), path, &fileSpec);
 521     if (err == noErr) {
 522         /*
 523          * Since FSpDeleteCompat will delete an empty directory, make sure
 524          * that this isn't a directory first.
 525          */
 526
 527         FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
 528         if (isDirectory == true) {
 529             errno = EISDIR;
 530             return TCL_ERROR;
 531         }
 532     }
 533     err = FSpDeleteCompat(&fileSpec);
 534     if (err == fLckdErr) {
 535         FSpRstFLockCompat(&fileSpec);
 536         err = FSpDeleteCompat(&fileSpec);
 537         if (err != noErr) {
 538             FSpSetFLockCompat(&fileSpec);
 539         }
 540     }
 541     if (err != noErr) {
 542         errno = TclMacOSErrorToPosixError(err);
 543         return TCL_ERROR;
 544     }
 545     return TCL_OK;
 546 }
 547 \f
 548 /*
 549  *---------------------------------------------------------------------------
 550  *
 551  * TclpObjCreateDirectory, DoCreateDirectory --
 552  *
 553  *      Creates the specified directory.  All parent directories of the
 554  *      specified directory must already exist.  The directory is
 555  *      automatically created with permissions so that user can access
 556  *      the new directory and create new files or subdirectories in it.
 557  *
 558  * Results:
 559  *      If the directory was successfully created, returns TCL_OK.
 560  *      Otherwise the return value is TCL_ERROR and errno is set to
 561  *      indicate the error.  Some possible values for errno are:
 562  *
 563  *      EACCES:     a parent directory can't be read and/or written.
 564  *      EEXIST:     path already exists.
 565  *      ENOENT:     a parent directory doesn't exist.
 566  *
 567  * Side effects:
 568  *      A directory is created with the current umask, except that
 569  *      permission for u+rwx will always be added.
 570  *
 571  *---------------------------------------------------------------------------
 572  */
 573
 574 int
 575 TclpObjCreateDirectory(pathPtr)
 576     Tcl_Obj *pathPtr;
 577 {
 578     return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
 579 }
 580
 581 static int
 582 DoCreateDirectory(
 583     CONST char *path)           /* Pathname of directory to create (native). */
 584 {
 585     OSErr err;
 586     FSSpec dirSpec;
 587     long outDirID;
 588
 589     err = FSpLocationFromPath(strlen(path), path, &dirSpec);
 590     if (err == noErr) {
 591         err = dupFNErr;         /* EEXIST. */
 592     } else if (err == fnfErr) {
 593         err = FSpDirCreateCompat(&dirSpec, smSystemScript, &outDirID);
 594     }
 595
 596     if (err != noErr) {
 597         errno = TclMacOSErrorToPosixError(err);
 598         return TCL_ERROR;
 599     }
 600     return TCL_OK;
 601 }
 602 \f
 603 /*
 604  *---------------------------------------------------------------------------
 605  *
 606  * TclpObjCopyDirectory, DoCopyDirectory --
 607  *
 608  *      Recursively copies a directory.  The target directory dst must
 609  *      not already exist.  Note that this function does not merge two
 610  *      directory hierarchies, even if the target directory is an an
 611  *      empty directory.
 612  *
 613  * Results:
 614  *      If the directory was successfully copied, returns TCL_OK.
 615  *      Otherwise the return value is TCL_ERROR, errno is set to indicate
 616  *      the error, and the pathname of the file that caused the error
 617  *      is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
 618  *      for a description of possible values for errno.
 619  *
 620  * Side effects:
 621  *      An exact copy of the directory hierarchy src will be created
 622  *      with the name dst.  If an error occurs, the error will
 623  *      be returned immediately, and remaining files will not be
 624  *      processed.
 625  *
 626  *---------------------------------------------------------------------------
 627  */
 628
 629 int
 630 TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
 631     Tcl_Obj *srcPathPtr;
 632     Tcl_Obj *destPathPtr;
 633     Tcl_Obj **errorPtr;
 634 {
 635     Tcl_DString ds;
 636     int ret;
 637     ret = DoCopyDirectory(Tcl_FSGetNativePath(srcPathPtr),
 638                           Tcl_FSGetNativePath(destPathPtr), &ds);
 639     if (ret != TCL_OK) {
 640         *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
 641         Tcl_DStringFree(&ds);
 642         Tcl_IncrRefCount(*errorPtr);
 643     }
 644     return ret;
 645 }
 646
 647 static int
 648 DoCopyDirectory(
 649     CONST char *src,            /* Pathname of directory to be copied
 650                                  * (Native). */
 651     CONST char *dst,            /* Pathname of target directory (Native). */
 652     Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free
 653                                  * DString filled with UTF-8 name of file
 654                                  * causing error. */
 655 {
 656     OSErr err, saveErr;
 657     long srcID, tmpDirID;
 658     FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpDirSpec, tmpFileSpec;
 659     Boolean srcIsDirectory, srcLocked;
 660     Boolean dstIsDirectory, dstExists;
 661     Str31 tmpName;
 662
 663     err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
 664     if (err == noErr) {
 665         err = FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
 666     }
 667     if (err == noErr) {
 668         if (srcIsDirectory == false) {
 669             err = afpObjectTypeErr;     /* ENOTDIR. */
 670         }
 671     }
 672     if (err == noErr) {
 673         err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
 674                 &dstIsDirectory);
 675     }
 676     if (dstExists) {
 677         if (dstIsDirectory == false) {
 678             err = afpObjectTypeErr;     /* ENOTDIR. */
 679         } else {
 680             err = dupFNErr;             /* EEXIST. */
 681         }
 682     }
 683     if (err != noErr) {
 684         goto done;
 685     }
 686     if ((srcFileSpec.vRefNum == dstFileSpec.vRefNum) &&
 687             (srcFileSpec.parID == dstFileSpec.parID) &&
 688             (Pstrequal(srcFileSpec.name, dstFileSpec.name) != 0)) {
 689         /*
 690          * Copying on top of self.  No-op.
 691          */
 692
 693         goto done;
 694     }
 695
 696     /*
 697      * This algorthm will work making a copy of the source directory in
 698      * the current directory with a new name, in a new directory with the
 699      * same name, and in a new directory with a new name:
 700      *
 701      * 1. Make dstDir/tmpDir.
 702      * 2. Copy srcDir/src to dstDir/tmpDir/src
 703      * 3. Rename dstDir/tmpDir/src to dstDir/tmpDir/dst (if necessary).
 704      * 4. CatMove dstDir/tmpDir/dst to dstDir/dst.
 705      * 5. Remove dstDir/tmpDir.
 706      */
 707
 708     err = FSpGetFLockCompat(&srcFileSpec, &srcLocked);
 709     if (srcLocked) {
 710         FSpRstFLockCompat(&srcFileSpec);
 711     }
 712     if (err == noErr) {
 713         err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID,
 714                 dstFileSpec.parID, tmpName);
 715     }
 716     if (err == noErr) {
 717         FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
 718                 tmpName, &tmpDirSpec);
 719         err = FSpDirCreateCompat(&tmpDirSpec, smSystemScript, &tmpDirID);
 720     }
 721     if (err == noErr) {
 722         err = FSpDirectoryCopy(&srcFileSpec, &tmpDirSpec, NULL, NULL, 0, true,
 723                 CopyErrHandler);
 724     }
 725
 726     /*
 727      * Even if the Copy failed, Rename/Move whatever did get copied to the
 728      * appropriate final destination, if possible.
 729      */
 730
 731     saveErr = err;
 732     err = noErr;
 733     if (Pstrequal(srcFileSpec.name, dstFileSpec.name) == 0) {
 734         err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID,
 735                 srcFileSpec.name, &tmpFileSpec);
 736         if (err == noErr) {
 737             err = FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
 738         }
 739     }
 740     if (err == noErr) {
 741         err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID,
 742                 dstFileSpec.name, &tmpFileSpec);
 743     }
 744     if (err == noErr) {
 745         err = FSpCatMoveCompat(&tmpFileSpec, &dstDirSpec);
 746     }
 747     if (err == noErr) {
 748         if (srcLocked) {
 749             FSpSetFLockCompat(&dstFileSpec);
 750         }
 751     }
 752
 753     FSpDeleteCompat(&tmpDirSpec);
 754
 755     if (saveErr != noErr) {
 756         err = saveErr;
 757     }
 758
 759     done:
 760     if (err != noErr) {
 761         errno = TclMacOSErrorToPosixError(err);
 762         if (errorPtr != NULL) {
 763             Tcl_ExternalToUtfDString(NULL, dst, -1, errorPtr);
 764         }
 765         return TCL_ERROR;
 766     }
 767     return TCL_OK;
 768 }
 769 \f
 770 /*
 771  *----------------------------------------------------------------------
 772  *
 773  * CopyErrHandler --
 774  *
 775  *      This procedure is called from the MoreFiles procedure
 776  *      FSpDirectoryCopy whenever an error occurs.
 777  *
 778  * Results:
 779  *      False if the condition should not be considered an error, true
 780  *      otherwise.
 781  *
 782  * Side effects:
 783  *      Since FSpDirectoryCopy() is called only after removing any
 784  *      existing target directories, there shouldn't be any errors.
 785  *
 786  *----------------------------------------------------------------------
 787  */
 788
 789 static pascal Boolean
 790 CopyErrHandler(
 791     OSErr error,                /* Error that occured */
 792     short failedOperation,      /* operation that caused the error */
 793     short srcVRefNum,           /* volume ref number of source */
 794     long srcDirID,              /* directory id of source */
 795     ConstStr255Param srcName,   /* name of source */
 796     short dstVRefNum,           /* volume ref number of dst */
 797     long dstDirID,              /* directory id of dst */
 798     ConstStr255Param dstName)   /* name of dst directory */
 799 {
 800     return true;
 801 }
 802 \f
 803 /*
 804  *---------------------------------------------------------------------------
 805  *
 806  * TclpObjRemoveDirectory, DoRemoveDirectory --
 807  *
 808  *      Removes directory (and its contents, if the recursive flag is set).
 809  *
 810  * Results:
 811  *      If the directory was successfully removed, returns TCL_OK.
 812  *      Otherwise the return value is TCL_ERROR, errno is set to indicate
 813  *      the error, and the pathname of the file that caused the error
 814  *      is stored in errorPtr.  Some possible values for errno are:
 815  *
 816  *      EACCES:     path directory can't be read and/or written.
 817  *      EEXIST:     path is a non-empty directory.
 818  *      EINVAL:     path is a root directory.
 819  *      ENOENT:     path doesn't exist or is "".
 820  *      ENOTDIR:    path is not a directory.
 821  *
 822  * Side effects:
 823  *      Directory removed.  If an error occurs, the error will be returned
 824  *      immediately, and remaining files will not be deleted.
 825  *
 826  *---------------------------------------------------------------------------
 827  */
 828
 829 int
 830 TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
 831     Tcl_Obj *pathPtr;
 832     int recursive;
 833     Tcl_Obj **errorPtr;
 834 {
 835     Tcl_DString ds;
 836     int ret;
 837     ret = DoRemoveDirectory(Tcl_FSGetNativePath(pathPtr),recursive, &ds);
 838     if (ret != TCL_OK) {
 839         *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
 840         Tcl_DStringFree(&ds);
 841         Tcl_IncrRefCount(*errorPtr);
 842     }
 843     return ret;
 844 }
 845
 846 static int
 847 DoRemoveDirectory(
 848     CONST char *path,           /* Pathname of directory to be removed
 849                                  * (native). */
 850     int recursive,              /* If non-zero, removes directories that
 851                                  * are nonempty.  Otherwise, will only remove
 852                                  * empty directories. */
 853     Tcl_DString *errorPtr)      /* If non-NULL, uninitialized or free
 854                                  * DString filled with UTF-8 name of file
 855                                  * causing error. */
 856 {
 857     OSErr err;
 858     FSSpec fileSpec;
 859     long dirID;
 860     int locked;
 861     Boolean isDirectory;
 862     CInfoPBRec pb;
 863     Str255 fileName;
 864
 865
 866     locked = 0;
 867     err = FSpLocationFromPath(strlen(path), path, &fileSpec);
 868     if (err != noErr) {
 869         goto done;
 870     }
 871
 872     /*
 873      * Since FSpDeleteCompat will delete a file, make sure this isn't
 874      * a file first.
 875      */
 876
 877     isDirectory = 1;
 878     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
 879     if (isDirectory == 0) {
 880         errno = ENOTDIR;
 881         return TCL_ERROR;
 882     }
 883
 884     err = FSpDeleteCompat(&fileSpec);
 885     if (err == fLckdErr) {
 886         locked = 1;
 887         FSpRstFLockCompat(&fileSpec);
 888         err = FSpDeleteCompat(&fileSpec);
 889     }
 890     if (err == noErr) {
 891         return TCL_OK;
 892     }
 893     if (err != fBsyErr) {
 894         goto done;
 895     }
 896
 897     if (recursive == 0) {
 898         /*
 899          * fBsyErr means one of three things: file busy, directory not empty,
 900          * or working directory control block open.  Determine if directory
 901          * is empty. If directory is not empty, return EEXIST.
 902          */
 903
 904         pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
 905         pb.hFileInfo.ioDirID = dirID;
 906         pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
 907         pb.hFileInfo.ioFDirIndex = 1;
 908         if (PBGetCatInfoSync(&pb) == noErr) {
 909             err = dupFNErr;     /* EEXIST */
 910             goto done;
 911         }
 912     }
 913
 914     /*
 915      * DeleteDirectory removes a directory and all its contents, including
 916      * any locked files.  There is no interface to get the name of the
 917      * file that caused the error, if an error occurs deleting this tree,
 918      * unless we rewrite DeleteDirectory ourselves.
 919      */
 920
 921     err = DeleteDirectory(fileSpec.vRefNum, dirID, NULL);
 922
 923     done:
 924     if (err != noErr) {
 925         if (errorPtr != NULL) {
 926             Tcl_UtfToExternalDString(NULL, path, -1, errorPtr);
 927         }
 928         if (locked) {
 929             FSpSetFLockCompat(&fileSpec);
 930         }
 931         errno = TclMacOSErrorToPosixError(err);
 932         return TCL_ERROR;
 933     }
 934     return TCL_OK;
 935 }
 936 \f
 937 /*
 938  *---------------------------------------------------------------------------
 939  *
 940  * GetFileSpecs --
 941  *
 942  *      Gets FSSpecs for the specified path and its parent directory.
 943  *
 944  * Results:
 945  *      The return value is noErr if there was no error getting FSSpecs,
 946  *      otherwise it is an error describing the problem.  Fills buffers
 947  *      with information, as above.
 948  *
 949  * Side effects:
 950  *      None.
 951  *
 952  *---------------------------------------------------------------------------
 953  */
 954
 955 static OSErr
 956 GetFileSpecs(
 957     CONST char *path,           /* The path to query. */
 958     FSSpec *pathSpecPtr,        /* Filled with information about path. */
 959     FSSpec *dirSpecPtr,         /* Filled with information about path's
 960                                  * parent directory. */
 961     Boolean *pathExistsPtr,     /* Set to true if path actually exists,
 962                                  * false if it doesn't or there was an
 963                                  * error reading the specified path. */
 964     Boolean *pathIsDirectoryPtr)/* Set to true if path is itself a directory,
 965                                  * otherwise false. */
 966 {
 967     CONST char *dirName;
 968     OSErr err;
 969     int argc;
 970     CONST char **argv;
 971     long d;
 972     Tcl_DString buffer;
 973
 974     *pathExistsPtr = false;
 975     *pathIsDirectoryPtr = false;
 976
 977     Tcl_DStringInit(&buffer);
 978     Tcl_SplitPath(path, &argc, &argv);
 979     if (argc == 1) {
 980         dirName = ":";
 981     } else {
 982         dirName = Tcl_JoinPath(argc - 1, argv, &buffer);
 983     }
 984     err = FSpLocationFromPath(strlen(dirName), dirName, dirSpecPtr);
 985     Tcl_DStringFree(&buffer);
 986     ckfree((char *) argv);
 987
 988     if (err == noErr) {
 989         err = FSpLocationFromPath(strlen(path), path, pathSpecPtr);
 990         if (err == noErr) {
 991             *pathExistsPtr = true;
 992             err = FSpGetDirectoryID(pathSpecPtr, &d, pathIsDirectoryPtr);
 993         } else if (err == fnfErr) {
 994             err = noErr;
 995         }
 996     }
 997     return err;
 998 }
 999 \f
1000 /*
1001  *-------------------------------------------------------------------------
1002  *
1003  * FSpGetFLockCompat --
1004  *
1005  *      Determines if there exists a software lock on the specified
1006  *      file.  The software lock could prevent the file from being
1007  *      renamed or moved.
1008  *
1009  * Results:
1010  *      Standard macintosh error code.
1011  *
1012  * Side effects:
1013  *      None.
1014  *
1015  *
1016  *-------------------------------------------------------------------------
1017  */
1018
1019 OSErr
1020 FSpGetFLockCompat(
1021     const FSSpec *specPtr,      /* File to query. */
1022     Boolean *lockedPtr)         /* Set to true if file is locked, false
1023                                  * if it isn't or there was an error reading
1024                                  * specified file. */
1025 {
1026     CInfoPBRec pb;
1027     OSErr err;
1028
1029     pb.hFileInfo.ioVRefNum = specPtr->vRefNum;
1030     pb.hFileInfo.ioDirID = specPtr->parID;
1031     pb.hFileInfo.ioNamePtr = (StringPtr) specPtr->name;
1032     pb.hFileInfo.ioFDirIndex = 0;
1033
1034     err = PBGetCatInfoSync(&pb);
1035     if ((err == noErr) && (pb.hFileInfo.ioFlAttrib & 0x01)) {
1036         *lockedPtr = true;
1037     } else {
1038         *lockedPtr = false;
1039     }
1040     return err;
1041 }
1042 \f
1043 /*
1044  *----------------------------------------------------------------------
1045  *
1046  * Pstrequal --
1047  *
1048  *      Pascal string compare.
1049  *
1050  * Results:
1051  *      Returns 1 if strings equal, 0 otherwise.
1052  *
1053  * Side effects:
1054  *      None.
1055  *
1056  *----------------------------------------------------------------------
1057  */
1058
1059 static int
1060 Pstrequal (
1061     ConstStr255Param stringA,   /* Pascal string A */
1062     ConstStr255Param stringB)   /* Pascal string B */
1063 {
1064     int i, len;
1065
1066     len = *stringA;
1067     for (i = 0; i <= len; i++) {
1068         if (*stringA++ != *stringB++) {
1069             return 0;
1070         }
1071     }
1072     return 1;
1073 }
1074 \f
1075 /*
1076  *----------------------------------------------------------------------
1077  *
1078  * GetFileFinderAttributes --
1079  *
1080  *      Returns a Tcl_Obj containing the value of a file attribute
1081  *      which is part of the FInfo record. Which attribute is controlled
1082  *      by objIndex.
1083  *
1084  * Results:
1085  *      Returns a standard TCL error. If the return value is TCL_OK,
1086  *      the new creator or file type object is put into attributePtrPtr.
1087  *      The object will have ref count 0. If there is an error,
1088  *      attributePtrPtr is not touched.
1089  *
1090  * Side effects:
1091  *      A new object is allocated if the file is valid.
1092  *
1093  *----------------------------------------------------------------------
1094  */
1095
1096 static int
1097 GetFileFinderAttributes(
1098     Tcl_Interp *interp,         /* The interp to report errors with. */
1099     int objIndex,               /* The index of the attribute option. */
1100     Tcl_Obj *fileName,  /* The name of the file (UTF-8). */
1101     Tcl_Obj **attributePtrPtr)  /* A pointer to return the object with. */
1102 {
1103     OSErr err;
1104     FSSpec fileSpec;
1105     FInfo finfo;
1106     CONST char *native;
1107
1108     native=Tcl_FSGetNativePath(fileName);
1109     err = FSpLLocationFromPath(strlen(native),
1110             native, &fileSpec);
1111
1112     if (err == noErr) {
1113         err = FSpGetFInfo(&fileSpec, &finfo);
1114     }
1115
1116     if (err == noErr) {
1117         switch (objIndex) {
1118             case MAC_CREATOR_ATTRIBUTE:
1119                 *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdCreator);
1120                 break;
1121             case MAC_HIDDEN_ATTRIBUTE:
1122                 *attributePtrPtr = Tcl_NewBooleanObj(finfo.fdFlags
1123                         & kIsInvisible);
1124                 break;
1125             case MAC_TYPE_ATTRIBUTE:
1126                 *attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType);
1127                 break;
1128         }
1129     } else if (err == fnfErr) {
1130         long dirID;
1131         Boolean isDirectory = 0;
1132
1133         err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1134         if ((err == noErr) && isDirectory) {
1135             if (objIndex == MAC_HIDDEN_ATTRIBUTE) {
1136                 *attributePtrPtr = Tcl_NewBooleanObj(0);
1137             } else {
1138                 *attributePtrPtr = Tcl_NewOSTypeObj('Fldr');
1139             }
1140         }
1141     }
1142
1143     if (err != noErr) {
1144         errno = TclMacOSErrorToPosixError(err);
1145         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1146                 "could not read \"", Tcl_GetString(fileName), "\": ",
1147                 Tcl_PosixError(interp), (char *) NULL);
1148         return TCL_ERROR;
1149     }
1150     return TCL_OK;
1151 }
1152 \f
1153 /*
1154  *----------------------------------------------------------------------
1155  *
1156  * GetFileReadOnly --
1157  *
1158  *      Returns a Tcl_Obj containing a Boolean value indicating whether
1159  *      or not the file is read-only. The object will have ref count 0.
1160  *      This procedure just checks the Finder attributes; it does not
1161  *      check AppleShare sharing attributes.
1162  *
1163  * Results:
1164  *      Returns a standard TCL error. If the return value is TCL_OK,
1165  *      the new creator type object is put into readOnlyPtrPtr.
1166  *      If there is an error, readOnlyPtrPtr is not touched.
1167  *
1168  * Side effects:
1169  *      A new object is allocated if the file is valid.
1170  *
1171  *----------------------------------------------------------------------
1172  */
1173
1174 static int
1175 GetFileReadOnly(
1176     Tcl_Interp *interp,         /* The interp to report errors with. */
1177     int objIndex,               /* The index of the attribute. */
1178     Tcl_Obj *fileName,  /* The name of the file (UTF-8). */
1179     Tcl_Obj **readOnlyPtrPtr)   /* A pointer to return the object with. */
1180 {
1181     OSErr err;
1182     FSSpec fileSpec;
1183     CInfoPBRec paramBlock;
1184     CONST char *native;
1185
1186     native=Tcl_FSGetNativePath(fileName);
1187     err = FSpLLocationFromPath(strlen(native),
1188             native, &fileSpec);
1189
1190     if (err == noErr) {
1191         if (err == noErr) {
1192             paramBlock.hFileInfo.ioCompletion = NULL;
1193             paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
1194             paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
1195             paramBlock.hFileInfo.ioFDirIndex = 0;
1196             paramBlock.hFileInfo.ioDirID = fileSpec.parID;
1197             err = PBGetCatInfo(&paramBlock, 0);
1198             if (err == noErr) {
1199
1200                 /*
1201                  * For some unknown reason, the Mac does not give
1202                  * symbols for the bits in the ioFlAttrib field.
1203                  * 1 -> locked.
1204                  */
1205
1206                 *readOnlyPtrPtr = Tcl_NewBooleanObj(
1207                         paramBlock.hFileInfo.ioFlAttrib & 1);
1208             }
1209         }
1210     }
1211     if (err != noErr) {
1212         errno = TclMacOSErrorToPosixError(err);
1213         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1214                 "could not read \"", Tcl_GetString(fileName), "\": ",
1215                 Tcl_PosixError(interp), (char *) NULL);
1216         return TCL_ERROR;
1217     }
1218     return TCL_OK;
1219 }
1220 \f
1221 /*
1222  *----------------------------------------------------------------------
1223  *
1224  * SetFileFinderAttributes --
1225  *
1226  *      Sets the file to the creator or file type given by attributePtr.
1227  *      objIndex determines whether the creator or file type is set.
1228  *
1229  * Results:
1230  *      Returns a standard TCL error.
1231  *
1232  * Side effects:
1233  *      The file's attribute is set.
1234  *
1235  *----------------------------------------------------------------------
1236  */
1237
1238 static int
1239 SetFileFinderAttributes(
1240     Tcl_Interp *interp,         /* The interp to report errors with. */
1241     int objIndex,               /* The index of the attribute. */
1242     Tcl_Obj *fileName,  /* The name of the file (UTF-8). */
1243     Tcl_Obj *attributePtr)      /* The command line object. */
1244 {
1245     OSErr err;
1246     FSSpec fileSpec;
1247     FInfo finfo;
1248     CONST char *native;
1249
1250     native=Tcl_FSGetNativePath(fileName);
1251     err = FSpLLocationFromPath(strlen(native),
1252             native, &fileSpec);
1253
1254     if (err == noErr) {
1255         err = FSpGetFInfo(&fileSpec, &finfo);
1256     }
1257
1258     if (err == noErr) {
1259         switch (objIndex) {
1260             case MAC_CREATOR_ATTRIBUTE:
1261                 if (Tcl_GetOSTypeFromObj(interp, attributePtr,
1262                         &finfo.fdCreator) != TCL_OK) {
1263                     return TCL_ERROR;
1264                 }
1265                 break;
1266             case MAC_HIDDEN_ATTRIBUTE: {
1267                 int hidden;
1268
1269                 if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
1270                         != TCL_OK) {
1271                     return TCL_ERROR;
1272                 }
1273                 if (hidden) {
1274                     finfo.fdFlags |= kIsInvisible;
1275                 } else {
1276                     finfo.fdFlags &= ~kIsInvisible;
1277                 }
1278                 break;
1279             }
1280             case MAC_TYPE_ATTRIBUTE:
1281                 if (Tcl_GetOSTypeFromObj(interp, attributePtr,
1282                         &finfo.fdType) != TCL_OK) {
1283                     return TCL_ERROR;
1284                 }
1285                 break;
1286         }
1287         err = FSpSetFInfo(&fileSpec, &finfo);
1288     } else if (err == fnfErr) {
1289         long dirID;
1290         Boolean isDirectory = 0;
1291
1292         err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1293         if ((err == noErr) && isDirectory) {
1294             Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
1295             Tcl_AppendStringsToObj(resultPtr, "cannot set ",
1296                     tclpFileAttrStrings[objIndex], ": \"",
1297                     Tcl_GetString(fileName), "\" is a directory", (char *) NULL);
1298             return TCL_ERROR;
1299         }
1300     }
1301
1302     if (err != noErr) {
1303         errno = TclMacOSErrorToPosixError(err);
1304         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1305                 "could not read \"", Tcl_GetString(fileName), "\": ",
1306                 Tcl_PosixError(interp), (char *) NULL);
1307         return TCL_ERROR;
1308     }
1309     return TCL_OK;
1310 }
1311 \f
1312 /*
1313  *----------------------------------------------------------------------
1314  *
1315  * SetFileReadOnly --
1316  *
1317  *      Sets the file to be read-only according to the Boolean value
1318  *      given by hiddenPtr.
1319  *
1320  * Results:
1321  *      Returns a standard TCL error.
1322  *
1323  * Side effects:
1324  *      The file's attribute is set.
1325  *
1326  *----------------------------------------------------------------------
1327  */
1328
1329 static int
1330 SetFileReadOnly(
1331     Tcl_Interp *interp,         /* The interp to report errors with. */
1332     int objIndex,               /* The index of the attribute. */
1333     Tcl_Obj *fileName,  /* The name of the file (UTF-8). */
1334     Tcl_Obj *readOnlyPtr)       /* The command line object. */
1335 {
1336     OSErr err;
1337     FSSpec fileSpec;
1338     HParamBlockRec paramBlock;
1339     int hidden;
1340     CONST char *native;
1341
1342     native=Tcl_FSGetNativePath(fileName);
1343     err = FSpLLocationFromPath(strlen(native),
1344             native, &fileSpec);
1345
1346     if (err == noErr) {
1347         if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
1348             return TCL_ERROR;
1349         }
1350
1351         paramBlock.fileParam.ioCompletion = NULL;
1352         paramBlock.fileParam.ioNamePtr = fileSpec.name;
1353         paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum;
1354         paramBlock.fileParam.ioDirID = fileSpec.parID;
1355         if (hidden) {
1356             err = PBHSetFLock(&paramBlock, 0);
1357         } else {
1358             err = PBHRstFLock(&paramBlock, 0);
1359         }
1360     }
1361
1362     if (err == fnfErr) {
1363         long dirID;
1364         Boolean isDirectory = 0;
1365         err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1366         if ((err == noErr) && isDirectory) {
1367             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1368                     "cannot set a directory to read-only when File Sharing is turned off",
1369                     (char *) NULL);
1370             return TCL_ERROR;
1371         } else {
1372             err = fnfErr;
1373         }
1374     }
1375
1376     if (err != noErr) {
1377         errno = TclMacOSErrorToPosixError(err);
1378         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
1379                 "could not read \"", Tcl_GetString(fileName), "\": ",
1380                 Tcl_PosixError(interp), (char *) NULL);
1381         return TCL_ERROR;
1382     }
1383     return TCL_OK;
1384 }
1385 \f
1386 /*
1387  *---------------------------------------------------------------------------
1388  *
1389  * TclpObjListVolumes --
1390  *
1391  *      Lists the currently mounted volumes
1392  *
1393  * Results:
1394  *      The list of volumes.
1395  *
1396  * Side effects:
1397  *      None
1398  *
1399  *---------------------------------------------------------------------------
1400  */
1401 Tcl_Obj*
1402 TclpObjListVolumes(void)
1403 {
1404     HParamBlockRec pb;
1405     Str255 name;
1406     OSErr theError = noErr;
1407     Tcl_Obj *resultPtr, *elemPtr;
1408     short volIndex = 1;
1409     Tcl_DString dstr;
1410
1411     resultPtr = Tcl_NewObj();
1412
1413     /*
1414      * We use two facts:
1415      * 1) The Mac volumes are enumerated by the ioVolIndex parameter of
1416      * the HParamBlockRec.  They run through the integers contiguously,
1417      * starting at 1.
1418      * 2) PBHGetVInfoSync returns an error when you ask for a volume index
1419      * that does not exist.
1420      *
1421      */
1422
1423     while ( 1 ) {
1424         pb.volumeParam.ioNamePtr = (StringPtr) &name;
1425         pb.volumeParam.ioVolIndex = volIndex;
1426
1427         theError = PBHGetVInfoSync(&pb);
1428
1429         if ( theError != noErr ) {
1430             break;
1431         }
1432
1433         Tcl_ExternalToUtfDString(NULL, (CONST char *)&name[1], name[0], &dstr);
1434         elemPtr = Tcl_NewStringObj(Tcl_DStringValue(&dstr),
1435                 Tcl_DStringLength(&dstr));
1436         Tcl_AppendToObj(elemPtr, ":", 1);
1437         Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
1438
1439         Tcl_DStringFree(&dstr);
1440
1441         volIndex++;
1442     }
1443
1444     Tcl_IncrRefCount(resultPtr);
1445     return resultPtr;
1446 }
1447 \f
1448 /*
1449  *---------------------------------------------------------------------------
1450  *
1451  * TclpObjNormalizePath --
1452  *
1453  *      This function scans through a path specification and replaces
1454  *      it, in place, with a normalized version.  On MacOS, this means
1455  *      resolving all aliases present in the path and replacing the head of
1456  *      pathPtr with the absolute case-sensitive path to the last file or
1457  *      directory that could be validated in the path.
1458  *
1459  * Results:
1460  *      The new 'nextCheckpoint' value, giving as far as we could
1461  *      understand in the path.
1462  *
1463  * Side effects:
1464  *      The pathPtr string, which must contain a valid path, is
1465  *      possibly modified in place.
1466  *
1467  *---------------------------------------------------------------------------
1468  */
1469
1470 int
1471 TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
1472     Tcl_Interp *interp;
1473     Tcl_Obj *pathPtr;
1474     int nextCheckpoint;
1475 {
1476     #define MAXMACFILENAMELEN 31  /* assumed to be < sizeof(StrFileName) */
1477
1478     StrFileName fileName;
1479     StringPtr fileNamePtr;
1480     int fileNameLen,newPathLen;
1481     Handle newPathHandle;
1482     OSErr err;
1483     short vRefNum;
1484     long dirID;
1485     Boolean isDirectory;
1486     Boolean wasAlias=FALSE;
1487     FSSpec fileSpec, lastFileSpec;
1488
1489     Tcl_DString nativeds;
1490
1491     char cur;
1492     int firstCheckpoint=nextCheckpoint, lastCheckpoint;
1493     int origPathLen;
1494     char *path = Tcl_GetStringFromObj(pathPtr,&origPathLen);
1495
1496     {
1497         int currDirValid=0;
1498         /*
1499          * check if substring to first ':' after initial
1500          * nextCheckpoint is a valid relative or absolute
1501          * path to a directory, if not we return without
1502          * normalizing anything
1503          */
1504
1505         while (1) {
1506             cur = path[nextCheckpoint];
1507             if (cur == ':' || cur == 0) {
1508                 if (cur == ':') {
1509                     /* jump over separator */
1510                     nextCheckpoint++; cur = path[nextCheckpoint];
1511                 }
1512                 Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds);
1513                 err = FSpLLocationFromPath(Tcl_DStringLength(&nativeds),
1514                                           Tcl_DStringValue(&nativeds),
1515                                           &fileSpec);
1516                 Tcl_DStringFree(&nativeds);
1517                 if (err == noErr) {
1518                         lastFileSpec=fileSpec;
1519                         err = ResolveAliasFile(&fileSpec, true, &isDirectory,
1520                                        &wasAlias);
1521                         if (err == noErr) {
1522                     err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1523                     currDirValid = ((err == noErr) && isDirectory);
1524                     vRefNum = fileSpec.vRefNum;
1525                     }
1526                 }
1527                 break;
1528             }
1529             nextCheckpoint++;
1530         }
1531
1532         if(!currDirValid) {
1533             /* can't determine root dir, bail out */
1534             return firstCheckpoint;
1535         }
1536     }
1537
1538     /*
1539      * Now vRefNum and dirID point to a valid
1540      * directory, so walk the rest of the path
1541      * ( code adapted from FSpLocationFromPath() )
1542      */
1543
1544     lastCheckpoint=nextCheckpoint;
1545     while (1) {
1546         cur = path[nextCheckpoint];
1547         if (cur == ':' || cur == 0) {
1548             fileNameLen=nextCheckpoint-lastCheckpoint;
1549             fileNamePtr=fileName;
1550             if(fileNameLen==0) {
1551                 if (cur == ':') {
1552                     /*
1553                      * special case for empty dirname i.e. encountered
1554                      * a '::' path component: get parent dir of currDir
1555                      */
1556                     fileName[0]=2;
1557                     strcpy((char *) fileName + 1, "::");
1558                     lastCheckpoint--;
1559                 } else {
1560                     /*
1561                      * empty filename, i.e. want FSSpec for currDir
1562                      */
1563                     fileNamePtr=NULL;
1564                 }
1565             } else {
1566                 Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint],
1567                                          fileNameLen,&nativeds);
1568                 fileNameLen=Tcl_DStringLength(&nativeds);
1569                 if(fileNameLen > MAXMACFILENAMELEN) {
1570                     err = bdNamErr;
1571                 } else {
1572                 fileName[0]=fileNameLen;
1573                 strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds),
1574                         fileNameLen);
1575                 }
1576                 Tcl_DStringFree(&nativeds);
1577             }
1578             if(err == noErr)
1579             err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec);
1580             if(err != noErr) {
1581                 if(err != fnfErr) {
1582                     /*
1583                      * this can occur if trying to get parent of a root
1584                      * volume via '::' or when using an illegal
1585                      * filename; revert to last checkpoint and stop
1586                      * processing path further
1587                      */
1588                     err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec);
1589                     if(err != noErr) {
1590                         /* should never happen, bail out */
1591                         return firstCheckpoint;
1592                     }
1593                     nextCheckpoint=lastCheckpoint;
1594                     cur = path[lastCheckpoint];
1595                 }
1596                 break; /* arrived at nonexistent file or dir */
1597             } else {
1598                 /* fileSpec could point to an alias, resolve it */
1599                 lastFileSpec=fileSpec;
1600                 err = ResolveAliasFile(&fileSpec, true, &isDirectory,
1601                                        &wasAlias);
1602                 if (err != noErr || !isDirectory) {
1603                     break; /* fileSpec doesn't point to a dir */
1604                 }
1605             }
1606             if (cur == 0) break; /* arrived at end of path */
1607
1608             /* fileSpec points to possibly nonexisting subdirectory; validate */
1609             err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
1610             if (err != noErr || !isDirectory) {
1611                 break; /* fileSpec doesn't point to existing dir */
1612             }
1613             vRefNum = fileSpec.vRefNum;
1614
1615             /* found a new valid subdir in path, continue processing path */
1616             lastCheckpoint=nextCheckpoint+1;
1617         }
1618         wasAlias=FALSE;
1619         nextCheckpoint++;
1620     }
1621
1622     if (wasAlias)
1623         fileSpec=lastFileSpec;
1624
1625     /*
1626      * fileSpec now points to a possibly nonexisting file or dir
1627      *  inside a valid dir; get full path name to it
1628      */
1629
1630     err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle);
1631     if(err != noErr) {
1632         return firstCheckpoint; /* should not see any errors here, bail out */
1633     }
1634
1635     HLock(newPathHandle);
1636     Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds);
1637     if (cur != 0) {
1638         /* not at end, append remaining path */
1639         if ( newPathLen==0 || (*(*newPathHandle+(newPathLen-1))!=':' && path[nextCheckpoint] !=':')) {
1640             Tcl_DStringAppend(&nativeds, ":" , 1);
1641         }
1642         Tcl_DStringAppend(&nativeds, &path[nextCheckpoint],
1643                           strlen(&path[nextCheckpoint]));
1644     }
1645     DisposeHandle(newPathHandle);
1646
1647     fileNameLen=Tcl_DStringLength(&nativeds);
1648     Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen);
1649     Tcl_DStringFree(&nativeds);
1650
1651     return nextCheckpoint+(fileNameLen-origPathLen);
1652 }
1653