tclunixfcmd.c

tcl是工具命令语言

	Tcl_AppendResult(interp, "could not set owner for file \"", 
			 Tcl_GetString(fileName), "\": ", 
			 Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetPermissionsAttribute
 *
 *      Sets the file to the given permission.
 *
 * Results:
 *      Standard TCL result.
 *
 * Side effects:
 *      The permission of the file is changed.
 *      
 *---------------------------------------------------------------------------
 */

static int
SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
    Tcl_Interp *interp;		    /* The interp we are using for errors. */
    int objIndex;		    /* The index of the attribute. */
    Tcl_Obj *fileName;  	    /* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr;	    /* The attribute to set. */
{
    long mode;
    mode_t newMode;
    int result;
    CONST char *native;

    /*
     * First try if the string is a number
     */
    if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
        newMode = (mode_t) (mode & 0x00007FFF);
    } else {
	Tcl_StatBuf buf;
	char *modeStringPtr = Tcl_GetString(attributePtr);

	/*
	 * Try the forms "rwxrwxrwx" and "ugo=rwx"
	 *
	 * We get the current mode of the file, in order to allow for
	 * ug+-=rwx style chmod strings.
	 */
	result = TclpObjStat(fileName, &buf);
	if (result != 0) {
	    Tcl_AppendResult(interp, "could not read \"", 
		    Tcl_GetString(fileName), "\": ",
		    Tcl_PosixError(interp), (char *) NULL);
	    return TCL_ERROR;
	}
	newMode = (mode_t) (buf.st_mode & 0x00007FFF);

	if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		    "unknown permission string format \"",
		    modeStringPtr, "\"", (char *) NULL);
	    return TCL_ERROR;
	}
    }

    native = Tcl_FSGetNativePath(fileName);
    result = chmod(native, newMode);		/* INTL: Native. */
    if (result != 0) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"could not set permissions for file \"", 
		Tcl_GetString(fileName), "\": ",
		Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjListVolumes --
 *
 *	Lists the currently mounted volumes, which on UNIX is just /.
 *
 * Results:
 *	The list of volumes.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
