Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacFile.c@260cb5ec6c19 (annotated)

sl@0	1	/*
sl@0	2	* tclMacFile.c --
sl@0	3	*
sl@0	4	* This file implements the channel drivers for Macintosh
sl@0	5	* files. It also comtains Macintosh version of other Tcl
sl@0	6	* functions that deal with the file system.
sl@0	7	*
sl@0	8	* Copyright (c) 1995-1998 Sun Microsystems, Inc.
sl@0	9	*
sl@0	10	* See the file "license.terms" for information on usage and redistribution
sl@0	11	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	12	*
sl@0	13	* RCS: @(#) $Id: tclMacFile.c,v 1.27.2.1 2003/10/03 17:45:37 vincentdarley Exp $
sl@0	14	*/
sl@0	15
sl@0	16	/*
sl@0	17	* Note: This code eventually needs to support async I/O. In doing this
sl@0	18	* we will need to keep track of all current async I/O. If exit to shell
sl@0	19	* is called - we shouldn't exit until all asyc I/O completes.
sl@0	20	*/
sl@0	21
sl@0	22	#include "tclInt.h"
sl@0	23	#include "tclPort.h"
sl@0	24	#include "tclMacInt.h"
sl@0	25	#include <Aliases.h>
sl@0	26	#include <Resources.h>
sl@0	27	#include <Files.h>
sl@0	28	#include <Errors.h>
sl@0	29	#include <Processes.h>
sl@0	30	#include <Strings.h>
sl@0	31	#include <Types.h>
sl@0	32	#include <MoreFiles.h>
sl@0	33	#include <MoreFilesExtras.h>
sl@0	34	#include <FSpCompat.h>
sl@0	35
sl@0	36	static int NativeMatchType(Tcl_Obj tempName, Tcl_GlobTypeData types,
sl@0	37	HFileInfo fileInfo, OSType okType, OSType okCreator);
sl@0	38	static OSErr FspLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
sl@0	39	FSSpec* specPtr));
sl@0	40	static OSErr FspLLocationFromFsPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
sl@0	41	FSSpec* specPtr));
sl@0	42
sl@0	43	static OSErr CreateAliasFile _ANSI_ARGS_((FSSpec theAliasFile, FSSpec targetFile));
sl@0	44
sl@0	45	static OSErr
sl@0	46	FspLocationFromFsPath(pathPtr, specPtr)
sl@0	47	Tcl_Obj *pathPtr;
sl@0	48	FSSpec* specPtr;
sl@0	49	{
sl@0	50	CONST char *native = Tcl_FSGetNativePath(pathPtr);
sl@0	51	return FSpLocationFromPath(strlen(native), native, specPtr);
sl@0	52	}
sl@0	53
sl@0	54	static OSErr
sl@0	55	FspLLocationFromFsPath(pathPtr, specPtr)
sl@0	56	Tcl_Obj *pathPtr;
sl@0	57	FSSpec* specPtr;
sl@0	58	{
sl@0	59	CONST char *native = Tcl_FSGetNativePath(pathPtr);
sl@0	60	return FSpLLocationFromPath(strlen(native), native, specPtr);
sl@0	61	}
sl@0	62
sl@0	63
sl@0	64	/*
sl@0	65	*----------------------------------------------------------------------
sl@0	66	*
sl@0	67	* TclpFindExecutable --
sl@0	68	*
sl@0	69	* This procedure computes the absolute path name of the current
sl@0	70	* application, given its argv[0] value. However, this
sl@0	71	* implementation doesn't need the argv[0] value. NULL
sl@0	72	* may be passed in its place.
sl@0	73	*
sl@0	74	* Results:
sl@0	75	* None.
sl@0	76	*
sl@0	77	* Side effects:
sl@0	78	* The variable tclExecutableName gets filled in with the file
sl@0	79	* name for the application, if we figured it out. If we couldn't
sl@0	80	* figure it out, Tcl_FindExecutable is set to NULL.
sl@0	81	*
sl@0	82	*----------------------------------------------------------------------
sl@0	83	*/
sl@0	84
sl@0	85	char *
sl@0	86	TclpFindExecutable(
sl@0	87	CONST char argv0) / The value of the application's argv[0]. */
sl@0	88	{
sl@0	89	ProcessSerialNumber psn;
sl@0	90	ProcessInfoRec info;
sl@0	91	Str63 appName;
sl@0	92	FSSpec fileSpec;
sl@0	93	int pathLength;
sl@0	94	Handle pathName = NULL;
sl@0	95	OSErr err;
sl@0	96	Tcl_DString ds;
sl@0	97
sl@0	98	TclInitSubsystems(argv0);
sl@0	99
sl@0	100	GetCurrentProcess(&psn);
sl@0	101	info.processInfoLength = sizeof(ProcessInfoRec);
sl@0	102	info.processName = appName;
sl@0	103	info.processAppSpec = &fileSpec;
sl@0	104	GetProcessInformation(&psn, &info);
sl@0	105
sl@0	106	if (tclExecutableName != NULL) {
sl@0	107	ckfree(tclExecutableName);
sl@0	108	tclExecutableName = NULL;
sl@0	109	}
sl@0	110
sl@0	111	err = FSpPathFromLocation(&fileSpec, &pathLength, &pathName);
sl@0	112	HLock(pathName);
sl@0	113	Tcl_ExternalToUtfDString(NULL, *pathName, pathLength, &ds);
sl@0	114	HUnlock(pathName);
sl@0	115	DisposeHandle(pathName);
sl@0	116
sl@0	117	tclExecutableName = (char *) ckalloc((unsigned)
sl@0	118	(Tcl_DStringLength(&ds) + 1));
sl@0	119	strcpy(tclExecutableName, Tcl_DStringValue(&ds));
sl@0	120	Tcl_DStringFree(&ds);
sl@0	121	return tclExecutableName;
sl@0	122	}
sl@0	123
sl@0	124	/*
sl@0	125	*----------------------------------------------------------------------
sl@0	126	*
sl@0	127	* TclpMatchInDirectory --
sl@0	128	*
sl@0	129	* This routine is used by the globbing code to search a
sl@0	130	* directory for all files which match a given pattern.
sl@0	131	*
sl@0	132	* Results:
sl@0	133	*
sl@0	134	* The return value is a standard Tcl result indicating whether an
sl@0	135	* error occurred in globbing. Errors are left in interp, good
sl@0	136	* results are lappended to resultPtr (which must be a valid object)
sl@0	137	*
sl@0	138	* Side effects:
sl@0	139	* None.
sl@0	140	*
sl@0	141	---------------------------------------------------------------------- /
sl@0	142
sl@0	143	int
sl@0	144	TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
sl@0	145	Tcl_Interp interp; / Interpreter to receive errors. */
sl@0	146	Tcl_Obj resultPtr; / List object to lappend results. */
sl@0	147	Tcl_Obj pathPtr; / Contains path to directory to search. */
sl@0	148	CONST char pattern; / Pattern to match against. NULL or empty
sl@0	149	* means pathPtr is actually a single file
sl@0	150	* to check. */
sl@0	151	Tcl_GlobTypeData types; / Object containing list of acceptable types.
sl@0	152	* May be NULL. In particular the directory
sl@0	153	* flag is very important. */
sl@0	154	{
sl@0	155	OSType okType = 0;
sl@0	156	OSType okCreator = 0;
sl@0	157	Tcl_Obj *fileNamePtr;
sl@0	158
sl@0	159	fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
sl@0	160	if (fileNamePtr == NULL) {
sl@0	161	return TCL_ERROR;
sl@0	162	}
sl@0	163
sl@0	164	if (types != NULL) {
sl@0	165	if (types->macType != NULL) {
sl@0	166	Tcl_GetOSTypeFromObj(NULL, types->macType, &okType);
sl@0	167	}
sl@0	168	if (types->macCreator != NULL) {
sl@0	169	Tcl_GetOSTypeFromObj(NULL, types->macCreator, &okCreator);
sl@0	170	}
sl@0	171	}
sl@0	172
sl@0	173	if (pattern == NULL \|\| (*pattern == '\0')) {
sl@0	174	/* Match a single file directly */
sl@0	175	Tcl_StatBuf buf;
sl@0	176	CInfoPBRec paramBlock;
sl@0	177	FSSpec fileSpec;
sl@0	178
sl@0	179	if (TclpObjLstat(fileNamePtr, &buf) != 0) {
sl@0	180	/* File doesn't exist */
sl@0	181	Tcl_DecrRefCount(fileNamePtr);
sl@0	182	return TCL_OK;
sl@0	183	}
sl@0	184
sl@0	185	if (FspLLocationFromFsPath(fileNamePtr, &fileSpec) == noErr) {
sl@0	186	paramBlock.hFileInfo.ioCompletion = NULL;
sl@0	187	paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
sl@0	188	paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
sl@0	189	paramBlock.hFileInfo.ioFDirIndex = 0;
sl@0	190	paramBlock.hFileInfo.ioDirID = fileSpec.parID;
sl@0	191
sl@0	192	PBGetCatInfo(&paramBlock, 0);
sl@0	193	}
sl@0	194
sl@0	195	if (NativeMatchType(fileNamePtr, types, paramBlock.hFileInfo,
sl@0	196	okType, okCreator)) {
sl@0	197	int fnameLen;
sl@0	198	char *fname = Tcl_GetStringFromObj(pathPtr,&fnameLen);
sl@0	199	if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
sl@0	200	Tcl_ListObjAppendElement(interp, resultPtr,
sl@0	201	Tcl_NewStringObj(fname+1, fnameLen-1));
sl@0	202	} else {
sl@0	203	Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
sl@0	204	}
sl@0	205	}
sl@0	206	Tcl_DecrRefCount(fileNamePtr);
sl@0	207	return TCL_OK;
sl@0	208	} else {
sl@0	209	char *fname;
sl@0	210	int fnameLen, result = TCL_OK;
sl@0	211	int baseLength;
sl@0	212	CInfoPBRec pb;
sl@0	213	OSErr err;
sl@0	214	FSSpec dirSpec;
sl@0	215	Boolean isDirectory;
sl@0	216	long dirID;
sl@0	217	short itemIndex;
sl@0	218	Str255 fileName;
sl@0	219	Tcl_DString fileString;
sl@0	220	Tcl_DString dsOrig;
sl@0	221
sl@0	222	Tcl_DStringInit(&dsOrig);
sl@0	223	Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
sl@0	224	baseLength = Tcl_DStringLength(&dsOrig);
sl@0	225
sl@0	226	/*
sl@0	227	* Make sure that the directory part of the name really is a
sl@0	228	* directory.
sl@0	229	*/
sl@0	230
sl@0	231	Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
sl@0	232	Tcl_DStringLength(&dsOrig), &fileString);
sl@0	233
sl@0	234	err = FSpLocationFromPath(Tcl_DStringLength(&fileString),
sl@0	235	Tcl_DStringValue(&fileString), &dirSpec);
sl@0	236	Tcl_DStringFree(&fileString);
sl@0	237	if (err == noErr) {
sl@0	238	err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
sl@0	239	}
sl@0	240
sl@0	241	if ((err != noErr) \|\| !isDirectory) {
sl@0	242	/*
sl@0	243	* Check if we had a relative path (unix style relative path
sl@0	244	* compatibility for glob)
sl@0	245	*/
sl@0	246	Tcl_DStringFree(&dsOrig);
sl@0	247	Tcl_DStringAppend(&dsOrig, ":", 1);
sl@0	248	Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
sl@0	249	baseLength = Tcl_DStringLength(&dsOrig);
sl@0	250
sl@0	251	Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&dsOrig),
sl@0	252	Tcl_DStringLength(&dsOrig), &fileString);
sl@0	253
sl@0	254	err = FSpLocationFromPath(Tcl_DStringLength(&fileString),
sl@0	255	Tcl_DStringValue(&fileString), &dirSpec);
sl@0	256	Tcl_DStringFree(&fileString);
sl@0	257	if (err == noErr) {
sl@0	258	err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
sl@0	259	}
sl@0	260
sl@0	261	if ((err != noErr) \|\| !isDirectory) {
sl@0	262	Tcl_DStringFree(&dsOrig);
sl@0	263	Tcl_DecrRefCount(fileNamePtr);
sl@0	264	return TCL_OK;
sl@0	265	}
sl@0	266	}
sl@0	267
sl@0	268	/* Make sure we have a trailing directory delimiter */
sl@0	269	if (Tcl_DStringValue(&dsOrig)[baseLength-1] != ':') {
sl@0	270	Tcl_DStringAppend(&dsOrig, ":", 1);
sl@0	271	baseLength++;
sl@0	272	}
sl@0	273
sl@0	274	/*
sl@0	275	* Now open the directory for reading and iterate over the contents.
sl@0	276	*/
sl@0	277
sl@0	278	pb.hFileInfo.ioVRefNum = dirSpec.vRefNum;
sl@0	279	pb.hFileInfo.ioDirID = dirID;
sl@0	280	pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
sl@0	281	pb.hFileInfo.ioFDirIndex = itemIndex = 1;
sl@0	282
sl@0	283	while (1) {
sl@0	284	pb.hFileInfo.ioFDirIndex = itemIndex;
sl@0	285	pb.hFileInfo.ioDirID = dirID;
sl@0	286	err = PBGetCatInfoSync(&pb);
sl@0	287	if (err != noErr) {
sl@0	288	break;
sl@0	289	}
sl@0	290
sl@0	291	/*
sl@0	292	* Now check to see if the file matches.
sl@0	293	*/
sl@0	294
sl@0	295	Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],
sl@0	296	&fileString);
sl@0	297	if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {
sl@0	298	Tcl_Obj *tempName;
sl@0	299	Tcl_DStringSetLength(&dsOrig, baseLength);
sl@0	300	Tcl_DStringAppend(&dsOrig, Tcl_DStringValue(&fileString), -1);
sl@0	301	fname = Tcl_DStringValue(&dsOrig);
sl@0	302	fnameLen = Tcl_DStringLength(&dsOrig);
sl@0	303
sl@0	304	/*
sl@0	305	* We use this tempName in calls to check the file's
sl@0	306	* type below. We may also use it for the result.
sl@0	307	*/
sl@0	308	tempName = Tcl_NewStringObj(fname, fnameLen);
sl@0	309	Tcl_IncrRefCount(tempName);
sl@0	310
sl@0	311	/* Is the type acceptable? */
sl@0	312	if (NativeMatchType(tempName, types, pb.hFileInfo,
sl@0	313	okType, okCreator)) {
sl@0	314	if ((fnameLen > 1) && (strchr(fname+1, ':') == NULL)) {
sl@0	315	Tcl_ListObjAppendElement(interp, resultPtr,
sl@0	316	Tcl_NewStringObj(fname+1, fnameLen-1));
sl@0	317	} else {
sl@0	318	Tcl_ListObjAppendElement(interp, resultPtr, tempName);
sl@0	319	}
sl@0	320	}
sl@0	321	/*
sl@0	322	* This will free the object, unless it was inserted in
sl@0	323	* the result list above.
sl@0	324	*/
sl@0	325	Tcl_DecrRefCount(tempName);
sl@0	326	}
sl@0	327	Tcl_DStringFree(&fileString);
sl@0	328	itemIndex++;
sl@0	329	}
sl@0	330
sl@0	331	Tcl_DStringFree(&dsOrig);
sl@0	332	Tcl_DecrRefCount(fileNamePtr);
sl@0	333	return result;
sl@0	334	}
sl@0	335	}
sl@0	336
sl@0	337	static int
sl@0	338	NativeMatchType(
sl@0	339	Tcl_Obj tempName, / Path to check */
sl@0	340	Tcl_GlobTypeData types, / Type description to match against */
sl@0	341	HFileInfo fileInfo, /* MacOS file info */
sl@0	342	OSType okType, /* Acceptable MacOS type, or zero */
sl@0	343	OSType okCreator) /* Acceptable MacOS creator, or zero */
sl@0	344	{
sl@0	345	if (types == NULL) {
sl@0	346	/* If invisible, don't return the file */
sl@0	347	if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
sl@0	348	return 0;
sl@0	349	}
sl@0	350	} else {
sl@0	351	Tcl_StatBuf buf;
sl@0	352
sl@0	353	if (fileInfo.ioFlFndrInfo.fdFlags & kIsInvisible) {
sl@0	354	/* If invisible */
sl@0	355	if ((types->perm == 0) \|\|
sl@0	356	!(types->perm & TCL_GLOB_PERM_HIDDEN)) {
sl@0	357	return 0;
sl@0	358	}
sl@0	359	} else {
sl@0	360	/* Visible */
sl@0	361	if (types->perm & TCL_GLOB_PERM_HIDDEN) {
sl@0	362	return 0;
sl@0	363	}
sl@0	364	}
sl@0	365	if (types->perm != 0) {
sl@0	366	if (
sl@0	367	((types->perm & TCL_GLOB_PERM_RONLY) &&
sl@0	368	!(fileInfo.ioFlAttrib & 1)) \|\|
sl@0	369	((types->perm & TCL_GLOB_PERM_R) &&
sl@0	370	(TclpObjAccess(tempName, R_OK) != 0)) \|\|
sl@0	371	((types->perm & TCL_GLOB_PERM_W) &&
sl@0	372	(TclpObjAccess(tempName, W_OK) != 0)) \|\|
sl@0	373	((types->perm & TCL_GLOB_PERM_X) &&
sl@0	374	(TclpObjAccess(tempName, X_OK) != 0))
sl@0	375	) {
sl@0	376	return 0;
sl@0	377	}
sl@0	378	}
sl@0	379	if (types->type != 0) {
sl@0	380	if (TclpObjStat(tempName, &buf) != 0) {
sl@0	381	/* Posix error occurred */
sl@0	382	return 0;
sl@0	383	}
sl@0	384	/*
sl@0	385	* In order bcdpfls as in 'find -t'
sl@0	386	*/
sl@0	387	if (
sl@0	388	((types->type & TCL_GLOB_TYPE_BLOCK) &&
sl@0	389	S_ISBLK(buf.st_mode)) \|\|
sl@0	390	((types->type & TCL_GLOB_TYPE_CHAR) &&
sl@0	391	S_ISCHR(buf.st_mode)) \|\|
sl@0	392	((types->type & TCL_GLOB_TYPE_DIR) &&
sl@0	393	S_ISDIR(buf.st_mode)) \|\|
sl@0	394	((types->type & TCL_GLOB_TYPE_PIPE) &&
sl@0	395	S_ISFIFO(buf.st_mode)) \|\|
sl@0	396	((types->type & TCL_GLOB_TYPE_FILE) &&
sl@0	397	S_ISREG(buf.st_mode))
sl@0	398	#ifdef S_ISSOCK
sl@0	399	\|\| ((types->type & TCL_GLOB_TYPE_SOCK) &&
sl@0	400	S_ISSOCK(buf.st_mode))
sl@0	401	#endif
sl@0	402	) {
sl@0	403	/* Do nothing -- this file is ok */
sl@0	404	} else {
sl@0	405	int typeOk = 0;
sl@0	406	#ifdef S_ISLNK
sl@0	407	if (types->type & TCL_GLOB_TYPE_LINK) {
sl@0	408	if (TclpObjLstat(tempName, &buf) == 0) {
sl@0	409	if (S_ISLNK(buf.st_mode)) {
sl@0	410	typeOk = 1;
sl@0	411	}
sl@0	412	}
sl@0	413	}
sl@0	414	#endif
sl@0	415	if (typeOk == 0) {
sl@0	416	return 0;
sl@0	417	}
sl@0	418	}
sl@0	419	}
sl@0	420	if (((okType != 0) && (okType !=
sl@0	421	fileInfo.ioFlFndrInfo.fdType)) \|\|
sl@0	422	((okCreator != 0) && (okCreator !=
sl@0	423	fileInfo.ioFlFndrInfo.fdCreator))) {
sl@0	424	return 0;
sl@0	425	}
sl@0	426	}
sl@0	427	return 1;
sl@0	428	}
sl@0	429
sl@0	430
sl@0	431	/*
sl@0	432	*----------------------------------------------------------------------
sl@0	433	*
sl@0	434	* TclpObjAccess --
sl@0	435	*
sl@0	436	* This function replaces the library version of access().
sl@0	437	*
sl@0	438	* Results:
sl@0	439	* See access documentation.
sl@0	440	*
sl@0	441	* Side effects:
sl@0	442	* See access documentation.
sl@0	443	*
sl@0	444	*----------------------------------------------------------------------
sl@0	445	*/
sl@0	446
sl@0	447	int
sl@0	448	TclpObjAccess(pathPtr, mode)
sl@0	449	Tcl_Obj *pathPtr;
sl@0	450	int mode;
sl@0	451	{
sl@0	452	HFileInfo fpb;
sl@0	453	HVolumeParam vpb;
sl@0	454	OSErr err;
sl@0	455	FSSpec fileSpec;
sl@0	456	Boolean isDirectory;
sl@0	457	long dirID;
sl@0	458	int full_mode = 0;
sl@0	459
sl@0	460	err = FspLLocationFromFsPath(pathPtr, &fileSpec);
sl@0	461
sl@0	462	if (err != noErr) {
sl@0	463	errno = TclMacOSErrorToPosixError(err);
sl@0	464	return -1;
sl@0	465	}
sl@0	466
sl@0	467	/*
sl@0	468	* Fill the fpb & vpb struct up with info about file or directory.
sl@0	469	*/
sl@0	470	FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	471	vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
sl@0	472	vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
sl@0	473	if (isDirectory) {
sl@0	474	fpb.ioDirID = fileSpec.parID;
sl@0	475	} else {
sl@0	476	fpb.ioDirID = dirID;
sl@0	477	}
sl@0	478
sl@0	479	fpb.ioFDirIndex = 0;
sl@0	480	err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
sl@0	481	if (err == noErr) {
sl@0	482	vpb.ioVolIndex = 0;
sl@0	483	err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
sl@0	484	if (err == noErr) {
sl@0	485	/*
sl@0	486	* Use the Volume Info & File Info to determine
sl@0	487	* access information. If we have got this far
sl@0	488	* we know the directory is searchable or the file
sl@0	489	* exists. (We have F_OK)
sl@0	490	*/
sl@0	491
sl@0	492	/*
sl@0	493	* Check to see if the volume is hardware or
sl@0	494	* software locked. If so we arn't W_OK.
sl@0	495	*/
sl@0	496	if (mode & W_OK) {
sl@0	497	if ((vpb.ioVAtrb & 0x0080) \|\| (vpb.ioVAtrb & 0x8000)) {
sl@0	498	errno = EROFS;
sl@0	499	return -1;
sl@0	500	}
sl@0	501	if (fpb.ioFlAttrib & 0x01) {
sl@0	502	errno = EACCES;
sl@0	503	return -1;
sl@0	504	}
sl@0	505	}
sl@0	506
sl@0	507	/*
sl@0	508	* Directories are always searchable and executable. But only
sl@0	509	* files of type 'APPL' are executable.
sl@0	510	*/
sl@0	511	if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
sl@0	512	&& (fpb.ioFlFndrInfo.fdType != 'APPL')) {
sl@0	513	return -1;
sl@0	514	}
sl@0	515	}
sl@0	516	}
sl@0	517
sl@0	518	if (err != noErr) {
sl@0	519	errno = TclMacOSErrorToPosixError(err);
sl@0	520	return -1;
sl@0	521	}
sl@0	522
sl@0	523	return 0;
sl@0	524	}
sl@0	525
sl@0	526	/*
sl@0	527	*----------------------------------------------------------------------
sl@0	528	*
sl@0	529	* TclpObjChdir --
sl@0	530	*
sl@0	531	* This function replaces the library version of chdir().
sl@0	532	*
sl@0	533	* Results:
sl@0	534	* See chdir() documentation.
sl@0	535	*
sl@0	536	* Side effects:
sl@0	537	* See chdir() documentation. Also the cache maintained used by
sl@0	538	* Tcl_FSGetCwd() is deallocated and set to NULL.
sl@0	539	*
sl@0	540	*----------------------------------------------------------------------
sl@0	541	*/
sl@0	542
sl@0	543	int
sl@0	544	TclpObjChdir(pathPtr)
sl@0	545	Tcl_Obj *pathPtr;
sl@0	546	{
sl@0	547	FSSpec spec;
sl@0	548	OSErr err;
sl@0	549	Boolean isFolder;
sl@0	550	long dirID;
sl@0	551
sl@0	552	err = FspLocationFromFsPath(pathPtr, &spec);
sl@0	553
sl@0	554	if (err != noErr) {
sl@0	555	errno = ENOENT;
sl@0	556	return -1;
sl@0	557	}
sl@0	558
sl@0	559	err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
sl@0	560	if (err != noErr) {
sl@0	561	errno = ENOENT;
sl@0	562	return -1;
sl@0	563	}
sl@0	564
sl@0	565	if (isFolder != true) {
sl@0	566	errno = ENOTDIR;
sl@0	567	return -1;
sl@0	568	}
sl@0	569
sl@0	570	err = FSpSetDefaultDir(&spec);
sl@0	571	if (err != noErr) {
sl@0	572	switch (err) {
sl@0	573	case afpAccessDenied:
sl@0	574	errno = EACCES;
sl@0	575	break;
sl@0	576	default:
sl@0	577	errno = ENOENT;
sl@0	578	}
sl@0	579	return -1;
sl@0	580	}
sl@0	581
sl@0	582	return 0;
sl@0	583	}
sl@0	584
sl@0	585	/*
sl@0	586	*----------------------------------------------------------------------
sl@0	587	*
sl@0	588	* TclpObjGetCwd --
sl@0	589	*
sl@0	590	* This function replaces the library version of getcwd().
sl@0	591	*
sl@0	592	* Results:
sl@0	593	* The result is a pointer to a string specifying the current
sl@0	594	* directory, or NULL if the current directory could not be
sl@0	595	* determined. If NULL is returned, an error message is left in the
sl@0	596	* interp's result. Storage for the result string is allocated in
sl@0	597	* bufferPtr; the caller must call Tcl_DStringFree() when the result
sl@0	598	* is no longer needed.
sl@0	599	*
sl@0	600	* Side effects:
sl@0	601	* None.
sl@0	602	*
sl@0	603	*----------------------------------------------------------------------
sl@0	604	*/
sl@0	605
sl@0	606	Tcl_Obj*
sl@0	607	TclpObjGetCwd(interp)
sl@0	608	Tcl_Interp *interp;
sl@0	609	{
sl@0	610	Tcl_DString ds;
sl@0	611	if (TclpGetCwd(interp, &ds) != NULL) {
sl@0	612	Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
sl@0	613	Tcl_IncrRefCount(cwdPtr);
sl@0	614	Tcl_DStringFree(&ds);
sl@0	615	return cwdPtr;
sl@0	616	} else {
sl@0	617	return NULL;
sl@0	618	}
sl@0	619	}
sl@0	620
sl@0	621	CONST char *
sl@0	622	TclpGetCwd(
sl@0	623	Tcl_Interp interp, / If non-NULL, used for error reporting. */
sl@0	624	Tcl_DString bufferPtr) / Uninitialized or free DString filled
sl@0	625	* with name of current directory. */
sl@0	626	{
sl@0	627	FSSpec theSpec;
sl@0	628	int length;
sl@0	629	Handle pathHandle = NULL;
sl@0	630
sl@0	631	if (FSpGetDefaultDir(&theSpec) != noErr) {
sl@0	632	if (interp != NULL) {
sl@0	633	Tcl_SetResult(interp, "error getting working directory name",
sl@0	634	TCL_STATIC);
sl@0	635	}
sl@0	636	return NULL;
sl@0	637	}
sl@0	638	if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
sl@0	639	if (interp != NULL) {
sl@0	640	Tcl_SetResult(interp, "error getting working directory name",
sl@0	641	TCL_STATIC);
sl@0	642	}
sl@0	643	return NULL;
sl@0	644	}
sl@0	645	HLock(pathHandle);
sl@0	646	Tcl_ExternalToUtfDString(NULL, *pathHandle, length, bufferPtr);
sl@0	647	HUnlock(pathHandle);
sl@0	648	DisposeHandle(pathHandle);
sl@0	649
sl@0	650	return Tcl_DStringValue(bufferPtr);
sl@0	651	}
sl@0	652
sl@0	653	/*
sl@0	654	*----------------------------------------------------------------------
sl@0	655	*
sl@0	656	* TclpReadlink --
sl@0	657	*
sl@0	658	* This function replaces the library version of readlink().
sl@0	659	*
sl@0	660	* Results:
sl@0	661	* The result is a pointer to a string specifying the contents
sl@0	662	* of the symbolic link given by 'path', or NULL if the symbolic
sl@0	663	* link could not be read. Storage for the result string is
sl@0	664	* allocated in bufferPtr; the caller must call Tcl_DStringFree()
sl@0	665	* when the result is no longer needed.
sl@0	666	*
sl@0	667	* Side effects:
sl@0	668	* See readlink() documentation.
sl@0	669	*
sl@0	670	*---------------------------------------------------------------------------
sl@0	671	*/
sl@0	672
sl@0	673	char *
sl@0	674	TclpReadlink(
sl@0	675	CONST char path, / Path of file to readlink (UTF-8). */
sl@0	676	Tcl_DString linkPtr) / Uninitialized or free DString filled
sl@0	677	* with contents of link (UTF-8). */
sl@0	678	{
sl@0	679	HFileInfo fpb;
sl@0	680	OSErr err;
sl@0	681	FSSpec fileSpec;
sl@0	682	Boolean isDirectory;
sl@0	683	Boolean wasAlias;
sl@0	684	long dirID;
sl@0	685	char fileName[257];
sl@0	686	char *end;
sl@0	687	Handle theString = NULL;
sl@0	688	int pathSize;
sl@0	689	Tcl_DString ds;
sl@0	690
sl@0	691	Tcl_UtfToExternalDString(NULL, path, -1, &ds);
sl@0	692
sl@0	693	/*
sl@0	694	* Remove ending colons if they exist.
sl@0	695	*/
sl@0	696
sl@0	697	while ((Tcl_DStringLength(&ds) != 0)
sl@0	698	&& (Tcl_DStringValue(&ds)[Tcl_DStringLength(&ds) - 1] == ':')) {
sl@0	699	Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 1);
sl@0	700	}
sl@0	701
sl@0	702	end = strrchr(Tcl_DStringValue(&ds), ':');
sl@0	703	if (end == NULL ) {
sl@0	704	strcpy(fileName + 1, Tcl_DStringValue(&ds));
sl@0	705	} else {
sl@0	706	strcpy(fileName + 1, end + 1);
sl@0	707	Tcl_DStringSetLength(&ds, end + 1 - Tcl_DStringValue(&ds));
sl@0	708	}
sl@0	709	fileName[0] = (char) strlen(fileName + 1);
sl@0	710
sl@0	711	/*
sl@0	712	* Create the file spec for the directory of the file
sl@0	713	* we want to look at.
sl@0	714	*/
sl@0	715
sl@0	716	if (end != NULL) {
sl@0	717	err = FSpLocationFromPath(Tcl_DStringLength(&ds),
sl@0	718	Tcl_DStringValue(&ds), &fileSpec);
sl@0	719	if (err != noErr) {
sl@0	720	Tcl_DStringFree(&ds);
sl@0	721	errno = EINVAL;
sl@0	722	return NULL;
sl@0	723	}
sl@0	724	} else {
sl@0	725	FSMakeFSSpecCompat(0, 0, NULL, &fileSpec);
sl@0	726	}
sl@0	727	Tcl_DStringFree(&ds);
sl@0	728
sl@0	729	/*
sl@0	730	* Fill the fpb struct up with info about file or directory.
sl@0	731	*/
sl@0	732
sl@0	733	FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	734	fpb.ioVRefNum = fileSpec.vRefNum;
sl@0	735	fpb.ioDirID = dirID;
sl@0	736	fpb.ioNamePtr = (StringPtr) fileName;
sl@0	737
sl@0	738	fpb.ioFDirIndex = 0;
sl@0	739	err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
sl@0	740	if (err != noErr) {
sl@0	741	errno = TclMacOSErrorToPosixError(err);
sl@0	742	return NULL;
sl@0	743	} else {
sl@0	744	if (fpb.ioFlAttrib & 0x10) {
sl@0	745	errno = EINVAL;
sl@0	746	return NULL;
sl@0	747	} else {
sl@0	748	if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
sl@0	749	/*
sl@0	750	* The file is a link!
sl@0	751	*/
sl@0	752	} else {
sl@0	753	errno = EINVAL;
sl@0	754	return NULL;
sl@0	755	}
sl@0	756	}
sl@0	757	}
sl@0	758
sl@0	759	/*
sl@0	760	* If we are here it's really a link - now find out
sl@0	761	* where it points to.
sl@0	762	*/
sl@0	763	err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName,
sl@0	764	&fileSpec);
sl@0	765	if (err == noErr) {
sl@0	766	err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);
sl@0	767	}
sl@0	768	if ((err == fnfErr) \|\| wasAlias) {
sl@0	769	err = FSpPathFromLocation(&fileSpec, &pathSize, &theString);
sl@0	770	if (err != noErr) {
sl@0	771	DisposeHandle(theString);
sl@0	772	errno = ENAMETOOLONG;
sl@0	773	return NULL;
sl@0	774	}
sl@0	775	} else {
sl@0	776	errno = EINVAL;
sl@0	777	return NULL;
sl@0	778	}
sl@0	779
sl@0	780	Tcl_ExternalToUtfDString(NULL, *theString, pathSize, linkPtr);
sl@0	781	DisposeHandle(theString);
sl@0	782
sl@0	783	return Tcl_DStringValue(linkPtr);
sl@0	784	}
sl@0	785
sl@0	786	static int
sl@0	787	TclpObjStatAlias _ANSI_ARGS_((Tcl_Obj pathPtr, Tcl_StatBuf bufPtr,
sl@0	788	Boolean resolveLink));
sl@0	789
sl@0	790
sl@0	791	/*
sl@0	792	*----------------------------------------------------------------------
sl@0	793	*
sl@0	794	* TclpObjLstat --
sl@0	795	*
sl@0	796	* This function replaces the library version of lstat().
sl@0	797	*
sl@0	798	* Results:
sl@0	799	* See lstat() documentation.
sl@0	800	*
sl@0	801	* Side effects:
sl@0	802	* See lstat() documentation.
sl@0	803	*
sl@0	804	*----------------------------------------------------------------------
sl@0	805	*/
sl@0	806
sl@0	807	int
sl@0	808	TclpObjLstat(pathPtr, buf)
sl@0	809	Tcl_Obj *pathPtr;
sl@0	810	Tcl_StatBuf *buf;
sl@0	811	{
sl@0	812	return TclpObjStatAlias(pathPtr, buf, FALSE);
sl@0	813	}
sl@0	814
sl@0	815	/*
sl@0	816	*----------------------------------------------------------------------
sl@0	817	*
sl@0	818	* TclpObjStat --
sl@0	819	*
sl@0	820	* This function replaces the library version of stat().
sl@0	821	*
sl@0	822	* Results:
sl@0	823	* See stat() documentation.
sl@0	824	*
sl@0	825	* Side effects:
sl@0	826	* See stat() documentation.
sl@0	827	*
sl@0	828	*----------------------------------------------------------------------
sl@0	829	*/
sl@0	830
sl@0	831	int
sl@0	832	TclpObjStat(pathPtr, bufPtr)
sl@0	833	Tcl_Obj *pathPtr;
sl@0	834	Tcl_StatBuf *bufPtr;
sl@0	835	{
sl@0	836	return TclpObjStatAlias(pathPtr, bufPtr, TRUE);
sl@0	837	}
sl@0	838
sl@0	839
sl@0	840	static int
sl@0	841	TclpObjStatAlias (Tcl_Obj pathPtr, Tcl_StatBuf bufPtr, Boolean resolveLink)
sl@0	842	{
sl@0	843	HFileInfo fpb;
sl@0	844	HVolumeParam vpb;
sl@0	845	OSErr err;
sl@0	846	FSSpec fileSpec;
sl@0	847	Boolean isDirectory;
sl@0	848	long dirID;
sl@0	849
sl@0	850	if (resolveLink)
sl@0	851	err = FspLocationFromFsPath(pathPtr, &fileSpec);
sl@0	852	else
sl@0	853	err = FspLLocationFromFsPath(pathPtr, &fileSpec);
sl@0	854
sl@0	855	if (err != noErr) {
sl@0	856	errno = TclMacOSErrorToPosixError(err);
sl@0	857	return -1;
sl@0	858	}
sl@0	859
sl@0	860	/*
sl@0	861	* Fill the fpb & vpb struct up with info about file or directory.
sl@0	862	*/
sl@0	863
sl@0	864	FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	865	vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
sl@0	866	vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
sl@0	867	if (isDirectory) {
sl@0	868	fpb.ioDirID = fileSpec.parID;
sl@0	869	} else {
sl@0	870	fpb.ioDirID = dirID;
sl@0	871	}
sl@0	872
sl@0	873	fpb.ioFDirIndex = 0;
sl@0	874	err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
sl@0	875	if (err == noErr) {
sl@0	876	vpb.ioVolIndex = 0;
sl@0	877	err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
sl@0	878	if (err == noErr && bufPtr != NULL) {
sl@0	879	/*
sl@0	880	* Files are always readable by everyone.
sl@0	881	*/
sl@0	882
sl@0	883	bufPtr->st_mode = S_IRUSR \| S_IRGRP \| S_IROTH;
sl@0	884
sl@0	885	/*
sl@0	886	* Use the Volume Info & File Info to fill out stat buf.
sl@0	887	*/
sl@0	888	if (fpb.ioFlAttrib & 0x10) {
sl@0	889	bufPtr->st_mode \|= S_IFDIR;
sl@0	890	bufPtr->st_nlink = 2;
sl@0	891	} else {
sl@0	892	bufPtr->st_nlink = 1;
sl@0	893	if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
sl@0	894	bufPtr->st_mode \|= S_IFLNK;
sl@0	895	} else {
sl@0	896	bufPtr->st_mode \|= S_IFREG;
sl@0	897	}
sl@0	898	}
sl@0	899	if ((fpb.ioFlAttrib & 0x10) \|\| (fpb.ioFlFndrInfo.fdType == 'APPL')) {
sl@0	900	/*
sl@0	901	* Directories and applications are executable by everyone.
sl@0	902	*/
sl@0	903
sl@0	904	bufPtr->st_mode \|= S_IXUSR \| S_IXGRP \| S_IXOTH;
sl@0	905	}
sl@0	906	if ((fpb.ioFlAttrib & 0x01) == 0){
sl@0	907	/*
sl@0	908	* If not locked, then everyone has write acces.
sl@0	909	*/
sl@0	910
sl@0	911	bufPtr->st_mode \|= S_IWUSR \| S_IWGRP \| S_IWOTH;
sl@0	912	}
sl@0	913	bufPtr->st_ino = fpb.ioDirID;
sl@0	914	bufPtr->st_dev = fpb.ioVRefNum;
sl@0	915	bufPtr->st_uid = -1;
sl@0	916	bufPtr->st_gid = -1;
sl@0	917	bufPtr->st_rdev = 0;
sl@0	918	bufPtr->st_size = fpb.ioFlLgLen;
sl@0	919	bufPtr->st_blksize = vpb.ioVAlBlkSiz;
sl@0	920	bufPtr->st_blocks = (bufPtr->st_size + bufPtr->st_blksize - 1)
sl@0	921	/ bufPtr->st_blksize;
sl@0	922
sl@0	923	/*
sl@0	924	* The times returned by the Mac file system are in the
sl@0	925	* local time zone. We convert them to GMT so that the
sl@0	926	* epoch starts from GMT. This is also consistent with
sl@0	927	* what is returned from "clock seconds".
sl@0	928	*/
sl@0	929
sl@0	930	bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat
sl@0	931	- TclpGetGMTOffset() + tcl_mac_epoch_offset;
sl@0	932	bufPtr->st_ctime = fpb.ioFlCrDat - TclpGetGMTOffset()
sl@0	933	+ tcl_mac_epoch_offset;
sl@0	934	}
sl@0	935	}
sl@0	936
sl@0	937	if (err != noErr) {
sl@0	938	errno = TclMacOSErrorToPosixError(err);
sl@0	939	}
sl@0	940
sl@0	941	return (err == noErr ? 0 : -1);
sl@0	942	}
sl@0	943
sl@0	944	/*
sl@0	945	*----------------------------------------------------------------------
sl@0	946	*
sl@0	947	* Tcl_WaitPid --
sl@0	948	*
sl@0	949	* Fakes a call to wait pid.
sl@0	950	*
sl@0	951	* Results:
sl@0	952	* Always returns -1.
sl@0	953	*
sl@0	954	* Side effects:
sl@0	955	* None.
sl@0	956	*
sl@0	957	*----------------------------------------------------------------------
sl@0	958	*/
sl@0	959
sl@0	960	Tcl_Pid
sl@0	961	Tcl_WaitPid(
sl@0	962	Tcl_Pid pid,
sl@0	963	int *statPtr,
sl@0	964	int options)
sl@0	965	{
sl@0	966	return (Tcl_Pid) -1;
sl@0	967	}
sl@0	968
sl@0	969	/*
sl@0	970	*----------------------------------------------------------------------
sl@0	971	*
sl@0	972	* TclMacFOpenHack --
sl@0	973	*
sl@0	974	* This function replaces fopen. It supports paths with alises.
sl@0	975	* Note, remember to undefine the fopen macro!
sl@0	976	*
sl@0	977	* Results:
sl@0	978	* See fopen documentation.
sl@0	979	*
sl@0	980	* Side effects:
sl@0	981	* See fopen documentation.
sl@0	982	*
sl@0	983	*----------------------------------------------------------------------
sl@0	984	*/
sl@0	985
sl@0	986	#undef fopen
sl@0	987	FILE *
sl@0	988	TclMacFOpenHack(
sl@0	989	CONST char *path,
sl@0	990	CONST char *mode)
sl@0	991	{
sl@0	992	OSErr err;
sl@0	993	FSSpec fileSpec;
sl@0	994	Handle pathString = NULL;
sl@0	995	int size;
sl@0	996	FILE * f;
sl@0	997
sl@0	998	err = FSpLocationFromPath(strlen(path), path, &fileSpec);
sl@0	999	if ((err != noErr) && (err != fnfErr)) {
sl@0	1000	return NULL;
sl@0	1001	}
sl@0	1002	err = FSpPathFromLocation(&fileSpec, &size, &pathString);
sl@0	1003	if ((err != noErr) && (err != fnfErr)) {
sl@0	1004	return NULL;
sl@0	1005	}
sl@0	1006
sl@0	1007	HLock(pathString);
sl@0	1008	f = fopen(*pathString, mode);
sl@0	1009	HUnlock(pathString);
sl@0	1010	DisposeHandle(pathString);
sl@0	1011	return f;
sl@0	1012	}
sl@0	1013
sl@0	1014	/*
sl@0	1015	*---------------------------------------------------------------------------
sl@0	1016	*
sl@0	1017	* TclpGetUserHome --
sl@0	1018	*
sl@0	1019	* This function takes the specified user name and finds their
sl@0	1020	* home directory.
sl@0	1021	*
sl@0	1022	* Results:
sl@0	1023	* The result is a pointer to a string specifying the user's home
sl@0	1024	* directory, or NULL if the user's home directory could not be
sl@0	1025	* determined. Storage for the result string is allocated in
sl@0	1026	* bufferPtr; the caller must call Tcl_DStringFree() when the result
sl@0	1027	* is no longer needed.
sl@0	1028	*
sl@0	1029	* Side effects:
sl@0	1030	* None.
sl@0	1031	*
sl@0	1032	*----------------------------------------------------------------------
sl@0	1033	*/
sl@0	1034
sl@0	1035	char *
sl@0	1036	TclpGetUserHome(name, bufferPtr)
sl@0	1037	CONST char name; / User name for desired home directory. */
sl@0	1038	Tcl_DString bufferPtr; / Uninitialized or free DString filled
sl@0	1039	* with name of user's home directory. */
sl@0	1040	{
sl@0	1041	return NULL;
sl@0	1042	}
sl@0	1043
sl@0	1044	/*
sl@0	1045	*----------------------------------------------------------------------
sl@0	1046	*
sl@0	1047	* TclMacOSErrorToPosixError --
sl@0	1048	*
sl@0	1049	* Given a Macintosh OSErr return the appropiate POSIX error.
sl@0	1050	*
sl@0	1051	* Results:
sl@0	1052	* A Posix error.
sl@0	1053	*
sl@0	1054	* Side effects:
sl@0	1055	* None.
sl@0	1056	*
sl@0	1057	*----------------------------------------------------------------------
sl@0	1058	*/
sl@0	1059
sl@0	1060	int
sl@0	1061	TclMacOSErrorToPosixError(
sl@0	1062	int error) /* A Macintosh error. */
sl@0	1063	{
sl@0	1064	switch (error) {
sl@0	1065	case noErr:
sl@0	1066	return 0;
sl@0	1067	case bdNamErr:
sl@0	1068	return ENAMETOOLONG;
sl@0	1069	case afpObjectTypeErr:
sl@0	1070	return ENOTDIR;
sl@0	1071	case fnfErr:
sl@0	1072	case dirNFErr:
sl@0	1073	return ENOENT;
sl@0	1074	case dupFNErr:
sl@0	1075	return EEXIST;
sl@0	1076	case dirFulErr:
sl@0	1077	case dskFulErr:
sl@0	1078	return ENOSPC;
sl@0	1079	case fBsyErr:
sl@0	1080	return EBUSY;
sl@0	1081	case tmfoErr:
sl@0	1082	return ENFILE;
sl@0	1083	case fLckdErr:
sl@0	1084	case permErr:
sl@0	1085	case afpAccessDenied:
sl@0	1086	return EACCES;
sl@0	1087	case wPrErr:
sl@0	1088	case vLckdErr:
sl@0	1089	return EROFS;
sl@0	1090	case badMovErr:
sl@0	1091	return EINVAL;
sl@0	1092	case diffVolErr:
sl@0	1093	return EXDEV;
sl@0	1094	default:
sl@0	1095	return EINVAL;
sl@0	1096	}
sl@0	1097	}
sl@0	1098
sl@0	1099	int
sl@0	1100	TclMacChmod(
sl@0	1101	CONST char *path,
sl@0	1102	int mode)
sl@0	1103	{
sl@0	1104	HParamBlockRec hpb;
sl@0	1105	OSErr err;
sl@0	1106	Str255 pathName;
sl@0	1107	strcpy((char *) pathName + 1, path);
sl@0	1108	pathName[0] = strlen(path);
sl@0	1109	hpb.fileParam.ioNamePtr = pathName;
sl@0	1110	hpb.fileParam.ioVRefNum = 0;
sl@0	1111	hpb.fileParam.ioDirID = 0;
sl@0	1112
sl@0	1113	if (mode & 0200) {
sl@0	1114	err = PBHRstFLockSync(&hpb);
sl@0	1115	} else {
sl@0	1116	err = PBHSetFLockSync(&hpb);
sl@0	1117	}
sl@0	1118
sl@0	1119	if (err != noErr) {
sl@0	1120	errno = TclMacOSErrorToPosixError(err);
sl@0	1121	return -1;
sl@0	1122	}
sl@0	1123
sl@0	1124	return 0;
sl@0	1125	}
sl@0	1126
sl@0	1127
sl@0	1128	/*
sl@0	1129	*----------------------------------------------------------------------
sl@0	1130	*
sl@0	1131	* TclpTempFileName --
sl@0	1132	*
sl@0	1133	* This function returns a unique filename.
sl@0	1134	*
sl@0	1135	* Results:
sl@0	1136	* Returns a valid Tcl_Obj* with refCount 0, or NULL on failure.
sl@0	1137	*
sl@0	1138	* Side effects:
sl@0	1139	* None.
sl@0	1140	*
sl@0	1141	*----------------------------------------------------------------------
sl@0	1142	*/
sl@0	1143
sl@0	1144	Tcl_Obj*
sl@0	1145	TclpTempFileName()
sl@0	1146	{
sl@0	1147	char fileName[L_tmpnam];
sl@0	1148
sl@0	1149	if (tmpnam(fileName) == NULL) { /* INTL: Native. */
sl@0	1150	return NULL;
sl@0	1151	}
sl@0	1152
sl@0	1153	return TclpNativeToNormalized((ClientData) fileName);
sl@0	1154	}
sl@0	1155
sl@0	1156	#ifdef S_IFLNK
sl@0	1157
sl@0	1158	Tcl_Obj*
sl@0	1159	TclpObjLink(pathPtr, toPtr, linkAction)
sl@0	1160	Tcl_Obj *pathPtr;
sl@0	1161	Tcl_Obj *toPtr;
sl@0	1162	int linkAction;
sl@0	1163	{
sl@0	1164	Tcl_Obj* link = NULL;
sl@0	1165
sl@0	1166	if (toPtr != NULL) {
sl@0	1167	if (TclpObjAccess(pathPtr, F_OK) != -1) {
sl@0	1168	/* src exists */
sl@0	1169	errno = EEXIST;
sl@0	1170	return NULL;
sl@0	1171	}
sl@0	1172	if (TclpObjAccess(toPtr, F_OK) == -1) {
sl@0	1173	/* target doesn't exist */
sl@0	1174	errno = ENOENT;
sl@0	1175	return NULL;
sl@0	1176	}
sl@0	1177
sl@0	1178	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
sl@0	1179	/* Needs to create a new link */
sl@0	1180	FSSpec spec;
sl@0	1181	FSSpec linkSpec;
sl@0	1182	OSErr err;
sl@0	1183	CONST char *path;
sl@0	1184
sl@0	1185	err = FspLocationFromFsPath(toPtr, &spec);
sl@0	1186	if (err != noErr) {
sl@0	1187	errno = ENOENT;
sl@0	1188	return NULL;
sl@0	1189	}
sl@0	1190
sl@0	1191	path = Tcl_FSGetNativePath(pathPtr);
sl@0	1192	err = FSpLocationFromPath(strlen(path), path, &linkSpec);
sl@0	1193	if (err == noErr) {
sl@0	1194	err = dupFNErr; /* EEXIST. */
sl@0	1195	} else {
sl@0	1196	err = CreateAliasFile(&linkSpec, &spec);
sl@0	1197	}
sl@0	1198	if (err != noErr) {
sl@0	1199	errno = TclMacOSErrorToPosixError(err);
sl@0	1200	return NULL;
sl@0	1201	}
sl@0	1202	return toPtr;
sl@0	1203	} else {
sl@0	1204	errno = ENODEV;
sl@0	1205	return NULL;
sl@0	1206	}
sl@0	1207	} else {
sl@0	1208	Tcl_DString ds;
sl@0	1209	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
sl@0	1210	if (transPtr == NULL) {
sl@0	1211	return NULL;
sl@0	1212	}
sl@0	1213	if (TclpReadlink(Tcl_GetString(transPtr), &ds) != NULL) {
sl@0	1214	link = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
sl@0	1215	Tcl_IncrRefCount(link);
sl@0	1216	Tcl_DStringFree(&ds);
sl@0	1217	}
sl@0	1218	Tcl_DecrRefCount(transPtr);
sl@0	1219	}
sl@0	1220	return link;
sl@0	1221	}
sl@0	1222
sl@0	1223	#endif
sl@0	1224
sl@0	1225
sl@0	1226	/*
sl@0	1227	*---------------------------------------------------------------------------
sl@0	1228	*
sl@0	1229	* TclpFilesystemPathType --
sl@0	1230	*
sl@0	1231	* This function is part of the native filesystem support, and
sl@0	1232	* returns the path type of the given path. Right now it simply
sl@0	1233	* returns NULL. In the future it could return specific path
sl@0	1234	* types, like 'HFS', 'HFS+', 'nfs', 'samba', 'FAT32', etc.
sl@0	1235	*
sl@0	1236	* Results:
sl@0	1237	* NULL at present.
sl@0	1238	*
sl@0	1239	* Side effects:
sl@0	1240	* None.
sl@0	1241	*
sl@0	1242	*---------------------------------------------------------------------------
sl@0	1243	*/
sl@0	1244	Tcl_Obj*
sl@0	1245	TclpFilesystemPathType(pathObjPtr)
sl@0	1246	Tcl_Obj* pathObjPtr;
sl@0	1247	{
sl@0	1248	/* All native paths are of the same type */
sl@0	1249	return NULL;
sl@0	1250	}
sl@0	1251
sl@0	1252	/*
sl@0	1253	*---------------------------------------------------------------------------
sl@0	1254	*
sl@0	1255	* TclpUtime --
sl@0	1256	*
sl@0	1257	* Set the modification date for a file.
sl@0	1258	*
sl@0	1259	* Results:
sl@0	1260	* 0 on success, -1 on error.
sl@0	1261	*
sl@0	1262	* Side effects:
sl@0	1263	* None.
sl@0	1264	*
sl@0	1265	*---------------------------------------------------------------------------
sl@0	1266	*/
sl@0	1267	int
sl@0	1268	TclpUtime(pathPtr, tval)
sl@0	1269	Tcl_Obj pathPtr; / File to modify */
sl@0	1270	struct utimbuf tval; / New modification date structure */
sl@0	1271	{
sl@0	1272	long gmt_offset=TclpGetGMTOffset();
sl@0	1273	struct utimbuf local_tval;
sl@0	1274	local_tval.actime=tval->actime+gmt_offset;
sl@0	1275	local_tval.modtime=tval->modtime+gmt_offset;
sl@0	1276	return utime(Tcl_FSGetNativePath(Tcl_FSGetNormalizedPath(NULL,pathPtr)),
sl@0	1277	&local_tval);
sl@0	1278	}
sl@0	1279
sl@0	1280	/*
sl@0	1281	*---------------------------------------------------------------------------
sl@0	1282	*
sl@0	1283	* CreateAliasFile --
sl@0	1284	*
sl@0	1285	* Creates an alias file located at aliasDest referring to the targetFile.
sl@0	1286	*
sl@0	1287	* Results:
sl@0	1288	* 0 on success, OS error code on error.
sl@0	1289	*
sl@0	1290	* Side effects:
sl@0	1291	* None.
sl@0	1292	*
sl@0	1293	*---------------------------------------------------------------------------
sl@0	1294	*/
sl@0	1295	static OSErr
sl@0	1296	CreateAliasFile(FSSpec theAliasFile, FSSpec targetFile)
sl@0	1297	{
sl@0	1298	CInfoPBRec cat;
sl@0	1299	FInfo fndrInfo;
sl@0	1300	AliasHandle theAlias;
sl@0	1301	short saveRef, rsrc = -1;
sl@0	1302	OSErr err;
sl@0	1303
sl@0	1304	saveRef = CurResFile();
sl@0	1305	/* set up the Finder information record for the alias file */
sl@0	1306	cat.dirInfo.ioNamePtr = targetFile->name;
sl@0	1307	cat.dirInfo.ioVRefNum = targetFile->vRefNum;
sl@0	1308	cat.dirInfo.ioFDirIndex = 0;
sl@0	1309	cat.dirInfo.ioDrDirID = targetFile->parID;
sl@0	1310	err = PBGetCatInfoSync(&cat);
sl@0	1311	if (err != noErr) goto bail;
sl@0	1312	if ((cat.dirInfo.ioFlAttrib & 16) == 0) {
sl@0	1313	/* file alias */
sl@0	1314	switch (cat.hFileInfo.ioFlFndrInfo.fdType) {
sl@0	1315	case 'APPL': fndrInfo.fdType = kApplicationAliasType; break;
sl@0	1316	case 'APPC': fndrInfo.fdType = kApplicationCPAliasType; break;
sl@0	1317	case 'APPD': fndrInfo.fdType = kApplicationDAAliasType; break;
sl@0	1318	default: fndrInfo.fdType = cat.hFileInfo.ioFlFndrInfo.fdType; break;
sl@0	1319	}
sl@0	1320	fndrInfo.fdCreator = cat.hFileInfo.ioFlFndrInfo.fdCreator;
sl@0	1321	} else {
sl@0	1322	/* folder alias */
sl@0	1323	fndrInfo.fdType = kContainerFolderAliasType;
sl@0	1324	fndrInfo.fdCreator = 'MACS';
sl@0	1325	}
sl@0	1326	fndrInfo.fdFlags = kIsAlias;
sl@0	1327	fndrInfo.fdLocation.v = 0;
sl@0	1328	fndrInfo.fdLocation.h = 0;
sl@0	1329	fndrInfo.fdFldr = 0;
sl@0	1330	/* create new file and set the file information */
sl@0	1331	FSpCreateResFile( theAliasFile, fndrInfo.fdCreator, fndrInfo.fdType, smSystemScript);
sl@0	1332	if ((err = ResError()) != noErr) goto bail;
sl@0	1333	err = FSpSetFInfo( theAliasFile, &fndrInfo);
sl@0	1334	if (err != noErr) goto bail;
sl@0	1335	/* save the alias resource */
sl@0	1336	rsrc = FSpOpenResFile(theAliasFile, fsRdWrPerm);
sl@0	1337	if (rsrc == -1) { err = ResError(); goto bail; }
sl@0	1338	UseResFile(rsrc);
sl@0	1339	err = NewAlias(theAliasFile, targetFile, &theAlias);
sl@0	1340	if (err != noErr) goto bail;
sl@0	1341	AddResource((Handle) theAlias, rAliasType, 0, theAliasFile->name);
sl@0	1342	if ((err = ResError()) != noErr) goto bail;
sl@0	1343	CloseResFile(rsrc);
sl@0	1344	rsrc = -1;
sl@0	1345	/* done */
sl@0	1346	bail:
sl@0	1347	if (rsrc != -1) CloseResFile(rsrc);
sl@0	1348	UseResFile(saveRef);
sl@0	1349	return err;
sl@0	1350	}

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--