tclwinfile.c

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

    
    switch (reparseBuffer->ReparseTag) {
	case 0x80000000|IO_REPARSE_TAG_SYMBOLIC_LINK: 
	case IO_REPARSE_TAG_SYMBOLIC_LINK: 
	case IO_REPARSE_TAG_MOUNT_POINT: {
	    Tcl_Obj *retVal;
	    Tcl_DString ds;
	    CONST char *copy;
	    int len;
	    
	    Tcl_WinTCharToUtf( 
		(CONST char*)reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, 
		(int)reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength, 
		&ds);
	
	    copy = Tcl_DStringValue(&ds);
	    len = Tcl_DStringLength(&ds);
	    /* 
	     * Certain native path representations on Windows have this special
	     * prefix to indicate that they are to be treated specially.  For
	     * example extremely long paths, or symlinks 
	     */
	    if (*copy == '\\') {
		if (0 == strncmp(copy,"\\??\\",4)) {
		    copy += 4;
		    len -= 4;
		} else if (0 == strncmp(copy,"\\\\?\\",4)) {
		    copy += 4;
		    len -= 4;
		}
	    }
	    retVal = Tcl_NewStringObj(copy,len);
	    Tcl_IncrRefCount(retVal);
	    Tcl_DStringFree(&ds);
	    return retVal;
	}
    }
    Tcl_SetErrno(EINVAL);
    return NULL;
}

/*
 *--------------------------------------------------------------------
 *
 * NativeReadReparse
 *
 * Read the junction/reparse information from a given NTFS directory.
 *
 * Assumption that LinkDirectory is a valid, existing directory.
 * 
 * Returns zero on success.
 *--------------------------------------------------------------------
 */
static int 
NativeReadReparse(LinkDirectory, buffer)
    CONST TCHAR* LinkDirectory;   /* The junction to read */
    REPARSE_DATA_BUFFER* buffer;  /* Pointer to buffer. Cannot be NULL */
{
    HANDLE hFile;
    int returnedLength;
   
    hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_READ, 0,
	NULL, OPEN_EXISTING, 
	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
    if (hFile == INVALID_HANDLE_VALUE) {
	/* Error creating directory */
	TclWinConvertError(GetLastError());
	return -1;
    }
    /* Get the link */
    if (!DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, NULL, 
			 0, buffer, sizeof(DUMMY_REPARSE_BUFFER), 
			 &returnedLength, NULL)) {	
	/* Error setting junction */
	TclWinConvertError(GetLastError());
	CloseHandle(hFile);
	return -1;
    }
    CloseHandle(hFile);
    
    if (!IsReparseTagValid(buffer->ReparseTag)) {
	Tcl_SetErrno(EINVAL);
	return -1;
    }
    return 0;
}

/*
 *--------------------------------------------------------------------
 *
 * NativeWriteReparse
 *
 * Write the reparse information for a given directory.
 * 
 * Assumption that LinkDirectory does not exist.
 *--------------------------------------------------------------------
 */
