os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacFile.c
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacFile.c	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,1350 @@
     1.4 +/* 
     1.5 + * tclMacFile.c --
     1.6 + *
     1.7 + *      This file implements the channel drivers for Macintosh
     1.8 + *	files.  It also comtains Macintosh version of other Tcl
     1.9 + *	functions that deal with the file system.
    1.10 + *
    1.11 + * Copyright (c) 1995-1998 Sun Microsystems, Inc.
    1.12 + *
    1.13 + * See the file "license.terms" for information on usage and redistribution
    1.14 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.15 + *
    1.16 + * RCS: @(#) $Id: tclMacFile.c,v 1.27.2.1 2003/10/03 17:45:37 vincentdarley Exp $
    1.17 + */
    1.18 +
    1.19 +/*
    1.20 + * Note: This code eventually needs to support async I/O.  In doing this
    1.21 + * we will need to keep track of all current async I/O.  If exit to shell
    1.22 + * is called - we shouldn't exit until all asyc I/O completes.
    1.23 + */
    1.24 +
    1.25 +#include "tclInt.h"
    1.26 +#include "tclPort.h"
    1.27 +#include "tclMacInt.h"
    1.28 +#include <Aliases.h>
    1.29 +#include <Resources.h>
    1.30 +#include <Files.h>
    1.31 +#include <Errors.h>
    1.32 +#include <Processes.h>
    1.33 +#include <Strings.h>
    1.34 +#include <Types.h>
    1.35 +#include <MoreFiles.h>
    1.36 +#include <MoreFilesExtras.h>
    1.37 +#include <FSpCompat.h>
    1.38 +
    1.39 +static int NativeMatchType(Tcl_Obj *tempName, Tcl_GlobTypeData *types, 
    1.40 +			   HFileInfo fileInfo, OSType okType, OSType okCreator);
    1.41 +static OSErr FspLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr, 
    1.42 +						FSSpec* specPtr));
    1.43 +static OSErr FspLLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr, 
    1.44 +						FSSpec* specPtr));
    1.45 +
    1.46 +static OSErr CreateAliasFile _ANSI_ARGS_((FSSpec *theAliasFile, FSSpec *targetFile));
    1.47 +
    1.48 +static OSErr 
    1.49 +FspLocationFromFsPath(pathPtr, specPtr)
    1.50 +    Tcl_Obj *pathPtr;
    1.51 +    FSSpec* specPtr;
    1.52 +{
    1.53 +    CONST char *native = Tcl_FSGetNativePath(pathPtr);
    1.54 +    return FSpLocationFromPath(strlen(native), native, specPtr);
    1.55 +}
    1.56 +
    1.57 +static OSErr 
    1.58 +FspLLocationFromFsPath(pathPtr, specPtr)
    1.59 +    Tcl_Obj *pathPtr;
    1.60 +    FSSpec* specPtr;
    1.61 +{
    1.62 +    CONST char *native = Tcl_FSGetNativePath(pathPtr);
    1.63 +    return FSpLLocationFromPath(strlen(native), native, specPtr);
    1.64 +}
    1.65 +
    1.66 +
    1.67 +/*
    1.68 + *----------------------------------------------------------------------
    1.69 + *
    1.70 + * TclpFindExecutable --
    1.71 + *
    1.72 + *	This procedure computes the absolute path name of the current
    1.73 + *	application, given its argv[0] value.  However, this
    1.74 + *	implementation doesn't need the argv[0] value.  NULL
    1.75 + *	may be passed in its place.
    1.76 + *
    1.77 + * Results:
    1.78 + *	None.
    1.79 + *
    1.80 + * Side effects:
    1.81 + *	The variable tclExecutableName gets filled in with the file
    1.82 + *	name for the application, if we figured it out.  If we couldn't
    1.83 + *	figure it out, Tcl_FindExecutable is set to NULL.
    1.84 + *
    1.85 + *----------------------------------------------------------------------
    1.86 + */
    1.87 +
    1.88 +char *
    1.89 +TclpFindExecutable(
    1.90 +    CONST char *argv0)		/* The value of the application's argv[0]. */
    1.91 +{
    1.92 +    ProcessSerialNumber psn;
    1.93 +    ProcessInfoRec info;
    1.94 +    Str63 appName;
    1.95 +    FSSpec fileSpec;
    1.96 +    int pathLength;
    1.97 +    Handle pathName = NULL;
    1.98 +    OSErr err;
    1.99 +    Tcl_DString ds;
   1.100 +    
   1.101 +    TclInitSubsystems(argv0);
   1.102 +    
   1.103 +    GetCurrentProcess(&psn);
   1.104 +    info.processInfoLength = sizeof(ProcessInfoRec);
   1.105 +    info.processName = appName;
   1.106 +    info.processAppSpec = &fileSpec;
   1.107 +    GetProcessInformation(&psn, &info);
   1.108 +
   1.109 +    if (tclExecutableName != NULL) {
   1.110 +	ckfree(tclExecutableName);
   1.111 +	tclExecutableName = NULL;
   1.112 +    }
   1.113 +    
   1.114 +    err = FSpPathFromLocation(&fileSpec, &pathLength, &pathName);
   1.115 +    HLock(pathName);
   1.116 +    Tcl_ExternalToUtfDString(NULL, *pathName, pathLength, &ds);
   1.117 +    HUnlock(pathName);
   1.118 +    DisposeHandle(pathName);	
   1.119 +
   1.120 +    tclExecutableName = (char *) ckalloc((unsigned) 
   1.121 +    	    (Tcl_DStringLength(&ds) + 1));
   1.122 +    strcpy(tclExecutableName, Tcl_DStringValue(&ds));
   1.123 +    Tcl_DStringFree(&ds);
   1.124 +    return tclExecutableName;
   1.125 +}
   1.126 +
   1.127 +/*
   1.128 + *----------------------------------------------------------------------
   1.129 + *
   1.130 + * TclpMatchInDirectory --
   1.131 + *
   1.132 + *	This routine is used by the globbing code to search a
   1.133 + *	directory for all files which match a given pattern.
   1.134 + *
   1.135 + * Results: 
   1.136 + *	
   1.137 + *	The return value is a standard Tcl result indicating whether an
   1.138 + *	error occurred in globbing.  Errors are left in interp, good
   1.139 + *	results are lappended to resultPtr (which must be a valid object)
   1.140 + *
   1.141 + * Side effects:
   1.142 + *	None.
   1.143 + *
   1.144 + *---------------------------------------------------------------------- */
   1.145 +
   1.146 +int
   1.147 +TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
   1.148 +    Tcl_Interp *interp;		/* Interpreter to receive errors. */
   1.149 +    Tcl_Obj *resultPtr;		/* List object to lappend results. */
   1.150 +    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
   1.151 +    CONST char *pattern;	/* Pattern to match against.  NULL or empty
   1.152 +                        	 * means pathPtr is actually a single file
   1.153 +                        	 * to check. */
   1.154 +    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
   1.155 +				 * May be NULL. In particular the directory
   1.156 +				 * flag is very important. */
   1.157 +{
   1.158 +    OSType okType = 0;
   1.159 +    OSType okCreator = 0;
   1.160 +    Tcl_Obj *fileNamePtr;
   1.161 +
   1.162 +    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
   1.163 +    if (fileNamePtr == NULL) {
   1.164 +	return TCL_ERROR;
   1.165 +    }
   1.166 +    
   1.167 +    if (types != NULL) {
   1.168 +	if (types->macType != NULL) {
   1.169 +	    Tcl_GetOSTypeFromObj(NULL, types->macType, &okType);
   1.170 +	}
   1.171 +	if (types->macCreator != NULL) {
   1.172 +	    Tcl_GetOSTypeFromObj(NULL, types->macCreator, &okCreator);
   1.173 +	}
   1.174 +    }
   1.175 +
   1.176 +    if (pattern == NULL || (*pattern == '\0')) {
   1.177 +	/* Match a single file directly */
   1.178 +	Tcl_StatBuf buf;
   1.179 +	CInfoPBRec paramBlock;
   1.180 +	FSSpec fileSpec;
   1.181 +	
   1.182 +	if (TclpObjLstat(fileNamePtr, &buf) != 0) {
   1.183 +	    /* File doesn't exist */
   1.184 +	    Tcl_DecrRefCount(fileNamePtr);
   1.185 +	    return TCL_OK;
   1.186 +	}
   1.187 +
   1.188 +	if (FspLLocationFromFsPath(fileNamePtr, &fileSpec) == noErr) {
   1.189 +	    paramBlock.hFileInfo.ioCompletion = NULL;
   1.190 +	    paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
   1.191 +	    paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
   1.192 +	    paramBlock.hFileInfo.ioFDirIndex = 0;
   1.193 +	    paramBlock.hFileInfo.ioDirID = fileSpec.parID;
   1.194 +	    
   1.195 +	    PBGetCatInfo(&paramBlock, 0);
   1.196 +	}
   1.197 +
   1.198 +	if (NativeMatchType(fileNamePtr, types, paramBlock.hFileInfo,
   1.199 +			    okType, okCreator)) {
   1.200 +	    int fnameLen;
   1.201 +	    char *fname = Tcl_GetStringFromObj(pathPtr,&fnameLen);
   1.202 +	    if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
   1.203 +		Tcl_ListObjAppendElement(interp, resultPtr, 
   1.204 +			Tcl_NewStringObj(fname+1, fnameLen-1));
   1.205 +	    } else {
   1.206 +		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
   1.207 +	    }
   1.208 +	}
   1.209 +	Tcl_DecrRefCount(fileNamePtr);
   1.210 +	return TCL_OK;
   1.211 +    } else {
   1.212 +	char *fname;
   1.213 +	int fnameLen, result = TCL_OK;
   1.214 +	int baseLength;
   1.215 +	CInfoPBRec pb;
   1.216 +	OSErr err;
   1.217 +	FSSpec dirSpec;
   1.218 +	Boolean isDirectory;
   1.219 +	long dirID;
   1.220 +	short itemIndex;
   1.221 +	Str255 fileName;
   1.222 +	Tcl_DString fileString;    
   1.223 +	Tcl_DString dsOrig;
   1.224 +
   1.225 +	Tcl_DStringInit(&dsOrig);
   1.226 +	Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
   1.227 +	baseLength = Tcl_DStringLength(&dsOrig);
   1.228 +
   1.229 +	/*
   1.230 +	 * Make sure that the directory part of the name really is a
   1.231 +	 * directory.
   1.232 +	 */
   1.233 +
   1.234 +	Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
   1.235 +		Tcl_DStringLength(&dsOrig), &fileString);
   1.236 +
   1.237 +	err = FSpLocationFromPath(Tcl_DStringLength(&fileString), 
   1.238 +				  Tcl_DStringValue(&fileString), &dirSpec);
   1.239 +	Tcl_DStringFree(&fileString);
   1.240 +	if (err == noErr) {
   1.241 +	    err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
   1.242 +	}
   1.243 +	
   1.244 +	if ((err != noErr) || !isDirectory) {
   1.245 +	    /*
   1.246 +	     * Check if we had a relative path (unix style relative path 
   1.247 +	     * compatibility for glob)
   1.248 +	     */
   1.249 +	    Tcl_DStringFree(&dsOrig);
   1.250 +	    Tcl_DStringAppend(&dsOrig, ":", 1);
   1.251 +	    Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
   1.252 +	    baseLength = Tcl_DStringLength(&dsOrig);
   1.253 +
   1.254 +	    Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
   1.255 +		    Tcl_DStringLength(&dsOrig), &fileString);
   1.256 +	    
   1.257 +	    err = FSpLocationFromPath(Tcl_DStringLength(&fileString), 
   1.258 +				      Tcl_DStringValue(&fileString), &dirSpec);
   1.259 +	    Tcl_DStringFree(&fileString);
   1.260 +	    if (err == noErr) {
   1.261 +		err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
   1.262 +	    }
   1.263 +	    
   1.264 +	    if ((err != noErr) || !isDirectory) {
   1.265 +		Tcl_DStringFree(&dsOrig);
   1.266 +		Tcl_DecrRefCount(fileNamePtr);
   1.267 +		return TCL_OK;
   1.268 +	    }
   1.269 +	}
   1.270 +
   1.271 +	/* Make sure we have a trailing directory delimiter */
   1.272 +	if (Tcl_DStringValue(&dsOrig)[baseLength-1] != ':') {
   1.273 +	    Tcl_DStringAppend(&dsOrig, ":", 1);
   1.274 +	    baseLength++;
   1.275 +	}
   1.276 +	
   1.277 +	/*
   1.278 +	 * Now open the directory for reading and iterate over the contents.
   1.279 +	 */
   1.280 +
   1.281 +	pb.hFileInfo.ioVRefNum = dirSpec.vRefNum;
   1.282 +	pb.hFileInfo.ioDirID = dirID;
   1.283 +	pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
   1.284 +	pb.hFileInfo.ioFDirIndex = itemIndex = 1;
   1.285 +
   1.286 +	while (1) {
   1.287 +	    pb.hFileInfo.ioFDirIndex = itemIndex;
   1.288 +	    pb.hFileInfo.ioDirID = dirID;
   1.289 +	    err = PBGetCatInfoSync(&pb);
   1.290 +	    if (err != noErr) {
   1.291 +		break;
   1.292 +	    }
   1.293 +
   1.294 +	    /*
   1.295 +	     * Now check to see if the file matches.  
   1.296 +	     */
   1.297 +	     
   1.298 +	    Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],
   1.299 +		    &fileString);
   1.300 +	    if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {
   1.301 +		Tcl_Obj *tempName;
   1.302 +		Tcl_DStringSetLength(&dsOrig, baseLength);
   1.303 +		Tcl_DStringAppend(&dsOrig, Tcl_DStringValue(&fileString), -1);
   1.304 +		fname = Tcl_DStringValue(&dsOrig);
   1.305 +		fnameLen = Tcl_DStringLength(&dsOrig);
   1.306 +		
   1.307 +		/* 
   1.308 +		 * We use this tempName in calls to check the file's
   1.309 +		 * type below.  We may also use it for the result.
   1.310 +		 */
   1.311 +		tempName = Tcl_NewStringObj(fname, fnameLen);
   1.312 +		Tcl_IncrRefCount(tempName);
   1.313 +
   1.314 +		/* Is the type acceptable? */
   1.315 +		if (NativeMatchType(tempName, types, pb.hFileInfo,
   1.316 +				    okType, okCreator)) {
   1.317 +		    if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
   1.318 +			Tcl_ListObjAppendElement(interp, resultPtr, 
   1.319 +				Tcl_NewStringObj(fname+1, fnameLen-1));
   1.320 +		    } else {
   1.321 +			Tcl_ListObjAppendElement(interp, resultPtr, tempName);
   1.322 +		    }
   1.323 +		}
   1.324 +		/* 
   1.325 +		 * This will free the object, unless it was inserted in
   1.326 +		 * the result list above.
   1.327 +		 */
   1.328 +		Tcl_DecrRefCount(tempName);
   1.329 +	    }
   1.330 +	    Tcl_DStringFree(&fileString);
   1.331 +	    itemIndex++;
   1.332 +	}
   1.333 +
   1.334 +	Tcl_DStringFree(&dsOrig);
   1.335 +	Tcl_DecrRefCount(fileNamePtr);
   1.336 +	return result;
   1.337 +    }
   1.338 +}
   1.339 +
   1.340 +static int 
   1.341 +NativeMatchType(
   1.342 +    Tcl_Obj *tempName,        /* Path to check */
   1.343 +    Tcl_GlobTypeData *types,  /* Type description to match against */
   1.344 +    HFileInfo fileInfo,       /* MacOS file info */
   1.345 +    OSType okType,            /* Acceptable MacOS type, or zero */
   1.346 +    OSType okCreator)         /* Acceptable MacOS creator, or zero */
   1.347 +{
   1.348 +    if (types == NULL) {
   1.349 +	/* If invisible, don't return the file */
   1.350 +	if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
   1.351 +	    return 0;
   1.352 +	}
   1.353 +    } else {
   1.354 +	Tcl_StatBuf buf;
   1.355 +	
   1.356 +	if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
   1.357 +	    /* If invisible */
   1.358 +	    if ((types->perm == 0) || 
   1.359 +	      !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
   1.360 +		return 0;
   1.361 +	    }
   1.362 +	} else {
   1.363 +	    /* Visible */
   1.364 +	    if (types->perm & TCL_GLOB_PERM_HIDDEN) {
   1.365 +		return 0;
   1.366 +	    }
   1.367 +	}
   1.368 +	if (types->perm != 0) {
   1.369 +	    if (
   1.370 +		((types->perm & TCL_GLOB_PERM_RONLY) &&
   1.371 +			!(fileInfo.ioFlAttrib & 1)) ||
   1.372 +		((types->perm & TCL_GLOB_PERM_R) &&
   1.373 +			(TclpObjAccess(tempName, R_OK) != 0)) ||
   1.374 +		((types->perm & TCL_GLOB_PERM_W) &&
   1.375 +			(TclpObjAccess(tempName, W_OK) != 0)) ||
   1.376 +		((types->perm & TCL_GLOB_PERM_X) &&
   1.377 +			(TclpObjAccess(tempName, X_OK) != 0))
   1.378 +		) {
   1.379 +		return 0;
   1.380 +	    }
   1.381 +	}
   1.382 +	if (types->type != 0) {
   1.383 +	    if (TclpObjStat(tempName, &buf) != 0) {
   1.384 +		/* Posix error occurred */
   1.385 +		return 0;
   1.386 +	    }
   1.387 +	    /*
   1.388 +	     * In order bcdpfls as in 'find -t'
   1.389 +	     */
   1.390 +	    if (
   1.391 +		((types->type & TCL_GLOB_TYPE_BLOCK) &&
   1.392 +			S_ISBLK(buf.st_mode)) ||
   1.393 +		((types->type & TCL_GLOB_TYPE_CHAR) &&
   1.394 +			S_ISCHR(buf.st_mode)) ||
   1.395 +		((types->type & TCL_GLOB_TYPE_DIR) &&
   1.396 +			S_ISDIR(buf.st_mode)) ||
   1.397 +		((types->type & TCL_GLOB_TYPE_PIPE) &&
   1.398 +			S_ISFIFO(buf.st_mode)) ||
   1.399 +		((types->type & TCL_GLOB_TYPE_FILE) &&
   1.400 +			S_ISREG(buf.st_mode))
   1.401 +#ifdef S_ISSOCK
   1.402 +		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&
   1.403 +			S_ISSOCK(buf.st_mode))
   1.404 +#endif
   1.405 +		) {
   1.406 +		/* Do nothing -- this file is ok */
   1.407 +	    } else {
   1.408 +		int typeOk = 0;
   1.409 +#ifdef S_ISLNK
   1.410 +		if (types->type & TCL_GLOB_TYPE_LINK) {
   1.411 +		    if (TclpObjLstat(tempName, &buf) == 0) {
   1.412 +			if (S_ISLNK(buf.st_mode)) {
   1.413 +			    typeOk = 1;
   1.414 +			}
   1.415 +		    }
   1.416 +		}
   1.417 +#endif
   1.418 +		if (typeOk == 0) {
   1.419 +		    return 0;
   1.420 +		}
   1.421 +	    }
   1.422 +	}
   1.423 +	if (((okType != 0) && (okType !=
   1.424 +			       fileInfo.ioFlFndrInfo.fdType)) ||
   1.425 +	    ((okCreator != 0) && (okCreator !=
   1.426 +				  fileInfo.ioFlFndrInfo.fdCreator))) {
   1.427 +	    return 0;
   1.428 +	}
   1.429 +    }
   1.430 +    return 1;
   1.431 +}
   1.432 +
   1.433 +
   1.434 +/*
   1.435 + *----------------------------------------------------------------------
   1.436 + *
   1.437 + * TclpObjAccess --
   1.438 + *
   1.439 + *	This function replaces the library version of access().
   1.440 + *
   1.441 + * Results:
   1.442 + *	See access documentation.
   1.443 + *
   1.444 + * Side effects:
   1.445 + *	See access documentation.
   1.446 + *
   1.447 + *----------------------------------------------------------------------
   1.448 + */
   1.449 +
   1.450 +int 
   1.451 +TclpObjAccess(pathPtr, mode)
   1.452 +    Tcl_Obj *pathPtr;
   1.453 +    int mode;
   1.454 +{
   1.455 +    HFileInfo fpb;
   1.456 +    HVolumeParam vpb;
   1.457 +    OSErr err;
   1.458 +    FSSpec fileSpec;
   1.459 +    Boolean isDirectory;
   1.460 +    long dirID;
   1.461 +    int full_mode = 0;
   1.462 +
   1.463 +    err = FspLLocationFromFsPath(pathPtr, &fileSpec);
   1.464 +
   1.465 +    if (err != noErr) {
   1.466 +	errno = TclMacOSErrorToPosixError(err);
   1.467 +	return -1;
   1.468 +    }
   1.469 +    
   1.470 +    /*
   1.471 +     * Fill the fpb & vpb struct up with info about file or directory.
   1.472 +     */
   1.473 +    FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
   1.474 +    vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
   1.475 +    vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
   1.476 +    if (isDirectory) {
   1.477 +	fpb.ioDirID = fileSpec.parID;
   1.478 +    } else {
   1.479 +	fpb.ioDirID = dirID;
   1.480 +    }
   1.481 +
   1.482 +    fpb.ioFDirIndex = 0;
   1.483 +    err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
   1.484 +    if (err == noErr) {
   1.485 +	vpb.ioVolIndex = 0;
   1.486 +	err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
   1.487 +	if (err == noErr) {
   1.488 +	    /* 
   1.489 +	     * Use the Volume Info & File Info to determine
   1.490 +	     * access information.  If we have got this far
   1.491 +	     * we know the directory is searchable or the file
   1.492 +	     * exists.  (We have F_OK)
   1.493 +	     */
   1.494 +
   1.495 +	    /*
   1.496 +	     * Check to see if the volume is hardware or
   1.497 +	     * software locked.  If so we arn't W_OK.
   1.498 +	     */
   1.499 +	    if (mode & W_OK) {
   1.500 +		if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {
   1.501 +		    errno = EROFS;
   1.502 +		    return -1;
   1.503 +		}
   1.504 +		if (fpb.ioFlAttrib & 0x01) {
   1.505 +		    errno = EACCES;
   1.506 +		    return -1;
   1.507 +		}
   1.508 +	    }
   1.509 +	    
   1.510 +	    /*
   1.511 +	     * Directories are always searchable and executable.  But only 
   1.512 +	     * files of type 'APPL' are executable.
   1.513 +	     */
   1.514 +	    if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
   1.515 +		&& (fpb.ioFlFndrInfo.fdType != 'APPL')) {
   1.516 +		return -1;
   1.517 +	    }
   1.518 +	}
   1.519 +    }
   1.520 +
   1.521 +    if (err != noErr) {
   1.522 +	errno = TclMacOSErrorToPosixError(err);
   1.523 +	return -1;
   1.524 +    }
   1.525 +    
   1.526 +    return 0;
   1.527 +}
   1.528 +
   1.529 +/*
   1.530 + *----------------------------------------------------------------------
   1.531 + *
   1.532 + * TclpObjChdir --
   1.533 + *
   1.534 + *	This function replaces the library version of chdir().
   1.535 + *
   1.536 + * Results:
   1.537 + *	See chdir() documentation.
   1.538 + *
   1.539 + * Side effects:
   1.540 + *	See chdir() documentation.  Also the cache maintained used by 
   1.541 + *	Tcl_FSGetCwd() is deallocated and set to NULL.
   1.542 + *
   1.543 + *----------------------------------------------------------------------
   1.544 + */
   1.545 +
   1.546 +int 
   1.547 +TclpObjChdir(pathPtr)
   1.548 +    Tcl_Obj *pathPtr;
   1.549 +{
   1.550 +    FSSpec spec;
   1.551 +    OSErr err;
   1.552 +    Boolean isFolder;
   1.553 +    long dirID;
   1.554 +
   1.555 +    err = FspLocationFromFsPath(pathPtr, &spec);
   1.556 +
   1.557 +    if (err != noErr) {
   1.558 +	errno = ENOENT;
   1.559 +	return -1;
   1.560 +    }
   1.561 +    
   1.562 +    err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
   1.563 +    if (err != noErr) {
   1.564 +	errno = ENOENT;
   1.565 +	return -1;
   1.566 +    }
   1.567 +
   1.568 +    if (isFolder != true) {
   1.569 +	errno = ENOTDIR;
   1.570 +	return -1;
   1.571 +    }
   1.572 +
   1.573 +    err = FSpSetDefaultDir(&spec);
   1.574 +    if (err != noErr) {
   1.575 +	switch (err) {
   1.576 +	    case afpAccessDenied:
   1.577 +		errno = EACCES;
   1.578 +		break;
   1.579 +	    default:
   1.580 +		errno = ENOENT;
   1.581 +	}
   1.582 +	return -1;
   1.583 +    }
   1.584 +
   1.585 +    return 0;
   1.586 +}
   1.587 +
   1.588 +/*
   1.589 + *----------------------------------------------------------------------
   1.590 + *
   1.591 + * TclpObjGetCwd --
   1.592 + *
   1.593 + *	This function replaces the library version of getcwd().
   1.594 + *
   1.595 + * Results:
   1.596 + *	The result is a pointer to a string specifying the current
   1.597 + *	directory, or NULL if the current directory could not be
   1.598 + *	determined.  If NULL is returned, an error message is left in the
   1.599 + *	interp's result.  Storage for the result string is allocated in
   1.600 + *	bufferPtr; the caller must call Tcl_DStringFree() when the result
   1.601 + *	is no longer needed.
   1.602 + *
   1.603 + * Side effects:
   1.604 + *	None.
   1.605 + *
   1.606 + *----------------------------------------------------------------------
   1.607 + */
   1.608 +
   1.609 +Tcl_Obj* 
   1.610 +TclpObjGetCwd(interp)
   1.611 +    Tcl_Interp *interp;
   1.612 +{
   1.613 +    Tcl_DString ds;
   1.614 +    if (TclpGetCwd(interp, &ds) != NULL) {
   1.615 +	Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
   1.616 +	Tcl_IncrRefCount(cwdPtr);
   1.617 +	Tcl_DStringFree(&ds);
   1.618 +	return cwdPtr;
   1.619 +    } else {
   1.620 +	return NULL;
   1.621 +    }
   1.622 +}
   1.623 +
   1.624 +CONST char *
   1.625 +TclpGetCwd(
   1.626 +    Tcl_Interp *interp,		/* If non-NULL, used for error reporting. */
   1.627 +    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled
   1.628 +				 * with name of current directory. */
   1.629 +{
   1.630 +    FSSpec theSpec;
   1.631 +    int length;
   1.632 +    Handle pathHandle = NULL;
   1.633 +    
   1.634 +    if (FSpGetDefaultDir(&theSpec) != noErr) {
   1.635 + 	if (interp != NULL) {
   1.636 +	    Tcl_SetResult(interp, "error getting working directory name",
   1.637 +		    TCL_STATIC);
   1.638 +	}
   1.639 +	return NULL;
   1.640 +    }
   1.641 +    if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
   1.642 + 	if (interp != NULL) {
   1.643 +	     Tcl_SetResult(interp, "error getting working directory name",
   1.644 +		    TCL_STATIC);
   1.645 +	}
   1.646 +	return NULL;
   1.647 +    }
   1.648 +    HLock(pathHandle);
   1.649 +    Tcl_ExternalToUtfDString(NULL, *pathHandle, length, bufferPtr);
   1.650 +    HUnlock(pathHandle);
   1.651 +    DisposeHandle(pathHandle);	
   1.652 +
   1.653 +    return Tcl_DStringValue(bufferPtr);
   1.654 +}
   1.655 +
   1.656 +/*
   1.657 + *----------------------------------------------------------------------
   1.658 + *
   1.659 + * TclpReadlink --
   1.660 + *
   1.661 + *	This function replaces the library version of readlink().
   1.662 + *
   1.663 + * Results:
   1.664 + *	The result is a pointer to a string specifying the contents
   1.665 + *	of the symbolic link given by 'path', or NULL if the symbolic
   1.666 + *	link could not be read.  Storage for the result string is
   1.667 + *	allocated in bufferPtr; the caller must call Tcl_DStringFree()
   1.668 + *	when the result is no longer needed.
   1.669 + *
   1.670 + * Side effects:
   1.671 + *	See readlink() documentation.
   1.672 + *
   1.673 + *---------------------------------------------------------------------------
   1.674 + */
   1.675 +
   1.676 +char *
   1.677 +TclpReadlink(
   1.678 +    CONST char *path,		/* Path of file to readlink (UTF-8). */
   1.679 +    Tcl_DString *linkPtr)	/* Uninitialized or free DString filled
   1.680 +				 * with contents of link (UTF-8). */
   1.681 +{
   1.682 +    HFileInfo fpb;
   1.683 +    OSErr err;
   1.684 +    FSSpec fileSpec;
   1.685 +    Boolean isDirectory;
   1.686 +    Boolean wasAlias;
   1.687 +    long dirID;
   1.688 +    char fileName[257];
   1.689 +    char *end;
   1.690 +    Handle theString = NULL;
   1.691 +    int pathSize;
   1.692 +    Tcl_DString ds;
   1.693 +    
   1.694 +    Tcl_UtfToExternalDString(NULL, path, -1, &ds);
   1.695 +
   1.696 +    /*
   1.697 +     * Remove ending colons if they exist.
   1.698 +     */
   1.699 +     
   1.700 +    while ((Tcl_DStringLength(&ds) != 0) 
   1.701 +	   && (Tcl_DStringValue(&ds)[Tcl_DStringLength(&ds) - 1] == ':')) {
   1.702 +	Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 1);
   1.703 +    }
   1.704 +
   1.705 +    end = strrchr(Tcl_DStringValue(&ds), ':');
   1.706 +    if (end == NULL ) {
   1.707 +	strcpy(fileName + 1, Tcl_DStringValue(&ds));
   1.708 +    } else {
   1.709 +	strcpy(fileName + 1, end + 1);
   1.710 +	Tcl_DStringSetLength(&ds, end + 1 - Tcl_DStringValue(&ds));
   1.711 +    }
   1.712 +    fileName[0] = (char) strlen(fileName + 1);
   1.713 +    
   1.714 +    /*
   1.715 +     * Create the file spec for the directory of the file
   1.716 +     * we want to look at.
   1.717 +     */
   1.718 +
   1.719 +    if (end != NULL) {
   1.720 +	err = FSpLocationFromPath(Tcl_DStringLength(&ds), 
   1.721 +				  Tcl_DStringValue(&ds), &fileSpec);
   1.722 +	if (err != noErr) {
   1.723 +	    Tcl_DStringFree(&ds);
   1.724 +	    errno = EINVAL;
   1.725 +	    return NULL;
   1.726 +	}
   1.727 +    } else {
   1.728 +	FSMakeFSSpecCompat(0, 0, NULL, &fileSpec);
   1.729 +    }
   1.730 +    Tcl_DStringFree(&ds);
   1.731 +    
   1.732 +    /*
   1.733 +     * Fill the fpb struct up with info about file or directory.
   1.734 +     */
   1.735 +
   1.736 +    FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
   1.737 +    fpb.ioVRefNum = fileSpec.vRefNum;
   1.738 +    fpb.ioDirID = dirID;
   1.739 +    fpb.ioNamePtr = (StringPtr) fileName;
   1.740 +
   1.741 +    fpb.ioFDirIndex = 0;
   1.742 +    err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
   1.743 +    if (err != noErr) {
   1.744 +	errno = TclMacOSErrorToPosixError(err);
   1.745 +	return NULL;
   1.746 +    } else {
   1.747 +	if (fpb.ioFlAttrib & 0x10) {
   1.748 +	    errno = EINVAL;
   1.749 +	    return NULL;
   1.750 +	} else {
   1.751 +	    if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
   1.752 +		/*
   1.753 +		 * The file is a link!
   1.754 +		 */
   1.755 +	    } else {
   1.756 +		errno = EINVAL;
   1.757 +		return NULL;
   1.758 +	    }
   1.759 +	}
   1.760 +    }
   1.761 +    
   1.762 +    /*
   1.763 +     * If we are here it's really a link - now find out
   1.764 +     * where it points to.
   1.765 +     */
   1.766 +    err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName, 
   1.767 +    	    &fileSpec);
   1.768 +    if (err == noErr) {
   1.769 +	err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);
   1.770 +    }
   1.771 +    if ((err == fnfErr) || wasAlias) {
   1.772 +	err = FSpPathFromLocation(&fileSpec, &pathSize, &theString);
   1.773 +	if (err != noErr) {
   1.774 +	    DisposeHandle(theString);
   1.775 +	    errno = ENAMETOOLONG;
   1.776 +	    return NULL;
   1.777 +	}
   1.778 +    } else {
   1.779 +    	errno = EINVAL;
   1.780 +	return NULL;
   1.781 +    }
   1.782 +    
   1.783 +    Tcl_ExternalToUtfDString(NULL, *theString, pathSize, linkPtr);
   1.784 +    DisposeHandle(theString);
   1.785 +    
   1.786 +    return Tcl_DStringValue(linkPtr);
   1.787 +}
   1.788 +
   1.789 +static int 
   1.790 +TclpObjStatAlias _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr, 
   1.791 +			      Boolean resolveLink));
   1.792 +
   1.793 +
   1.794 +/*
   1.795 + *----------------------------------------------------------------------
   1.796 + *
   1.797 + * TclpObjLstat --
   1.798 + *
   1.799 + *	This function replaces the library version of lstat().
   1.800 + *
   1.801 + * Results:
   1.802 + *	See lstat() documentation.
   1.803 + *
   1.804 + * Side effects:
   1.805 + *	See lstat() documentation.
   1.806 + *
   1.807 + *----------------------------------------------------------------------
   1.808 + */
   1.809 +
   1.810 +int 
   1.811 +TclpObjLstat(pathPtr, buf)
   1.812 +    Tcl_Obj *pathPtr;
   1.813 +    Tcl_StatBuf *buf;
   1.814 +{
   1.815 +    return TclpObjStatAlias(pathPtr, buf, FALSE);
   1.816 +}
   1.817 +
   1.818 +/*
   1.819 + *----------------------------------------------------------------------
   1.820 + *
   1.821 + * TclpObjStat --
   1.822 + *
   1.823 + *	This function replaces the library version of stat().
   1.824 + *
   1.825 + * Results:
   1.826 + *	See stat() documentation.
   1.827 + *
   1.828 + * Side effects:
   1.829 + *	See stat() documentation.
   1.830 + *
   1.831 + *----------------------------------------------------------------------
   1.832 + */
   1.833 +
   1.834 +int 
   1.835 +TclpObjStat(pathPtr, bufPtr)
   1.836 +    Tcl_Obj *pathPtr;
   1.837 +    Tcl_StatBuf *bufPtr;
   1.838 +{
   1.839 +    return TclpObjStatAlias(pathPtr, bufPtr, TRUE);
   1.840 +}
   1.841 +
   1.842 +
   1.843 +static int
   1.844 +TclpObjStatAlias (Tcl_Obj *pathPtr, Tcl_StatBuf *bufPtr, Boolean resolveLink)
   1.845 +{
   1.846 +    HFileInfo fpb;
   1.847 +    HVolumeParam vpb;
   1.848 +    OSErr err;
   1.849 +    FSSpec fileSpec;
   1.850 +    Boolean isDirectory;
   1.851 +    long dirID;
   1.852 +    
   1.853 +    if (resolveLink)
   1.854 +    	err = FspLocationFromFsPath(pathPtr, &fileSpec);
   1.855 +    else
   1.856 +    	err = FspLLocationFromFsPath(pathPtr, &fileSpec);
   1.857 +    
   1.858 +    if (err != noErr) {
   1.859 +	errno = TclMacOSErrorToPosixError(err);
   1.860 +	return -1;
   1.861 +    }
   1.862 +    
   1.863 +    /*
   1.864 +     * Fill the fpb & vpb struct up with info about file or directory.
   1.865 +     */
   1.866 +     
   1.867 +    FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
   1.868 +    vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
   1.869 +    vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
   1.870 +    if (isDirectory) {
   1.871 +	fpb.ioDirID = fileSpec.parID;
   1.872 +    } else {
   1.873 +	fpb.ioDirID = dirID;
   1.874 +    }
   1.875 +
   1.876 +    fpb.ioFDirIndex = 0;
   1.877 +    err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
   1.878 +    if (err == noErr) {
   1.879 +	vpb.ioVolIndex = 0;
   1.880 +	err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
   1.881 +	if (err == noErr && bufPtr != NULL) {
   1.882 +	    /* 
   1.883 +	     * Files are always readable by everyone.
   1.884 +	     */
   1.885 +	     
   1.886 +	    bufPtr->st_mode = S_IRUSR | S_IRGRP | S_IROTH;
   1.887 +
   1.888 +	    /* 
   1.889 +	     * Use the Volume Info & File Info to fill out stat buf.
   1.890 +	     */
   1.891 +	    if (fpb.ioFlAttrib & 0x10) {
   1.892 +		bufPtr->st_mode |= S_IFDIR;
   1.893 +		bufPtr->st_nlink = 2;
   1.894 +	    } else {
   1.895 +		bufPtr->st_nlink = 1;
   1.896 +		if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
   1.897 +		    bufPtr->st_mode |= S_IFLNK;
   1.898 +		} else {
   1.899 +		    bufPtr->st_mode |= S_IFREG;
   1.900 +		}
   1.901 +	    }
   1.902 +	    if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
   1.903 +		/*
   1.904 +		 * Directories and applications are executable by everyone.
   1.905 +		 */
   1.906 +		 
   1.907 +		bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
   1.908 +	    }
   1.909 +	    if ((fpb.ioFlAttrib & 0x01) == 0){
   1.910 +		/* 
   1.911 +		 * If not locked, then everyone has write acces.
   1.912 +		 */
   1.913 +		 
   1.914 +		bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
   1.915 +	    }
   1.916 +	    bufPtr->st_ino = fpb.ioDirID;
   1.917 +	    bufPtr->st_dev = fpb.ioVRefNum;
   1.918 +	    bufPtr->st_uid = -1;
   1.919 +	    bufPtr->st_gid = -1;
   1.920 +	    bufPtr->st_rdev = 0;
   1.921 +	    bufPtr->st_size = fpb.ioFlLgLen;
   1.922 +	    bufPtr->st_blksize = vpb.ioVAlBlkSiz;
   1.923 +	    bufPtr->st_blocks = (bufPtr->st_size + bufPtr->st_blksize - 1)
   1.924 +		/ bufPtr->st_blksize;
   1.925 +
   1.926 +	    /*
   1.927 +	     * The times returned by the Mac file system are in the
   1.928 +	     * local time zone.  We convert them to GMT so that the
   1.929 +	     * epoch starts from GMT.  This is also consistent with
   1.930 +	     * what is returned from "clock seconds".
   1.931 +	     */
   1.932 +
   1.933 +	    bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat 
   1.934 +	      - TclpGetGMTOffset() + tcl_mac_epoch_offset;
   1.935 +	    bufPtr->st_ctime = fpb.ioFlCrDat - TclpGetGMTOffset() 
   1.936 +	      + tcl_mac_epoch_offset;
   1.937 +	}
   1.938 +    }
   1.939 +
   1.940 +    if (err != noErr) {
   1.941 +	errno = TclMacOSErrorToPosixError(err);
   1.942 +    }
   1.943 +    
   1.944 +    return (err == noErr ? 0 : -1);
   1.945 +}
   1.946 +
   1.947 +/*
   1.948 + *----------------------------------------------------------------------
   1.949 + *
   1.950 + * Tcl_WaitPid --
   1.951 + *
   1.952 + *	Fakes a call to wait pid.
   1.953 + *
   1.954 + * Results:
   1.955 + *	Always returns -1.
   1.956 + *
   1.957 + * Side effects:
   1.958 + *	None.
   1.959 + *
   1.960 + *----------------------------------------------------------------------
   1.961 + */
   1.962 +
   1.963 +Tcl_Pid
   1.964 +Tcl_WaitPid(
   1.965 +    Tcl_Pid pid,
   1.966 +    int *statPtr,
   1.967 +    int options)
   1.968 +{
   1.969 +    return (Tcl_Pid) -1;
   1.970 +}
   1.971 +
   1.972 +/*
   1.973 + *----------------------------------------------------------------------
   1.974 + *
   1.975 + * TclMacFOpenHack --
   1.976 + *
   1.977 + *	This function replaces fopen.  It supports paths with alises.
   1.978 + *	Note, remember to undefine the fopen macro!
   1.979 + *
   1.980 + * Results:
   1.981 + *	See fopen documentation.
   1.982 + *
   1.983 + * Side effects:
   1.984 + *	See fopen documentation.
   1.985 + *
   1.986 + *----------------------------------------------------------------------
   1.987 + */
   1.988 +
   1.989 +#undef fopen
   1.990 +FILE *
   1.991 +TclMacFOpenHack(
   1.992 +    CONST char *path,
   1.993 +    CONST char *mode)
   1.994 +{
   1.995 +    OSErr err;
   1.996 +    FSSpec fileSpec;
   1.997 +    Handle pathString = NULL;
   1.998 +    int size;
   1.999 +    FILE * f;
  1.1000 +    
  1.1001 +    err = FSpLocationFromPath(strlen(path), path, &fileSpec);
  1.1002 +    if ((err != noErr) && (err != fnfErr)) {
  1.1003 +	return NULL;
  1.1004 +    }
  1.1005 +    err = FSpPathFromLocation(&fileSpec, &size, &pathString);
  1.1006 +    if ((err != noErr) && (err != fnfErr)) {
  1.1007 +	return NULL;
  1.1008 +    }
  1.1009 +    
  1.1010 +    HLock(pathString);
  1.1011 +    f = fopen(*pathString, mode);
  1.1012 +    HUnlock(pathString);
  1.1013 +    DisposeHandle(pathString);
  1.1014 +    return f;
  1.1015 +}
  1.1016 +
  1.1017 +/*
  1.1018 + *---------------------------------------------------------------------------
  1.1019 + *
  1.1020 + * TclpGetUserHome --
  1.1021 + *
  1.1022 + *	This function takes the specified user name and finds their
  1.1023 + *	home directory.
  1.1024 + *
  1.1025 + * Results:
  1.1026 + *	The result is a pointer to a string specifying the user's home
  1.1027 + *	directory, or NULL if the user's home directory could not be
  1.1028 + *	determined.  Storage for the result string is allocated in
  1.1029 + *	bufferPtr; the caller must call Tcl_DStringFree() when the result
  1.1030 + *	is no longer needed.
  1.1031 + *
  1.1032 + * Side effects:
  1.1033 + *	None.
  1.1034 + *
  1.1035 + *----------------------------------------------------------------------
  1.1036 + */
  1.1037 +
  1.1038 +char *
  1.1039 +TclpGetUserHome(name, bufferPtr)
  1.1040 +    CONST char *name;		/* User name for desired home directory. */
  1.1041 +    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
  1.1042 +				 * with name of user's home directory. */
  1.1043 +{
  1.1044 +    return NULL;
  1.1045 +}
  1.1046 +
  1.1047 +/*
  1.1048 + *----------------------------------------------------------------------
  1.1049 + *
  1.1050 + * TclMacOSErrorToPosixError --
  1.1051 + *
  1.1052 + *	Given a Macintosh OSErr return the appropiate POSIX error.
  1.1053 + *
  1.1054 + * Results:
  1.1055 + *	A Posix error.
  1.1056 + *
  1.1057 + * Side effects:
  1.1058 + *	None.
  1.1059 + *
  1.1060 + *----------------------------------------------------------------------
  1.1061 + */
  1.1062 +
  1.1063 +int
  1.1064 +TclMacOSErrorToPosixError(
  1.1065 +    int error)	/* A Macintosh error. */
  1.1066 +{
  1.1067 +    switch (error) {
  1.1068 +	case noErr:
  1.1069 +	    return 0;
  1.1070 +	case bdNamErr:
  1.1071 +	    return ENAMETOOLONG;
  1.1072 +	case afpObjectTypeErr:
  1.1073 +	    return ENOTDIR;
  1.1074 +	case fnfErr:
  1.1075 +	case dirNFErr:
  1.1076 +	    return ENOENT;
  1.1077 +	case dupFNErr:
  1.1078 +	    return EEXIST;
  1.1079 +	case dirFulErr:
  1.1080 +	case dskFulErr:
  1.1081 +	    return ENOSPC;
  1.1082 +	case fBsyErr:
  1.1083 +	    return EBUSY;
  1.1084 +	case tmfoErr:
  1.1085 +	    return ENFILE;
  1.1086 +	case fLckdErr:
  1.1087 +	case permErr:
  1.1088 +	case afpAccessDenied:
  1.1089 +	    return EACCES;
  1.1090 +	case wPrErr:
  1.1091 +	case vLckdErr:
  1.1092 +	    return EROFS;
  1.1093 +	case badMovErr:
  1.1094 +	    return EINVAL;
  1.1095 +	case diffVolErr:
  1.1096 +	    return EXDEV;
  1.1097 +	default:
  1.1098 +	    return EINVAL;
  1.1099 +    }
  1.1100 +}
  1.1101 +
  1.1102 +int
  1.1103 +TclMacChmod(
  1.1104 +    CONST char *path, 
  1.1105 +    int mode)
  1.1106 +{
  1.1107 +    HParamBlockRec hpb;
  1.1108 +    OSErr err;
  1.1109 +    Str255 pathName;
  1.1110 +    strcpy((char *) pathName + 1, path);
  1.1111 +    pathName[0] = strlen(path);
  1.1112 +    hpb.fileParam.ioNamePtr = pathName;
  1.1113 +    hpb.fileParam.ioVRefNum = 0;
  1.1114 +    hpb.fileParam.ioDirID = 0;
  1.1115 +    
  1.1116 +    if (mode & 0200) {
  1.1117 +        err = PBHRstFLockSync(&hpb);
  1.1118 +    } else {
  1.1119 +        err = PBHSetFLockSync(&hpb);
  1.1120 +    }
  1.1121 +    
  1.1122 +    if (err != noErr) {
  1.1123 +        errno = TclMacOSErrorToPosixError(err);
  1.1124 +        return -1;
  1.1125 +    }
  1.1126 +    
  1.1127 +    return 0;
  1.1128 +}
  1.1129 +
  1.1130 +
  1.1131 +/*
  1.1132 + *----------------------------------------------------------------------
  1.1133 + *
  1.1134 + * TclpTempFileName --
  1.1135 + *
  1.1136 + *	This function returns a unique filename.
  1.1137 + *
  1.1138 + * Results:
  1.1139 + *	Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
  1.1140 + *
  1.1141 + * Side effects:
  1.1142 + *	None.
  1.1143 + *
  1.1144 + *----------------------------------------------------------------------
  1.1145 + */
  1.1146 +
  1.1147 +Tcl_Obj* 
  1.1148 +TclpTempFileName()
  1.1149 +{
  1.1150 +    char fileName[L_tmpnam];
  1.1151 +    
  1.1152 +    if (tmpnam(fileName) == NULL) {	       /* INTL: Native. */
  1.1153 +	return NULL;
  1.1154 +    }
  1.1155 +
  1.1156 +    return TclpNativeToNormalized((ClientData) fileName);
  1.1157 +}
  1.1158 +
  1.1159 +#ifdef S_IFLNK
  1.1160 +
  1.1161 +Tcl_Obj* 
  1.1162 +TclpObjLink(pathPtr, toPtr, linkAction)
  1.1163 +    Tcl_Obj *pathPtr;
  1.1164 +    Tcl_Obj *toPtr;
  1.1165 +    int linkAction;
  1.1166 +{
  1.1167 +    Tcl_Obj* link = NULL;
  1.1168 +
  1.1169 +    if (toPtr != NULL) {
  1.1170 +	if (TclpObjAccess(pathPtr, F_OK) != -1) {
  1.1171 +	    /* src exists */
  1.1172 +	    errno = EEXIST;
  1.1173 +	    return NULL;
  1.1174 +	}
  1.1175 +	if (TclpObjAccess(toPtr, F_OK) == -1) {
  1.1176 +	    /* target doesn't exist */
  1.1177 +	    errno = ENOENT;
  1.1178 +	    return NULL;
  1.1179 +	}
  1.1180 +
  1.1181 +	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
  1.1182 +	    /* Needs to create a new link */
  1.1183 +	    FSSpec spec;
  1.1184 +	    FSSpec linkSpec;
  1.1185 +	    OSErr err;
  1.1186 +	    CONST char *path;
  1.1187 +	    
  1.1188 +	    err = FspLocationFromFsPath(toPtr, &spec);
  1.1189 +	    if (err != noErr) {
  1.1190 +		errno = ENOENT;
  1.1191 +		return NULL;
  1.1192 +	    }
  1.1193 +
  1.1194 +	    path = Tcl_FSGetNativePath(pathPtr);
  1.1195 +	    err = FSpLocationFromPath(strlen(path), path, &linkSpec);
  1.1196 +	    if (err == noErr) {
  1.1197 +		err = dupFNErr;		/* EEXIST. */
  1.1198 +	    } else {
  1.1199 +		err = CreateAliasFile(&linkSpec, &spec);
  1.1200 +	    }
  1.1201 +	    if (err != noErr) {
  1.1202 +		errno = TclMacOSErrorToPosixError(err);
  1.1203 +		return NULL;
  1.1204 +	    }
  1.1205 +	    return toPtr;
  1.1206 +	} else {
  1.1207 +	    errno = ENODEV;
  1.1208 +	    return NULL;
  1.1209 +	}
  1.1210 +    } else {
  1.1211 +	Tcl_DString ds;
  1.1212 +	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
  1.1213 +	if (transPtr == NULL) {
  1.1214 +	    return NULL;
  1.1215 +	}
  1.1216 +	if (TclpReadlink(Tcl_GetString(transPtr), &ds) != NULL) {
  1.1217 +	    link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
  1.1218 +	    Tcl_IncrRefCount(link);
  1.1219 +	    Tcl_DStringFree(&ds);
  1.1220 +	}
  1.1221 +	Tcl_DecrRefCount(transPtr);
  1.1222 +    }
  1.1223 +    return link;
  1.1224 +}
  1.1225 +
  1.1226 +#endif
  1.1227 +
  1.1228 +
  1.1229 +/*
  1.1230 + *---------------------------------------------------------------------------
  1.1231 + *
  1.1232 + * TclpFilesystemPathType --
  1.1233 + *
  1.1234 + *      This function is part of the native filesystem support, and
  1.1235 + *      returns the path type of the given path.  Right now it simply
  1.1236 + *      returns NULL.  In the future it could return specific path
  1.1237 + *      types, like 'HFS', 'HFS+', 'nfs', 'samba', 'FAT32', etc.
  1.1238 + *
  1.1239 + * Results:
  1.1240 + *      NULL at present.
  1.1241 + *
  1.1242 + * Side effects:
  1.1243 + *	None.
  1.1244 + *
  1.1245 + *---------------------------------------------------------------------------
  1.1246 + */
  1.1247 +Tcl_Obj*
  1.1248 +TclpFilesystemPathType(pathObjPtr)
  1.1249 +    Tcl_Obj* pathObjPtr;
  1.1250 +{
  1.1251 +    /* All native paths are of the same type */
  1.1252 +    return NULL;
  1.1253 +}
  1.1254 +
  1.1255 +/*
  1.1256 + *---------------------------------------------------------------------------
  1.1257 + *
  1.1258 + * TclpUtime --
  1.1259 + *
  1.1260 + *	Set the modification date for a file.
  1.1261 + *
  1.1262 + * Results:
  1.1263 + *	0 on success, -1 on error.
  1.1264 + *
  1.1265 + * Side effects:
  1.1266 + *	None.
  1.1267 + *
  1.1268 + *---------------------------------------------------------------------------
  1.1269 + */
  1.1270 +int 
  1.1271 +TclpUtime(pathPtr, tval)
  1.1272 +    Tcl_Obj *pathPtr;      /* File to modify */
  1.1273 +    struct utimbuf *tval;  /* New modification date structure */
  1.1274 +{
  1.1275 +    long gmt_offset=TclpGetGMTOffset();
  1.1276 +    struct utimbuf local_tval;
  1.1277 +    local_tval.actime=tval->actime+gmt_offset;
  1.1278 +    local_tval.modtime=tval->modtime+gmt_offset;
  1.1279 +    return utime(Tcl_FSGetNativePath(Tcl_FSGetNormalizedPath(NULL,pathPtr)),
  1.1280 +		 &local_tval);
  1.1281 +}
  1.1282 +
  1.1283 +/*
  1.1284 + *---------------------------------------------------------------------------
  1.1285 + *
  1.1286 + * CreateAliasFile --
  1.1287 + *
  1.1288 + *	Creates an alias file located at aliasDest referring to the targetFile.
  1.1289 + *
  1.1290 + * Results:
  1.1291 + *	0 on success, OS error code on error.
  1.1292 + *
  1.1293 + * Side effects:
  1.1294 + *	None.
  1.1295 + *
  1.1296 + *---------------------------------------------------------------------------
  1.1297 + */
  1.1298 +static OSErr
  1.1299 +CreateAliasFile(FSSpec *theAliasFile, FSSpec *targetFile)
  1.1300 +{
  1.1301 +    CInfoPBRec cat;
  1.1302 +    FInfo fndrInfo;
  1.1303 +    AliasHandle theAlias;
  1.1304 +    short saveRef, rsrc = -1;
  1.1305 +    OSErr err;
  1.1306 +    
  1.1307 +    saveRef = CurResFile();
  1.1308 +    /* set up the Finder information record for the alias file */
  1.1309 +    cat.dirInfo.ioNamePtr = targetFile->name;
  1.1310 +    cat.dirInfo.ioVRefNum = targetFile->vRefNum;
  1.1311 +    cat.dirInfo.ioFDirIndex = 0;
  1.1312 +    cat.dirInfo.ioDrDirID = targetFile->parID;
  1.1313 +    err = PBGetCatInfoSync(&cat);
  1.1314 +    if (err != noErr) goto bail;
  1.1315 +    if ((cat.dirInfo.ioFlAttrib & 16) == 0) {
  1.1316 +        /* file alias */
  1.1317 +        switch (cat.hFileInfo.ioFlFndrInfo.fdType) {
  1.1318 +            case 'APPL': fndrInfo.fdType = kApplicationAliasType; break;
  1.1319 +            case 'APPC': fndrInfo.fdType = kApplicationCPAliasType; break;
  1.1320 +            case 'APPD': fndrInfo.fdType = kApplicationDAAliasType; break;
  1.1321 +            default: fndrInfo.fdType = cat.hFileInfo.ioFlFndrInfo.fdType; break;
  1.1322 +        }
  1.1323 +        fndrInfo.fdCreator = cat.hFileInfo.ioFlFndrInfo.fdCreator;
  1.1324 +    } else {
  1.1325 +        /* folder alias */
  1.1326 +        fndrInfo.fdType = kContainerFolderAliasType;
  1.1327 +        fndrInfo.fdCreator = 'MACS';
  1.1328 +    }
  1.1329 +    fndrInfo.fdFlags = kIsAlias;
  1.1330 +    fndrInfo.fdLocation.v = 0;
  1.1331 +    fndrInfo.fdLocation.h = 0;
  1.1332 +    fndrInfo.fdFldr = 0;
  1.1333 +    /* create new file and set the file information */
  1.1334 +    FSpCreateResFile( theAliasFile, fndrInfo.fdCreator, fndrInfo.fdType, smSystemScript);
  1.1335 +    if ((err = ResError()) != noErr) goto bail;
  1.1336 +    err = FSpSetFInfo( theAliasFile, &fndrInfo);
  1.1337 +    if (err != noErr) goto bail;
  1.1338 +    /* save the alias resource */
  1.1339 +    rsrc = FSpOpenResFile(theAliasFile, fsRdWrPerm);
  1.1340 +    if (rsrc == -1) { err = ResError(); goto bail; }
  1.1341 +    UseResFile(rsrc);
  1.1342 +    err = NewAlias(theAliasFile, targetFile, &theAlias);
  1.1343 +    if (err != noErr) goto bail;
  1.1344 +    AddResource((Handle) theAlias, rAliasType, 0, theAliasFile->name);
  1.1345 +    if ((err = ResError()) != noErr) goto bail;
  1.1346 +    CloseResFile(rsrc);
  1.1347 +    rsrc = -1;
  1.1348 +    /* done */
  1.1349 + bail:
  1.1350 +    if (rsrc != -1) CloseResFile(rsrc);
  1.1351 +    UseResFile(saveRef);
  1.1352 +    return err;
  1.1353 +}