/* 

  * tclMacFile.c --

  *

  *      This file implements the channel drivers for Macintosh

  *	files.  It also comtains Macintosh version of other Tcl

  *	functions that deal with the file system.

  *

  * Copyright (c) 1995-1998 Sun Microsystems, Inc.

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclMacFile.c,v 1.27.2.1 2003/10/03 17:45:37 vincentdarley Exp $

  */

 /*

  * Note: This code eventually needs to support async I/O.  In doing this

  * we will need to keep track of all current async I/O.  If exit to shell

  * is called - we shouldn't exit until all asyc I/O completes.

  */

 #include "tclInt.h"

 #include "tclPort.h"

 #include "tclMacInt.h"

 #include <Aliases.h>

 #include <Resources.h>

 #include <Files.h>

 #include <Errors.h>

 #include <Processes.h>

 #include <Strings.h>

 #include <Types.h>

 #include <MoreFiles.h>

 #include <MoreFilesExtras.h>

 #include <FSpCompat.h>

 static int NativeMatchType(Tcl_Obj *tempName, Tcl_GlobTypeData *types, 

 			   HFileInfo fileInfo, OSType okType, OSType okCreator);

 static OSErr FspLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr, 

 						FSSpec* specPtr));

 static OSErr FspLLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr, 

 						FSSpec* specPtr));

 static OSErr CreateAliasFile _ANSI_ARGS_((FSSpec *theAliasFile, FSSpec *targetFile));

 static OSErr 

 FspLocationFromFsPath(pathPtr, specPtr)

     Tcl_Obj *pathPtr;

     FSSpec* specPtr;

 {

     CONST char *native = Tcl_FSGetNativePath(pathPtr);

     return FSpLocationFromPath(strlen(native), native, specPtr);

 }

 static OSErr 

 FspLLocationFromFsPath(pathPtr, specPtr)

     Tcl_Obj *pathPtr;

     FSSpec* specPtr;

 {

     CONST char *native = Tcl_FSGetNativePath(pathPtr);

     return FSpLLocationFromPath(strlen(native), native, specPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpFindExecutable --

  *

  *	This procedure computes the absolute path name of the current

  *	application, given its argv[0] value.  However, this

  *	implementation doesn't need the argv[0] value.  NULL

  *	may be passed in its place.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The variable tclExecutableName gets filled in with the file

  *	name for the application, if we figured it out.  If we couldn't

  *	figure it out, Tcl_FindExecutable is set to NULL.

  *

  *----------------------------------------------------------------------

  */

 char *

 TclpFindExecutable(

     CONST char *argv0)		/* The value of the application's argv[0]. */

 {

     ProcessSerialNumber psn;

     ProcessInfoRec info;

     Str63 appName;

     FSSpec fileSpec;

     int pathLength;

     Handle pathName = NULL;

     OSErr err;

     Tcl_DString ds;

     TclInitSubsystems(argv0);

     GetCurrentProcess(&psn);

     info.processInfoLength = sizeof(ProcessInfoRec);

     info.processName = appName;

     info.processAppSpec = &fileSpec;

     GetProcessInformation(&psn, &info);

     if (tclExecutableName != NULL) {

 	ckfree(tclExecutableName);

 	tclExecutableName = NULL;

     }

     err = FSpPathFromLocation(&fileSpec, &pathLength, &pathName);

     HLock(pathName);

     Tcl_ExternalToUtfDString(NULL, *pathName, pathLength, &ds);

     HUnlock(pathName);

     DisposeHandle(pathName);	

     tclExecutableName = (char *) ckalloc((unsigned) 

     	    (Tcl_DStringLength(&ds) + 1));

     strcpy(tclExecutableName, Tcl_DStringValue(&ds));

     Tcl_DStringFree(&ds);

     return tclExecutableName;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpMatchInDirectory --

  *

  *	This routine is used by the globbing code to search a

  *	directory for all files which match a given pattern.

  *

  * Results: 

  *	

  *	The return value is a standard Tcl result indicating whether an

  *	error occurred in globbing.  Errors are left in interp, good

  *	results are lappended to resultPtr (which must be a valid object)

  *

  * Side effects:

  *	None.

  *

  *---------------------------------------------------------------------- */

 int

 TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)

     Tcl_Interp *interp;		/* Interpreter to receive errors. */

     Tcl_Obj *resultPtr;		/* List object to lappend results. */

     Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */

     CONST char *pattern;	/* Pattern to match against.  NULL or empty

                         	 * means pathPtr is actually a single file

                         	 * to check. */

     Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.

 				 * May be NULL. In particular the directory

 				 * flag is very important. */

 {

     OSType okType = 0;

     OSType okCreator = 0;

     Tcl_Obj *fileNamePtr;

     fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

     if (fileNamePtr == NULL) {

 	return TCL_ERROR;

     }

     if (types != NULL) {

 	if (types->macType != NULL) {

 	    Tcl_GetOSTypeFromObj(NULL, types->macType, &okType);

 	}

 	if (types->macCreator != NULL) {

 	    Tcl_GetOSTypeFromObj(NULL, types->macCreator, &okCreator);

 	}

     }

     if (pattern == NULL || (*pattern == '\0')) {

 	/* Match a single file directly */

 	Tcl_StatBuf buf;

 	CInfoPBRec paramBlock;

 	FSSpec fileSpec;

 	if (TclpObjLstat(fileNamePtr, &buf) != 0) {

 	    /* File doesn't exist */

 	    Tcl_DecrRefCount(fileNamePtr);

 	    return TCL_OK;

 	}

 	if (FspLLocationFromFsPath(fileNamePtr, &fileSpec) == noErr) {

 	    paramBlock.hFileInfo.ioCompletion = NULL;

 	    paramBlock.hFileInfo.ioNamePtr = fileSpec.name;

 	    paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;

 	    paramBlock.hFileInfo.ioFDirIndex = 0;

 	    paramBlock.hFileInfo.ioDirID = fileSpec.parID;

 	    PBGetCatInfo(&paramBlock, 0);

 	}

 	if (NativeMatchType(fileNamePtr, types, paramBlock.hFileInfo,

 			    okType, okCreator)) {

 	    int fnameLen;

 	    char *fname = Tcl_GetStringFromObj(pathPtr,&fnameLen);

 	    if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {

 		Tcl_ListObjAppendElement(interp, resultPtr, 

 			Tcl_NewStringObj(fname+1, fnameLen-1));

 	    } else {

 		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);

 	    }

 	}

 	Tcl_DecrRefCount(fileNamePtr);

 	return TCL_OK;

     } else {

 	char *fname;

 	int fnameLen, result = TCL_OK;

 	int baseLength;

 	CInfoPBRec pb;

 	OSErr err;

 	FSSpec dirSpec;

 	Boolean isDirectory;

 	long dirID;

 	short itemIndex;

 	Str255 fileName;

 	Tcl_DString fileString;    

 	Tcl_DString dsOrig;

 	Tcl_DStringInit(&dsOrig);

 	Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);

 	baseLength = Tcl_DStringLength(&dsOrig);

 	/*

 	 * Make sure that the directory part of the name really is a

 	 * directory.

 	 */

 	Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),

 		Tcl_DStringLength(&dsOrig), &fileString);

 	err = FSpLocationFromPath(Tcl_DStringLength(&fileString), 

 				  Tcl_DStringValue(&fileString), &dirSpec);

 	Tcl_DStringFree(&fileString);

 	if (err == noErr) {

 	    err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);

 	}

 	if ((err != noErr) || !isDirectory) {

 	    /*

 	     * Check if we had a relative path (unix style relative path 

 	     * compatibility for glob)

 	     */

 	    Tcl_DStringFree(&dsOrig);

 	    Tcl_DStringAppend(&dsOrig, ":", 1);

 	    Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);

 	    baseLength = Tcl_DStringLength(&dsOrig);

 	    Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),

 		    Tcl_DStringLength(&dsOrig), &fileString);

 	    err = FSpLocationFromPath(Tcl_DStringLength(&fileString), 

 				      Tcl_DStringValue(&fileString), &dirSpec);

 	    Tcl_DStringFree(&fileString);

 	    if (err == noErr) {

 		err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);

 	    }

 	    if ((err != noErr) || !isDirectory) {

 		Tcl_DStringFree(&dsOrig);

 		Tcl_DecrRefCount(fileNamePtr);

 		return TCL_OK;

 	    }

 	}

 	/* Make sure we have a trailing directory delimiter */

 	if (Tcl_DStringValue(&dsOrig)[baseLength-1] != ':') {

 	    Tcl_DStringAppend(&dsOrig, ":", 1);

 	    baseLength++;

 	}

 	/*

 	 * Now open the directory for reading and iterate over the contents.

 	 */

 	pb.hFileInfo.ioVRefNum = dirSpec.vRefNum;

 	pb.hFileInfo.ioDirID = dirID;

 	pb.hFileInfo.ioNamePtr = (StringPtr) fileName;

 	pb.hFileInfo.ioFDirIndex = itemIndex = 1;

 	while (1) {

 	    pb.hFileInfo.ioFDirIndex = itemIndex;

 	    pb.hFileInfo.ioDirID = dirID;

 	    err = PBGetCatInfoSync(&pb);

 	    if (err != noErr) {

 		break;

 	    }

 	    /*

 	     * Now check to see if the file matches.  

 	     */

 	    Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],

 		    &fileString);

 	    if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {

 		Tcl_Obj *tempName;

 		Tcl_DStringSetLength(&dsOrig, baseLength);

 		Tcl_DStringAppend(&dsOrig, Tcl_DStringValue(&fileString), -1);

 		fname = Tcl_DStringValue(&dsOrig);

 		fnameLen = Tcl_DStringLength(&dsOrig);

 		/* 

 		 * We use this tempName in calls to check the file's

 		 * type below.  We may also use it for the result.

 		 */

 		tempName = Tcl_NewStringObj(fname, fnameLen);

 		Tcl_IncrRefCount(tempName);

 		/* Is the type acceptable? */

 		if (NativeMatchType(tempName, types, pb.hFileInfo,

 				    okType, okCreator)) {

 		    if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {

 			Tcl_ListObjAppendElement(interp, resultPtr, 

 				Tcl_NewStringObj(fname+1, fnameLen-1));

 		    } else {

 			Tcl_ListObjAppendElement(interp, resultPtr, tempName);

 		    }

 		}

 		/* 

 		 * This will free the object, unless it was inserted in

 		 * the result list above.

 		 */

 		Tcl_DecrRefCount(tempName);

 	    }

 	    Tcl_DStringFree(&fileString);

 	    itemIndex++;

 	}

 	Tcl_DStringFree(&dsOrig);

 	Tcl_DecrRefCount(fileNamePtr);

 	return result;

     }

 }

 static int 

 NativeMatchType(

     Tcl_Obj *tempName,        /* Path to check */

     Tcl_GlobTypeData *types,  /* Type description to match against */

     HFileInfo fileInfo,       /* MacOS file info */

     OSType okType,            /* Acceptable MacOS type, or zero */

     OSType okCreator)         /* Acceptable MacOS creator, or zero */

 {

     if (types == NULL) {

 	/* If invisible, don't return the file */

 	if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {

 	    return 0;

 	}

     } else {

 	Tcl_StatBuf buf;

 	if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {

 	    /* If invisible */

 	    if ((types->perm == 0) || 

 	      !(types->perm & TCL_GLOB_PERM_HIDDEN)) {

 		return 0;

 	    }

 	} else {

 	    /* Visible */

 	    if (types->perm & TCL_GLOB_PERM_HIDDEN) {

 		return 0;

 	    }

 	}

 	if (types->perm != 0) {

 	    if (

 		((types->perm & TCL_GLOB_PERM_RONLY) &&

 			!(fileInfo.ioFlAttrib & 1)) ||

 		((types->perm & TCL_GLOB_PERM_R) &&

 			(TclpObjAccess(tempName, R_OK) != 0)) ||

 		((types->perm & TCL_GLOB_PERM_W) &&

 			(TclpObjAccess(tempName, W_OK) != 0)) ||

 		((types->perm & TCL_GLOB_PERM_X) &&

 			(TclpObjAccess(tempName, X_OK) != 0))

 		) {

 		return 0;

 	    }

 	}

 	if (types->type != 0) {

 	    if (TclpObjStat(tempName, &buf) != 0) {

 		/* Posix error occurred */

 		return 0;

 	    }

 	    /*

 	     * In order bcdpfls as in 'find -t'

 	     */

 	    if (

 		((types->type & TCL_GLOB_TYPE_BLOCK) &&

 			S_ISBLK(buf.st_mode)) ||

 		((types->type & TCL_GLOB_TYPE_CHAR) &&

 			S_ISCHR(buf.st_mode)) ||

 		((types->type & TCL_GLOB_TYPE_DIR) &&

 			S_ISDIR(buf.st_mode)) ||

 		((types->type & TCL_GLOB_TYPE_PIPE) &&

 			S_ISFIFO(buf.st_mode)) ||

 		((types->type & TCL_GLOB_TYPE_FILE) &&

 			S_ISREG(buf.st_mode))

 #ifdef S_ISSOCK

 		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&

 			S_ISSOCK(buf.st_mode))

 #endif

 		) {

 		/* Do nothing -- this file is ok */

 	    } else {

 		int typeOk = 0;

 #ifdef S_ISLNK

 		if (types->type & TCL_GLOB_TYPE_LINK) {

 		    if (TclpObjLstat(tempName, &buf) == 0) {

 			if (S_ISLNK(buf.st_mode)) {

 			    typeOk = 1;

 			}

 		    }

 		}

 #endif

 		if (typeOk == 0) {

 		    return 0;

 		}

 	    }

 	}

 	if (((okType != 0) && (okType !=

 			       fileInfo.ioFlFndrInfo.fdType)) ||

 	    ((okCreator != 0) && (okCreator !=

 				  fileInfo.ioFlFndrInfo.fdCreator))) {

 	    return 0;

 	}

     }

     return 1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpObjAccess --

  *

  *	This function replaces the library version of access().

  *

  * Results:

  *	See access documentation.

  *

  * Side effects:

  *	See access documentation.

  *

  *----------------------------------------------------------------------

  */

 int 

 TclpObjAccess(pathPtr, mode)

     Tcl_Obj *pathPtr;

     int mode;

 {

     HFileInfo fpb;

     HVolumeParam vpb;

     OSErr err;

     FSSpec fileSpec;

     Boolean isDirectory;

     long dirID;

     int full_mode = 0;

     err = FspLLocationFromFsPath(pathPtr, &fileSpec);

     if (err != noErr) {

 	errno = TclMacOSErrorToPosixError(err);

 	return -1;

     }

     /*

      * Fill the fpb & vpb struct up with info about file or directory.

      */

     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);

     vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;

     vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;

     if (isDirectory) {

 	fpb.ioDirID = fileSpec.parID;

     } else {

 	fpb.ioDirID = dirID;

     }

     fpb.ioFDirIndex = 0;

     err = PBGetCatInfoSync((CInfoPBPtr)&fpb);

     if (err == noErr) {

 	vpb.ioVolIndex = 0;

 	err = PBHGetVInfoSync((HParmBlkPtr)&vpb);

 	if (err == noErr) {

 	    /* 

 	     * Use the Volume Info & File Info to determine

 	     * access information.  If we have got this far

 	     * we know the directory is searchable or the file

 	     * exists.  (We have F_OK)

 	     */

 	    /*

 	     * Check to see if the volume is hardware or

 	     * software locked.  If so we arn't W_OK.

 	     */

 	    if (mode & W_OK) {

 		if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {

 		    errno = EROFS;

 		    return -1;

 		}

 		if (fpb.ioFlAttrib & 0x01) {

 		    errno = EACCES;

 		    return -1;

 		}

 	    }

 	    /*

 	     * Directories are always searchable and executable.  But only 

 	     * files of type 'APPL' are executable.

 	     */

 	    if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)

 		&& (fpb.ioFlFndrInfo.fdType != 'APPL')) {

 		return -1;

 	    }

 	}

     }

     if (err != noErr) {

 	errno = TclMacOSErrorToPosixError(err);

 	return -1;

     }

     return 0;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpObjChdir --

  *

  *	This function replaces the library version of chdir().

  *

  * Results:

  *	See chdir() documentation.

  *

  * Side effects:

  *	See chdir() documentation.  Also the cache maintained used by 

  *	Tcl_FSGetCwd() is deallocated and set to NULL.

  *

  *----------------------------------------------------------------------

  */

 int 

 TclpObjChdir(pathPtr)

     Tcl_Obj *pathPtr;

 {

     FSSpec spec;

     OSErr err;

     Boolean isFolder;

     long dirID;

     err = FspLocationFromFsPath(pathPtr, &spec);

     if (err != noErr) {

 	errno = ENOENT;

 	return -1;

     }

     err = FSpGetDirectoryID(&spec, &dirID, &isFolder);

     if (err != noErr) {

 	errno = ENOENT;

 	return -1;

     }

     if (isFolder != true) {

 	errno = ENOTDIR;

 	return -1;

     }

     err = FSpSetDefaultDir(&spec);

     if (err != noErr) {

 	switch (err) {

 	    case afpAccessDenied:

 		errno = EACCES;

 		break;

 	    default:

 		errno = ENOENT;

 	}

 	return -1;

     }

     return 0;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpObjGetCwd --

  *

  *	This function replaces the library version of getcwd().

  *

  * Results:

  *	The result is a pointer to a string specifying the current

  *	directory, or NULL if the current directory could not be

  *	determined.  If NULL is returned, an error message is left in the

  *	interp's result.  Storage for the result string is allocated in

  *	bufferPtr; the caller must call Tcl_DStringFree() when the result

  *	is no longer needed.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Obj* 

 TclpObjGetCwd(interp)

     Tcl_Interp *interp;

 {

     Tcl_DString ds;

     if (TclpGetCwd(interp, &ds) != NULL) {

 	Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);

 	Tcl_IncrRefCount(cwdPtr);

 	Tcl_DStringFree(&ds);

 	return cwdPtr;

     } else {

 	return NULL;

     }

 }

 CONST char *

 TclpGetCwd(

     Tcl_Interp *interp,		/* If non-NULL, used for error reporting. */

     Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled

 				 * with name of current directory. */

 {

     FSSpec theSpec;

     int length;

     Handle pathHandle = NULL;

     if (FSpGetDefaultDir(&theSpec) != noErr) {

  	if (interp != NULL) {

 	    Tcl_SetResult(interp, "error getting working directory name",

 		    TCL_STATIC);

 	}

 	return NULL;

     }

     if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {

  	if (interp != NULL) {

 	     Tcl_SetResult(interp, "error getting working directory name",

 		    TCL_STATIC);

 	}

 	return NULL;

     }

     HLock(pathHandle);

     Tcl_ExternalToUtfDString(NULL, *pathHandle, length, bufferPtr);

     HUnlock(pathHandle);

     DisposeHandle(pathHandle);	

     return Tcl_DStringValue(bufferPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpReadlink --

  *

  *	This function replaces the library version of readlink().

  *

  * Results:

  *	The result is a pointer to a string specifying the contents

  *	of the symbolic link given by 'path', or NULL if the symbolic

  *	link could not be read.  Storage for the result string is

  *	allocated in bufferPtr; the caller must call Tcl_DStringFree()

  *	when the result is no longer needed.

  *

  * Side effects:

  *	See readlink() documentation.

  *

  *---------------------------------------------------------------------------

  */

 char *

 TclpReadlink(

     CONST char *path,		/* Path of file to readlink (UTF-8). */

     Tcl_DString *linkPtr)	/* Uninitialized or free DString filled

 				 * with contents of link (UTF-8). */

 {

     HFileInfo fpb;

     OSErr err;

     FSSpec fileSpec;

     Boolean isDirectory;

     Boolean wasAlias;

     long dirID;

     char fileName[257];

     char *end;

     Handle theString = NULL;

     int pathSize;

     Tcl_DString ds;

     Tcl_UtfToExternalDString(NULL, path, -1, &ds);

     /*

      * Remove ending colons if they exist.

      */

     while ((Tcl_DStringLength(&ds) != 0) 

 	   && (Tcl_DStringValue(&ds)[Tcl_DStringLength(&ds) - 1] == ':')) {

 	Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 1);

     }

     end = strrchr(Tcl_DStringValue(&ds), ':');

     if (end == NULL ) {

 	strcpy(fileName + 1, Tcl_DStringValue(&ds));

     } else {

 	strcpy(fileName + 1, end + 1);

 	Tcl_DStringSetLength(&ds, end + 1 - Tcl_DStringValue(&ds));

     }

     fileName[0] = (char) strlen(fileName + 1);

     /*

      * Create the file spec for the directory of the file

      * we want to look at.

      */

     if (end != NULL) {

 	err = FSpLocationFromPath(Tcl_DStringLength(&ds), 

 				  Tcl_DStringValue(&ds), &fileSpec);

 	if (err != noErr) {

 	    Tcl_DStringFree(&ds);

 	    errno = EINVAL;

 	    return NULL;

 	}

     } else {

 	FSMakeFSSpecCompat(0, 0, NULL, &fileSpec);

     }

     Tcl_DStringFree(&ds);

     /*

      * Fill the fpb struct up with info about file or directory.

      */

     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);

     fpb.ioVRefNum = fileSpec.vRefNum;

     fpb.ioDirID = dirID;

     fpb.ioNamePtr = (StringPtr) fileName;

     fpb.ioFDirIndex = 0;

     err = PBGetCatInfoSync((CInfoPBPtr)&fpb);

     if (err != noErr) {

 	errno = TclMacOSErrorToPosixError(err);

 	return NULL;

     } else {

 	if (fpb.ioFlAttrib & 0x10) {

 	    errno = EINVAL;

 	    return NULL;

 	} else {

 	    if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {

 		/*

 		 * The file is a link!

 		 */

 	    } else {

 		errno = EINVAL;

 		return NULL;

 	    }

 	}

     }

     /*

      * If we are here it's really a link - now find out

      * where it points to.

      */

     err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName, 

     	    &fileSpec);

     if (err == noErr) {

 	err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);

     }

     if ((err == fnfErr) || wasAlias) {

 	err = FSpPathFromLocation(&fileSpec, &pathSize, &theString);

 	if (err != noErr) {

 	    DisposeHandle(theString);

 	    errno = ENAMETOOLONG;

 	    return NULL;

 	}

     } else {

     	errno = EINVAL;

 	return NULL;

     }

     Tcl_ExternalToUtfDString(NULL, *theString, pathSize, linkPtr);

     DisposeHandle(theString);

     return Tcl_DStringValue(linkPtr);

 }

 static int 

 TclpObjStatAlias _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr, 

 			      Boolean resolveLink));

 /*

  *----------------------------------------------------------------------

  *

  * TclpObjLstat --

  *

  *	This function replaces the library version of lstat().

  *

  * Results:

  *	See lstat() documentation.

  *

  * Side effects:

  *	See lstat() documentation.

  *

  *----------------------------------------------------------------------

  */

 int 

 TclpObjLstat(pathPtr, buf)

     Tcl_Obj *pathPtr;

     Tcl_StatBuf *buf;

 {

     return TclpObjStatAlias(pathPtr, buf, FALSE);

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpObjStat --

  *

  *	This function replaces the library version of stat().

  *

  * Results:

  *	See stat() documentation.

  *

  * Side effects:

  *	See stat() documentation.

  *

  *----------------------------------------------------------------------

  */

 int 

 TclpObjStat(pathPtr, bufPtr)

     Tcl_Obj *pathPtr;

     Tcl_StatBuf *bufPtr;

 {

     return TclpObjStatAlias(pathPtr, bufPtr, TRUE);

 }

 static int

 TclpObjStatAlias (Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr, Boolean resolveLink)

 {

     HFileInfo fpb;

     HVolumeParam vpb;

     OSErr err;

     FSSpec fileSpec;

     Boolean isDirectory;

     long dirID;

     if (resolveLink)

     	err = FspLocationFromFsPath(pathPtr, &fileSpec);

     else

     	err = FspLLocationFromFsPath(pathPtr, &fileSpec);

     if (err != noErr) {

 	errno = TclMacOSErrorToPosixError(err);

 	return -1;

     }

     /*

      * Fill the fpb & vpb struct up with info about file or directory.

      */

     FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);

     vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;

     vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;

     if (isDirectory) {

 	fpb.ioDirID = fileSpec.parID;

     } else {

 	fpb.ioDirID = dirID;

     }

     fpb.ioFDirIndex = 0;

     err = PBGetCatInfoSync((CInfoPBPtr)&fpb);

     if (err == noErr) {

 	vpb.ioVolIndex = 0;

 	err = PBHGetVInfoSync((HParmBlkPtr)&vpb);

 	if (err == noErr && bufPtr != NULL) {

 	    /* 

 	     * Files are always readable by everyone.

 	     */

 	    bufPtr->st_mode = S_IRUSR | S_IRGRP | S_IROTH;

 	    /* 

 	     * Use the Volume Info & File Info to fill out stat buf.

 	     */

 	    if (fpb.ioFlAttrib & 0x10) {

 		bufPtr->st_mode |= S_IFDIR;

 		bufPtr->st_nlink = 2;

 	    } else {

 		bufPtr->st_nlink = 1;

 		if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {

 		    bufPtr->st_mode |= S_IFLNK;

 		} else {

 		    bufPtr->st_mode |= S_IFREG;

 		}

 	    }

 	    if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {

 		/*

 		 * Directories and applications are executable by everyone.

 		 */

 		bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;

 	    }

 	    if ((fpb.ioFlAttrib & 0x01) == 0){

 		/* 

 		 * If not locked, then everyone has write acces.

 		 */

 		bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;

 	    }

 	    bufPtr->st_ino = fpb.ioDirID;

 	    bufPtr->st_dev = fpb.ioVRefNum;

 	    bufPtr->st_uid = -1;

 	    bufPtr->st_gid = -1;

 	    bufPtr->st_rdev = 0;

 	    bufPtr->st_size = fpb.ioFlLgLen;

 	    bufPtr->st_blksize = vpb.ioVAlBlkSiz;

 	    bufPtr->st_blocks = (bufPtr->st_size + bufPtr->st_blksize - 1)

 		/ bufPtr->st_blksize;

 	    /*

 	     * The times returned by the Mac file system are in the

 	     * local time zone.  We convert them to GMT so that the

 	     * epoch starts from GMT.  This is also consistent with

 	     * what is returned from "clock seconds".

 	     */

 	    bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat 

 	      - TclpGetGMTOffset() + tcl_mac_epoch_offset;

 	    bufPtr->st_ctime = fpb.ioFlCrDat - TclpGetGMTOffset() 

 	      + tcl_mac_epoch_offset;

 	}

     }

     if (err != noErr) {

 	errno = TclMacOSErrorToPosixError(err);

     }

     return (err == noErr ? 0 : -1);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_WaitPid --

  *

  *	Fakes a call to wait pid.

  *

  * Results:

  *	Always returns -1.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Pid

 Tcl_WaitPid(

     Tcl_Pid pid,

     int *statPtr,

     int options)

 {

     return (Tcl_Pid) -1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclMacFOpenHack --

  *

  *	This function replaces fopen.  It supports paths with alises.

  *	Note, remember to undefine the fopen macro!

  *

  * Results:

  *	See fopen documentation.

  *

  * Side effects:

  *	See fopen documentation.

  *

  *----------------------------------------------------------------------

  */

 #undef fopen

 FILE *

 TclMacFOpenHack(

     CONST char *path,

     CONST char *mode)

 {

     OSErr err;

     FSSpec fileSpec;

     Handle pathString = NULL;

     int size;

     FILE * f;

     err = FSpLocationFromPath(strlen(path), path, &fileSpec);

     if ((err != noErr) && (err != fnfErr)) {

 	return NULL;

     }

     err = FSpPathFromLocation(&fileSpec, &size, &pathString);

     if ((err != noErr) && (err != fnfErr)) {

 	return NULL;

     }

     HLock(pathString);

     f = fopen(*pathString, mode);

     HUnlock(pathString);

     DisposeHandle(pathString);

     return f;

 }

 /*

  *---------------------------------------------------------------------------

  *

  * TclpGetUserHome --

  *

  *	This function takes the specified user name and finds their

  *	home directory.

  *

  * Results:

  *	The result is a pointer to a string specifying the user's home

  *	directory, or NULL if the user's home directory could not be

  *	determined.  Storage for the result string is allocated in

  *	bufferPtr; the caller must call Tcl_DStringFree() when the result

  *	is no longer needed.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 char *

 TclpGetUserHome(name, bufferPtr)

     CONST char *name;		/* User name for desired home directory. */

     Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled

 				 * with name of user's home directory. */

 {

     return NULL;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclMacOSErrorToPosixError --

  *

  *	Given a Macintosh OSErr return the appropiate POSIX error.

  *

  * Results:

  *	A Posix error.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 int

 TclMacOSErrorToPosixError(

     int error)	/* A Macintosh error. */

 {

     switch (error) {

 	case noErr:

 	    return 0;

 	case bdNamErr:

 	    return ENAMETOOLONG;

 	case afpObjectTypeErr:

 	    return ENOTDIR;

 	case fnfErr:

 	case dirNFErr:

 	    return ENOENT;

 	case dupFNErr:

 	    return EEXIST;

 	case dirFulErr:

 	case dskFulErr:

 	    return ENOSPC;

 	case fBsyErr:

 	    return EBUSY;

 	case tmfoErr:

 	    return ENFILE;

 	case fLckdErr:

 	case permErr:

 	case afpAccessDenied:

 	    return EACCES;

 	case wPrErr:

 	case vLckdErr:

 	    return EROFS;

 	case badMovErr:

 	    return EINVAL;

 	case diffVolErr:

 	    return EXDEV;

 	default:

 	    return EINVAL;

     }

 }

 int

 TclMacChmod(

     CONST char *path, 

     int mode)

 {

     HParamBlockRec hpb;

     OSErr err;

     Str255 pathName;

     strcpy((char *) pathName + 1, path);

     pathName[0] = strlen(path);

     hpb.fileParam.ioNamePtr = pathName;

     hpb.fileParam.ioVRefNum = 0;

     hpb.fileParam.ioDirID = 0;

     if (mode & 0200) {

         err = PBHRstFLockSync(&hpb);

     } else {

         err = PBHSetFLockSync(&hpb);

     }

     if (err != noErr) {

         errno = TclMacOSErrorToPosixError(err);

         return -1;

     }

     return 0;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpTempFileName --

  *

  *	This function returns a unique filename.

  *

  * Results:

  *	Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 Tcl_Obj* 

 TclpTempFileName()

 {

     char fileName[L_tmpnam];

     if (tmpnam(fileName) == NULL) {	       /* INTL: Native. */

 	return NULL;

     }

     return TclpNativeToNormalized((ClientData) fileName);

 }

 #ifdef S_IFLNK

 Tcl_Obj* 

 TclpObjLink(pathPtr, toPtr, linkAction)

     Tcl_Obj *pathPtr;

     Tcl_Obj *toPtr;

     int linkAction;

 {

     Tcl_Obj* link = NULL;

     if (toPtr != NULL) {

 	if (TclpObjAccess(pathPtr, F_OK) != -1) {

 	    /* src exists */

 	    errno = EEXIST;

 	    return NULL;

 	}

 	if (TclpObjAccess(toPtr, F_OK) == -1) {

 	    /* target doesn't exist */

 	    errno = ENOENT;

 	    return NULL;

 	}

 	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {

 	    /* Needs to create a new link */

 	    FSSpec spec;

 	    FSSpec linkSpec;

 	    OSErr err;

 	    CONST char *path;

 	    err = FspLocationFromFsPath(toPtr, &spec);

 	    if (err != noErr) {

 		errno = ENOENT;

 		return NULL;

 	    }

 	    path = Tcl_FSGetNativePath(pathPtr);

 	    err = FSpLocationFromPath(strlen(path), path, &linkSpec);

 	    if (err == noErr) {

 		err = dupFNErr;		/* EEXIST. */

 	    } else {

 		err = CreateAliasFile(&linkSpec, &spec);

 	    }

 	    if (err != noErr) {

 		errno = TclMacOSErrorToPosixError(err);

 		return NULL;

 	    }

 	    return toPtr;

 	} else {

 	    errno = ENODEV;

 	    return NULL;

 	}

     } else {

 	Tcl_DString ds;

 	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);

 	if (transPtr == NULL) {

 	    return NULL;

 	}

 	if (TclpReadlink(Tcl_GetString(transPtr), &ds) != NULL) {

 	    link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);

 	    Tcl_IncrRefCount(link);

 	    Tcl_DStringFree(&ds);

 	}

 	Tcl_DecrRefCount(transPtr);

     }

     return link;

 }

 #endif

 /*

  *---------------------------------------------------------------------------

  *

  * TclpFilesystemPathType --

  *

  *      This function is part of the native filesystem support, and

  *      returns the path type of the given path.  Right now it simply

  *      returns NULL.  In the future it could return specific path

  *      types, like 'HFS', 'HFS+', 'nfs', 'samba', 'FAT32', etc.

  *

  * Results:

  *      NULL at present.

  *

  * Side effects:

  *	None.

  *

  *---------------------------------------------------------------------------

  */

 Tcl_Obj*

 TclpFilesystemPathType(pathObjPtr)

     Tcl_Obj* pathObjPtr;

 {

     /* All native paths are of the same type */

     return NULL;

 }

 /*

  *---------------------------------------------------------------------------

  *

  * TclpUtime --

  *

  *	Set the modification date for a file.

  *

  * Results:

  *	0 on success, -1 on error.

  *

  * Side effects:

  *	None.

  *

  *---------------------------------------------------------------------------

  */

 int 

 TclpUtime(pathPtr, tval)

     Tcl_Obj *pathPtr;      /* File to modify */

     struct utimbuf *tval;  /* New modification date structure */

 {

     long gmt_offset=TclpGetGMTOffset();

     struct utimbuf local_tval;

     local_tval.actime=tval->actime+gmt_offset;

     local_tval.modtime=tval->modtime+gmt_offset;

     return utime(Tcl_FSGetNativePath(Tcl_FSGetNormalizedPath(NULL,pathPtr)),

 		 &local_tval);

 }

 /*

  *---------------------------------------------------------------------------

  *

  * CreateAliasFile --

  *

  *	Creates an alias file located at aliasDest referring to the targetFile.

  *

  * Results:

  *	0 on success, OS error code on error.

  *

  * Side effects:

  *	None.

  *

  *---------------------------------------------------------------------------

  */

 static OSErr

 CreateAliasFile(FSSpec *theAliasFile, FSSpec *targetFile)

 {

     CInfoPBRec cat;

     FInfo fndrInfo;

     AliasHandle theAlias;

     short saveRef, rsrc = -1;

     OSErr err;

     saveRef = CurResFile();

     /* set up the Finder information record for the alias file */

     cat.dirInfo.ioNamePtr = targetFile->name;

     cat.dirInfo.ioVRefNum = targetFile->vRefNum;

     cat.dirInfo.ioFDirIndex = 0;

     cat.dirInfo.ioDrDirID = targetFile->parID;

     err = PBGetCatInfoSync(&cat);

     if (err != noErr) goto bail;

     if ((cat.dirInfo.ioFlAttrib & 16) == 0) {

         /* file alias */

         switch (cat.hFileInfo.ioFlFndrInfo.fdType) {

             case 'APPL': fndrInfo.fdType = kApplicationAliasType; break;

             case 'APPC': fndrInfo.fdType = kApplicationCPAliasType; break;

             case 'APPD': fndrInfo.fdType = kApplicationDAAliasType; break;

             default: fndrInfo.fdType = cat.hFileInfo.ioFlFndrInfo.fdType; break;

         }

         fndrInfo.fdCreator = cat.hFileInfo.ioFlFndrInfo.fdCreator;

     } else {

         /* folder alias */

         fndrInfo.fdType = kContainerFolderAliasType;

         fndrInfo.fdCreator = 'MACS';

     }

     fndrInfo.fdFlags = kIsAlias;

     fndrInfo.fdLocation.v = 0;

     fndrInfo.fdLocation.h = 0;

     fndrInfo.fdFldr = 0;

     /* create new file and set the file information */

     FSpCreateResFile( theAliasFile, fndrInfo.fdCreator, fndrInfo.fdType, smSystemScript);

     if ((err = ResError()) != noErr) goto bail;

     err = FSpSetFInfo( theAliasFile, &fndrInfo);

     if (err != noErr) goto bail;

     /* save the alias resource */

     rsrc = FSpOpenResFile(theAliasFile, fsRdWrPerm);

     if (rsrc == -1) { err = ResError(); goto bail; }

     UseResFile(rsrc);

     err = NewAlias(theAliasFile, targetFile, &theAlias);

     if (err != noErr) goto bail;

     AddResource((Handle) theAlias, rAliasType, 0, theAliasFile->name);

     if ((err = ResError()) != noErr) goto bail;

     CloseResFile(rsrc);

     rsrc = -1;

     /* done */

  bail:

     if (rsrc != -1) CloseResFile(rsrc);

     UseResFile(saveRef);

     return err;

 }