Tcl Source Code

2012-06-19  Jan Nijtmans  <[email protected]>

	* win/tclWinReg.c:          Plug memory leak, part of [Bug #3362446]
	* library/reg/pkgIndex.tcl: Dde version should be 1.3.0, not 1.3

2012-06-11  Don Porter  <[email protected]>

	* generic/tclBasic.c:	[Bug 3532959] Make sure the lifetime management
	* generic/tclProc.c:	of entries in the linePBodyPtr hash table can
	* tests/proc.test:	tolerate either order of teardown, interp first,
	or Proc first.

} "foo ba\u00c7r baz"
test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} {
    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz
    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
    registry delete HKEY_CURRENT_USER\\TclFoobar
    set result
} "foo ba r baz"







test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup {
    registry delete HKEY_CURRENT_USER\\TclFoobar
} -body {
    registry values HKEY_CURRENT_USER\\TclFoobar
} -returnCodes error -result {unable to open key: The system cannot find the file specified.}
test registry-7.2 {GetValueNames} -constraints {win reg} -setup {

 */

#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

#ifdef _MSC_VER
#   pragma comment (lib, "advapi32.lib")
#endif
#include <stdlib.h>

#ifndef UNICODE
#   undef Tcl_WinTCharToUtf

 * Registry_Init declaration is in the source file itself, which is only
 * accessed when we are building a library.
 */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT









/*
 * The following macros convert between different endian ints.
 */

#define SWAPWORD(x)	MAKEWORD(HIBYTE(x), LOBYTE(x))
#define SWAPLONG(x)	MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))

    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Key to enumerate. */
    Tcl_Obj *patternObj,	/* Optional match pattern. */
    REGSAM mode)		/* Mode flags to pass. */
{
    const char *pattern;	/* Pattern being matched against subkeys */
    HKEY key;			/* Handle to the key being examined */
    DWORD subKeyCount;		/* Number of subkeys to list */
    DWORD maxSubKeyLen;		/* Maximum string length of any subkey */
    TCHAR *buffer;		/* Buffer to hold the subkey name */
    DWORD maxBufSize;		/* Maximum size of the buffer */
    DWORD bufSize;		/* Size of the buffer */
    DWORD index;		/* Position of the current subkey */
    char *name;			/* Subkey name */
    Tcl_Obj *resultPtr;		/* List of subkeys being accumulated */
    int result = TCL_OK;	/* Return value from this command */
    Tcl_DString ds;		/* Buffer to translate subkey name to UTF-8 */

     */

    mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Determine how big a buffer is needed for enumerating subkeys, and how
     * many subkeys there are.
     */

    result = RegQueryInfoKey(key, NULL, NULL, NULL,
	    &subKeyCount, &maxSubKeyLen, NULL, NULL, NULL, NULL, NULL, NULL);
    if (result != ERROR_SUCCESS) {
	Tcl_SetObjResult(interp, Tcl_NewObj());
	Tcl_AppendResult(interp, "unable to query key \"",
		Tcl_GetString(keyNameObj), "\": ", NULL);
	AppendSystemError(interp, result);
	RegCloseKey(key);
	return TCL_ERROR;
    }
    maxBufSize = maxSubKeyLen + 1;
    buffer = ckalloc(maxBufSize * sizeof(TCHAR));

    /*
     * Enumerate the subkeys.
     */

    resultPtr = Tcl_NewObj();
    for (index = 0; index < subKeyCount; ++index) {
	bufSize = maxBufSize;
	result = RegEnumKeyEx(key, index, buffer, &bufSize,
		NULL, NULL, NULL, NULL);
	if ((result == ERROR_MORE_DATA) && (maxBufSize < MAX_KEY_LENGTH)) {
	    maxBufSize = MAX_KEY_LENGTH + 1;
	    buffer = ckrealloc(buffer, maxBufSize * sizeof(TCHAR));
	    bufSize = maxBufSize;
	    result = RegEnumKeyEx(key, index, buffer, &bufSize,
		    NULL, NULL, NULL, NULL);
	}
	if (result != ERROR_SUCCESS) {



	    Tcl_SetObjResult(interp, Tcl_NewObj());
	    Tcl_AppendResult(interp, "unable to enumerate subkeys of \"",
		    Tcl_GetString(keyNameObj), "\": ", NULL);
	    AppendSystemError(interp, result);
	    result = TCL_ERROR;

	    break;
	}
	Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
	name = Tcl_DStringValue(&ds);
	if (pattern && !Tcl_StringMatch(name, pattern)) {
	    Tcl_DStringFree(&ds);
	    continue;

    }
    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */
    }

    ckfree(buffer);
    RegCloseKey(key);
    return result;
}

