/*  * 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 2003/03/03 20:22:43 das 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. * *---------------------------------------------------------------------- */intTclpMatchInDirectory(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 */	    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);	    }	}	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);		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);	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;