From 289662f4dd776fb4e9410efcc9a5512714b83927 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 30 Mar 2010 12:33:46 +0000 Subject: TIP #362 IMPLEMENTATION * win/tclWinReg.c: [Patch 2960976]: Apply patch from Damon Courtney to * tests/registry.test: allow the registry command to be told to work with both 32-bit and 64-bit registries. --- ChangeLog | 12 +- tests/registry.test | 53 ++++++++- win/tclWinReg.c | 318 +++++++++++++++++++++++++++++++++------------------- 3 files changed, 260 insertions(+), 123 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4cd68e5..8614245 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,16 @@ +2010-03-30 Donal K. Fellows + + TIP #362 IMPLEMENTATION + + * win/tclWinReg.c: [Patch 2960976]: Apply patch from Damon Courtney to + * tests/registry.test: allow the registry command to be told to work + with both 32-bit and 64-bit registries. + 2010-03-29 Jan Nijtmans - * unix/tcl.m4 Only test for -visibility=hidden with gcc + * unix/tcl.m4: Only test for -visibility=hidden with gcc (Second remark in [Bug 2976508]) - * unix/configure regen + * unix/configure: regen 2010-03-29 Don Porter diff --git a/tests/registry.test b/tests/registry.test index 62c9d84..8a7c4d4 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -10,7 +10,7 @@ # Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved. # Copyright (c) 1998-1999 by Scriptics Corporation. # -# RCS: @(#) $Id: registry.test,v 1.24 2008/11/29 14:44:24 patthoyts Exp $ +# RCS: @(#) $Id: registry.test,v 1.25 2010/03/30 12:33:47 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -35,17 +35,32 @@ testConstraint english [expr { [llength [info commands testlocale]] && [string match "English*" [testlocale all ""]] }] - + test registry-1.1 {argument parsing for registry command} {win reg} { list [catch {registry} msg] $msg -} {1 {wrong # args: should be "registry option ?arg ...?"}} +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} +test registry-1.1a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit} msg] $msg +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} +test registry-1.1b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit} msg] $msg +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} test registry-1.2 {argument parsing for registry command} {win reg} { list [catch {registry foo} msg] $msg } {1 {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}} +test registry-1.2a {argument parsing for registry command} {win reg} { + list [catch {registry -33bit foo} msg] $msg +} {1 {bad option "-33bit": must be broadcast, delete, get, keys, set, type, or values}} test registry-1.3 {argument parsing for registry command} {win reg} { list [catch {registry d} msg] $msg } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} +test registry-1.3a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit d} msg] $msg +} {1 {wrong # args: should be "registry -32bit delete keyName ?valueName?"}} +test registry-1.3b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit d} msg] $msg +} {1 {wrong # args: should be "registry -64bit delete keyName ?valueName?"}} test registry-1.4 {argument parsing for registry command} {win reg} { list [catch {registry delete} msg] $msg } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} @@ -56,6 +71,12 @@ test registry-1.5 {argument parsing for registry command} {win reg} { test registry-1.6 {argument parsing for registry command} {win reg} { list [catch {registry g} msg] $msg } {1 {wrong # args: should be "registry get keyName valueName"}} +test registry-1.6a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit g} msg] $msg +} {1 {wrong # args: should be "registry -32bit get keyName valueName"}} +test registry-1.6b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit g} msg] $msg +} {1 {wrong # args: should be "registry -64bit get keyName valueName"}} test registry-1.7 {argument parsing for registry command} {win reg} { list [catch {registry get} msg] $msg } {1 {wrong # args: should be "registry get keyName valueName"}} @@ -69,6 +90,12 @@ test registry-1.9 {argument parsing for registry command} {win reg} { test registry-1.10 {argument parsing for registry command} {win reg} { list [catch {registry k} msg] $msg } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} +test registry-1.10a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit k} msg] $msg +} {1 {wrong # args: should be "registry -32bit keys keyName ?pattern?"}} +test registry-1.10b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit k} msg] $msg +} {1 {wrong # args: should be "registry -64bit keys keyName ?pattern?"}} test registry-1.11 {argument parsing for registry command} {win reg} { list [catch {registry keys} msg] $msg } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} @@ -79,6 +106,12 @@ test registry-1.12 {argument parsing for registry command} {win reg} { test registry-1.13 {argument parsing for registry command} {win reg} { list [catch {registry s} msg] $msg } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} +test registry-1.13a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit s} msg] $msg +} {1 {wrong # args: should be "registry -32bit set keyName ?valueName data ?type??"}} +test registry-1.13b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit s} msg] $msg +} {1 {wrong # args: should be "registry -64bit set keyName ?valueName data ?type??"}} test registry-1.14 {argument parsing for registry command} {win reg} { list [catch {registry set} msg] $msg } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} @@ -92,6 +125,12 @@ test registry-1.16 {argument parsing for registry command} {win reg} { test registry-1.17 {argument parsing for registry command} {win reg} { list [catch {registry t} msg] $msg } {1 {wrong # args: should be "registry type keyName valueName"}} +test registry-1.17a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit t} msg] $msg +} {1 {wrong # args: should be "registry -32bit type keyName valueName"}} +test registry-1.17b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit t} msg] $msg +} {1 {wrong # args: should be "registry -64bit type keyName valueName"}} test registry-1.18 {argument parsing for registry command} {win reg} { list [catch {registry type} msg] $msg } {1 {wrong # args: should be "registry type keyName valueName"}} @@ -105,6 +144,12 @@ test registry-1.20 {argument parsing for registry command} {win reg} { test registry-1.21 {argument parsing for registry command} {win reg} { list [catch {registry v} msg] $msg } {1 {wrong # args: should be "registry values keyName ?pattern?"}} +test registry-1.21a {argument parsing for registry command} {win reg} { + list [catch {registry -32bit v} msg] $msg +} {1 {wrong # args: should be "registry -32bit values keyName ?pattern?"}} +test registry-1.21b {argument parsing for registry command} {win reg} { + list [catch {registry -64bit v} msg] $msg +} {1 {wrong # args: should be "registry -64bit values keyName ?pattern?"}} test registry-1.22 {argument parsing for registry command} {win reg} { list [catch {registry values} msg] $msg } {1 {wrong # args: should be "registry values keyName ?pattern?"}} @@ -630,7 +675,7 @@ test registry-12.4 {BroadcastValue} -constraints {win reg} -body { test registry-12.5 {BroadcastValue} -constraints {win reg} -body { registry b {} } -result {1 0} - + # cleanup ::tcltest::cleanupTests return diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 195afd2..d5e1a28 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinReg.c,v 1.50 2010/01/10 22:58:40 nijtmans Exp $ + * RCS: @(#) $Id: tclWinReg.c,v 1.51 2010/03/30 12:33:47 dkf Exp $ */ #undef STATIC_BUILD @@ -25,6 +25,17 @@ #include /* + * Ensure that we can say which registry is being accessed. + */ + +#ifndef KEY_WOW64_64KEY +#define KEY_WOW64_64KEY (0x0100) +#endif +#ifndef KEY_WOW64_32KEY +#define KEY_WOW64_32KEY (0x0200) +#endif + +/* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the * Registry_Init declaration is in the source file itself, which is only * accessed when we are building a library. @@ -37,8 +48,8 @@ * 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))) +#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) +#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) /* * The following flag is used in OpenKeys to indicate that the specified key @@ -171,17 +182,18 @@ static int BroadcastValue(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); static void DeleteCmd(ClientData clientData); -static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj); +static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, + REGSAM mode); static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj); + Tcl_Obj *patternObj, REGSAM mode); static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *valueNameObj); + Tcl_Obj *valueNameObj, REGSAM mode); static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, - Tcl_Obj *patternObj); + Tcl_Obj *patternObj, REGSAM mode); static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, REGSAM mode, int flags, HKEY *keyPtr); static DWORD OpenSubKey(char *hostName, HKEY rootKey, @@ -191,13 +203,13 @@ static int ParseKeyName(Tcl_Interp *interp, char *name, char **hostNamePtr, HKEY *rootKeyPtr, char **keyNamePtr); static DWORD RecursiveDeleteKey(HKEY hStartKey, - const TCHAR * pKeyName); + const TCHAR * pKeyName, REGSAM mode); static int RegistryObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, - Tcl_Obj *typeObj); + Tcl_Obj *typeObj, REGSAM mode); EXTERN int Registry_Init(Tcl_Interp *interp); EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); @@ -235,11 +247,11 @@ Registry_Init( */ useWide = (TclWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS); - regWinProcs = useWide ? &unicodeProcs : &asciiProcs; + regWinProcs = useWide ? &unicodeProcs : &asciiProcs; cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, - (ClientData)interp, DeleteCmd); - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd); + interp, DeleteCmd); + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); return Tcl_PkgProvide(interp, "registry", "1.2.1"); } @@ -280,7 +292,7 @@ Registry_Unload( * Delete the originally registered command. */ - cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); + cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); if (cmd != NULL) { Tcl_DeleteCommandFromToken(interp, cmd); } @@ -310,7 +322,8 @@ DeleteCmd( ClientData clientData) { Tcl_Interp *interp = clientData; - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL); + + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); } /* @@ -336,7 +349,9 @@ RegistryObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - int index; + int n = 1; + int index, argc; + REGSAM mode = 0; const char *errString = NULL; static const char *const subcommands[] = { @@ -345,78 +360,112 @@ RegistryObjCmd( enum SubCmdIdx { BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx }; + static const char *const modes[] = { + "-32bit", "-64bit", NULL + }; if (objc < 2) { - Tcl_WrongNumArgs(interp, objc, objv, "option ?arg ...?"); + wrongArgs: + Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index) - != TCL_OK) { + if (Tcl_GetString(objv[n])[0] == '-') { + if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + switch (index) { + case 0: /* -32bit */ + mode |= KEY_WOW64_32KEY; + break; + case 1: /* -64bit */ + mode |= KEY_WOW64_64KEY; + break; + } + if (objc < 3) { + goto wrongArgs; + } + } + + if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, + &index) != TCL_OK) { return TCL_ERROR; } + argc = (objc - n); switch (index) { case BroadcastIdx: /* broadcast */ - return BroadcastValue(interp, objc, objv); + if (argc == 1 || argc == 3) { + int res = BroadcastValue(interp, argc, objv + n); + + if (res != TCL_BREAK) { + return res; + } + } + errString = "keyName ?-timeout milliseconds?"; break; case DeleteIdx: /* delete */ - if (objc == 3) { - return DeleteKey(interp, objv[2]); - } else if (objc == 4) { - return DeleteValue(interp, objv[2], objv[3]); + if (argc == 1) { + return DeleteKey(interp, objv[n], mode); + } else if (argc == 2) { + return DeleteValue(interp, objv[n], objv[++n], mode); } errString = "keyName ?valueName?"; break; case GetIdx: /* get */ - if (objc == 4) { - return GetValue(interp, objv[2], objv[3]); + if (argc == 2) { + return GetValue(interp, objv[n], objv[++n], mode); } errString = "keyName valueName"; break; case KeysIdx: /* keys */ - if (objc == 3) { - return GetKeyNames(interp, objv[2], NULL); - } else if (objc == 4) { - return GetKeyNames(interp, objv[2], objv[3]); + if (argc == 1) { + return GetKeyNames(interp, objv[n], NULL, mode); + } else if (argc == 2) { + return GetKeyNames(interp, objv[n], objv[++n], mode); } errString = "keyName ?pattern?"; break; case SetIdx: /* set */ - if (objc == 3) { + if (argc == 1) { HKEY key; /* * Create the key and then close it immediately. */ - if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) { + mode |= KEY_ALL_ACCESS; + if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) { return TCL_ERROR; } RegCloseKey(key); return TCL_OK; - } else if (objc == 5 || objc == 6) { - Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5]; - return SetValue(interp, objv[2], objv[3], objv[4], typeObj); + } else if (argc == 3) { + return SetValue(interp, objv[n], objv[++n], objv[++n], NULL, + mode); + } else if (argc == 4) { + return SetValue(interp, objv[n], objv[++n], objv[++n], objv[++n], + mode); } errString = "keyName ?valueName data ?type??"; break; case TypeIdx: /* type */ - if (objc == 4) { - return GetType(interp, objv[2], objv[3]); + if (argc == 2) { + return GetType(interp, objv[n], objv[++n], mode); } errString = "keyName valueName"; break; case ValuesIdx: /* values */ - if (objc == 3) { - return GetValueNames(interp, objv[2], NULL); - } else if (objc == 4) { - return GetValueNames(interp, objv[2], objv[3]); + if (argc == 1) { + return GetValueNames(interp, objv[n], NULL, mode); + } else if (argc == 2) { + return GetValueNames(interp, objv[n], objv[++n], mode); } errString = "keyName ?pattern?"; break; } - Tcl_WrongNumArgs(interp, 2, objv, errString); + Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString); return TCL_ERROR; } @@ -439,7 +488,8 @@ RegistryObjCmd( static int DeleteKey( Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Obj *keyNameObj) /* Name of key to delete. */ + Tcl_Obj *keyNameObj, /* Name of key to delete. */ + REGSAM mode) /* Mode flags to pass. */ { char *tail, *buffer, *hostName, *keyName; const char *nativeTail; @@ -447,13 +497,14 @@ DeleteKey( DWORD result; int length; Tcl_DString buf; + REGSAM saveMode = mode; /* * Find the parent of the key being deleted and open it. */ keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc((unsigned int) length + 1); + buffer = ckalloc((unsigned) length + 1); strcpy(buffer, keyName); if (ParseKeyName(interp, buffer, &hostName, &rootKey, @@ -463,8 +514,8 @@ DeleteKey( } if (*keyName == '\0') { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad key: cannot delete root keys", -1)); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("bad key: cannot delete root keys", -1)); ckfree(buffer); return TCL_ERROR; } @@ -477,15 +528,15 @@ DeleteKey( keyName = NULL; } - result = OpenSubKey(hostName, rootKey, keyName, - KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey); + mode |= KEY_ENUMERATE_SUB_KEYS | DELETE; + result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey); if (result != ERROR_SUCCESS) { ckfree(buffer); if (result == ERROR_FILE_NOT_FOUND) { return TCL_OK; } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to delete key: ", -1)); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -495,7 +546,7 @@ DeleteKey( */ nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); - result = RecursiveDeleteKey(subkey, nativeTail); + result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { @@ -532,7 +583,8 @@ static int DeleteValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to delete. */ + Tcl_Obj *valueNameObj, /* Name of value to delete. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; char *valueName; @@ -544,8 +596,8 @@ DeleteValue( * Attempt to open the key for deletion. */ - if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_SET_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -589,9 +641,10 @@ static int GetKeyNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj) /* Optional match pattern. */ + Tcl_Obj *patternObj, /* Optional match pattern. */ + REGSAM mode) /* Mode flags to pass. */ { - const char *pattern; /* Pattern being matched against subkeys */ + 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 */ @@ -609,26 +662,26 @@ GetKeyNames( pattern = NULL; } - /* Attempt to open the key for enumeration. */ + /* + * Attempt to open the key for enumeration. + */ - if (OpenKey(interp, keyNameObj, - KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS, - 0, &key) != TCL_OK) { + 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 + * Determine how big a buffer is needed for enumerating subkeys, and how + * many subkeys there are. */ - result = (*regWinProcs->regQueryInfoKeyProc) - (key, NULL, NULL, NULL, &subKeyCount, &maxSubKeyLen, NULL, NULL, - NULL, NULL, NULL, NULL); + result = regWinProcs->regQueryInfoKeyProc(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); + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); RegCloseKey(key); return TCL_ERROR; @@ -639,19 +692,19 @@ GetKeyNames( buffer = ckalloc(maxSubKeyLen+1); } - /* Enumerate the subkeys */ + /* + * Enumerate the subkeys. + */ resultPtr = Tcl_NewObj(); for (index = 0; index < subKeyCount; ++index) { bufSize = maxSubKeyLen+1; - result = (*regWinProcs->regEnumKeyExProc) - (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); + result = regWinProcs->regEnumKeyExProc(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); + Tcl_AppendResult(interp, "unable to enumerate subkeys of \"", + Tcl_GetString(keyNameObj), "\": ", NULL); AppendSystemError(interp, result); result = TCL_ERROR; break; @@ -703,11 +756,11 @@ static int GetType( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to get. */ + Tcl_Obj *valueNameObj, /* Name of value to get. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; - DWORD result; - DWORD type; + DWORD result, type; Tcl_DString ds; const char *valueName, *nativeValue; int length; @@ -716,8 +769,8 @@ GetType( * Attempt to open the key for reading. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -774,7 +827,8 @@ static int GetValue( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Name of key. */ - Tcl_Obj *valueNameObj) /* Name of value to get. */ + Tcl_Obj *valueNameObj, /* Name of value to get. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; const char *valueName, *nativeValue; @@ -786,7 +840,8 @@ GetValue( * Attempt to open the key for reading. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -841,7 +896,7 @@ GetValue( if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, - *((DWORD*) Tcl_DStringValue(&data))))); + *((DWORD *) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); char *end = Tcl_DStringValue(&data) + length; @@ -853,16 +908,17 @@ GetValue( * we get bogus data. */ - while (p < end && ((regWinProcs->useWide) - ? *((Tcl_UniChar *)p) : *p) != 0) { + while ((p < end) + && (regWinProcs->useWide ? *((Tcl_UniChar *) p) : *p) != 0) { Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); if (regWinProcs->useWide) { - Tcl_UniChar* up = (Tcl_UniChar*) p; + Tcl_UniChar *up = (Tcl_UniChar *) p; + while (*up++ != 0) {} - p = (char*) up; + p = (char *) up; } else { while (*p++ != '\0') {} } @@ -907,7 +963,8 @@ static int GetValueNames( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *keyNameObj, /* Key to enumerate. */ - Tcl_Obj *patternObj) /* Optional match pattern. */ + Tcl_Obj *patternObj, /* Optional match pattern. */ + REGSAM mode) /* Mode flags to pass. */ { HKEY key; Tcl_Obj *resultPtr; @@ -919,8 +976,8 @@ GetValueNames( * Attempt to open the key for enumeration. */ - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) - != TCL_OK) { + mode |= KEY_QUERY_VALUE; + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { return TCL_ERROR; } @@ -944,7 +1001,7 @@ GetValueNames( resultPtr = Tcl_NewObj(); Tcl_DStringInit(&buffer); Tcl_DStringSetLength(&buffer, - (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize)); + (int) (regWinProcs->useWide ? maxSize*2 : maxSize)); index = 0; result = TCL_OK; @@ -1022,7 +1079,7 @@ OpenKey( DWORD result; keyName = Tcl_GetStringFromObj(keyNameObj, &length); - buffer = ckalloc((unsigned int) length + 1); + buffer = ckalloc((unsigned) length + 1); strcpy(buffer, keyName); result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); @@ -1223,12 +1280,16 @@ ParseKeyName( static DWORD RecursiveDeleteKey( HKEY startKey, /* Parent of key to be deleted. */ - const char *keyName) /* Name of key to be deleted in external + const char *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. @@ -1238,8 +1299,8 @@ RecursiveDeleteKey( return ERROR_BADKEY; } - result = regWinProcs->regOpenKeyExProc(startKey, keyName, 0, - KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey); + mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; + result = regWinProcs->regOpenKeyExProc(startKey, keyName, 0, mode, &hKey); if (result != ERROR_SUCCESS) { return result; } @@ -1254,6 +1315,7 @@ RecursiveDeleteKey( Tcl_DStringSetLength(&subkey, (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize)); + mode = saveMode; while (result == ERROR_SUCCESS) { /* * Always get index 0 because key deletion changes ordering. @@ -1263,10 +1325,36 @@ RecursiveDeleteKey( result = regWinProcs->regEnumKeyExProc(hKey, 0, Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); if (result == ERROR_NO_MORE_ITEMS) { - result = regWinProcs->regDeleteKeyProc(startKey, keyName); + /* + * 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. + */ + + if (mode && !checkExProc) { + HINSTANCE dllH; + + checkExProc = 1; + dllH = LoadLibrary("advapi32.dll"); + if (dllH) { + if (regWinProcs->useWide) { + regDeleteKeyExProc = (FARPROC) + GetProcAddress(dllH, "RegDeleteKeyExW"); + } else { + regDeleteKeyExProc = (FARPROC) + GetProcAddress(dllH, "RegDeleteKeyExA"); + } + } + } + if (mode && regDeleteKeyExProc) { + result = regDeleteKeyExProc(startKey, keyName, mode, 0); + } else { + result = regWinProcs->regDeleteKeyProc(startKey, keyName); + } break; } else if (result == ERROR_SUCCESS) { - result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey)); + result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey), + mode); } } Tcl_DStringFree(&subkey); @@ -1298,12 +1386,12 @@ SetValue( Tcl_Obj *keyNameObj, /* Name of key. */ Tcl_Obj *valueNameObj, /* Name of value to set. */ Tcl_Obj *dataObj, /* Data to be written. */ - Tcl_Obj *typeObj) /* Type of data to be written. */ + Tcl_Obj *typeObj, /* Type of data to be written. */ + REGSAM mode) /* Mode flags to pass. */ { - int type; + int type, length; DWORD result; HKEY key; - int length; const char *valueName; Tcl_DString nameBuf; @@ -1311,12 +1399,13 @@ SetValue( type = REG_SZ; } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", 0, (int *) &type) != TCL_OK) { - if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) { + if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) { return TCL_ERROR; } Tcl_ResetResult(interp); } - if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) { + mode |= KEY_ALL_ACCESS; + if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { return TCL_ERROR; } @@ -1369,7 +1458,7 @@ SetValue( Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, &buf); result = regWinProcs->regSetValueExProc(key, valueName, 0, - (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), + (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), (DWORD) Tcl_DStringLength(&buf)); Tcl_DStringFree(&data); Tcl_DStringFree(&buf); @@ -1389,7 +1478,7 @@ SetValue( length = Tcl_DStringLength(&buf) + 1; result = regWinProcs->regSetValueExProc(key, valueName, 0, - (DWORD) type, (BYTE *) data, (DWORD) length); + (DWORD) type, (BYTE *) data, (DWORD) length); Tcl_DStringFree(&buf); } else { BYTE *data; @@ -1400,7 +1489,7 @@ SetValue( data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); result = regWinProcs->regSetValueExProc(key, valueName, 0, - (DWORD) type, data, (DWORD) length); + (DWORD) type, data, (DWORD) length); } Tcl_DStringFree(&nameBuf); @@ -1445,24 +1534,18 @@ BroadcastValue( const char *str; Tcl_Obj *objPtr; - if ((objc != 3) && (objc != 5)) { - Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); - return TCL_ERROR; - } - - if (objc > 3) { - str = Tcl_GetStringFromObj(objv[3], &len); + if (objc == 3) { + str = Tcl_GetStringFromObj(objv[1], &len); if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) { - Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); - return TCL_ERROR; + return TCL_BREAK; } - if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], (int *) &timeout) != TCL_OK) { return TCL_ERROR; } } - str = Tcl_GetStringFromObj(objv[2], &len); + str = Tcl_GetStringFromObj(objv[0], &len); if (len == 0) { str = NULL; } @@ -1526,7 +1609,8 @@ AppendSystemError( MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, 0, NULL); if (length > 0) { - wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR)); + wMsgPtr = (WCHAR *) + LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR)); MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr, length + 1); LocalFree(msgPtr); @@ -1604,7 +1688,7 @@ ConvertDWORD( * Check to see if the low bit is in the first byte. */ - localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; + localType = (*((char *) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; return (type != localType) ? (DWORD) SWAPLONG(value) : value; } -- cgit v0.12