tclmacfile.c

tcl是工具命令语言

/* 
 * 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.
 *
 *---------------------------------------------------------------------- */

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 */
	    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;