Tcl Source Code

2009-11-24  Pat Thoyts  <[email protected]>

	* tests/fCmd.test:  [Bug 2893771] Teach [file stat] to handle locked
	* win/tclWinFile.c: files so that [file exists] no longer lies.

2009-11-23  Jan Nijtmans  <[email protected]>

	* library/tclIndex  (regenerated) to reflect various changes
	                    in safe.tcl and other files.

2009-11-23  Kevin Kenny  <[email protected]>

# This file tests the tclFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: fCmd.test,v 1.70 2009/11/24 00:08:27 patthoyts Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

test fCmd-30.1 {file writable on 'My Documents'} -setup {
    # Get the localized version of the folder name by looking in the registry.
    set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal]
} -constraints {2000orNewer reg} -body {
    file writable $mydocsname
} -result 1
test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {2000orNewer} -body {
    expr {[info exists env(USERPROFILE)]
          && [file exists $env(USERPROFILE)/NTUSER.DAT]
          && [file readable $env(USERPROFILE)/NTUSER.DAT]}

} -result {1}
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {2000orNewer} -body {
    set r {}
    if {[info exists env(SystemDrive)]} {
        set path $env(SystemDrive)/pagefile.sys
        lappend r exists [file exists $path]
        lappend r readable [file readable $path]
        lappend r stat [catch {file stat $path a} e] $e
    }
    return $r
} -result {exists 1 readable 0 stat 0 {}}

# cleanup
cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

/*
 * tclWinFile.c --
 *
 *	This file contains temporary wrappers around UNIX file handling
 *	functions. These wrappers map the UNIX functions to Win32 HANDLE-style
 *	files, which can be manipulated through the Win32 console redirection
 *	interfaces.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclWinFile.c,v 1.99 2009/11/24 00:08:27 patthoyts Exp $
 */

/* #define _WIN32_WINNT	0x0500 */

#include "tclWinInt.h"
#include "tclFileSystem.h"
#include <winioctl.h>

    }

    /*
     * Make sure source file doesn't exist.
     */

    attr = tclWinProcs->getFileAttributesProc(linkSourcePath);
    if (attr != INVALID_FILE_ATTRIBUTES) {
	Tcl_SetErrno(EEXIST);
	return -1;
    }

    /*
     * Get the full path referenced by the source file/directory.
     */

    }

    /*
     * Check the target.
     */

    attr = tclWinProcs->getFileAttributesProc(linkTargetPath);
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * The target doesn't exist.
	 */

	TclWinConvertError(GetLastError());
	return -1;

    }

    /*
     * Make sure source file does exist.
     */

    attr = tclWinProcs->getFileAttributesProc(linkSourcePath);
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * The source doesn't exist.
	 */

	TclWinConvertError(GetLastError());
	return NULL;

	    DWORD attr;
	    const char *str = Tcl_GetStringFromObj(norm,&len);

	    native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);

	    if (tclWinProcs->getFileAttributesExProc == NULL) {
		attr = tclWinProcs->getFileAttributesProc(native);
		if (attr == INVALID_FILE_ATTRIBUTES) {
		    return TCL_OK;
		}
	    } else {
		WIN32_FILE_ATTRIBUTE_DATA data;

		if (tclWinProcs->getFileAttributesExProc(native,
			GetFileExInfoStandard, &data) != TRUE) {

	native = Tcl_FSGetNativePath(pathPtr);
	if (native == NULL) {
	    return TCL_OK;
	}
	attr = tclWinProcs->getFileAttributesProc(native);

	if ((attr == INVALID_FILE_ATTRIBUTES) 
	    || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
	    return TCL_OK;
	}

	/*
	 * Build up the directory name for searching, including a trailing
	 * directory separator.
	 */

    const TCHAR *nativePath,	/* Path of file to access, native encoding. */
    int mode)			/* Permission setting. */
{
    DWORD attr;

    attr = tclWinProcs->getFileAttributesProc(nativePath);

    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * File might not exist.
	 */

	WIN32_FIND_DATAT ffd;
	HANDLE hFind;
	hFind = tclWinProcs->findFirstFileProc(nativePath, &ffd);
	if (hFind != INVALID_HANDLE_VALUE) {
	    attr = ffd.w.dwFileAttributes;
	    FindClose(hFind);
	} else {
	    TclWinConvertError(GetLastError());
	    return -1;
	}
    }

    if ((mode & W_OK)
	    && (tclWinProcs->getFileSecurityProc == NULL)
	    && (attr & FILE_ATTRIBUTE_READONLY)) {
	/*
	 * We don't have the advanced 'getFileSecurityProc', and our

	 * Fall back on the less capable routines. This means no nlink or ino.
	 */

	WIN32_FILE_ATTRIBUTE_DATA data;

	if (tclWinProcs->getFileAttributesExProc(nativePath,
		GetFileExInfoStandard, &data) != TRUE) {

	    /*
	     * We might have just been denied access
	     */
	    
	    WIN32_FIND_DATAT ffd;
	    HANDLE hFind;
	    hFind = tclWinProcs->findFirstFileProc(nativePath, &ffd);
	    if (hFind != INVALID_HANDLE_VALUE) {
		memcpy(&data, &ffd, sizeof(data));
		FindClose(hFind);
	    } else {
		Tcl_SetErrno(ENOENT);
		return -1;
	    }
	}

	attr = data.dwFileAttributes;

	statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
		(((Tcl_WideInt) data.nFileSizeHigh) << 32);
	statPtr->st_atime = ToCTime(data.ftLastAccessTime);