tclwinfile.c

这是leon3处理器的交叉编译链

	    Tcl_DStringFree(&ds);

	    Tcl_DStringSetLength(&dsOrig, dirLength);
	}

	FindClose(handle);
	Tcl_DStringFree(&dirString);
	Tcl_DStringFree(&dsOrig);

	return TCL_OK;
	
        error:
	Tcl_DStringFree(&dirString);
	TclWinConvertError(GetLastError());
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, message, Tcl_DStringValue(&dsOrig), "\": ", 
			 Tcl_PosixError(interp), (char *) NULL);
			 Tcl_DStringFree(&dsOrig);
	return TCL_ERROR;
    }

}

/* 
 * Does the given path represent a root volume?  We need this special
 * case because for NTFS root volumes, the getFileAttributesProc returns
 * a 'hidden' attribute when it should not.
 */
static int
WinIsDrive(
    CONST char *name,     /* Name (UTF-8) */
    int len)              /* Length of name */
{
    int remove = 0;
    while (len > 4) {
        if ((name[len-1] != '.' || name[len-2] != '.') 
	    || (name[len-3] != '/' && name[len-3] != '\\')) {
            /* We don't have '/..' at the end */
	    if (remove == 0) {
	        break;
	    }
	    remove--;
	    while (len > 0) {
		len--;
		if (name[len] == '/' || name[len] == '\\') {
		    break;
		}
	    }
	    if (len < 4) {
	        len++;
		break;
	    }
        } else {
	    /* We do have '/..' */
	    len -= 3;
	    remove++;
        }
    }
    if (len < 4) {
	if (len == 0) {
	    /* 
	     * Not sure if this is possible, but we pass it on
	     * anyway 
	     */
	} else if (len == 1 && (name[0] == '/' || name[0] == '\\')) {
	    /* Path is pointing to the root volume */
	    return 1;
	} else if ((name[1] == ':') 
		   && (len == 2 || (name[2] == '/' || name[2] == '\\'))) {
	    /* Path is of the form 'x:' or 'x:/' or 'x:\' */
	    return 1;
	}
    }
    return 0;
}
	   

/* 
 * This function needs a special case for a path which is a root
 * volume, because for NTFS root volumes, the getFileAttributesProc
 * returns a 'hidden' attribute when it should not.
 */