/*
 *----------------------------------------------------------------------
 *

    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *keyNameObj,	/* Key to enumerate. */
    Tcl_Obj *patternObj,	/* Optional match pattern. */
    REGSAM mode)		/* Mode flags to pass. */
{
    HKEY key;
    Tcl_Obj *resultPtr;
    DWORD index, size, maxSize, result;
    Tcl_DString buffer, ds;
    const char *pattern, *name;

    /*
     * Attempt to open the key for enumeration.
     */

    mode |= KEY_QUERY_VALUE;
    if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Query the key to determine the appropriate buffer size to hold the
     * largest value name plus the terminating null.
     */

    result = RegQueryInfoKey(key, NULL, NULL, NULL, NULL,
	    NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
    if (result != ERROR_SUCCESS) {
	Tcl_AppendResult(interp, "unable to query key \"",
		Tcl_GetString(keyNameObj), "\": ", NULL);
	AppendSystemError(interp, result);
	RegCloseKey(key);
	result = TCL_ERROR;
	goto done;
    }
    maxSize++;

    resultPtr = Tcl_NewObj();
    Tcl_DStringInit(&buffer);
    Tcl_DStringSetLength(&buffer,
	    (int) (maxSize*sizeof(TCHAR)));
    index = 0;
    result = TCL_OK;

    if (patternObj) {
	pattern = Tcl_GetString(patternObj);
    } else {
	pattern = NULL;
    }

    /*
     * Enumerate the values under the given subkey until we get an error,
     * indicating the end of the list. Note that we need to reset size after
     * each iteration because RegEnumValue smashes the old value.
     */

    size = maxSize;
    while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer),
	    &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) {
	size *= 2;

	Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
		&ds);
	name = Tcl_DStringValue(&ds);
	if (!pattern || Tcl_StringMatch(name, pattern)) {
	    result = Tcl_ListObjAppendElement(interp, resultPtr,
		    Tcl_NewStringObj(name, Tcl_DStringLength(&ds)));
	    if (result != TCL_OK) {
		Tcl_DStringFree(&ds);
		break;
	    }
	}
	Tcl_DStringFree(&ds);

	index++;
	size = maxSize;
    }
    Tcl_SetObjResult(interp, resultPtr);
    Tcl_DStringFree(&buffer);

  done:
    RegCloseKey(key);
    return result;
}

/*
 *----------------------------------------------------------------------
 *

static DWORD
RecursiveDeleteKey(
    HKEY startKey,		/* Parent of key to be deleted. */
    const TCHAR *keyName,	/* Name of key to be deleted in external
				 * encoding, not UTF. */
    REGSAM mode)		/* Mode flags to pass. */
{
    DWORD result, size, maxSize;
    Tcl_DString subkey;
    HKEY hKey;
    REGSAM saveMode = mode;
    static int checkExProc = 0;
    static FARPROC regDeleteKeyExProc = NULL;

    /*
     * Do not allow NULL or empty key name.
     */

    if (!keyName || *keyName == '\0') {
	return ERROR_BADKEY;
    }

    mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE;
    result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey);
    if (result != ERROR_SUCCESS) {
	return result;
    }
    result = RegQueryInfoKey(hKey, NULL, NULL, NULL, NULL,
	    &maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
    maxSize++;
    if (result != ERROR_SUCCESS) {
	return result;
    }

    Tcl_DStringInit(&subkey);
    Tcl_DStringSetLength(&subkey,
	    (int) (maxSize * sizeof(TCHAR)));

    mode = saveMode;
    while (result == ERROR_SUCCESS) {
	/*
	 * Always get index 0 because key deletion changes ordering.
	 */

	size = maxSize;
	result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey),
		&size, NULL, NULL, NULL, NULL);
	if (result == ERROR_NO_MORE_ITEMS) {
	    /*
	     * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we
	     * can't compile with it in. We need to check for it at runtime
	     * and use it if we find it.