sl@0: /* 
sl@0:  * tclUnixFile.c --
sl@0:  *
sl@0:  *      This file contains wrappers around UNIX file handling functions.
sl@0:  *      These wrappers mask differences between Windows and UNIX.
sl@0:  *
sl@0:  * Copyright (c) 1995-1998 Sun Microsystems, Inc.
sl@0:  * Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved.   
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclUnixFile.c,v 1.32.2.2 2003/10/31 08:46:41 vincentdarley Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclInt.h"
sl@0: #include "tclPort.h"
sl@0: #if defined(__SYMBIAN32__) 
sl@0: #include "convertPathSlashes.h"
sl@0: #include "tclSymbianGlobals.h"
sl@0: #endif 
sl@0: 
sl@0: static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFindExecutable --
sl@0:  *
sl@0:  *	This procedure computes the absolute path name of the current
sl@0:  *	application, given its argv[0] value.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A dirty UTF string that is the path to the executable.  At this
sl@0:  *	point we may not know the system encoding.  Convert the native
sl@0:  *	string value to UTF using the default encoding.  The assumption
sl@0:  *	is that we will still be able to parse the path given the path
sl@0:  *	name contains ASCII string and '/' chars do not conflict with
sl@0:  *	other UTF chars.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The variable tclNativeExecutableName gets filled in with the file
sl@0:  *	name for the application, if we figured it out.  If we couldn't
sl@0:  *	figure it out, tclNativeExecutableName is set to NULL.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: char *
sl@0: TclpFindExecutable(argv0)
sl@0:     CONST char *argv0;		/* The value of the application's argv[0]
sl@0: 				 * (native). */
sl@0: {
sl@0:     CONST char *name, *p;
sl@0:     Tcl_StatBuf statBuf;
sl@0:     int length;
sl@0:     Tcl_DString buffer, nameString;
sl@0: #ifdef __SYMBIAN32__     
sl@0:     char bufferUsed;
sl@0: #endif
sl@0: 
sl@0:     if (argv0 == NULL) {
sl@0: 	return NULL;
sl@0:     }
sl@0:     if (tclNativeExecutableName != NULL) {
sl@0: 	return tclNativeExecutableName;
sl@0:     }
sl@0: 
sl@0: #ifdef __SYMBIAN32__     
sl@0:     // assuming if we're not using eshell that we have to specify the path.
sl@0:     bufferUsed = 0;
sl@0:     if (!strstr(argv0, "Z:\\sys\\bin")) {
sl@0:     	Tcl_DStringInit(&buffer);
sl@0:     	Tcl_DStringSetLength(&buffer, 0);
sl@0:     	Tcl_DStringAppend(&buffer, "Z:\\sys\\bin\\", 11);
sl@0:     	name = Tcl_DStringAppend(&buffer, argv0, -1);
sl@0:         bufferUsed = 1;
sl@0:     }
sl@0:     else    
sl@0:     	name = argv0;  //use if we don't have to specify the path.
sl@0:     
sl@0:     tclNativeExecutableName = ckalloc((unsigned) (strlen(name) + 1));
sl@0:     strcpy(tclNativeExecutableName, name);
sl@0: 
sl@0:     tclCopySymbianPathSlashConversion(TO_TCL, tclNativeExecutableName, tclNativeExecutableName);  
sl@0:  
sl@0:     if (bufferUsed) {
sl@0:     	Tcl_DStringFree(&buffer);
sl@0:     }
sl@0:     
sl@0:     return tclNativeExecutableName;    
sl@0: #else    
sl@0:     
sl@0: 
sl@0:     Tcl_DStringInit(&buffer);
sl@0: 
sl@0:     name = argv0;
sl@0:     for (p = name; *p != '\0'; p++) {
sl@0: 	if (*p == '/') {
sl@0: 	    /*
sl@0: 	     * The name contains a slash, so use the name directly
sl@0: 	     * without doing a path search.
sl@0: 	     */
sl@0: 
sl@0: 	    goto gotName;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     p = getenv("PATH");					/* INTL: Native. */
sl@0:     if (p == NULL) {
sl@0: 	/*
sl@0: 	 * There's no PATH environment variable; use the default that
sl@0: 	 * is used by sh.
sl@0: 	 */
sl@0: 
sl@0: 	p = ":/bin:/usr/bin";
sl@0:     } else if (*p == '\0') {
sl@0: 	/*
sl@0: 	 * An empty path is equivalent to ".".
sl@0: 	 */
sl@0: 
sl@0: 	p = "./";
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Search through all the directories named in the PATH variable
sl@0:      * to see if argv[0] is in one of them.  If so, use that file
sl@0:      * name.
sl@0:      */
sl@0: 
sl@0:     while (1) {
sl@0: 	while (isspace(UCHAR(*p))) {		/* INTL: BUG */
sl@0: 	    p++;
sl@0: 	}
sl@0: 	name = p;
sl@0: 	while ((*p != ':') && (*p != 0)) {
sl@0: 	    p++;
sl@0: 	}
sl@0: 	Tcl_DStringSetLength(&buffer, 0);
sl@0: 	if (p != name) {
sl@0: 	    Tcl_DStringAppend(&buffer, name, p - name);
sl@0: 	    if (p[-1] != '/') {
sl@0: 		Tcl_DStringAppend(&buffer, "/", 1);
sl@0: 	    }
sl@0: 	}
sl@0: 	name = Tcl_DStringAppend(&buffer, argv0, -1);
sl@0: 
sl@0: 	/*
sl@0: 	 * INTL: The following calls to access() and stat() should not be
sl@0: 	 * converted to Tclp routines because they need to operate on native
sl@0: 	 * strings directly.
sl@0: 	 */
sl@0: 
sl@0: 	if ((access(name, X_OK) == 0)			/* INTL: Native. */
sl@0: 		&& (TclOSstat(name, &statBuf) == 0)	/* INTL: Native. */
sl@0: 		&& S_ISREG(statBuf.st_mode)) {
sl@0: 	    goto gotName;
sl@0: 	}
sl@0: 	if (*p == '\0') {
sl@0: 	    break;
sl@0: 	} else if (*(p+1) == 0) {
sl@0: 	    p = "./";
sl@0: 	} else {
sl@0: 	    p++;
sl@0: 	}
sl@0:     }
sl@0:     goto done;
sl@0: 
sl@0:     /*
sl@0:      * If the name starts with "/" then just copy it to tclExecutableName.
sl@0:      */
sl@0: 
sl@0: gotName:
sl@0: #ifdef DJGPP
sl@0:     if (name[1] == ':')  {
sl@0: #else
sl@0:     if (name[0] == '/')  {
sl@0: #endif
sl@0: 	Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
sl@0: 	tclNativeExecutableName = (char *)
sl@0: 		ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
sl@0: 	strcpy(tclNativeExecutableName, Tcl_DStringValue(&nameString));
sl@0: 	Tcl_DStringFree(&nameString);
sl@0: 	goto done;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * The name is relative to the current working directory.  First
sl@0:      * strip off a leading "./", if any, then add the full path name of
sl@0:      * the current working directory.
sl@0:      */
sl@0: 
sl@0:     if ((name[0] == '.') && (name[1] == '/')) {
sl@0: 	name += 2;
sl@0:     }
sl@0: 
sl@0:     Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
sl@0: 
sl@0:     Tcl_DStringFree(&buffer);
sl@0:     TclpGetCwd(NULL, &buffer);
sl@0: 
sl@0:     length = Tcl_DStringLength(&buffer) + Tcl_DStringLength(&nameString) + 2;
sl@0:     tclNativeExecutableName = (char *) ckalloc((unsigned) length);
sl@0:     strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer));
sl@0:     tclNativeExecutableName[Tcl_DStringLength(&buffer)] = '/';
sl@0:     strcpy(tclNativeExecutableName + Tcl_DStringLength(&buffer) + 1,
sl@0: 	    Tcl_DStringValue(&nameString));
sl@0:     Tcl_DStringFree(&nameString);
sl@0: 
sl@0: #endif    
sl@0:     
sl@0: done:
sl@0:     Tcl_DStringFree(&buffer);
sl@0:     return tclNativeExecutableName;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpMatchInDirectory --
sl@0:  *
sl@0:  *	This routine is used by the globbing code to search a
sl@0:  *	directory for all files which match a given pattern.
sl@0:  *
sl@0:  * Results: 
sl@0:  *	The return value is a standard Tcl result indicating whether an
sl@0:  *	error occurred in globbing.  Errors are left in interp, good
sl@0:  *	results are lappended to resultPtr (which must be a valid object)
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------- */
sl@0: 
sl@0: int
sl@0: TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
sl@0:     Tcl_Interp *interp;		/* Interpreter to receive errors. */
sl@0:     Tcl_Obj *resultPtr;		/* List object to lappend results. */
sl@0:     Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
sl@0:     CONST char *pattern;	/* Pattern to match against. */
sl@0:     Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
sl@0: 				 * May be NULL. In particular the directory
sl@0: 				 * flag is very important. */
sl@0: {
sl@0:     CONST char *native;
sl@0:     Tcl_Obj *fileNamePtr;
sl@0: 
sl@0:     fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
sl@0:     if (fileNamePtr == NULL) {
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     
sl@0:     if (pattern == NULL || (*pattern == '\0')) {
sl@0: 	/* Match a file directly */
sl@0: 	native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
sl@0: 	if (NativeMatchType(native, types)) {
sl@0: 	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
sl@0: 	}
sl@0: 	Tcl_DecrRefCount(fileNamePtr);
sl@0: 	return TCL_OK;
sl@0:     } else {
sl@0: 	DIR *d;
sl@0: 	Tcl_DirEntry *entryPtr;
sl@0: 	CONST char *dirName;
sl@0: 	int dirLength;
sl@0: 	int matchHidden;
sl@0: 	int nativeDirLen;
sl@0: 	Tcl_StatBuf statBuf;
sl@0: 	Tcl_DString ds;      /* native encoding of dir */
sl@0: 	Tcl_DString dsOrig;  /* utf-8 encoding of dir */
sl@0: 
sl@0: 	Tcl_DStringInit(&dsOrig);
sl@0: 	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
sl@0: 	Tcl_DStringAppend(&dsOrig, dirName, dirLength);
sl@0: 	
sl@0: 	/*
sl@0: 	 * Make sure that the directory part of the name really is a
sl@0: 	 * directory.  If the directory name is "", use the name "."
sl@0: 	 * instead, because some UNIX systems don't treat "" like "."
sl@0: 	 * automatically.  Keep the "" for use in generating file names,
sl@0: 	 * otherwise "glob foo.c" would return "./foo.c".
sl@0: 	 */
sl@0: 
sl@0: 	if (dirLength == 0) {
sl@0: 	    dirName = ".";
sl@0: 	} else {
sl@0: 	    dirName = Tcl_DStringValue(&dsOrig);
sl@0: 	    /* Make sure we have a trailing directory delimiter */
sl@0: 	    if (dirName[dirLength-1] != '/') {
sl@0: 		dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
sl@0: 		dirLength++;
sl@0: 	    }
sl@0: 	}
sl@0: 	Tcl_DecrRefCount(fileNamePtr);
sl@0: 	
sl@0: 	/*
sl@0: 	 * Now open the directory for reading and iterate over the contents.
sl@0: 	 */
sl@0: 
sl@0: 	native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
sl@0: 
sl@0: 	if ((TclOSstat(native, &statBuf) != 0)		/* INTL: Native. */
sl@0: 		|| !S_ISDIR(statBuf.st_mode)) {
sl@0: 	    Tcl_DStringFree(&dsOrig);
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	    return TCL_OK;
sl@0: 	}
sl@0: 
sl@0: 	d = opendir(native);				/* INTL: Native. */
sl@0: 	if (d == NULL) {
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	    Tcl_ResetResult(interp);
sl@0: 	    Tcl_AppendResult(interp, "couldn't read directory \"",
sl@0: 		    Tcl_DStringValue(&dsOrig), "\": ",
sl@0: 		    Tcl_PosixError(interp), (char *) NULL);
sl@0: 	    Tcl_DStringFree(&dsOrig);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 
sl@0: 	nativeDirLen = Tcl_DStringLength(&ds);
sl@0: 
sl@0: 	/*
sl@0: 	 * Check to see if -type or the pattern requests hidden files.
sl@0: 	 */
sl@0: 	matchHidden = ((types && (types->perm & TCL_GLOB_PERM_HIDDEN)) ||
sl@0: 		((pattern[0] == '.')
sl@0: 			|| ((pattern[0] == '\\') && (pattern[1] == '.'))));
sl@0: 
sl@0: 	while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
sl@0: 	    Tcl_DString utfDs;
sl@0: 	    CONST char *utfname;
sl@0: 
sl@0: 	    /* 
sl@0: 	     * Skip this file if it doesn't agree with the hidden
sl@0: 	     * parameters requested by the user (via -type or pattern).
sl@0: 	     */
sl@0: 	    if (*entryPtr->d_name == '.') {
sl@0: 		if (!matchHidden) continue;
sl@0: 	    } else {
sl@0: 		if (matchHidden) continue;
sl@0: 	    }
sl@0: 
sl@0: 	    /*
sl@0: 	     * Now check to see if the file matches, according to both type
sl@0: 	     * and pattern.  If so, add the file to the result.
sl@0: 	     */
sl@0: 
sl@0: 	    utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name,
sl@0: 		    -1, &utfDs);
sl@0: 	    if (Tcl_StringCaseMatch(utfname, pattern, 0)) {
sl@0: 		int typeOk = 1;
sl@0: 
sl@0: 		if (types != NULL) {
sl@0: 		    Tcl_DStringSetLength(&ds, nativeDirLen);
sl@0: 		    native = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
sl@0: 		    typeOk = NativeMatchType(native, types);
sl@0: 		}
sl@0: 		if (typeOk) {
sl@0: 		    Tcl_ListObjAppendElement(interp, resultPtr, 
sl@0: 			    TclNewFSPathObj(pathPtr, utfname,
sl@0: 				    Tcl_DStringLength(&utfDs)));
sl@0: 		}
sl@0: 	    }
sl@0: 	    Tcl_DStringFree(&utfDs);
sl@0: 	}
sl@0: 
sl@0: 	closedir(d);
sl@0: 	Tcl_DStringFree(&ds);
sl@0: 	Tcl_DStringFree(&dsOrig);
sl@0: 	return TCL_OK;
sl@0:     }
sl@0: }
sl@0: static int 
sl@0: NativeMatchType(
sl@0:     CONST char* nativeEntry,  /* Native path to check */
sl@0:     Tcl_GlobTypeData *types)  /* Type description to match against */
sl@0: {
sl@0:     Tcl_StatBuf buf;
sl@0:     if (types == NULL) {
sl@0: 	/* 
sl@0: 	 * Simply check for the file's existence, but do it
sl@0: 	 * with lstat, in case it is a link to a file which
sl@0: 	 * doesn't exist (since that case would not show up
sl@0: 	 * if we used 'access' or 'stat')
sl@0: 	 */
sl@0: 	if (TclOSlstat(nativeEntry, &buf) != 0) {
sl@0: 	    return 0;
sl@0: 	}
sl@0:     } else {
sl@0: 	if (types->perm != 0) {
sl@0: 	    if (TclOSstat(nativeEntry, &buf) != 0) {
sl@0: 		/* 
sl@0: 		 * Either the file has disappeared between the
sl@0: 		 * 'readdir' call and the 'stat' call, or
sl@0: 		 * the file is a link to a file which doesn't
sl@0: 		 * exist (which we could ascertain with
sl@0: 		 * lstat), or there is some other strange
sl@0: 		 * problem.  In all these cases, we define this
sl@0: 		 * to mean the file does not match any defined
sl@0: 		 * permission, and therefore it is not 
sl@0: 		 * added to the list of files to return.
sl@0: 		 */
sl@0: 		return 0;
sl@0: 	    }
sl@0: 	    
sl@0: 	    /* 
sl@0: 	     * readonly means that there are NO write permissions
sl@0: 	     * (even for user), but execute is OK for anybody
sl@0: 	     */
sl@0: 	    if (((types->perm & TCL_GLOB_PERM_RONLY) &&
sl@0: 			(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
sl@0: 		((types->perm & TCL_GLOB_PERM_R) &&
sl@0: 			(access(nativeEntry, R_OK) != 0)) ||
sl@0: 		((types->perm & TCL_GLOB_PERM_W) &&
sl@0: 			(access(nativeEntry, W_OK) != 0)) ||
sl@0: 		((types->perm & TCL_GLOB_PERM_X) &&
sl@0: 			(access(nativeEntry, X_OK) != 0))
sl@0: 		) {
sl@0: 		return 0;
sl@0: 	    }
sl@0: 	}
sl@0: 	if (types->type != 0) {
sl@0: 	    if (types->perm == 0) {
sl@0: 		/* We haven't yet done a stat on the file */
sl@0: 		if (TclOSstat(nativeEntry, &buf) != 0) {
sl@0: 		    /* 
sl@0: 		     * Posix error occurred.  The only ok
sl@0: 		     * case is if this is a link to a nonexistent
sl@0: 		     * file, and the user did 'glob -l'. So
sl@0: 		     * we check that here:
sl@0: 		     */
sl@0: 		    if (types->type & TCL_GLOB_TYPE_LINK) {
sl@0: 			if (TclOSlstat(nativeEntry, &buf) == 0) {
sl@0: 			    if (S_ISLNK(buf.st_mode)) {
sl@0: 				return 1;
sl@0: 			    }
sl@0: 			}
sl@0: 		    }
sl@0: 		    return 0;
sl@0: 		}
sl@0: 	    }
sl@0: 	    /*
sl@0: 	     * In order bcdpfls as in 'find -t'
sl@0: 	     */
sl@0: 	    if (
sl@0: 		((types->type & TCL_GLOB_TYPE_BLOCK) &&
sl@0: 			S_ISBLK(buf.st_mode)) ||
sl@0: 		((types->type & TCL_GLOB_TYPE_CHAR) &&
sl@0: 			S_ISCHR(buf.st_mode)) ||
sl@0: 		((types->type & TCL_GLOB_TYPE_DIR) &&
sl@0: 			S_ISDIR(buf.st_mode)) ||
sl@0: 		((types->type & TCL_GLOB_TYPE_PIPE) &&
sl@0: 			S_ISFIFO(buf.st_mode)) ||
sl@0: 		((types->type & TCL_GLOB_TYPE_FILE) &&
sl@0: 			S_ISREG(buf.st_mode))
sl@0: #ifdef S_ISSOCK
sl@0: 		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&
sl@0: 			S_ISSOCK(buf.st_mode))
sl@0: #endif /* S_ISSOCK */
sl@0: 		) {
sl@0: 		/* Do nothing -- this file is ok */
sl@0: 	    } else {
sl@0: #ifdef S_ISLNK
sl@0: 		if (types->type & TCL_GLOB_TYPE_LINK) {
sl@0: 		    if (TclOSlstat(nativeEntry, &buf) == 0) {
sl@0: 			if (S_ISLNK(buf.st_mode)) {
sl@0: 			    return 1;
sl@0: 			}
sl@0: 		    }
sl@0: 		}
sl@0: #endif /* S_ISLNK */
sl@0: 		return 0;
sl@0: 	    }
sl@0: 	}
sl@0:     }
sl@0:     return 1;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpGetUserHome --
sl@0:  *
sl@0:  *	This function takes the specified user name and finds their
sl@0:  *	home directory.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The result is a pointer to a string specifying the user's home
sl@0:  *	directory, or NULL if the user's home directory could not be
sl@0:  *	determined.  Storage for the result string is allocated in
sl@0:  *	bufferPtr; the caller must call Tcl_DStringFree() when the result
sl@0:  *	is no longer needed.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: char *
sl@0: TclpGetUserHome(name, bufferPtr)
sl@0:     CONST char *name;		/* User name for desired home directory. */
sl@0:     Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
sl@0: 				 * with name of user's home directory. */
sl@0: {
sl@0:     struct passwd *pwPtr;
sl@0:     Tcl_DString ds;
sl@0:     CONST char *native;
sl@0: 
sl@0:     native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
sl@0:     pwPtr = getpwnam(native);				/* INTL: Native. */
sl@0:     Tcl_DStringFree(&ds);
sl@0:     
sl@0:     if (pwPtr == NULL) {
sl@0: 	endpwent();
sl@0: 	return NULL;
sl@0:     }
sl@0:     Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
sl@0:     endpwent();
sl@0:     return Tcl_DStringValue(bufferPtr);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjAccess --
sl@0:  *
sl@0:  *	This function replaces the library version of access().
sl@0:  *
sl@0:  * Results:
sl@0:  *	See access() documentation.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	See access() documentation.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int 
sl@0: TclpObjAccess(pathPtr, mode)
sl@0:     Tcl_Obj *pathPtr;        /* Path of file to access */
sl@0:     int mode;                /* Permission setting. */
sl@0: {
sl@0:     CONST char *path = Tcl_FSGetNativePath(pathPtr);
sl@0:     if (path == NULL) {
sl@0: 	return -1;
sl@0:     } else {
sl@0: 	return access(path, mode);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjChdir --
sl@0:  *
sl@0:  *	This function replaces the library version of chdir().
sl@0:  *
sl@0:  * Results:
sl@0:  *	See chdir() documentation.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	See chdir() documentation.  
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int 
sl@0: TclpObjChdir(pathPtr)
sl@0:     Tcl_Obj *pathPtr;          /* Path to new working directory */
sl@0: {
sl@0:     CONST char *path = Tcl_FSGetNativePath(pathPtr);
sl@0:     if (path == NULL) {
sl@0: 	return -1;
sl@0:     } else {
sl@0: 	return chdir(path);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjLstat --
sl@0:  *
sl@0:  *	This function replaces the library version of lstat().
sl@0:  *
sl@0:  * Results:
sl@0:  *	See lstat() documentation.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	See lstat() documentation.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int 
sl@0: TclpObjLstat(pathPtr, bufPtr)
sl@0:     Tcl_Obj *pathPtr;		/* Path of file to stat */
sl@0:     Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
sl@0: {
sl@0:     return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjGetCwd --
sl@0:  *
sl@0:  *	This function replaces the library version of getcwd().
sl@0:  *
sl@0:  * Results:
sl@0:  *	The result is a pointer to a string specifying the current
sl@0:  *	directory, or NULL if the current directory could not be
sl@0:  *	determined.  If NULL is returned, an error message is left in the
sl@0:  *	interp's result.  Storage for the result string is allocated in
sl@0:  *	bufferPtr; the caller must call Tcl_DStringFree() when the result
sl@0:  *	is no longer needed.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: Tcl_Obj* 
sl@0: TclpObjGetCwd(interp)
sl@0:     Tcl_Interp *interp;
sl@0: {
sl@0:     Tcl_DString ds;
sl@0:     if (TclpGetCwd(interp, &ds) != NULL) {
sl@0: 	Tcl_Obj *cwdPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
sl@0: 	Tcl_IncrRefCount(cwdPtr);
sl@0: 	Tcl_DStringFree(&ds);
sl@0: 	return cwdPtr;
sl@0:     } else {
sl@0: 	return NULL;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /* Older string based version */
sl@0: CONST char *
sl@0: TclpGetCwd(interp, bufferPtr)
sl@0:     Tcl_Interp *interp;		/* If non-NULL, used for error reporting. */
sl@0:     Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
sl@0: 				 * with name of current directory. */
sl@0: {
sl@0:     char buffer[MAXPATHLEN+1];
sl@0: 
sl@0: #ifdef USEGETWD
sl@0:     if (getwd(buffer) == NULL) {			/* INTL: Native. */
sl@0: #else
sl@0:     if (getcwd(buffer, MAXPATHLEN + 1) == NULL) {	/* INTL: Native. */
sl@0: #endif
sl@0: 	if (interp != NULL) {
sl@0: 	    Tcl_AppendResult(interp,
sl@0: 		    "error getting working directory name: ",
sl@0: 		    Tcl_PosixError(interp), (char *) NULL);
sl@0: 	}
sl@0: 	return NULL;
sl@0:     }
sl@0: 	/* TODO - the line bellow is a temporary patch. The defect number is: DEF116621. */
sl@0: 	buffer[0] = 'c';
sl@0:     return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpReadlink --
sl@0:  *
sl@0:  *	This function replaces the library version of readlink().
sl@0:  *
sl@0:  * Results:
sl@0:  *	The result is a pointer to a string specifying the contents
sl@0:  *	of the symbolic link given by 'path', or NULL if the symbolic
sl@0:  *	link could not be read.  Storage for the result string is
sl@0:  *	allocated in bufferPtr; the caller must call Tcl_DStringFree()
sl@0:  *	when the result is no longer needed.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	See readlink() documentation.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: char *
sl@0: TclpReadlink(path, linkPtr)
sl@0:     CONST char *path;		/* Path of file to readlink (UTF-8). */
sl@0:     Tcl_DString *linkPtr;	/* Uninitialized or free DString filled
sl@0: 				 * with contents of link (UTF-8). */
sl@0: {
sl@0: #ifndef DJGPP
sl@0:     char link[MAXPATHLEN];
sl@0:     int length;
sl@0:     CONST char *native;
sl@0:     Tcl_DString ds;
sl@0: 
sl@0:     native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
sl@0:     length = readlink(native, link, sizeof(link));	/* INTL: Native. */
sl@0:     Tcl_DStringFree(&ds);
sl@0:     
sl@0:     if (length < 0) {
sl@0: 	return NULL;
sl@0:     }
sl@0: 
sl@0:     Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
sl@0:     return Tcl_DStringValue(linkPtr);
sl@0: #else
sl@0:     return NULL;
sl@0: #endif
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpObjStat --
sl@0:  *
sl@0:  *	This function replaces the library version of stat().
sl@0:  *
sl@0:  * Results:
sl@0:  *	See stat() documentation.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	See stat() documentation.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int 
sl@0: TclpObjStat(pathPtr, bufPtr)
sl@0:     Tcl_Obj *pathPtr;		/* Path of file to stat */
sl@0:     Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
sl@0: {
sl@0:     CONST char *path = Tcl_FSGetNativePath(pathPtr);
sl@0:     if (path == NULL) {
sl@0: 	return -1;
sl@0:     } else {
sl@0: 	return TclOSstat(path, bufPtr);
sl@0:     }
sl@0: }
sl@0: 
sl@0: 
sl@0: #ifdef S_IFLNK
sl@0: 
sl@0: Tcl_Obj* 
sl@0: TclpObjLink(pathPtr, toPtr, linkAction)
sl@0:     Tcl_Obj *pathPtr;
sl@0:     Tcl_Obj *toPtr;
sl@0:     int linkAction;
sl@0: {
sl@0:     if (toPtr != NULL) {
sl@0: 	CONST char *src = Tcl_FSGetNativePath(pathPtr);
sl@0: 	CONST char *target = Tcl_FSGetNativePath(toPtr);
sl@0: 	
sl@0: 	if (src == NULL || target == NULL) {
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 	if (access(src, F_OK) != -1) {
sl@0: 	    /* src exists */
sl@0: 	    errno = EEXIST;
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 	if (access(target, F_OK) == -1) {
sl@0: 	    /* target doesn't exist */
sl@0: 	    errno = ENOENT;
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 	/* 
sl@0: 	 * Check symbolic link flag first, since we prefer to
sl@0: 	 * create these.
sl@0: 	 */
sl@0: 	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
sl@0: 	    if (symlink(target, src) != 0) return NULL;
sl@0: 	} else if (linkAction & TCL_CREATE_HARD_LINK) {
sl@0: 	    if (link(target, src) != 0) return NULL;
sl@0: 	} else {
sl@0: 	    errno = ENODEV;
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 	return toPtr;
sl@0:     } else {
sl@0: 	Tcl_Obj* linkPtr = NULL;
sl@0: 
sl@0: 	char link[MAXPATHLEN];
sl@0: 	int length;
sl@0: 	Tcl_DString ds;
sl@0: 	Tcl_Obj *transPtr;
sl@0: 	
sl@0: 	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
sl@0: 	if (transPtr == NULL) {
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 	Tcl_DecrRefCount(transPtr);
sl@0: 	
sl@0: 	length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
sl@0: 	if (length < 0) {
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 
sl@0: 	Tcl_ExternalToUtfDString(NULL, link, length, &ds);
sl@0: 	linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), 
sl@0: 				   Tcl_DStringLength(&ds));
sl@0: 	Tcl_DStringFree(&ds);
sl@0: 	if (linkPtr != NULL) {
sl@0: 	    Tcl_IncrRefCount(linkPtr);
sl@0: 	}
sl@0: 	return linkPtr;
sl@0:     }
sl@0: }
sl@0: 
sl@0: #endif
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFilesystemPathType --
sl@0:  *
sl@0:  *      This function is part of the native filesystem support, and
sl@0:  *      returns the path type of the given path.  Right now it simply
sl@0:  *      returns NULL.  In the future it could return specific path
sl@0:  *      types, like 'nfs', 'samba', 'FAT32', etc.
sl@0:  *
sl@0:  * Results:
sl@0:  *      NULL at present.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: Tcl_Obj*
sl@0: TclpFilesystemPathType(pathObjPtr)
sl@0:     Tcl_Obj* pathObjPtr;
sl@0: {
sl@0:     /* All native paths are of the same type */
sl@0:     return NULL;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpUtime --
sl@0:  *
sl@0:  *	Set the modification date for a file.
sl@0:  *
sl@0:  * Results:
sl@0:  *	0 on success, -1 on error.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: int 
sl@0: TclpUtime(pathPtr, tval)
sl@0:     Tcl_Obj *pathPtr;      /* File to modify */
sl@0:     struct utimbuf *tval;  /* New modification date structure */
sl@0: {
sl@0:     return utime(Tcl_FSGetNativePath(pathPtr),tval);
sl@0: }