static int 
NativeWriteReparse(LinkDirectory, buffer)
    CONST TCHAR* LinkDirectory;
    REPARSE_DATA_BUFFER* buffer;
{
    HANDLE hFile;
    int returnedLength;
    
    /* Create the directory - it must not already exist */
    if ((*tclWinProcs->createDirectoryProc)(LinkDirectory, NULL) == 0) {
	/* Error creating directory */
	TclWinConvertError(GetLastError());
	return -1;
    }
    hFile = (*tclWinProcs->createFileProc)(LinkDirectory, GENERIC_WRITE, 0,
	NULL, OPEN_EXISTING, 
	FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
    if (hFile == INVALID_HANDLE_VALUE) {
	/* Error creating directory */
	TclWinConvertError(GetLastError());
	return -1;
    }
    /* Set the link */
    if (!DeviceIoControl(hFile, FSCTL_SET_REPARSE_POINT, buffer, 
			 buffer->ReparseDataLength 
			 + REPARSE_MOUNTPOINT_HEADER_SIZE,
			 NULL, 0, &returnedLength, NULL)) {	
	/* Error setting junction */
	TclWinConvertError(GetLastError());
	CloseHandle(hFile);
	(*tclWinProcs->removeDirectoryProc)(LinkDirectory);
	return -1;
    }
    CloseHandle(hFile);
    /* We succeeded */
    return 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpFindExecutable --
 *
 *	This procedure computes the absolute path name of the current
 *	application, given its argv[0] value.
 *
 * Results:
 *	A dirty UTF string that is the path to the executable.  At this
 *	point we may not know the system encoding.  Convert the native
 *	string value to UTF using the default encoding.  The assumption
 *	is that we will still be able to parse the path given the path
 *	name contains ASCII string and '/' chars do not conflict with
 *	other UTF chars.
 *
 * Side effects:
 *	The variable tclNativeExecutableName gets filled in with the file
 *	name for the application, if we figured it out.  If we couldn't
 *	figure it out, tclNativeExecutableName is set to NULL.
 *
 *---------------------------------------------------------------------------
 */

char *
TclpFindExecutable(argv0)
    CONST char *argv0;		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_DString ds;
    WCHAR wName[MAX_PATH];

    if (argv0 == NULL) {
	return NULL;
    }
    if (tclNativeExecutableName != NULL) {
	return tclNativeExecutableName;
    }

    /*
     * Under Windows we ignore argv0, and return the path for the file used to
     * create this process.
     */

    (*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH);
    Tcl_WinTCharToUtf((CONST TCHAR *) wName, -1, &ds);

    tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1));
    strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds));
    Tcl_DStringFree(&ds);

    TclWinNoBackslash(tclNativeExecutableName);
    return tclNativeExecutableName;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpMatchInDirectory --
 *
 *	This routine is used by the globbing code to search a
 *	directory for all files which match a given pattern.
 *
 * Results: 
 *	
 *	The return value is a standard Tcl result indicating whether an
 *	error occurred in globbing.  Errors are left in interp, good
 *	results are lappended to resultPtr (which must be a valid object)
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------- */