TclpObjListVolumes(void)
{
    Tcl_Obj *resultPtr = Tcl_NewStringObj("/",1);

    Tcl_IncrRefCount(resultPtr);
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * GetModeFromPermString --
 *
 *	This procedure is invoked to process the "file permissions"
 *	Tcl command, to check for a "rwxrwxrwx" or "ugoa+-=rwxst" string.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
GetModeFromPermString(interp, modeStringPtr, modePtr)
    Tcl_Interp *interp;		/* The interp we are using for errors. */
    char *modeStringPtr;	/* Permissions string */
    mode_t *modePtr;		/* pointer to the mode value */
{
    mode_t newMode;
    mode_t oldMode;		/* Storage for the value of the old mode
				 * (that is passed in), to allow for the
				 * chmod style manipulation */
    int i,n, who, op, what, op_found, who_found;

    /*
     * We start off checking for an "rwxrwxrwx" style permissions string
     */
    if (strlen(modeStringPtr) != 9) {
        goto chmodStyleCheck;
    }

    newMode = 0;
    for (i = 0; i < 9; i++) {
	switch (*(modeStringPtr+i)) {
	    case 'r':
		if ((i%3) != 0) {
		    goto chmodStyleCheck;
		}
		newMode |= (1<<(8-i));
		break;
	    case 'w':
		if ((i%3) != 1) {
		    goto chmodStyleCheck;
		}
		newMode |= (1<<(8-i));
		break;
	    case 'x':
		if ((i%3) != 2) {
		    goto chmodStyleCheck;
		}
		newMode |= (1<<(8-i));
		break;
	    case 's':
		if (((i%3) != 2) || (i > 5)) {
		    goto chmodStyleCheck;
		}
		newMode |= (1<<(8-i));
		newMode |= (1<<(11-(i/3)));
		break;
	    case 'S':
		if (((i%3) != 2) || (i > 5)) {
		    goto chmodStyleCheck;
		}
		newMode |= (1<<(11-(i/3)));
		break;
	    case 't':
		if (i != 8) {
		    goto chmodStyleCheck;
		}
		newMode |= (1<<(8-i));
		newMode |= (1<<9);
		break;
	    case 'T':
		if (i != 8) {
		    goto chmodStyleCheck;
		}
		newMode |= (1<<9);
		break;
	    case '-':
		break;
	    default:
		/*
		 * Oops, not what we thought it was, so go on
		 */
		goto chmodStyleCheck;
	}
    }
    *modePtr = newMode;
    return TCL_OK;

    chmodStyleCheck:
    /*
     * We now check for an "ugoa+-=rwxst" style permissions string
     */

    for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) {
	oldMode = *modePtr;
	who = op = what = op_found = who_found = 0;
	for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) {
	    if (!who_found) {
		/* who */
		switch (*(modeStringPtr+n+i)) {
		    case 'u' :
			who |= 0x9c0;
			continue;
		    case 'g' :
			who |= 0x438;
			continue;
		    case 'o' :
			who |= 0x207;
			continue;
		    case 'a' :
			who |= 0xfff;
			continue;
		}
	    }
	    who_found = 1;
	    if (who == 0) {
		who = 0xfff;
	    }
	    if (!op_found) {
		/* op */
		switch (*(modeStringPtr+n+i)) {
		    case '+' :
			op = 1;
			op_found = 1;
			continue;
		    case '-' :
			op = 2;
			op_found = 1;
			continue;
		    case '=' :
			op = 3;
			op_found = 1;
			continue;
		    default  :
			return TCL_ERROR;
			break;
		}
	    }
	    /* what */
	    switch (*(modeStringPtr+n+i)) {
		case 'r' :
		    what |= 0x124;
		    continue;
		case 'w' :
		    what |= 0x92;
		    continue;
		case 'x' :
		    what |= 0x49;
		    continue;
		case 's' :
		    what |= 0xc00;
		    continue;
		case 't' :
		    what |= 0x200;
		    continue;
		case ',' :
		    break;
		default  :
		    return TCL_ERROR;
		    break;
	    }
	    if (*(modeStringPtr+n+i) == ',') {
		i++;
		break;
	    }
	}
	switch (op) {
	    case 1 :
		*modePtr = oldMode | (who & what);
		continue;
	    case 2 :
		*modePtr = oldMode & ~(who & what);
		continue;
	    case 3 :
		*modePtr = (oldMode & ~who) | (who & what);
		continue;
	}
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjNormalizePath --
 *
 *	This function scans through a path specification and replaces
 *	it, in place, with a normalized version.  A normalized version
 *	is one in which all symlinks in the path are replaced with
 *	their expanded form (except a symlink at the very end of the
 *	path).
 *
 * Results:
 *	The new 'nextCheckpoint' value, giving as far as we could
 *	understand in the path.
 *
 * Side effects:
 *	The pathPtr string, is modified.
 *
 *---------------------------------------------------------------------------
 */
int
TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
    Tcl_Interp *interp;
    Tcl_Obj *pathPtr;
    int nextCheckpoint;
{
    char *currentPathEndPosition;
    int pathLen;
    char cur;
    char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
    Tcl_DString ds;
    CONST char *nativePath; 
#endif
    /* 
     * We add '1' here because if nextCheckpoint is zero we know
     * that '/' exists, and if it isn't zero, it must point at
     * a directory separator which we also know exists.
     */
    currentPathEndPosition = path + nextCheckpoint;
    if (*currentPathEndPosition == '/') {
	currentPathEndPosition++;
    }

#ifndef NO_REALPATH
    /* For speed, try to get the entire path in one go */
    if (nextCheckpoint == 0) {
        char *lastDir = strrchr(currentPathEndPosition, '/');
	if (lastDir != NULL) {
	    nativePath = Tcl_UtfToExternalDString(NULL, path, 
						  lastDir - path, &ds);
	    if (Realpath(nativePath, normPath) != NULL) {
		nextCheckpoint = lastDir - path;
		goto wholeStringOk;
	    }
	}
    }
    /* Else do it the slow way */
#endif
    
    while (1) {
	cur = *currentPathEndPosition;
	if ((cur == '/') && (path != currentPathEndPosition)) {
	    /* Reached directory separator */
	    Tcl_DString ds;
	    CONST char *nativePath;
	    int accessOk;

	    nativePath = Tcl_UtfToExternalDString(NULL, path, 
		    currentPathEndPosition - path, &ds);
	    accessOk = access(nativePath, F_OK);
	    Tcl_DStringFree(&ds);
	    if (accessOk != 0) {
		/* File doesn't exist */
		break;
	    }
	    /* Update the acceptable point */
	    nextCheckpoint = currentPathEndPosition - path;
	} else if (cur == 0) {
	    /* Reached end of string */
	    break;
	}
	currentPathEndPosition++;
    }
    /* 
     * We should really now convert this to a canonical path.  We do
     * that with 'realpath' if we have it available.  Otherwise we could
     * step through every single path component, checking whether it is a 
     * symlink, but that would be a lot of work, and most modern OSes 
     * have 'realpath'.
     */
#ifndef NO_REALPATH
    /* 
     * If we only had '/foo' or '/' then we never increment nextCheckpoint
     * and we don't need or want to go through 'Realpath'.  Also, on some
     * platforms, passing an empty string to 'Realpath' will give us the
     * normalized pwd, which is not what we want at all!
     */
    if (nextCheckpoint == 0) return 0;
    
    nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds);
    if (Realpath(nativePath, normPath) != NULL) {
	int newNormLen;
	wholeStringOk:
	newNormLen = strlen(normPath);
	if ((newNormLen == Tcl_DStringLength(&ds))
		&& (strcmp(normPath, nativePath) == 0)) {
	    /* String is unchanged */
	    Tcl_DStringFree(&ds);
	    if (path[nextCheckpoint] != '\0') {
		nextCheckpoint++;
	    }
	    return nextCheckpoint;
	}
	
	/* 
	 * Free up the native path and put in its place the
	 * converted, normalized path.
	 */
	Tcl_DStringFree(&ds);
	Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds);

	if (path[nextCheckpoint] != '\0') {
	    /* not at end, append remaining path */
	    int normLen = Tcl_DStringLength(&ds);
	    Tcl_DStringAppend(&ds, path + nextCheckpoint,
		    pathLen - nextCheckpoint);
	    /* 
	     * We recognise up to and including the directory
	     * separator.
	     */	
	    nextCheckpoint = normLen + 1;
	} else {
	    /* We recognise the whole string */ 
	    nextCheckpoint = Tcl_DStringLength(&ds);
	}
	/* 
	 * Overwrite with the normalized path.
	 */
	Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds),
		Tcl_DStringLength(&ds));
    }
    Tcl_DStringFree(&ds);
#endif	/* !NO_REALPATH */

    return nextCheckpoint;
}