Tcl Source Code

Artifact 6de378025402f53a232eff04404be0fa4e95259c:

Attachment "TclpObjAccess.c" to ticket [1617990fff] added by decosterjos 2006-12-18 22:30:06.

---

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjAccess --
 *
 *	This function replaces the library version of access().
 *
 * Results:
 *	See access() documentation + stat() documentation.
 *
 * Side effects:
 *	See access() documentation + stat() documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjAccess(
    Tcl_Obj *pathPtr,		/* Path of file to access */
    int mode)			/* Permission setting. */
{
    CONST char *path = Tcl_FSGetNativePath(pathPtr);
    if (path == NULL) {
	return -1;
    } else {
	int result =  access(path, mode);
	/* For file mounted via NFS, access() may be to liberal */
	Tcl_StatBuf buf;
	int statResult = TclpObjStat(pathPtr, &buf);
	if (statResult != 0)
	    return -1;
	if ((mode & R_OK) && ((buf.st_mode & S_IRUSR) == 0))
	    result = -1;
	if ((mode & W_OK) && ((buf.st_mode & S_IWUSR) == 0))
	    result = -1;
	if ((mode & X_OK) && ((buf.st_mode & S_IXUSR) == 0))
	    result = -1;
	return result;
    }
}