int
TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
    Tcl_Interp *interp;		/* Interpreter to receive errors. */
    Tcl_Obj *resultPtr;		/* List object to lappend results. */
    Tcl_Obj *pathPtr;	        /* Contains path to directory to search. */
    CONST char *pattern;	/* Pattern to match against. */
    Tcl_GlobTypeData *types;	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    CONST TCHAR *nativeName;

    if (pattern == NULL || (*pattern == '\0')) {
	Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (norm != NULL) {
	    int len;
	    char *str = Tcl_GetStringFromObj(norm,&len);
	    /* Match a file directly */
	    nativeName = (CONST TCHAR*) Tcl_FSGetNativePath(pathPtr);
	    if (NativeMatchType(str, len, nativeName, types)) {
		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	    }
	}
	return TCL_OK;
    } else {
	char drivePat[] = "?:\\";
	const char *message;
	CONST char *dir;
	char *root;
	int dirLength;
	Tcl_DString dirString;
	DWORD attr, volFlags;
	HANDLE handle;
	WIN32_FIND_DATAT data;
	BOOL found;
	Tcl_DString ds;
	Tcl_DString dsOrig;
	Tcl_Obj *fileNamePtr;
	int matchSpecialDots;
	
	/*
	 * Convert the path to normalized form since some interfaces only
	 * accept backslashes.  Also, ensure that the directory ends with a
	 * separator character.
	 */

	fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
	if (fileNamePtr == NULL) {
	    return TCL_ERROR;
	}
	Tcl_DStringInit(&dsOrig);
	Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);

	dirLength = Tcl_DStringLength(&dsOrig);
	Tcl_DStringInit(&dirString);
	if (dirLength == 0) {
	    Tcl_DStringAppend(&dirString, ".\\", 2);
	} else {
	    char *p;

	    Tcl_DStringAppend(&dirString, Tcl_DStringValue(&dsOrig),
		    Tcl_DStringLength(&dsOrig));
	    for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
		if (*p == '/') {
		    *p = '\\';
		}
	    }
	    p--;
	    /* Make sure we have a trailing directory delimiter */
	    if ((*p != '\\') && (*p != ':')) {
		Tcl_DStringAppend(&dirString, "\\", 1);
		Tcl_DStringAppend(&dsOrig, "/", 1);
		dirLength++;
	    }
	}
	dir = Tcl_DStringValue(&dirString);

	/*
	 * First verify that the specified path is actually a directory.
	 */

	nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
	attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
	Tcl_DStringFree(&ds);

	if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
	    Tcl_DStringFree(&dirString);
	    return TCL_OK;
	}

	/*
	 * Next check the volume information for the directory to see
	 * whether comparisons should be case sensitive or not.  If the
	 * root is null, then we use the root of the current directory.
	 * If the root is just a drive specifier, we use the root
	 * directory of the given drive.
	 */

	switch (Tcl_GetPathType(dir)) {
	    case TCL_PATH_RELATIVE:
		found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL, 
			&volFlags, NULL, 0);
		break;
	    case TCL_PATH_VOLUME_RELATIVE:
		if (dir[0] == '\\') {
		    root = NULL;
		} else {
		    root = drivePat;
		    *root = dir[0];
		}
		found = GetVolumeInformationA(root, NULL, 0, NULL, NULL, 
			&volFlags, NULL, 0);
		break;
	    case TCL_PATH_ABSOLUTE:
		if (dir[1] == ':') {
		    root = drivePat;
		    *root = dir[0];
		    found = GetVolumeInformationA(root, NULL, 0, NULL, NULL, 
			    &volFlags, NULL, 0);
		} else if (dir[1] == '\\') {
		    char *p;

		    p = strchr(dir + 2, '\\');
		    p = strchr(p + 1, '\\');
		    p++;
		    nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds);
		    found = (*tclWinProcs->getVolumeInformationProc)(nativeName, 
			    NULL, 0, NULL, NULL, &volFlags, NULL, 0);
		    Tcl_DStringFree(&ds);
		}
		break;
	}

	if (found == 0) {
	    message = "couldn't read volume information for \"";
	    goto error;
	}

	/*
	 * Check to see if the pattern should match the special
	 * . and .. names, referring to the current directory,
	 * or the directory above.  We need a special check for
	 * this because paths beginning with a dot are not considered
	 * hidden on Windows, and so otherwise a relative glob like
	 * 'glob -join * *' will actually return './. ../..' etc.
	 */

	if ((pattern[0] == '.')
		|| ((pattern[0] == '\\') && (pattern[1] == '.'))) {
	    matchSpecialDots = 1;
	} else {
	    matchSpecialDots = 0;
	}

	/*
	 * We need to check all files in the directory, so append a *.*
	 * to the path. 
	 */

	dir = Tcl_DStringAppend(&dirString, "*.*", 3);
	nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
	handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
	Tcl_DStringFree(&ds);

	if (handle == INVALID_HANDLE_VALUE) {
	    message = "couldn't read directory \"";
	    goto error;
	}

	/*
	 * Now iterate over all of the files in the directory.
	 */

	for (found = 1; found != 0; 
		found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
	    CONST TCHAR *nativeMatchResult;
	    CONST char *name, *fname;
	    
	    if (tclWinProcs->useWide) {
		nativeName = (CONST TCHAR *) data.w.cFileName;
	    } else {
		nativeName = (CONST TCHAR *) data.a.cFileName;
	    }
	    name = Tcl_WinTCharToUtf(nativeName, -1, &ds);

	    if (!matchSpecialDots) {
		/* If it is exactly '.' or '..' then we ignore it */
		if (name[0] == '.') {
		    if (name[1] == '\0' 
		      || (name[1] == '.' && name[2] == '\0')) {
			continue;
		    }
		}
	    }
	    
	    /*
	     * Check to see if the file matches the pattern.  Note that
	     * we are ignoring the case sensitivity flag because Windows
	     * doesn't honor case even if the volume is case sensitive.
	     * If the volume also doesn't preserve case, then we
	     * previously returned the lower case form of the name.  This
	     * didn't seem quite right since there are
	     * non-case-preserving volumes that actually return mixed
	     * case.  So now we are returning exactly what we get from
	     * the system.
	     */

	    nativeMatchResult = NULL;

	    if (Tcl_StringCaseMatch(name, pattern, 1) != 0) {
		nativeMatchResult = nativeName;
	    }
	    Tcl_DStringFree(&ds);

	    if (nativeMatchResult == NULL) {
		continue;
	    }

	    /*
	     * If the file matches, then we need to process the remainder
	     * of the path.
	     */

	    name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds);
	    Tcl_DStringAppend(&dsOrig, name, -1);
	    Tcl_DStringFree(&ds);

	    fname = Tcl_DStringValue(&dsOrig);
	    nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(&dsOrig), 
					   &ds);
	    
	    if (NativeMatchType(fname, Tcl_DStringLength(&dsOrig), 
				nativeName, types)) {
		Tcl_ListObjAppendElement(interp, resultPtr, 
			Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
	    }
	    /*
	     * Free ds here to ensure that nativeName is valid above.
	     */