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

sl@0	1	/*
sl@0	2	* tclMacFCmd.c --
sl@0	3	*
sl@0	4	* Implements the Macintosh specific portions of the file manipulation
sl@0	5	* subcommands of the "file" command.
sl@0	6	*
sl@0	7	* Copyright (c) 1996-1998 Sun Microsystems, Inc.
sl@0	8	*
sl@0	9	* See the file "license.terms" for information on usage and redistribution
sl@0	10	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	11	*
sl@0	12	* RCS: @(#) $Id: tclMacFCmd.c,v 1.19 2003/02/04 17:06:51 vincentdarley Exp $
sl@0	13	*/
sl@0	14
sl@0	15	#include "tclInt.h"
sl@0	16	#include "tclMac.h"
sl@0	17	#include "tclMacInt.h"
sl@0	18	#include "tclPort.h"
sl@0	19	#include <FSpCompat.h>
sl@0	20	#include <MoreFilesExtras.h>
sl@0	21	#include <Strings.h>
sl@0	22	#include <Errors.h>
sl@0	23	#include <FileCopy.h>
sl@0	24	#include <DirectoryCopy.h>
sl@0	25	#include <Script.h>
sl@0	26	#include <string.h>
sl@0	27	#include <Finder.h>
sl@0	28	#include <Aliases.h>
sl@0	29
sl@0	30	/*
sl@0	31	* Callback for the file attributes code.
sl@0	32	*/
sl@0	33
sl@0	34	static int GetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	35	int objIndex, Tcl_Obj *fileName,
sl@0	36	Tcl_Obj **attributePtrPtr));
sl@0	37	static int GetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	38	int objIndex, Tcl_Obj *fileName,
sl@0	39	Tcl_Obj **readOnlyPtrPtr));
sl@0	40	static int SetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	41	int objIndex, Tcl_Obj *fileName,
sl@0	42	Tcl_Obj *attributePtr));
sl@0	43	static int SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	44	int objIndex, Tcl_Obj *fileName,
sl@0	45	Tcl_Obj *readOnlyPtr));
sl@0	46
sl@0	47	/*
sl@0	48	* These are indeces into the tclpFileAttrsStrings table below.
sl@0	49	*/
sl@0	50
sl@0	51	#define MAC_CREATOR_ATTRIBUTE 0
sl@0	52	#define MAC_HIDDEN_ATTRIBUTE 1
sl@0	53	#define MAC_READONLY_ATTRIBUTE 2
sl@0	54	#define MAC_TYPE_ATTRIBUTE 3
sl@0	55
sl@0	56	/*
sl@0	57	* Global variables for the file attributes code.
sl@0	58	*/
sl@0	59
sl@0	60	CONST char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
sl@0	61	"-type", (char *) NULL};
sl@0	62	CONST TclFileAttrProcs tclpFileAttrProcs[] = {
sl@0	63	{GetFileFinderAttributes, SetFileFinderAttributes},
sl@0	64	{GetFileFinderAttributes, SetFileFinderAttributes},
sl@0	65	{GetFileReadOnly, SetFileReadOnly},
sl@0	66	{GetFileFinderAttributes, SetFileFinderAttributes}};
sl@0	67
sl@0	68	/*
sl@0	69	* File specific static data
sl@0	70	*/
sl@0	71
sl@0	72	static long startSeed = 248923489;
sl@0	73
sl@0	74	/*
sl@0	75	* Prototypes for procedure only used in this file
sl@0	76	*/
sl@0	77
sl@0	78	static pascal Boolean CopyErrHandler _ANSI_ARGS_((OSErr error,
sl@0	79	short failedOperation,
sl@0	80	short srcVRefNum, long srcDirID,
sl@0	81	ConstStr255Param srcName, short dstVRefNum,
sl@0	82	long dstDirID,ConstStr255Param dstName));
sl@0	83	static int DoCopyDirectory _ANSI_ARGS_((CONST char *src,
sl@0	84	CONST char dst, Tcl_DString errorPtr));
sl@0	85	static int DoCopyFile _ANSI_ARGS_((CONST char *src,
sl@0	86	CONST char *dst));
sl@0	87	static int DoCreateDirectory _ANSI_ARGS_((CONST char *path));
sl@0	88	static int DoRemoveDirectory _ANSI_ARGS_((CONST char *path,
sl@0	89	int recursive, Tcl_DString *errorPtr));
sl@0	90	static int DoRenameFile _ANSI_ARGS_((CONST char *src,
sl@0	91	CONST char *dst));
sl@0	92	OSErr FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr,
sl@0	93	Boolean *lockedPtr));
sl@0	94	static OSErr GetFileSpecs _ANSI_ARGS_((CONST char *path,
sl@0	95	FSSpec pathSpecPtr, FSSpec dirSpecPtr,
sl@0	96	Boolean *pathExistsPtr,
sl@0	97	Boolean *pathIsDirectoryPtr));
sl@0	98	static OSErr MoveRename _ANSI_ARGS_((const FSSpec *srcSpecPtr,
sl@0	99	const FSSpec *dstSpecPtr, StringPtr copyName));
sl@0	100	static int Pstrequal _ANSI_ARGS_((ConstStr255Param stringA,
sl@0	101	ConstStr255Param stringB));
sl@0	102
sl@0	103	/*
sl@0	104	*---------------------------------------------------------------------------
sl@0	105	*
sl@0	106	* TclpObjRenameFile, DoRenameFile --
sl@0	107	*
sl@0	108	* Changes the name of an existing file or directory, from src to dst.
sl@0	109	* If src and dst refer to the same file or directory, does nothing
sl@0	110	* and returns success. Otherwise if dst already exists, it will be
sl@0	111	* deleted and replaced by src subject to the following conditions:
sl@0	112	* If src is a directory, dst may be an empty directory.
sl@0	113	* If src is a file, dst may be a file.
sl@0	114	* In any other situation where dst already exists, the rename will
sl@0	115	* fail.
sl@0	116	*
sl@0	117	* Results:
sl@0	118	* If the directory was successfully created, returns TCL_OK.
sl@0	119	* Otherwise the return value is TCL_ERROR and errno is set to
sl@0	120	* indicate the error. Some possible values for errno are:
sl@0	121	*
sl@0	122	* EACCES: src or dst parent directory can't be read and/or written.
sl@0	123	* EEXIST: dst is a non-empty directory.
sl@0	124	* EINVAL: src is a root directory or dst is a subdirectory of src.
sl@0	125	* EISDIR: dst is a directory, but src is not.
sl@0	126	* ENOENT: src doesn't exist. src or dst is "".
sl@0	127	* ENOTDIR: src is a directory, but dst is not.
sl@0	128	* EXDEV: src and dst are on different filesystems.
sl@0	129	*
sl@0	130	* Side effects:
sl@0	131	* The implementation of rename may allow cross-filesystem renames,
sl@0	132	* but the caller should be prepared to emulate it with copy and
sl@0	133	* delete if errno is EXDEV.
sl@0	134	*
sl@0	135	*---------------------------------------------------------------------------
sl@0	136	*/
sl@0	137
sl@0	138	int
sl@0	139	TclpObjRenameFile(srcPathPtr, destPathPtr)
sl@0	140	Tcl_Obj *srcPathPtr;
sl@0	141	Tcl_Obj *destPathPtr;
sl@0	142	{
sl@0	143	return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
sl@0	144	Tcl_FSGetNativePath(destPathPtr));
sl@0	145	}
sl@0	146
sl@0	147	static int
sl@0	148	DoRenameFile(
sl@0	149	CONST char src, / Pathname of file or dir to be renamed
sl@0	150	* (native). */
sl@0	151	CONST char dst) / New pathname of file or directory
sl@0	152	* (native). */
sl@0	153	{
sl@0	154	FSSpec srcFileSpec, dstFileSpec, dstDirSpec;
sl@0	155	OSErr err;
sl@0	156	long srcID, dummy;
sl@0	157	Boolean srcIsDirectory, dstIsDirectory, dstExists, dstLocked;
sl@0	158
sl@0	159	err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
sl@0	160	if (err == noErr) {
sl@0	161	FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
sl@0	162	}
sl@0	163	if (err == noErr) {
sl@0	164	err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
sl@0	165	&dstIsDirectory);
sl@0	166	}
sl@0	167	if (err == noErr) {
sl@0	168	if (dstExists == 0) {
sl@0	169	err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
sl@0	170	goto end;
sl@0	171	}
sl@0	172	err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
sl@0	173	if (dstLocked) {
sl@0	174	FSpRstFLockCompat(&dstFileSpec);
sl@0	175	}
sl@0	176	}
sl@0	177	if (err == noErr) {
sl@0	178	if (srcIsDirectory) {
sl@0	179	if (dstIsDirectory) {
sl@0	180	/*
sl@0	181	* The following call will remove an empty directory. If it
sl@0	182	* fails, it's because it wasn't empty.
sl@0	183	*/
sl@0	184
sl@0	185	if (DoRemoveDirectory(dst, 0, NULL) != TCL_OK) {
sl@0	186	return TCL_ERROR;
sl@0	187	}
sl@0	188
sl@0	189	/*
sl@0	190	* Now that that empty directory is gone, we can try
sl@0	191	* renaming src. If that fails, we'll put this empty
sl@0	192	* directory back, for completeness.
sl@0	193	*/
sl@0	194
sl@0	195	err = MoveRename(&srcFileSpec, &dstDirSpec, dstFileSpec.name);
sl@0	196	if (err != noErr) {
sl@0	197	FSpDirCreateCompat(&dstFileSpec, smSystemScript, &dummy);
sl@0	198	if (dstLocked) {
sl@0	199	FSpSetFLockCompat(&dstFileSpec);
sl@0	200	}
sl@0	201	}
sl@0	202	} else {
sl@0	203	errno = ENOTDIR;
sl@0	204	return TCL_ERROR;
sl@0	205	}
sl@0	206	} else {
sl@0	207	if (dstIsDirectory) {
sl@0	208	errno = EISDIR;
sl@0	209	return TCL_ERROR;
sl@0	210	} else {
sl@0	211	/*
sl@0	212	* Overwrite existing file by:
sl@0	213	*
sl@0	214	* 1. Rename existing file to temp name.
sl@0	215	* 2. Rename old file to new name.
sl@0	216	* 3. If success, delete temp file. If failure,
sl@0	217	* put temp file back to old name.
sl@0	218	*/
sl@0	219
sl@0	220	Str31 tmpName;
sl@0	221	FSSpec tmpFileSpec;
sl@0	222
sl@0	223	err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed,
sl@0	224	dstFileSpec.parID, dstFileSpec.parID, tmpName);
sl@0	225	if (err == noErr) {
sl@0	226	err = FSpRenameCompat(&dstFileSpec, tmpName);
sl@0	227	}
sl@0	228	if (err == noErr) {
sl@0	229	err = FSMakeFSSpecCompat(dstFileSpec.vRefNum,
sl@0	230	dstFileSpec.parID, tmpName, &tmpFileSpec);
sl@0	231	}
sl@0	232	if (err == noErr) {
sl@0	233	err = MoveRename(&srcFileSpec, &dstDirSpec,
sl@0	234	dstFileSpec.name);
sl@0	235	}
sl@0	236	if (err == noErr) {
sl@0	237	FSpDeleteCompat(&tmpFileSpec);
sl@0	238	} else {
sl@0	239	FSpDeleteCompat(&dstFileSpec);
sl@0	240	FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
sl@0	241	if (dstLocked) {
sl@0	242	FSpSetFLockCompat(&dstFileSpec);
sl@0	243	}
sl@0	244	}
sl@0	245	}
sl@0	246	}
sl@0	247	}
sl@0	248
sl@0	249	end:
sl@0	250	if (err != noErr) {
sl@0	251	errno = TclMacOSErrorToPosixError(err);
sl@0	252	return TCL_ERROR;
sl@0	253	}
sl@0	254	return TCL_OK;
sl@0	255	}
sl@0	256
sl@0	257	/*
sl@0	258	*--------------------------------------------------------------------------
sl@0	259	*
sl@0	260	* MoveRename --
sl@0	261	*
sl@0	262	* Helper function for TclpRenameFile. Renames a file or directory
sl@0	263	* into the same directory or another directory. The target name
sl@0	264	* must not already exist in the destination directory.
sl@0	265	*
sl@0	266	* Don't use FSpMoveRenameCompat because it doesn't work with
sl@0	267	* directories or with locked files.
sl@0	268	*
sl@0	269	* Results:
sl@0	270	* Returns a mac error indicating the cause of the failure.
sl@0	271	*
sl@0	272	* Side effects:
sl@0	273	* Creates a temp file in the target directory to handle a rename
sl@0	274	* between directories.
sl@0	275	*
sl@0	276	*--------------------------------------------------------------------------
sl@0	277	*/
sl@0	278
sl@0	279	static OSErr
sl@0	280	MoveRename(
sl@0	281	const FSSpec srcFileSpecPtr, / Source object. */
sl@0	282	const FSSpec dstDirSpecPtr, / Destination directory. */
sl@0	283	StringPtr copyName) /* New name for object in destination
sl@0	284	* directory. */
sl@0	285	{
sl@0	286	OSErr err;
sl@0	287	long srcID, dstID;
sl@0	288	Boolean srcIsDir, dstIsDir;
sl@0	289	Str31 tmpName;
sl@0	290	FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
sl@0	291	Boolean locked;
sl@0	292
sl@0	293	if (srcFileSpecPtr->parID == 1) {
sl@0	294	/*
sl@0	295	* Trying to rename a volume.
sl@0	296	*/
sl@0	297
sl@0	298	return badMovErr;
sl@0	299	}
sl@0	300	if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
sl@0	301	/*
sl@0	302	* Renaming across volumes.
sl@0	303	*/
sl@0	304
sl@0	305	return diffVolErr;
sl@0	306	}
sl@0	307	err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
sl@0	308	if (locked) {
sl@0	309	FSpRstFLockCompat(srcFileSpecPtr);
sl@0	310	}
sl@0	311	if (err == noErr) {
sl@0	312	err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
sl@0	313	}
sl@0	314	if (err == noErr) {
sl@0	315	if (srcFileSpecPtr->parID == dstID) {
sl@0	316	/*
sl@0	317	* Renaming object within directory.
sl@0	318	*/
sl@0	319
sl@0	320	err = FSpRenameCompat(srcFileSpecPtr, copyName);
sl@0	321	goto done;
sl@0	322	}
sl@0	323	if (Pstrequal(srcFileSpecPtr->name, copyName)) {
sl@0	324	/*
sl@0	325	* Moving object to another directory (under same name).
sl@0	326	*/
sl@0	327
sl@0	328	err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
sl@0	329	goto done;
sl@0	330	}
sl@0	331	err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
sl@0	332	}
sl@0	333	if (err == noErr) {
sl@0	334	/*
sl@0	335	* Fullblown: rename source object to temp name, move temp to
sl@0	336	* dest directory, and rename temp to target.
sl@0	337	*/
sl@0	338
sl@0	339	err = GenerateUniqueName(srcFileSpecPtr->vRefNum, &startSeed,
sl@0	340	srcFileSpecPtr->parID, dstID, tmpName);
sl@0	341	FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
sl@0	342	tmpName, &tmpSrcFileSpec);
sl@0	343	FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
sl@0	344	&tmpDstFileSpec);
sl@0	345	}
sl@0	346	if (err == noErr) {
sl@0	347	err = FSpRenameCompat(srcFileSpecPtr, tmpName);
sl@0	348	}
sl@0	349	if (err == noErr) {
sl@0	350	err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
sl@0	351	if (err == noErr) {
sl@0	352	err = FSpRenameCompat(&tmpDstFileSpec, copyName);
sl@0	353	if (err == noErr) {
sl@0	354	goto done;
sl@0	355	}
sl@0	356	FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
sl@0	357	NULL, &srcDirSpec);
sl@0	358	FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
sl@0	359	}
sl@0	360	FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
sl@0	361	}
sl@0	362
sl@0	363	done:
sl@0	364	if (locked != false) {
sl@0	365	if (err == noErr) {
sl@0	366	FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum,
sl@0	367	dstID, copyName, &dstFileSpec);
sl@0	368	FSpSetFLockCompat(&dstFileSpec);
sl@0	369	} else {
sl@0	370	FSpSetFLockCompat(srcFileSpecPtr);
sl@0	371	}
sl@0	372	}
sl@0	373	return err;
sl@0	374	}
sl@0	375
sl@0	376	/*
sl@0	377	*---------------------------------------------------------------------------
sl@0	378	*
sl@0	379	* TclpObjCopyFile, DoCopyFile --
sl@0	380	*
sl@0	381	* Copy a single file (not a directory). If dst already exists and
sl@0	382	* is not a directory, it is removed.
sl@0	383	*
sl@0	384	* Results:
sl@0	385	* If the file was successfully copied, returns TCL_OK. Otherwise
sl@0	386	* the return value is TCL_ERROR and errno is set to indicate the
sl@0	387	* error. Some possible values for errno are:
sl@0	388	*
sl@0	389	* EACCES: src or dst parent directory can't be read and/or written.
sl@0	390	* EISDIR: src or dst is a directory.
sl@0	391	* ENOENT: src doesn't exist. src or dst is "".
sl@0	392	*
sl@0	393	* Side effects:
sl@0	394	* This procedure will also copy symbolic links, block, and
sl@0	395	* character devices, and fifos. For symbolic links, the links
sl@0	396	* themselves will be copied and not what they point to. For the
sl@0	397	* other special file types, the directory entry will be copied and
sl@0	398	* not the contents of the device that it refers to.
sl@0	399	*
sl@0	400	*---------------------------------------------------------------------------
sl@0	401	*/
sl@0	402
sl@0	403	int
sl@0	404	TclpObjCopyFile(srcPathPtr, destPathPtr)
sl@0	405	Tcl_Obj *srcPathPtr;
sl@0	406	Tcl_Obj *destPathPtr;
sl@0	407	{
sl@0	408	return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
sl@0	409	Tcl_FSGetNativePath(destPathPtr));
sl@0	410	}
sl@0	411
sl@0	412	static int
sl@0	413	DoCopyFile(
sl@0	414	CONST char src, / Pathname of file to be copied (native). */
sl@0	415	CONST char dst) / Pathname of file to copy to (native). */
sl@0	416	{
sl@0	417	OSErr err, dstErr;
sl@0	418	Boolean dstExists, dstIsDirectory, dstLocked;
sl@0	419	FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpFileSpec;
sl@0	420	Str31 tmpName;
sl@0	421
sl@0	422	err = FSpLLocationFromPath(strlen(src), src, &srcFileSpec);
sl@0	423	if (err == noErr) {
sl@0	424	err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
sl@0	425	&dstIsDirectory);
sl@0	426	}
sl@0	427	if (dstExists) {
sl@0	428	if (dstIsDirectory) {
sl@0	429	errno = EISDIR;
sl@0	430	return TCL_ERROR;
sl@0	431	}
sl@0	432	err = FSpGetFLockCompat(&dstFileSpec, &dstLocked);
sl@0	433	if (dstLocked) {
sl@0	434	FSpRstFLockCompat(&dstFileSpec);
sl@0	435	}
sl@0	436
sl@0	437	/*
sl@0	438	* Backup dest file.
sl@0	439	*/
sl@0	440
sl@0	441	dstErr = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID,
sl@0	442	dstFileSpec.parID, tmpName);
sl@0	443	if (dstErr == noErr) {
sl@0	444	dstErr = FSpRenameCompat(&dstFileSpec, tmpName);
sl@0	445	}
sl@0	446	}
sl@0	447	if (err == noErr) {
sl@0	448	err = FSpFileCopy(&srcFileSpec, &dstDirSpec,
sl@0	449	(StringPtr) dstFileSpec.name, NULL, 0, true);
sl@0	450	}
sl@0	451	if ((dstExists != false) && (dstErr == noErr)) {
sl@0	452	FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
sl@0	453	tmpName, &tmpFileSpec);
sl@0	454	if (err == noErr) {
sl@0	455	/*
sl@0	456	* Delete backup file.
sl@0	457	*/
sl@0	458
sl@0	459	FSpDeleteCompat(&tmpFileSpec);
sl@0	460	} else {
sl@0	461
sl@0	462	/*
sl@0	463	* Restore backup file.
sl@0	464	*/
sl@0	465
sl@0	466	FSpDeleteCompat(&dstFileSpec);
sl@0	467	FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
sl@0	468	if (dstLocked) {
sl@0	469	FSpSetFLockCompat(&dstFileSpec);
sl@0	470	}
sl@0	471	}
sl@0	472	}
sl@0	473
sl@0	474	if (err != noErr) {
sl@0	475	errno = TclMacOSErrorToPosixError(err);
sl@0	476	return TCL_ERROR;
sl@0	477	}
sl@0	478	return TCL_OK;
sl@0	479	}
sl@0	480
sl@0	481	/*
sl@0	482	*---------------------------------------------------------------------------
sl@0	483	*
sl@0	484	* TclpObjDeleteFile, TclpDeleteFile --
sl@0	485	*
sl@0	486	* Removes a single file (not a directory).
sl@0	487	*
sl@0	488	* Results:
sl@0	489	* If the file was successfully deleted, returns TCL_OK. Otherwise
sl@0	490	* the return value is TCL_ERROR and errno is set to indicate the
sl@0	491	* error. Some possible values for errno are:
sl@0	492	*
sl@0	493	* EACCES: a parent directory can't be read and/or written.
sl@0	494	* EISDIR: path is a directory.
sl@0	495	* ENOENT: path doesn't exist or is "".
sl@0	496	*
sl@0	497	* Side effects:
sl@0	498	* The file is deleted, even if it is read-only.
sl@0	499	*
sl@0	500	*---------------------------------------------------------------------------
sl@0	501	*/
sl@0	502
sl@0	503	int
sl@0	504	TclpObjDeleteFile(pathPtr)
sl@0	505	Tcl_Obj *pathPtr;
sl@0	506	{
sl@0	507	return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
sl@0	508	}
sl@0	509
sl@0	510	int
sl@0	511	TclpDeleteFile(
sl@0	512	CONST char path) / Pathname of file to be removed (native). */
sl@0	513	{
sl@0	514	OSErr err;
sl@0	515	FSSpec fileSpec;
sl@0	516	Boolean isDirectory;
sl@0	517	long dirID;
sl@0	518
sl@0	519	err = FSpLLocationFromPath(strlen(path), path, &fileSpec);
sl@0	520	if (err == noErr) {
sl@0	521	/*
sl@0	522	* Since FSpDeleteCompat will delete an empty directory, make sure
sl@0	523	* that this isn't a directory first.
sl@0	524	*/
sl@0	525
sl@0	526	FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	527	if (isDirectory == true) {
sl@0	528	errno = EISDIR;
sl@0	529	return TCL_ERROR;
sl@0	530	}
sl@0	531	}
sl@0	532	err = FSpDeleteCompat(&fileSpec);
sl@0	533	if (err == fLckdErr) {
sl@0	534	FSpRstFLockCompat(&fileSpec);
sl@0	535	err = FSpDeleteCompat(&fileSpec);
sl@0	536	if (err != noErr) {
sl@0	537	FSpSetFLockCompat(&fileSpec);
sl@0	538	}
sl@0	539	}
sl@0	540	if (err != noErr) {
sl@0	541	errno = TclMacOSErrorToPosixError(err);
sl@0	542	return TCL_ERROR;
sl@0	543	}
sl@0	544	return TCL_OK;
sl@0	545	}
sl@0	546
sl@0	547	/*
sl@0	548	*---------------------------------------------------------------------------
sl@0	549	*
sl@0	550	* TclpObjCreateDirectory, DoCreateDirectory --
sl@0	551	*
sl@0	552	* Creates the specified directory. All parent directories of the
sl@0	553	* specified directory must already exist. The directory is
sl@0	554	* automatically created with permissions so that user can access
sl@0	555	* the new directory and create new files or subdirectories in it.
sl@0	556	*
sl@0	557	* Results:
sl@0	558	* If the directory was successfully created, returns TCL_OK.
sl@0	559	* Otherwise the return value is TCL_ERROR and errno is set to
sl@0	560	* indicate the error. Some possible values for errno are:
sl@0	561	*
sl@0	562	* EACCES: a parent directory can't be read and/or written.
sl@0	563	* EEXIST: path already exists.
sl@0	564	* ENOENT: a parent directory doesn't exist.
sl@0	565	*
sl@0	566	* Side effects:
sl@0	567	* A directory is created with the current umask, except that
sl@0	568	* permission for u+rwx will always be added.
sl@0	569	*
sl@0	570	*---------------------------------------------------------------------------
sl@0	571	*/
sl@0	572
sl@0	573	int
sl@0	574	TclpObjCreateDirectory(pathPtr)
sl@0	575	Tcl_Obj *pathPtr;
sl@0	576	{
sl@0	577	return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
sl@0	578	}
sl@0	579
sl@0	580	static int
sl@0	581	DoCreateDirectory(
sl@0	582	CONST char path) / Pathname of directory to create (native). */
sl@0	583	{
sl@0	584	OSErr err;
sl@0	585	FSSpec dirSpec;
sl@0	586	long outDirID;
sl@0	587
sl@0	588	err = FSpLocationFromPath(strlen(path), path, &dirSpec);
sl@0	589	if (err == noErr) {
sl@0	590	err = dupFNErr; /* EEXIST. */
sl@0	591	} else if (err == fnfErr) {
sl@0	592	err = FSpDirCreateCompat(&dirSpec, smSystemScript, &outDirID);
sl@0	593	}
sl@0	594
sl@0	595	if (err != noErr) {
sl@0	596	errno = TclMacOSErrorToPosixError(err);
sl@0	597	return TCL_ERROR;
sl@0	598	}
sl@0	599	return TCL_OK;
sl@0	600	}
sl@0	601
sl@0	602	/*
sl@0	603	*---------------------------------------------------------------------------
sl@0	604	*
sl@0	605	* TclpObjCopyDirectory, DoCopyDirectory --
sl@0	606	*
sl@0	607	* Recursively copies a directory. The target directory dst must
sl@0	608	* not already exist. Note that this function does not merge two
sl@0	609	* directory hierarchies, even if the target directory is an an
sl@0	610	* empty directory.
sl@0	611	*
sl@0	612	* Results:
sl@0	613	* If the directory was successfully copied, returns TCL_OK.
sl@0	614	* Otherwise the return value is TCL_ERROR, errno is set to indicate
sl@0	615	* the error, and the pathname of the file that caused the error
sl@0	616	* is stored in errorPtr. See TclpCreateDirectory and TclpCopyFile
sl@0	617	* for a description of possible values for errno.
sl@0	618	*
sl@0	619	* Side effects:
sl@0	620	* An exact copy of the directory hierarchy src will be created
sl@0	621	* with the name dst. If an error occurs, the error will
sl@0	622	* be returned immediately, and remaining files will not be
sl@0	623	* processed.
sl@0	624	*
sl@0	625	*---------------------------------------------------------------------------
sl@0	626	*/
sl@0	627
sl@0	628	int
sl@0	629	TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
sl@0	630	Tcl_Obj *srcPathPtr;
sl@0	631	Tcl_Obj *destPathPtr;
sl@0	632	Tcl_Obj **errorPtr;
sl@0	633	{
sl@0	634	Tcl_DString ds;
sl@0	635	int ret;
sl@0	636	ret = DoCopyDirectory(Tcl_FSGetNativePath(srcPathPtr),
sl@0	637	Tcl_FSGetNativePath(destPathPtr), &ds);
sl@0	638	if (ret != TCL_OK) {
sl@0	639	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
sl@0	640	Tcl_DStringFree(&ds);
sl@0	641	Tcl_IncrRefCount(*errorPtr);
sl@0	642	}
sl@0	643	return ret;
sl@0	644	}
sl@0	645
sl@0	646	static int
sl@0	647	DoCopyDirectory(
sl@0	648	CONST char src, / Pathname of directory to be copied
sl@0	649	* (Native). */
sl@0	650	CONST char dst, / Pathname of target directory (Native). */
sl@0	651	Tcl_DString errorPtr) / If non-NULL, uninitialized or free
sl@0	652	* DString filled with UTF-8 name of file
sl@0	653	* causing error. */
sl@0	654	{
sl@0	655	OSErr err, saveErr;
sl@0	656	long srcID, tmpDirID;
sl@0	657	FSSpec srcFileSpec, dstFileSpec, dstDirSpec, tmpDirSpec, tmpFileSpec;
sl@0	658	Boolean srcIsDirectory, srcLocked;
sl@0	659	Boolean dstIsDirectory, dstExists;
sl@0	660	Str31 tmpName;
sl@0	661
sl@0	662	err = FSpLocationFromPath(strlen(src), src, &srcFileSpec);
sl@0	663	if (err == noErr) {
sl@0	664	err = FSpGetDirectoryID(&srcFileSpec, &srcID, &srcIsDirectory);
sl@0	665	}
sl@0	666	if (err == noErr) {
sl@0	667	if (srcIsDirectory == false) {
sl@0	668	err = afpObjectTypeErr; /* ENOTDIR. */
sl@0	669	}
sl@0	670	}
sl@0	671	if (err == noErr) {
sl@0	672	err = GetFileSpecs(dst, &dstFileSpec, &dstDirSpec, &dstExists,
sl@0	673	&dstIsDirectory);
sl@0	674	}
sl@0	675	if (dstExists) {
sl@0	676	if (dstIsDirectory == false) {
sl@0	677	err = afpObjectTypeErr; /* ENOTDIR. */
sl@0	678	} else {
sl@0	679	err = dupFNErr; /* EEXIST. */
sl@0	680	}
sl@0	681	}
sl@0	682	if (err != noErr) {
sl@0	683	goto done;
sl@0	684	}
sl@0	685	if ((srcFileSpec.vRefNum == dstFileSpec.vRefNum) &&
sl@0	686	(srcFileSpec.parID == dstFileSpec.parID) &&
sl@0	687	(Pstrequal(srcFileSpec.name, dstFileSpec.name) != 0)) {
sl@0	688	/*
sl@0	689	* Copying on top of self. No-op.
sl@0	690	*/
sl@0	691
sl@0	692	goto done;
sl@0	693	}
sl@0	694
sl@0	695	/*
sl@0	696	* This algorthm will work making a copy of the source directory in
sl@0	697	* the current directory with a new name, in a new directory with the
sl@0	698	* same name, and in a new directory with a new name:
sl@0	699	*
sl@0	700	* 1. Make dstDir/tmpDir.
sl@0	701	* 2. Copy srcDir/src to dstDir/tmpDir/src
sl@0	702	* 3. Rename dstDir/tmpDir/src to dstDir/tmpDir/dst (if necessary).
sl@0	703	* 4. CatMove dstDir/tmpDir/dst to dstDir/dst.
sl@0	704	* 5. Remove dstDir/tmpDir.
sl@0	705	*/
sl@0	706
sl@0	707	err = FSpGetFLockCompat(&srcFileSpec, &srcLocked);
sl@0	708	if (srcLocked) {
sl@0	709	FSpRstFLockCompat(&srcFileSpec);
sl@0	710	}
sl@0	711	if (err == noErr) {
sl@0	712	err = GenerateUniqueName(dstFileSpec.vRefNum, &startSeed, dstFileSpec.parID,
sl@0	713	dstFileSpec.parID, tmpName);
sl@0	714	}
sl@0	715	if (err == noErr) {
sl@0	716	FSMakeFSSpecCompat(dstFileSpec.vRefNum, dstFileSpec.parID,
sl@0	717	tmpName, &tmpDirSpec);
sl@0	718	err = FSpDirCreateCompat(&tmpDirSpec, smSystemScript, &tmpDirID);
sl@0	719	}
sl@0	720	if (err == noErr) {
sl@0	721	err = FSpDirectoryCopy(&srcFileSpec, &tmpDirSpec, NULL, NULL, 0, true,
sl@0	722	CopyErrHandler);
sl@0	723	}
sl@0	724
sl@0	725	/*
sl@0	726	* Even if the Copy failed, Rename/Move whatever did get copied to the
sl@0	727	* appropriate final destination, if possible.
sl@0	728	*/
sl@0	729
sl@0	730	saveErr = err;
sl@0	731	err = noErr;
sl@0	732	if (Pstrequal(srcFileSpec.name, dstFileSpec.name) == 0) {
sl@0	733	err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID,
sl@0	734	srcFileSpec.name, &tmpFileSpec);
sl@0	735	if (err == noErr) {
sl@0	736	err = FSpRenameCompat(&tmpFileSpec, dstFileSpec.name);
sl@0	737	}
sl@0	738	}
sl@0	739	if (err == noErr) {
sl@0	740	err = FSMakeFSSpecCompat(tmpDirSpec.vRefNum, tmpDirID,
sl@0	741	dstFileSpec.name, &tmpFileSpec);
sl@0	742	}
sl@0	743	if (err == noErr) {
sl@0	744	err = FSpCatMoveCompat(&tmpFileSpec, &dstDirSpec);
sl@0	745	}
sl@0	746	if (err == noErr) {
sl@0	747	if (srcLocked) {
sl@0	748	FSpSetFLockCompat(&dstFileSpec);
sl@0	749	}
sl@0	750	}
sl@0	751
sl@0	752	FSpDeleteCompat(&tmpDirSpec);
sl@0	753
sl@0	754	if (saveErr != noErr) {
sl@0	755	err = saveErr;
sl@0	756	}
sl@0	757
sl@0	758	done:
sl@0	759	if (err != noErr) {
sl@0	760	errno = TclMacOSErrorToPosixError(err);
sl@0	761	if (errorPtr != NULL) {
sl@0	762	Tcl_ExternalToUtfDString(NULL, dst, -1, errorPtr);
sl@0	763	}
sl@0	764	return TCL_ERROR;
sl@0	765	}
sl@0	766	return TCL_OK;
sl@0	767	}
sl@0	768
sl@0	769	/*
sl@0	770	*----------------------------------------------------------------------
sl@0	771	*
sl@0	772	* CopyErrHandler --
sl@0	773	*
sl@0	774	* This procedure is called from the MoreFiles procedure
sl@0	775	* FSpDirectoryCopy whenever an error occurs.
sl@0	776	*
sl@0	777	* Results:
sl@0	778	* False if the condition should not be considered an error, true
sl@0	779	* otherwise.
sl@0	780	*
sl@0	781	* Side effects:
sl@0	782	* Since FSpDirectoryCopy() is called only after removing any
sl@0	783	* existing target directories, there shouldn't be any errors.
sl@0	784	*
sl@0	785	*----------------------------------------------------------------------
sl@0	786	*/
sl@0	787
sl@0	788	static pascal Boolean
sl@0	789	CopyErrHandler(
sl@0	790	OSErr error, /* Error that occured */
sl@0	791	short failedOperation, /* operation that caused the error */
sl@0	792	short srcVRefNum, /* volume ref number of source */
sl@0	793	long srcDirID, /* directory id of source */
sl@0	794	ConstStr255Param srcName, /* name of source */
sl@0	795	short dstVRefNum, /* volume ref number of dst */
sl@0	796	long dstDirID, /* directory id of dst */
sl@0	797	ConstStr255Param dstName) /* name of dst directory */
sl@0	798	{
sl@0	799	return true;
sl@0	800	}
sl@0	801
sl@0	802	/*
sl@0	803	*---------------------------------------------------------------------------
sl@0	804	*
sl@0	805	* TclpObjRemoveDirectory, DoRemoveDirectory --
sl@0	806	*
sl@0	807	* Removes directory (and its contents, if the recursive flag is set).
sl@0	808	*
sl@0	809	* Results:
sl@0	810	* If the directory was successfully removed, returns TCL_OK.
sl@0	811	* Otherwise the return value is TCL_ERROR, errno is set to indicate
sl@0	812	* the error, and the pathname of the file that caused the error
sl@0	813	* is stored in errorPtr. Some possible values for errno are:
sl@0	814	*
sl@0	815	* EACCES: path directory can't be read and/or written.
sl@0	816	* EEXIST: path is a non-empty directory.
sl@0	817	* EINVAL: path is a root directory.
sl@0	818	* ENOENT: path doesn't exist or is "".
sl@0	819	* ENOTDIR: path is not a directory.
sl@0	820	*
sl@0	821	* Side effects:
sl@0	822	* Directory removed. If an error occurs, the error will be returned
sl@0	823	* immediately, and remaining files will not be deleted.
sl@0	824	*
sl@0	825	*---------------------------------------------------------------------------
sl@0	826	*/
sl@0	827
sl@0	828	int
sl@0	829	TclpObjRemoveDirectory(pathPtr, recursive, errorPtr)
sl@0	830	Tcl_Obj *pathPtr;
sl@0	831	int recursive;
sl@0	832	Tcl_Obj **errorPtr;
sl@0	833	{
sl@0	834	Tcl_DString ds;
sl@0	835	int ret;
sl@0	836	ret = DoRemoveDirectory(Tcl_FSGetNativePath(pathPtr),recursive, &ds);
sl@0	837	if (ret != TCL_OK) {
sl@0	838	*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
sl@0	839	Tcl_DStringFree(&ds);
sl@0	840	Tcl_IncrRefCount(*errorPtr);
sl@0	841	}
sl@0	842	return ret;
sl@0	843	}
sl@0	844
sl@0	845	static int
sl@0	846	DoRemoveDirectory(
sl@0	847	CONST char path, / Pathname of directory to be removed
sl@0	848	* (native). */
sl@0	849	int recursive, /* If non-zero, removes directories that
sl@0	850	* are nonempty. Otherwise, will only remove
sl@0	851	* empty directories. */
sl@0	852	Tcl_DString errorPtr) / If non-NULL, uninitialized or free
sl@0	853	* DString filled with UTF-8 name of file
sl@0	854	* causing error. */
sl@0	855	{
sl@0	856	OSErr err;
sl@0	857	FSSpec fileSpec;
sl@0	858	long dirID;
sl@0	859	int locked;
sl@0	860	Boolean isDirectory;
sl@0	861	CInfoPBRec pb;
sl@0	862	Str255 fileName;
sl@0	863
sl@0	864
sl@0	865	locked = 0;
sl@0	866	err = FSpLocationFromPath(strlen(path), path, &fileSpec);
sl@0	867	if (err != noErr) {
sl@0	868	goto done;
sl@0	869	}
sl@0	870
sl@0	871	/*
sl@0	872	* Since FSpDeleteCompat will delete a file, make sure this isn't
sl@0	873	* a file first.
sl@0	874	*/
sl@0	875
sl@0	876	isDirectory = 1;
sl@0	877	FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	878	if (isDirectory == 0) {
sl@0	879	errno = ENOTDIR;
sl@0	880	return TCL_ERROR;
sl@0	881	}
sl@0	882
sl@0	883	err = FSpDeleteCompat(&fileSpec);
sl@0	884	if (err == fLckdErr) {
sl@0	885	locked = 1;
sl@0	886	FSpRstFLockCompat(&fileSpec);
sl@0	887	err = FSpDeleteCompat(&fileSpec);
sl@0	888	}
sl@0	889	if (err == noErr) {
sl@0	890	return TCL_OK;
sl@0	891	}
sl@0	892	if (err != fBsyErr) {
sl@0	893	goto done;
sl@0	894	}
sl@0	895
sl@0	896	if (recursive == 0) {
sl@0	897	/*
sl@0	898	* fBsyErr means one of three things: file busy, directory not empty,
sl@0	899	* or working directory control block open. Determine if directory
sl@0	900	* is empty. If directory is not empty, return EEXIST.
sl@0	901	*/
sl@0	902
sl@0	903	pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
sl@0	904	pb.hFileInfo.ioDirID = dirID;
sl@0	905	pb.hFileInfo.ioNamePtr = (StringPtr) fileName;
sl@0	906	pb.hFileInfo.ioFDirIndex = 1;
sl@0	907	if (PBGetCatInfoSync(&pb) == noErr) {
sl@0	908	err = dupFNErr; /* EEXIST */
sl@0	909	goto done;
sl@0	910	}
sl@0	911	}
sl@0	912
sl@0	913	/*
sl@0	914	* DeleteDirectory removes a directory and all its contents, including
sl@0	915	* any locked files. There is no interface to get the name of the
sl@0	916	* file that caused the error, if an error occurs deleting this tree,
sl@0	917	* unless we rewrite DeleteDirectory ourselves.
sl@0	918	*/
sl@0	919
sl@0	920	err = DeleteDirectory(fileSpec.vRefNum, dirID, NULL);
sl@0	921
sl@0	922	done:
sl@0	923	if (err != noErr) {
sl@0	924	if (errorPtr != NULL) {
sl@0	925	Tcl_UtfToExternalDString(NULL, path, -1, errorPtr);
sl@0	926	}
sl@0	927	if (locked) {
sl@0	928	FSpSetFLockCompat(&fileSpec);
sl@0	929	}
sl@0	930	errno = TclMacOSErrorToPosixError(err);
sl@0	931	return TCL_ERROR;
sl@0	932	}
sl@0	933	return TCL_OK;
sl@0	934	}
sl@0	935
sl@0	936	/*
sl@0	937	*---------------------------------------------------------------------------
sl@0	938	*
sl@0	939	* GetFileSpecs --
sl@0	940	*
sl@0	941	* Gets FSSpecs for the specified path and its parent directory.
sl@0	942	*
sl@0	943	* Results:
sl@0	944	* The return value is noErr if there was no error getting FSSpecs,
sl@0	945	* otherwise it is an error describing the problem. Fills buffers
sl@0	946	* with information, as above.
sl@0	947	*
sl@0	948	* Side effects:
sl@0	949	* None.
sl@0	950	*
sl@0	951	*---------------------------------------------------------------------------
sl@0	952	*/
sl@0	953
sl@0	954	static OSErr
sl@0	955	GetFileSpecs(
sl@0	956	CONST char path, / The path to query. */
sl@0	957	FSSpec pathSpecPtr, / Filled with information about path. */
sl@0	958	FSSpec dirSpecPtr, / Filled with information about path's
sl@0	959	* parent directory. */
sl@0	960	Boolean pathExistsPtr, / Set to true if path actually exists,
sl@0	961	* false if it doesn't or there was an
sl@0	962	* error reading the specified path. */
sl@0	963	Boolean pathIsDirectoryPtr)/ Set to true if path is itself a directory,
sl@0	964	* otherwise false. */
sl@0	965	{
sl@0	966	CONST char *dirName;
sl@0	967	OSErr err;
sl@0	968	int argc;
sl@0	969	CONST char **argv;
sl@0	970	long d;
sl@0	971	Tcl_DString buffer;
sl@0	972
sl@0	973	*pathExistsPtr = false;
sl@0	974	*pathIsDirectoryPtr = false;
sl@0	975
sl@0	976	Tcl_DStringInit(&buffer);
sl@0	977	Tcl_SplitPath(path, &argc, &argv);
sl@0	978	if (argc == 1) {
sl@0	979	dirName = ":";
sl@0	980	} else {
sl@0	981	dirName = Tcl_JoinPath(argc - 1, argv, &buffer);
sl@0	982	}
sl@0	983	err = FSpLocationFromPath(strlen(dirName), dirName, dirSpecPtr);
sl@0	984	Tcl_DStringFree(&buffer);
sl@0	985	ckfree((char *) argv);
sl@0	986
sl@0	987	if (err == noErr) {
sl@0	988	err = FSpLocationFromPath(strlen(path), path, pathSpecPtr);
sl@0	989	if (err == noErr) {
sl@0	990	*pathExistsPtr = true;
sl@0	991	err = FSpGetDirectoryID(pathSpecPtr, &d, pathIsDirectoryPtr);
sl@0	992	} else if (err == fnfErr) {
sl@0	993	err = noErr;
sl@0	994	}
sl@0	995	}
sl@0	996	return err;
sl@0	997	}
sl@0	998
sl@0	999	/*
sl@0	1000	*-------------------------------------------------------------------------
sl@0	1001	*
sl@0	1002	* FSpGetFLockCompat --
sl@0	1003	*
sl@0	1004	* Determines if there exists a software lock on the specified
sl@0	1005	* file. The software lock could prevent the file from being
sl@0	1006	* renamed or moved.
sl@0	1007	*
sl@0	1008	* Results:
sl@0	1009	* Standard macintosh error code.
sl@0	1010	*
sl@0	1011	* Side effects:
sl@0	1012	* None.
sl@0	1013	*
sl@0	1014	*
sl@0	1015	*-------------------------------------------------------------------------
sl@0	1016	*/
sl@0	1017
sl@0	1018	OSErr
sl@0	1019	FSpGetFLockCompat(
sl@0	1020	const FSSpec specPtr, / File to query. */
sl@0	1021	Boolean lockedPtr) / Set to true if file is locked, false
sl@0	1022	* if it isn't or there was an error reading
sl@0	1023	* specified file. */
sl@0	1024	{
sl@0	1025	CInfoPBRec pb;
sl@0	1026	OSErr err;
sl@0	1027
sl@0	1028	pb.hFileInfo.ioVRefNum = specPtr->vRefNum;
sl@0	1029	pb.hFileInfo.ioDirID = specPtr->parID;
sl@0	1030	pb.hFileInfo.ioNamePtr = (StringPtr) specPtr->name;
sl@0	1031	pb.hFileInfo.ioFDirIndex = 0;
sl@0	1032
sl@0	1033	err = PBGetCatInfoSync(&pb);
sl@0	1034	if ((err == noErr) && (pb.hFileInfo.ioFlAttrib & 0x01)) {
sl@0	1035	*lockedPtr = true;
sl@0	1036	} else {
sl@0	1037	*lockedPtr = false;
sl@0	1038	}
sl@0	1039	return err;
sl@0	1040	}
sl@0	1041
sl@0	1042	/*
sl@0	1043	*----------------------------------------------------------------------
sl@0	1044	*
sl@0	1045	* Pstrequal --
sl@0	1046	*
sl@0	1047	* Pascal string compare.
sl@0	1048	*
sl@0	1049	* Results:
sl@0	1050	* Returns 1 if strings equal, 0 otherwise.
sl@0	1051	*
sl@0	1052	* Side effects:
sl@0	1053	* None.
sl@0	1054	*
sl@0	1055	*----------------------------------------------------------------------
sl@0	1056	*/
sl@0	1057
sl@0	1058	static int
sl@0	1059	Pstrequal (
sl@0	1060	ConstStr255Param stringA, /* Pascal string A */
sl@0	1061	ConstStr255Param stringB) /* Pascal string B */
sl@0	1062	{
sl@0	1063	int i, len;
sl@0	1064
sl@0	1065	len = *stringA;
sl@0	1066	for (i = 0; i <= len; i++) {
sl@0	1067	if (stringA++ != stringB++) {
sl@0	1068	return 0;
sl@0	1069	}
sl@0	1070	}
sl@0	1071	return 1;
sl@0	1072	}
sl@0	1073
sl@0	1074	/*
sl@0	1075	*----------------------------------------------------------------------
sl@0	1076	*
sl@0	1077	* GetFileFinderAttributes --
sl@0	1078	*
sl@0	1079	* Returns a Tcl_Obj containing the value of a file attribute
sl@0	1080	* which is part of the FInfo record. Which attribute is controlled
sl@0	1081	* by objIndex.
sl@0	1082	*
sl@0	1083	* Results:
sl@0	1084	* Returns a standard TCL error. If the return value is TCL_OK,
sl@0	1085	* the new creator or file type object is put into attributePtrPtr.
sl@0	1086	* The object will have ref count 0. If there is an error,
sl@0	1087	* attributePtrPtr is not touched.
sl@0	1088	*
sl@0	1089	* Side effects:
sl@0	1090	* A new object is allocated if the file is valid.
sl@0	1091	*
sl@0	1092	*----------------------------------------------------------------------
sl@0	1093	*/
sl@0	1094
sl@0	1095	static int
sl@0	1096	GetFileFinderAttributes(
sl@0	1097	Tcl_Interp interp, / The interp to report errors with. */
sl@0	1098	int objIndex, /* The index of the attribute option. */
sl@0	1099	Tcl_Obj fileName, / The name of the file (UTF-8). */
sl@0	1100	Tcl_Obj *attributePtrPtr) / A pointer to return the object with. */
sl@0	1101	{
sl@0	1102	OSErr err;
sl@0	1103	FSSpec fileSpec;
sl@0	1104	FInfo finfo;
sl@0	1105	CONST char *native;
sl@0	1106
sl@0	1107	native=Tcl_FSGetNativePath(fileName);
sl@0	1108	err = FSpLLocationFromPath(strlen(native),
sl@0	1109	native, &fileSpec);
sl@0	1110
sl@0	1111	if (err == noErr) {
sl@0	1112	err = FSpGetFInfo(&fileSpec, &finfo);
sl@0	1113	}
sl@0	1114
sl@0	1115	if (err == noErr) {
sl@0	1116	switch (objIndex) {
sl@0	1117	case MAC_CREATOR_ATTRIBUTE:
sl@0	1118	*attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdCreator);
sl@0	1119	break;
sl@0	1120	case MAC_HIDDEN_ATTRIBUTE:
sl@0	1121	*attributePtrPtr = Tcl_NewBooleanObj(finfo.fdFlags
sl@0	1122	& kIsInvisible);
sl@0	1123	break;
sl@0	1124	case MAC_TYPE_ATTRIBUTE:
sl@0	1125	*attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType);
sl@0	1126	break;
sl@0	1127	}
sl@0	1128	} else if (err == fnfErr) {
sl@0	1129	long dirID;
sl@0	1130	Boolean isDirectory = 0;
sl@0	1131
sl@0	1132	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	1133	if ((err == noErr) && isDirectory) {
sl@0	1134	if (objIndex == MAC_HIDDEN_ATTRIBUTE) {
sl@0	1135	*attributePtrPtr = Tcl_NewBooleanObj(0);
sl@0	1136	} else {
sl@0	1137	*attributePtrPtr = Tcl_NewOSTypeObj('Fldr');
sl@0	1138	}
sl@0	1139	}
sl@0	1140	}
sl@0	1141
sl@0	1142	if (err != noErr) {
sl@0	1143	errno = TclMacOSErrorToPosixError(err);
sl@0	1144	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
sl@0	1145	"could not read \"", Tcl_GetString(fileName), "\": ",
sl@0	1146	Tcl_PosixError(interp), (char *) NULL);
sl@0	1147	return TCL_ERROR;
sl@0	1148	}
sl@0	1149	return TCL_OK;
sl@0	1150	}
sl@0	1151
sl@0	1152	/*
sl@0	1153	*----------------------------------------------------------------------
sl@0	1154	*
sl@0	1155	* GetFileReadOnly --
sl@0	1156	*
sl@0	1157	* Returns a Tcl_Obj containing a Boolean value indicating whether
sl@0	1158	* or not the file is read-only. The object will have ref count 0.
sl@0	1159	* This procedure just checks the Finder attributes; it does not
sl@0	1160	* check AppleShare sharing attributes.
sl@0	1161	*
sl@0	1162	* Results:
sl@0	1163	* Returns a standard TCL error. If the return value is TCL_OK,
sl@0	1164	* the new creator type object is put into readOnlyPtrPtr.
sl@0	1165	* If there is an error, readOnlyPtrPtr is not touched.
sl@0	1166	*
sl@0	1167	* Side effects:
sl@0	1168	* A new object is allocated if the file is valid.
sl@0	1169	*
sl@0	1170	*----------------------------------------------------------------------
sl@0	1171	*/
sl@0	1172
sl@0	1173	static int
sl@0	1174	GetFileReadOnly(
sl@0	1175	Tcl_Interp interp, / The interp to report errors with. */
sl@0	1176	int objIndex, /* The index of the attribute. */
sl@0	1177	Tcl_Obj fileName, / The name of the file (UTF-8). */
sl@0	1178	Tcl_Obj *readOnlyPtrPtr) / A pointer to return the object with. */
sl@0	1179	{
sl@0	1180	OSErr err;
sl@0	1181	FSSpec fileSpec;
sl@0	1182	CInfoPBRec paramBlock;
sl@0	1183	CONST char *native;
sl@0	1184
sl@0	1185	native=Tcl_FSGetNativePath(fileName);
sl@0	1186	err = FSpLLocationFromPath(strlen(native),
sl@0	1187	native, &fileSpec);
sl@0	1188
sl@0	1189	if (err == noErr) {
sl@0	1190	if (err == noErr) {
sl@0	1191	paramBlock.hFileInfo.ioCompletion = NULL;
sl@0	1192	paramBlock.hFileInfo.ioNamePtr = fileSpec.name;
sl@0	1193	paramBlock.hFileInfo.ioVRefNum = fileSpec.vRefNum;
sl@0	1194	paramBlock.hFileInfo.ioFDirIndex = 0;
sl@0	1195	paramBlock.hFileInfo.ioDirID = fileSpec.parID;
sl@0	1196	err = PBGetCatInfo(&paramBlock, 0);
sl@0	1197	if (err == noErr) {
sl@0	1198
sl@0	1199	/*
sl@0	1200	* For some unknown reason, the Mac does not give
sl@0	1201	* symbols for the bits in the ioFlAttrib field.
sl@0	1202	* 1 -> locked.
sl@0	1203	*/
sl@0	1204
sl@0	1205	*readOnlyPtrPtr = Tcl_NewBooleanObj(
sl@0	1206	paramBlock.hFileInfo.ioFlAttrib & 1);
sl@0	1207	}
sl@0	1208	}
sl@0	1209	}
sl@0	1210	if (err != noErr) {
sl@0	1211	errno = TclMacOSErrorToPosixError(err);
sl@0	1212	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
sl@0	1213	"could not read \"", Tcl_GetString(fileName), "\": ",
sl@0	1214	Tcl_PosixError(interp), (char *) NULL);
sl@0	1215	return TCL_ERROR;
sl@0	1216	}
sl@0	1217	return TCL_OK;
sl@0	1218	}
sl@0	1219
sl@0	1220	/*
sl@0	1221	*----------------------------------------------------------------------
sl@0	1222	*
sl@0	1223	* SetFileFinderAttributes --
sl@0	1224	*
sl@0	1225	* Sets the file to the creator or file type given by attributePtr.
sl@0	1226	* objIndex determines whether the creator or file type is set.
sl@0	1227	*
sl@0	1228	* Results:
sl@0	1229	* Returns a standard TCL error.
sl@0	1230	*
sl@0	1231	* Side effects:
sl@0	1232	* The file's attribute is set.
sl@0	1233	*
sl@0	1234	*----------------------------------------------------------------------
sl@0	1235	*/
sl@0	1236
sl@0	1237	static int
sl@0	1238	SetFileFinderAttributes(
sl@0	1239	Tcl_Interp interp, / The interp to report errors with. */
sl@0	1240	int objIndex, /* The index of the attribute. */
sl@0	1241	Tcl_Obj fileName, / The name of the file (UTF-8). */
sl@0	1242	Tcl_Obj attributePtr) / The command line object. */
sl@0	1243	{
sl@0	1244	OSErr err;
sl@0	1245	FSSpec fileSpec;
sl@0	1246	FInfo finfo;
sl@0	1247	CONST char *native;
sl@0	1248
sl@0	1249	native=Tcl_FSGetNativePath(fileName);
sl@0	1250	err = FSpLLocationFromPath(strlen(native),
sl@0	1251	native, &fileSpec);
sl@0	1252
sl@0	1253	if (err == noErr) {
sl@0	1254	err = FSpGetFInfo(&fileSpec, &finfo);
sl@0	1255	}
sl@0	1256
sl@0	1257	if (err == noErr) {
sl@0	1258	switch (objIndex) {
sl@0	1259	case MAC_CREATOR_ATTRIBUTE:
sl@0	1260	if (Tcl_GetOSTypeFromObj(interp, attributePtr,
sl@0	1261	&finfo.fdCreator) != TCL_OK) {
sl@0	1262	return TCL_ERROR;
sl@0	1263	}
sl@0	1264	break;
sl@0	1265	case MAC_HIDDEN_ATTRIBUTE: {
sl@0	1266	int hidden;
sl@0	1267
sl@0	1268	if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
sl@0	1269	!= TCL_OK) {
sl@0	1270	return TCL_ERROR;
sl@0	1271	}
sl@0	1272	if (hidden) {
sl@0	1273	finfo.fdFlags \|= kIsInvisible;
sl@0	1274	} else {
sl@0	1275	finfo.fdFlags &= ~kIsInvisible;
sl@0	1276	}
sl@0	1277	break;
sl@0	1278	}
sl@0	1279	case MAC_TYPE_ATTRIBUTE:
sl@0	1280	if (Tcl_GetOSTypeFromObj(interp, attributePtr,
sl@0	1281	&finfo.fdType) != TCL_OK) {
sl@0	1282	return TCL_ERROR;
sl@0	1283	}
sl@0	1284	break;
sl@0	1285	}
sl@0	1286	err = FSpSetFInfo(&fileSpec, &finfo);
sl@0	1287	} else if (err == fnfErr) {
sl@0	1288	long dirID;
sl@0	1289	Boolean isDirectory = 0;
sl@0	1290
sl@0	1291	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	1292	if ((err == noErr) && isDirectory) {
sl@0	1293	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
sl@0	1294	Tcl_AppendStringsToObj(resultPtr, "cannot set ",
sl@0	1295	tclpFileAttrStrings[objIndex], ": \"",
sl@0	1296	Tcl_GetString(fileName), "\" is a directory", (char *) NULL);
sl@0	1297	return TCL_ERROR;
sl@0	1298	}
sl@0	1299	}
sl@0	1300
sl@0	1301	if (err != noErr) {
sl@0	1302	errno = TclMacOSErrorToPosixError(err);
sl@0	1303	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
sl@0	1304	"could not read \"", Tcl_GetString(fileName), "\": ",
sl@0	1305	Tcl_PosixError(interp), (char *) NULL);
sl@0	1306	return TCL_ERROR;
sl@0	1307	}
sl@0	1308	return TCL_OK;
sl@0	1309	}
sl@0	1310
sl@0	1311	/*
sl@0	1312	*----------------------------------------------------------------------
sl@0	1313	*
sl@0	1314	* SetFileReadOnly --
sl@0	1315	*
sl@0	1316	* Sets the file to be read-only according to the Boolean value
sl@0	1317	* given by hiddenPtr.
sl@0	1318	*
sl@0	1319	* Results:
sl@0	1320	* Returns a standard TCL error.
sl@0	1321	*
sl@0	1322	* Side effects:
sl@0	1323	* The file's attribute is set.
sl@0	1324	*
sl@0	1325	*----------------------------------------------------------------------
sl@0	1326	*/
sl@0	1327
sl@0	1328	static int
sl@0	1329	SetFileReadOnly(
sl@0	1330	Tcl_Interp interp, / The interp to report errors with. */
sl@0	1331	int objIndex, /* The index of the attribute. */
sl@0	1332	Tcl_Obj fileName, / The name of the file (UTF-8). */
sl@0	1333	Tcl_Obj readOnlyPtr) / The command line object. */
sl@0	1334	{
sl@0	1335	OSErr err;
sl@0	1336	FSSpec fileSpec;
sl@0	1337	HParamBlockRec paramBlock;
sl@0	1338	int hidden;
sl@0	1339	CONST char *native;
sl@0	1340
sl@0	1341	native=Tcl_FSGetNativePath(fileName);
sl@0	1342	err = FSpLLocationFromPath(strlen(native),
sl@0	1343	native, &fileSpec);
sl@0	1344
sl@0	1345	if (err == noErr) {
sl@0	1346	if (Tcl_GetBooleanFromObj(interp, readOnlyPtr, &hidden) != TCL_OK) {
sl@0	1347	return TCL_ERROR;
sl@0	1348	}
sl@0	1349
sl@0	1350	paramBlock.fileParam.ioCompletion = NULL;
sl@0	1351	paramBlock.fileParam.ioNamePtr = fileSpec.name;
sl@0	1352	paramBlock.fileParam.ioVRefNum = fileSpec.vRefNum;
sl@0	1353	paramBlock.fileParam.ioDirID = fileSpec.parID;
sl@0	1354	if (hidden) {
sl@0	1355	err = PBHSetFLock(&paramBlock, 0);
sl@0	1356	} else {
sl@0	1357	err = PBHRstFLock(&paramBlock, 0);
sl@0	1358	}
sl@0	1359	}
sl@0	1360
sl@0	1361	if (err == fnfErr) {
sl@0	1362	long dirID;
sl@0	1363	Boolean isDirectory = 0;
sl@0	1364	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	1365	if ((err == noErr) && isDirectory) {
sl@0	1366	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
sl@0	1367	"cannot set a directory to read-only when File Sharing is turned off",
sl@0	1368	(char *) NULL);
sl@0	1369	return TCL_ERROR;
sl@0	1370	} else {
sl@0	1371	err = fnfErr;
sl@0	1372	}
sl@0	1373	}
sl@0	1374
sl@0	1375	if (err != noErr) {
sl@0	1376	errno = TclMacOSErrorToPosixError(err);
sl@0	1377	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
sl@0	1378	"could not read \"", Tcl_GetString(fileName), "\": ",
sl@0	1379	Tcl_PosixError(interp), (char *) NULL);
sl@0	1380	return TCL_ERROR;
sl@0	1381	}
sl@0	1382	return TCL_OK;
sl@0	1383	}
sl@0	1384
sl@0	1385	/*
sl@0	1386	*---------------------------------------------------------------------------
sl@0	1387	*
sl@0	1388	* TclpObjListVolumes --
sl@0	1389	*
sl@0	1390	* Lists the currently mounted volumes
sl@0	1391	*
sl@0	1392	* Results:
sl@0	1393	* The list of volumes.
sl@0	1394	*
sl@0	1395	* Side effects:
sl@0	1396	* None
sl@0	1397	*
sl@0	1398	*---------------------------------------------------------------------------
sl@0	1399	*/
sl@0	1400	Tcl_Obj*
sl@0	1401	TclpObjListVolumes(void)
sl@0	1402	{
sl@0	1403	HParamBlockRec pb;
sl@0	1404	Str255 name;
sl@0	1405	OSErr theError = noErr;
sl@0	1406	Tcl_Obj resultPtr, elemPtr;
sl@0	1407	short volIndex = 1;
sl@0	1408	Tcl_DString dstr;
sl@0	1409
sl@0	1410	resultPtr = Tcl_NewObj();
sl@0	1411
sl@0	1412	/*
sl@0	1413	* We use two facts:
sl@0	1414	* 1) The Mac volumes are enumerated by the ioVolIndex parameter of
sl@0	1415	* the HParamBlockRec. They run through the integers contiguously,
sl@0	1416	* starting at 1.
sl@0	1417	* 2) PBHGetVInfoSync returns an error when you ask for a volume index
sl@0	1418	* that does not exist.
sl@0	1419	*
sl@0	1420	*/
sl@0	1421
sl@0	1422	while ( 1 ) {
sl@0	1423	pb.volumeParam.ioNamePtr = (StringPtr) &name;
sl@0	1424	pb.volumeParam.ioVolIndex = volIndex;
sl@0	1425
sl@0	1426	theError = PBHGetVInfoSync(&pb);
sl@0	1427
sl@0	1428	if ( theError != noErr ) {
sl@0	1429	break;
sl@0	1430	}
sl@0	1431
sl@0	1432	Tcl_ExternalToUtfDString(NULL, (CONST char *)&name[1], name[0], &dstr);
sl@0	1433	elemPtr = Tcl_NewStringObj(Tcl_DStringValue(&dstr),
sl@0	1434	Tcl_DStringLength(&dstr));
sl@0	1435	Tcl_AppendToObj(elemPtr, ":", 1);
sl@0	1436	Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
sl@0	1437
sl@0	1438	Tcl_DStringFree(&dstr);
sl@0	1439
sl@0	1440	volIndex++;
sl@0	1441	}
sl@0	1442
sl@0	1443	Tcl_IncrRefCount(resultPtr);
sl@0	1444	return resultPtr;
sl@0	1445	}
sl@0	1446
sl@0	1447	/*
sl@0	1448	*---------------------------------------------------------------------------
sl@0	1449	*
sl@0	1450	* TclpObjNormalizePath --
sl@0	1451	*
sl@0	1452	* This function scans through a path specification and replaces
sl@0	1453	* it, in place, with a normalized version. On MacOS, this means
sl@0	1454	* resolving all aliases present in the path and replacing the head of
sl@0	1455	* pathPtr with the absolute case-sensitive path to the last file or
sl@0	1456	* directory that could be validated in the path.
sl@0	1457	*
sl@0	1458	* Results:
sl@0	1459	* The new 'nextCheckpoint' value, giving as far as we could
sl@0	1460	* understand in the path.
sl@0	1461	*
sl@0	1462	* Side effects:
sl@0	1463	* The pathPtr string, which must contain a valid path, is
sl@0	1464	* possibly modified in place.
sl@0	1465	*
sl@0	1466	*---------------------------------------------------------------------------
sl@0	1467	*/
sl@0	1468
sl@0	1469	int
sl@0	1470	TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
sl@0	1471	Tcl_Interp *interp;
sl@0	1472	Tcl_Obj *pathPtr;
sl@0	1473	int nextCheckpoint;
sl@0	1474	{
sl@0	1475	#define MAXMACFILENAMELEN 31 /* assumed to be < sizeof(StrFileName) */
sl@0	1476
sl@0	1477	StrFileName fileName;
sl@0	1478	StringPtr fileNamePtr;
sl@0	1479	int fileNameLen,newPathLen;
sl@0	1480	Handle newPathHandle;
sl@0	1481	OSErr err;
sl@0	1482	short vRefNum;
sl@0	1483	long dirID;
sl@0	1484	Boolean isDirectory;
sl@0	1485	Boolean wasAlias=FALSE;
sl@0	1486	FSSpec fileSpec, lastFileSpec;
sl@0	1487
sl@0	1488	Tcl_DString nativeds;
sl@0	1489
sl@0	1490	char cur;
sl@0	1491	int firstCheckpoint=nextCheckpoint, lastCheckpoint;
sl@0	1492	int origPathLen;
sl@0	1493	char *path = Tcl_GetStringFromObj(pathPtr,&origPathLen);
sl@0	1494
sl@0	1495	{
sl@0	1496	int currDirValid=0;
sl@0	1497	/*
sl@0	1498	* check if substring to first ':' after initial
sl@0	1499	* nextCheckpoint is a valid relative or absolute
sl@0	1500	* path to a directory, if not we return without
sl@0	1501	* normalizing anything
sl@0	1502	*/
sl@0	1503
sl@0	1504	while (1) {
sl@0	1505	cur = path[nextCheckpoint];
sl@0	1506	if (cur == ':' \|\| cur == 0) {
sl@0	1507	if (cur == ':') {
sl@0	1508	/* jump over separator */
sl@0	1509	nextCheckpoint++; cur = path[nextCheckpoint];
sl@0	1510	}
sl@0	1511	Tcl_UtfToExternalDString(NULL,path,nextCheckpoint,&nativeds);
sl@0	1512	err = FSpLLocationFromPath(Tcl_DStringLength(&nativeds),
sl@0	1513	Tcl_DStringValue(&nativeds),
sl@0	1514	&fileSpec);
sl@0	1515	Tcl_DStringFree(&nativeds);
sl@0	1516	if (err == noErr) {
sl@0	1517	lastFileSpec=fileSpec;
sl@0	1518	err = ResolveAliasFile(&fileSpec, true, &isDirectory,
sl@0	1519	&wasAlias);
sl@0	1520	if (err == noErr) {
sl@0	1521	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	1522	currDirValid = ((err == noErr) && isDirectory);
sl@0	1523	vRefNum = fileSpec.vRefNum;
sl@0	1524	}
sl@0	1525	}
sl@0	1526	break;
sl@0	1527	}
sl@0	1528	nextCheckpoint++;
sl@0	1529	}
sl@0	1530
sl@0	1531	if(!currDirValid) {
sl@0	1532	/* can't determine root dir, bail out */
sl@0	1533	return firstCheckpoint;
sl@0	1534	}
sl@0	1535	}
sl@0	1536
sl@0	1537	/*
sl@0	1538	* Now vRefNum and dirID point to a valid
sl@0	1539	* directory, so walk the rest of the path
sl@0	1540	* ( code adapted from FSpLocationFromPath() )
sl@0	1541	*/
sl@0	1542
sl@0	1543	lastCheckpoint=nextCheckpoint;
sl@0	1544	while (1) {
sl@0	1545	cur = path[nextCheckpoint];
sl@0	1546	if (cur == ':' \|\| cur == 0) {
sl@0	1547	fileNameLen=nextCheckpoint-lastCheckpoint;
sl@0	1548	fileNamePtr=fileName;
sl@0	1549	if(fileNameLen==0) {
sl@0	1550	if (cur == ':') {
sl@0	1551	/*
sl@0	1552	* special case for empty dirname i.e. encountered
sl@0	1553	* a '::' path component: get parent dir of currDir
sl@0	1554	*/
sl@0	1555	fileName[0]=2;
sl@0	1556	strcpy((char *) fileName + 1, "::");
sl@0	1557	lastCheckpoint--;
sl@0	1558	} else {
sl@0	1559	/*
sl@0	1560	* empty filename, i.e. want FSSpec for currDir
sl@0	1561	*/
sl@0	1562	fileNamePtr=NULL;
sl@0	1563	}
sl@0	1564	} else {
sl@0	1565	Tcl_UtfToExternalDString(NULL,&path[lastCheckpoint],
sl@0	1566	fileNameLen,&nativeds);
sl@0	1567	fileNameLen=Tcl_DStringLength(&nativeds);
sl@0	1568	if(fileNameLen > MAXMACFILENAMELEN) {
sl@0	1569	err = bdNamErr;
sl@0	1570	} else {
sl@0	1571	fileName[0]=fileNameLen;
sl@0	1572	strncpy((char *) fileName + 1, Tcl_DStringValue(&nativeds),
sl@0	1573	fileNameLen);
sl@0	1574	}
sl@0	1575	Tcl_DStringFree(&nativeds);
sl@0	1576	}
sl@0	1577	if(err == noErr)
sl@0	1578	err=FSMakeFSSpecCompat(vRefNum, dirID, fileNamePtr, &fileSpec);
sl@0	1579	if(err != noErr) {
sl@0	1580	if(err != fnfErr) {
sl@0	1581	/*
sl@0	1582	* this can occur if trying to get parent of a root
sl@0	1583	* volume via '::' or when using an illegal
sl@0	1584	* filename; revert to last checkpoint and stop
sl@0	1585	* processing path further
sl@0	1586	*/
sl@0	1587	err=FSMakeFSSpecCompat(vRefNum, dirID, NULL, &fileSpec);
sl@0	1588	if(err != noErr) {
sl@0	1589	/* should never happen, bail out */
sl@0	1590	return firstCheckpoint;
sl@0	1591	}
sl@0	1592	nextCheckpoint=lastCheckpoint;
sl@0	1593	cur = path[lastCheckpoint];
sl@0	1594	}
sl@0	1595	break; /* arrived at nonexistent file or dir */
sl@0	1596	} else {
sl@0	1597	/* fileSpec could point to an alias, resolve it */
sl@0	1598	lastFileSpec=fileSpec;
sl@0	1599	err = ResolveAliasFile(&fileSpec, true, &isDirectory,
sl@0	1600	&wasAlias);
sl@0	1601	if (err != noErr \|\| !isDirectory) {
sl@0	1602	break; /* fileSpec doesn't point to a dir */
sl@0	1603	}
sl@0	1604	}
sl@0	1605	if (cur == 0) break; /* arrived at end of path */
sl@0	1606
sl@0	1607	/* fileSpec points to possibly nonexisting subdirectory; validate */
sl@0	1608	err = FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
sl@0	1609	if (err != noErr \|\| !isDirectory) {
sl@0	1610	break; /* fileSpec doesn't point to existing dir */
sl@0	1611	}
sl@0	1612	vRefNum = fileSpec.vRefNum;
sl@0	1613
sl@0	1614	/* found a new valid subdir in path, continue processing path */
sl@0	1615	lastCheckpoint=nextCheckpoint+1;
sl@0	1616	}
sl@0	1617	wasAlias=FALSE;
sl@0	1618	nextCheckpoint++;
sl@0	1619	}
sl@0	1620
sl@0	1621	if (wasAlias)
sl@0	1622	fileSpec=lastFileSpec;
sl@0	1623
sl@0	1624	/*
sl@0	1625	* fileSpec now points to a possibly nonexisting file or dir
sl@0	1626	* inside a valid dir; get full path name to it
sl@0	1627	*/
sl@0	1628
sl@0	1629	err=FSpPathFromLocation(&fileSpec, &newPathLen, &newPathHandle);
sl@0	1630	if(err != noErr) {
sl@0	1631	return firstCheckpoint; /* should not see any errors here, bail out */
sl@0	1632	}
sl@0	1633
sl@0	1634	HLock(newPathHandle);
sl@0	1635	Tcl_ExternalToUtfDString(NULL,*newPathHandle,newPathLen,&nativeds);
sl@0	1636	if (cur != 0) {
sl@0	1637	/* not at end, append remaining path */
sl@0	1638	if ( newPathLen==0 \|\| ((newPathHandle+(newPathLen-1))!=':' && path[nextCheckpoint] !=':')) {
sl@0	1639	Tcl_DStringAppend(&nativeds, ":" , 1);
sl@0	1640	}
sl@0	1641	Tcl_DStringAppend(&nativeds, &path[nextCheckpoint],
sl@0	1642	strlen(&path[nextCheckpoint]));
sl@0	1643	}
sl@0	1644	DisposeHandle(newPathHandle);
sl@0	1645
sl@0	1646	fileNameLen=Tcl_DStringLength(&nativeds);
sl@0	1647	Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&nativeds),fileNameLen);
sl@0	1648	Tcl_DStringFree(&nativeds);
sl@0	1649
sl@0	1650	return nextCheckpoint+(fileNameLen-origPathLen);
sl@0	1651	}
sl@0	1652

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