static int 
NativeMatchType(
    CONST char *name,         /* Name */
    int nameLen,              /* Length of name */
    CONST TCHAR* nativeName,  /* Native path to check */
    Tcl_GlobTypeData *types)  /* Type description to match against */
{
    /*
     * 'attr' represents the attributes of the file, but we only
     * want to retrieve this info if it is absolutely necessary
     * because it is an expensive call.  Unfortunately, to deal
     * with hidden files properly, we must always retrieve it.
     * There are more modern Win32 APIs available which we should
     * look into.
     */

    DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
    if (attr == 0xffffffff) {
	/* File doesn't exist */
	return 0;
    }
    
    if (types == NULL) {
	/* If invisible, don't return the file */
	if (attr & FILE_ATTRIBUTE_HIDDEN && !WinIsDrive(name, nameLen)) {
	    return 0;
	}
    } else {
	if (attr & FILE_ATTRIBUTE_HIDDEN && !WinIsDrive(name, nameLen)) {
	    /* If invisible */
	    if ((types->perm == 0) || 
	      !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
		return 0;
	    }
	} else {
	    /* Visible */
	    if (types->perm & TCL_GLOB_PERM_HIDDEN) {
		return 0;
	    }
	}
	
	if (types->perm != 0) {
	    if (
		((types->perm & TCL_GLOB_PERM_RONLY) &&
			!(attr & FILE_ATTRIBUTE_READONLY)) ||
		((types->perm & TCL_GLOB_PERM_R) &&
			(NativeAccess(nativeName, R_OK) != 0)) ||
		((types->perm & TCL_GLOB_PERM_W) &&
			(NativeAccess(nativeName, W_OK) != 0)) ||
		((types->perm & TCL_GLOB_PERM_X) &&
			(NativeAccess(nativeName, X_OK) != 0))
		) {
		return 0;
	    }
	}
	if (types->type != 0) {
	    Tcl_StatBuf buf;
	    
	    if (NativeStat(nativeName, &buf, 0) != 0) {
		/* 
		 * Posix error occurred, either the file
		 * has disappeared, or there is some other
		 * strange error.  In any case we don't
		 * return this file.
		 */
		return 0;
	    }
	    /*
	     * In order bcdpfls as in 'find -t'
	     */
	    if (
		((types->type & TCL_GLOB_TYPE_BLOCK) &&
			S_ISBLK(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_CHAR) &&
			S_ISCHR(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_DIR) &&
			S_ISDIR(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_PIPE) &&
			S_ISFIFO(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_FILE) &&
			S_ISREG(buf.st_mode))
#ifdef S_ISSOCK
		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&
			S_ISSOCK(buf.st_mode))
#endif
		) {
		/* Do nothing -- this file is ok */
	    } else {
#ifdef S_ISLNK
		if (types->type & TCL_GLOB_TYPE_LINK) {
		    if (NativeStat(nativeName, &buf, 1) == 0) {
			if (S_ISLNK(buf.st_mode)) {
			    return 1;
			}
		    }
		}
#endif
		return 0;
	    }
	}		
    } 
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetUserHome --
 *
 *	This function takes the passed in user name and finds the
 *	corresponding home directory specified in the password file.
 *
 * Results:
 *	The result is a pointer to a string specifying the user's home
 *	directory, or NULL if the user's home directory could not be
 *	determined.  Storage for the result string is allocated in
 *	bufferPtr; the caller must call Tcl_DStringFree() when the result
 *	is no longer needed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpGetUserHome(name, bufferPtr)
    CONST char *name;		/* User name for desired home directory. */
    Tcl_DString *bufferPtr;	/* Uninitialized or free DString filled
				 * with name of user's home directory. */
{
    char *result;
    HINSTANCE netapiInst;

    result = NULL;

    Tcl_DStringInit(bufferPtr);

    netapiInst = LoadLibraryA("netapi32.dll");
    if (netapiInst != NULL) {
	NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
	NETGETDCNAMEPROC *netGetDCNameProc;
	NETUSERGETINFOPROC *netUserGetInfoProc;

	netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
		GetProcAddress(netapiInst, "NetApiBufferFree");
	netGetDCNameProc = (NETGETDCNAMEPROC *) 
		GetProcAddress(netapiInst, "NetGetDCName");
	netUserGetInfoProc = (NETUSERGETINFOPROC *) 
		GetProcAddress(netapiInst, "NetUserGetInfo");
	if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
		&& (netApiBufferFreeProc != NULL)) {
	    USER_INFO_1 *uiPtr;
	    Tcl_DString ds;
	    int nameLen, badDomain;
	    char *domain;
	    WCHAR *wName, *wHomeDir, *wDomain;
	    WCHAR buf[MAX_PATH];

	    badDomain = 0;
	    nameLen = -1;
	    wDomain = NULL;
	    domain = strchr(name, '@');
	    if (domain != NULL) {
		Tcl_DStringInit(&ds);
		wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
		badDomain = (*netGetDCNameProc)(NULL, wName,
			(LPBYTE *) &wDomain);
		Tcl_DStringFree(&ds);
		nameLen = domain - name;
	    }
	    if (badDomain == 0) {
		Tcl_DStringInit(&ds);
		wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
		if ((*netUserGetInfoProc)(wDomain, wName, 1,
			(LPBYTE *) &uiPtr) == 0) {
		    wHomeDir = uiPtr->usri1_home_dir;
		    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
			Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
				bufferPtr);
		    } else {
			/* 
			 * User exists but has no home dir.  Return
			 * "{Windows Drive}:/users/default".
			 */

			GetWindowsDirectoryW(buf, MAX_PATH);
			Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
			Tcl_DStringAppend(bufferPtr, "/users/default", -1);
		    }
		    result = Tcl_DStringValue(bufferPtr);
		    (*netApiBufferFreeProc)((void *) uiPtr);
		}
		Tcl_DStringFree(&ds);
	    }
	    if (wDomain != NULL) {
		(*netApiBufferFreeProc)((void *) wDomain);
	    }
	}
	FreeLibrary(netapiInst);
    }
    if (result == NULL) {
	/*
	 * Look in the "Password Lists" section of system.ini for the 
	 * local user.  There are also entries in that section that begin 
	 * with a "*" character that are used by Windows for other 
	 * purposes; ignore user names beginning with a "*".
	 */

	char buf[MAX_PATH];

	if (name[0] != '*') {
	    if (GetPrivateProfileStringA("Password Lists", name, "", buf, 
		    MAX_PATH, "system.ini") > 0) {
		/* 
		 * User exists, but there is no such thing as a home 
		 * directory in system.ini.  Return "{Windows drive}:/".
		 */

		GetWindowsDirectoryA(buf, MAX_PATH);
		Tcl_DStringAppend(bufferPtr, buf, 3);
		result = Tcl_DStringValue(bufferPtr);
	    }
	}
    }

    return result;
}


/*
 *---------------------------------------------------------------------------
 *
 * NativeAccess --
 *
 *	This function replaces the library version of access(), fixing the
 *	following bugs:
 * 
 *	1. access() returns that all files have execute permission.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *---------------------------------------------------------------------------
 */

static int
NativeAccess(
    CONST TCHAR *nativePath,	/* Path of file to access (UTF-8). */
    int mode)			/* Permission setting. */
{
    DWORD attr;

    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);

    if (attr == 0xffffffff) {
	/*
	 * File doesn't exist. 
	 */

	TclWinConvertError(GetLastError());
	return -1;
    }

    if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
	/*
	 * File is not writable.
	 */

	Tcl_SetErrno(EACCES);
	return -1;
    }

    if (mode & X_OK) {
	if (attr & FILE_ATTRIBUTE_DIRECTORY) {
	    /*
	     * Directories are always executable. 
	     */
	    
	    return 0;
	}
	if (NativeIsExec(nativePath)) {
	    return 0;
	}
	Tcl_SetErrno(EACCES);
	return -1;
    }

    return 0;
}

static int
NativeIsExec(nativePath)
    CONST TCHAR *nativePath;
{
    CONST char *p, *path;
    Tcl_DString ds;
    
    /* 
     * This is really not efficient.  We should be able to examine
     * the native path directly without converting to UTF.
     */
    Tcl_DStringInit(&ds);
    path = Tcl_WinTCharToUtf(nativePath, -1, &ds);
    
    p = strrchr(path, '.');
    if (p != NULL) {
	p++;
	/* 
	 * Note: in the old code, stat considered '.pif' files as
	 * executable, whereas access did not.
	 */
	if ((stricmp(p, "exe") == 0)
		|| (stricmp(p, "com") == 0)
		|| (stricmp(p, "bat") == 0)) {
	    /*
	     * File that ends with .exe, .com, or .bat is executable.
	     */

	    Tcl_DStringFree(&ds);
	    return 1;
	}
    }
    Tcl_DStringFree(&ds);
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpObjChdir --
 *
 *	This function replaces the library version of chdir().
 *
 * Results:
 *	See chdir() documentation.
 *
 * Side effects:
 *	See chdir() documentation.  
 *
 *----------------------------------------------------------------------
 */

int 
TclpObjChdir(pathPtr)
    Tcl_Obj *pathPtr; 	/* Path to new working directory. */
{
    int result;
    CONST TCHAR *nativePath;
#ifdef __CYGWIN__
    extern int cygwin_conv_to_posix_path 
	_ANSI_ARGS_((CONST char *, char *));
    char posixPath[MAX_PATH+1];
    CONST char *path;
    Tcl_DString ds;
#endif /* __CYGWIN__ */


    nativePath = (CONST TCHAR *) Tcl_FSGetNativePath(pathPtr);
#ifdef __CYGWIN__
    /* Cygwin chdir only groks POSIX path. */
    path = Tcl_WinTCharToUtf(nativePath, -1, &ds);
    cygwin_conv_to_posix_path(path, posixPath);
    result = (chdir(posixPath) == 0 ? 1 : 0);