home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
tcltk805.zip
/
tcl805s.zip
/
tcl8.0.5
/
os2
/
tclOS2Reg.c
< prev
next >
Wrap
C/C++ Source or Header
|
2001-02-09
|
38KB
|
1,258 lines
/*
* tclOS2Reg.c --
*
* This file contains the implementation of the "registry" Tcl
* built-in command. This command is built as a dynamically
* loadable extension in a separate DLL.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
* Copyright (c) 1999-2001 Illya Vaes
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclOS2Reg.c 1.8 97/08/01 11:17:49
*/
#include "tclOS2Int.h"
/*
* The following tables contain the mapping from registry root names
* to the system predefined keys.
*/
static char *iniFileNames[] = {
"BOTH", "USER", "SYSTEM", NULL
};
static HINI iniHandles[] = {
HINI_PROFILE, HINI_USERPROFILE, HINI_SYSTEMPROFILE, NULLHANDLE
};
/*
* The following define the amount of apps/keys we can enumerate from
* a profile.
*/
#define MAX_APPS 512 /* per profile */
#define MAX_APPLEN 32
#define MAX_KEYS 128 /* per app per profile */
/* If we want a high ENUM_KEYS, don't use 'char list[ENUM_KEYS]' but 'malloc' */
#define MAX_KEYLEN 64 /* CCHMAXPATH */
#define ENUM_APPS (MAX_APPS * MAX_APPLEN)
#define ENUM_KEYS (MAX_KEYS * MAX_KEYLEN)
#define USERPROFILE 0
#define SYSTEMPROFILE 1
/* Array for paths of profiles at time of loading. */
static char userIniPath[CCHMAXPATH+1];
static char sysIniPath[CCHMAXPATH+1];
/*
* The following gives the possible types to write keys as and mappings from
* the possible type argument to the registry command.
*/
#define BINARY 0
#define LONG 1
#define STRING 2
#define SZ 3
#define DWORD 4
#define MAXTYPE DWORD
static char *typeNames[] = {
"binary", "long", "string",
"sz", "dword", /* for Windows compatibility */
NULL
};
static ULONG ret;
/*
* Declarations for functions defined in this file.
*/
static void AppendSystemError(Tcl_Interp *interp, ULONG error);
static int RegistryObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj * CONST objv[]);
/* Windows compatible functions */
static int TclOS2RegDelete(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj);
static int TclOS2GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *typeObj);
static int TclOS2GetKeyNames(Tcl_Interp *interp,
Tcl_Obj *keyNameObj, Tcl_Obj *patternObj);
static int TclOS2SetKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
Tcl_Obj *typeObj);
/* Utility functions */
static int TclOS2OpenProfile(Tcl_Interp *interp, char *name,
char **iniFilePtr, char **keyNamePtr,
HINI *iniHandlePtr);
static int TclOS2CloseProfile(HINI iniHandle);
/* OS/2 specific functionality */
static int TclOS2GetAppNames(Tcl_Interp *interp,
Tcl_Obj *iniFileObj, Tcl_Obj *patternObj);
static int TclOS2GetAppKeyNames(Tcl_Interp *interp,
Tcl_Obj *appNameObj, Tcl_Obj *patternObj);
static int TclOS2SetAppKey(Tcl_Interp *interp, Tcl_Obj *appNameObj,
Tcl_Obj *keyNameObj, Tcl_Obj *dataObj,
Tcl_Obj *typeObj);
int Registry_Init(Tcl_Interp *interp);
/*
*----------------------------------------------------------------------
*
* _DLL_InitTerm --
*
* This wrapper function is used by OS/2 to invoke the
* initialization code for the DLL.
*
* Results:
* Returns TRUE on success, FALSE on failure;
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifdef __OS2__
#ifndef STATIC_BUILD
unsigned long
_DLL_InitTerm(
unsigned long hInst, /* Library instance handle. */
unsigned long reason) /* Reason this function is being called. */
{
switch (reason) {
case 0: { /* INIT */
/*
* Store paths of profiles into their array.
* Since the info isn't used (yet), we won't consider failure a
* fatal error.
*/
PRFPROFILE prfProfile;
/* Fill in the lengths with 0 or PrfQueryProfile will fail! */
prfProfile.pszUserName = userIniPath;
prfProfile.cchUserName = sizeof(userIniPath);
userIniPath[prfProfile.cchUserName-1] = '\0';
prfProfile.pszSysName = sysIniPath;
prfProfile.cchSysName = sizeof(sysIniPath);
sysIniPath[prfProfile.cchSysName-1] = '\0';
#ifdef VERBOSE
printf("TclOS2GetHAB(): %x\n", TclOS2GetHAB());
#endif
if (PrfQueryProfile(TclOS2GetHAB(), &prfProfile) == TRUE) {
#ifdef VERBOSE
printf("User Profile [%s] (%d)\nSystem Profile [%s] (%d)\n",
prfProfile.pszUserName, prfProfile.cchUserName,
prfProfile.pszSysName, prfProfile.cchSysName);
#endif
} else {
#ifdef VERBOSE
printf("PrfQueryProfile ERROR %x\n",
WinGetLastError(TclOS2GetHAB()));
#endif
userIniPath[0] = '\0';
sysIniPath[0] = '\0';
}
return TRUE;
break;
}
case 1: /* TERM */
#ifdef VERBOSE
printf("_DLL_InitTerm TERM\n");
fflush(stdout);
#endif
return TRUE;
}
return FALSE;
}
#endif
#endif
/*
*----------------------------------------------------------------------
*
* Registry_Init --
*
* This procedure initializes the registry command.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Registry_Init(
Tcl_Interp *interp)
{
#ifdef VERBOSE
printf("Registry_Init\n");
fflush(stdout);
#endif
Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
/*
Tcl_CreateObjCommand(interp, "profile", RegistryObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "ini", RegistryObjCmd, NULL, NULL);
*/
return Tcl_PkgProvide(interp, "registry", "1.0");
}
/*
*----------------------------------------------------------------------
*
* RegistryObjCmd --
*
* This function implements the Tcl "registry" command, also known
* as "profile" and "ini" in the OS/2 version.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
RegistryObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj * CONST objv[]) /* Argument values. */
{
int index;
char *errString = NULL;
static char *subcommands[] = { "delete", "get", "keys", "set", "type",
"values",
"apps", "appkeys", "appset",
(char *) NULL };
enum SubCmdIdx { DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx,
AppsIdx, AppKeysIdx, AppSetIdx };
#ifdef VERBOSE
printf("RegistryObjCmd()\n");
fflush(stdout);
#endif
if (objc < 2) {
Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index)
!= TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case DeleteIdx: /* delete */
if (objc == 3) {
return TclOS2RegDelete(interp, objv[2], NULL);
} else if (objc == 4) {
return TclOS2RegDelete(interp, objv[2], objv[3]);
}
errString = "keyName ?valueName?";
break;
case GetIdx: /* get */
if (objc == 4) {
return TclOS2GetValue(interp, objv[2], objv[3], NULL);
} else if (objc == 5) {
return TclOS2GetValue(interp, objv[2], objv[3], objv[4]);
}
errString = "keyName valueName ?asType?";
break;
case KeysIdx: /* keys */
if (objc == 3) {
return TclOS2GetKeyNames(interp, objv[2], NULL);
} else if (objc == 4) {
return TclOS2GetKeyNames(interp, objv[2], objv[3]);
}
errString = "keyName ?pattern?";
break;
case SetIdx: /* set */
if (objc == 3) {
/* Only the application isn't possible but will not complain */
return TclOS2SetKey(interp, objv[2], NULL, NULL, NULL);
} else if (objc == 5 || objc == 6) {
Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
return TclOS2SetKey(interp, objv[2], objv[3], objv[4], typeObj);
}
errString = "keyName ?valueName data ?type??";
break;
case ValuesIdx: /* values */
if (objc == 3 || objc == 4) {
return TclOS2GetValue(interp, objv[2], objv[3], NULL);
}
errString = "keyName ?pattern?";
break;
case AppsIdx: /* apps */
if (objc == 3) {
return TclOS2GetAppNames(interp, objv[2], NULL);
} else if (objc == 4) {
return TclOS2GetAppNames(interp, objv[2], objv[3]);
}
errString = "iniFile ?pattern?";
break;
case AppKeysIdx: /* appkeys */
if (objc == 3) {
return TclOS2GetAppKeyNames(interp, objv[2], NULL);
} else if (objc == 4) {
return TclOS2GetAppKeyNames(interp, objv[2], objv[3]);
}
errString = "iniFile\\\\appName ?pattern?";
break;
case AppSetIdx: /* appset */
if (objc == 3) {
/* Only the application */
return TclOS2SetAppKey(interp, objv[2], NULL, NULL, NULL);
} else if (objc == 5 || objc == 6) {
Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
return TclOS2SetAppKey(interp, objv[2], objv[3], objv[4],
typeObj);
}
errString = "appName ?keyName data ?type??";
break;
}
Tcl_WrongNumArgs(interp, 2, objv, errString);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* TclOS2RegDelete --
*
* This function deletes an application or key.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TclOS2RegDelete(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of app to delete. */
Tcl_Obj *valueNameObj) /* Name of key to delete. */
{
char *buffer, *iniFile, *keyName, *valueName;
HINI iniHandle;
int length;
Tcl_Obj *resultPtr;
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
valueName = (valueNameObj != NULL)
? Tcl_GetStringFromObj(valueNameObj, &length)
: NULL;
#ifdef VERBOSE
printf("TclOS2RegDelete(%s, %s)\n", keyName, valueName);
fflush(stdout);
#endif
if (TclOS2OpenProfile(interp, buffer, &iniFile, &keyName, &iniHandle)
!= TCL_OK) {
ckfree(buffer);
return TCL_ERROR;
}
ckfree(buffer);
resultPtr = Tcl_GetObjResult(interp);
if (valueName != NULL && *valueName == '\0') {
Tcl_AppendToObj(resultPtr, "bad key: cannot delete null keys", -1);
return TCL_ERROR;
}
/* Deleting application is done by passing NULL pszKey value */
ret = PrfWriteProfileData(iniHandle, keyName, (PSZ)valueName, (PVOID)NULL,
0);
#ifdef VERBOSE
printf("PrfWriteProfileData(%x, %s, %s, NULL, 0) returns %d\n", iniHandle,
keyName, valueName, ret);
fflush(stdout);
#endif
if (ret != TRUE) {
Tcl_AppendStringsToObj(resultPtr, "unable to delete key \"",
Tcl_GetStringFromObj(valueNameObj, NULL), "\" from application \"",
Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
AppendSystemError(interp, WinGetLastError(TclOS2GetHAB()));
return TCL_ERROR;
}
TclOS2CloseProfile(iniHandle);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclOS2GetValue --
*
* This function querys the profile for the value of a key.
*
* Results:
* A standard Tcl result.
* Returns the list of applications in the result object of the
* interpreter, or an error message on failure.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TclOS2GetValue(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of app. */
Tcl_Obj *valueNameObj, /* Name of key to query. */
Tcl_Obj *typeObj) /* Type of data to be written. */
{
char *buffer, *iniFile, *keyName, *valueName;
HINI iniHandle;
int length;
ULONG maxBuf;
Tcl_Obj *resultPtr;
Tcl_DString data;
/* IMPLEMENTATION STILL IGNORES TYPE */
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
valueName = Tcl_GetStringFromObj(valueNameObj, &length);
#ifdef VERBOSE
printf("TclOS2RegGetValue(%s, %s)\n", keyName, valueName);
fflush(stdout);
#endif
if (TclOS2OpenProfile(interp, buffer, &iniFile, &keyName, &iniHandle)
!= TCL_OK) {
ckfree(buffer);
return TCL_ERROR;
}
ckfree(buffer);
/*
* Initialize a Dstring to maximum statically allocated size
* we could get one more byte by avoiding Tcl_DStringSetLength()
* and just setting maxBuf to TCL_DSTRING_STATIC_SIZE, but this
* should be safer if the implementation Dstrings changes.
* There's no API call to query the length of the key value.
*/
Tcl_DStringInit(&data);
Tcl_DStringSetLength(&data, maxBuf = TCL_DSTRING_STATIC_SIZE - 1);
resultPtr = Tcl_GetObjResult(interp);
ret = PrfQueryProfileData(iniHandle, keyName, valueName,
(PVOID) Tcl_DStringValue(&data), &maxBuf);
#ifdef VERBOSE
printf("PrfQueryProfileData(%x, %s, %s, <>, %d) returns %d\n", iniHandle,
keyName, valueName, maxBuf, ret);
printf(" WinGetLastError %x, maxBuf now %d\n",
WinGetLastError(TclOS2GetHAB()), maxBuf);
fflush(stdout);
#endif
TclOS2CloseProfile(iniHandle);
if (ret != TRUE) {
Tcl_AppendStringsToObj(resultPtr, "unable to get key \"",
Tcl_GetStringFromObj(valueNameObj, NULL), "\" from application \"",
Tcl_GetStringFromObj(keyNameObj, NULL), "\": ", NULL);
AppendSystemError(interp, WinGetLastError(TclOS2GetHAB()));
Tcl_DStringFree(&data);
return TCL_ERROR;
}
/*
* OS/2 Profile data has no inherent type, only how applications wish to
* view them. Therefore, store it as a binary string.
*/
Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&data), maxBuf);
Tcl_DStringFree(&data);
return (ret == TRUE) ? TCL_OK : TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
* TclOS2GetKeyNames --
*
* This function enumerates the keys of in a profile.
* If the optional pattern is supplied, then only key
* names that match the pattern will be returned.
*
* Results:
* Returns the list of key names in the result object of the
* interpreter, or an error message on failure.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TclOS2GetKeyNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Key to enumerate. */
Tcl_Obj *patternObj) /* Optional match pattern. */
{
char *p, *buffer, *iniFile, *keyName;
char apps[ENUM_APPS];
char keyList[ENUM_KEYS];
char fullName[ENUM_APPS + MAX_KEYLEN];
ULONG bufMax;
HINI iniHandle;
int length, len2 = 0;
Tcl_Obj *resultPtr;
int result = TCL_OK;
char *pattern;
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
#ifdef VERBOSE
printf("TclOS2GetKeyNames, keyName [%s]\n", keyName);
fflush(stdout);
#endif
buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
if (TclOS2OpenProfile(interp, buffer, &iniFile, &keyName, &iniHandle)
!= TCL_OK) {
ckfree(buffer);
return TCL_ERROR;
}
ckfree(buffer);
/*
* If the keyName now is the empty string, that means we have to
* enumerate ALL the applications and their keys.
*/
if ( strcmp(keyName, "") == 0 ) {
bufMax = sizeof(apps);
if ( PrfQueryProfileData(iniHandle, NULL, NULL, &apps, &bufMax)
!= TRUE) {
#ifdef VERBOSE
printf(" PrfQueryProfileData ERROR %x\n",
WinGetLastError(TclOS2GetHAB()));
fflush(stdout);
#endif
TclOS2CloseProfile(iniHandle);
return TCL_ERROR;
}
/*
* apps now contains the names of the applications, separated by NULL
* characters; the last is terminated with two successive NULLs.
* bufMax now contains the total length of the list in apps excluding
* the final NULL character.
*/
#ifdef VERBOSE
printf(" PrfQueryProfileData returns %d in apps (first %s)\n",
bufMax, apps);
fflush(stdout);
#endif
} else {
/* Put single appname with second NULL character behind it in apps */
strcpy(apps, keyName);
p = apps + strlen(keyName) + 1;
*p = '\0';
}
/* for keyName in list of applications */
for (keyName = apps; *keyName != '\0'; keyName += strlen(keyName)+1) {
/* query keys for this application */
#ifdef VERBOSE
printf(" Querying keys of application [%s]\n", keyName);
fflush(stdout);
#endif
bufMax = sizeof(keyList);
if ( PrfQueryProfileData(iniHandle, keyName, NULL, &keyList, &bufMax)
!= TRUE) {
#ifdef VERBOSE
printf("PrfQueryProfileData(%x, %s, NULL, keyList, %d) ERROR %x\n",
iniHandle, keyName, bufMax, WinGetLastError(TclOS2GetHAB()));
fflush(stdout);
#endif
TclOS2CloseProfile(iniHandle);
return TCL_ERROR;
}
/*
* keyList now contains the names of the keys, separated by NULL
* characters; the last is terminated with two successive NULLs.
* bufMax now contains the total length of the list in keyList
* excluding the final NULL character.
*/
#ifdef VERBOSE
printf(" PrfQueryProfileData returns %d in buffer (first %s)\n",
bufMax, keyList);
fflush(stdout);
#endif
if (patternObj) {
pattern = Tcl_GetStringFromObj(patternObj, NULL);
} else {
pattern = NULL;
}
/*
* Enumerate over the keys until we get to the double NULL, indicating
* the end of the list.
*/
resultPtr = Tcl_GetObjResult(interp);
for (p = keyList; *p != '\0'; p += len2+1) {
length = strlen(keyName);
len2 = strlen(p);
#ifdef VERBOSE
printf(" keyName [%s] len %d, p [%s] len %d\n", keyName, length,
p, len2);
fflush(stdout);
#endif
if (length + 1 + len2 >= ENUM_APPS + MAX_KEYLEN) continue;
fullName[0] = '\0';
strcpy(fullName, keyName);
strcat(fullName, "\\");
strcat(fullName, p);
if (pattern && !Tcl_StringMatch(fullName, pattern)) {
#ifdef VERBOSE
printf(" Dismissing %s\n", fullName);
fflush(stdout);
#endif
continue;
}
#ifdef VERBOSE
printf(" Adding %s\n", fullName);
fflush(stdout);
#endif
result = Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(fullName, -1));
if (result != TCL_OK) {
break;
}
}
}
TclOS2CloseProfile(iniHandle);
return result;
}
/*
*----------------------------------------------------------------------
*
* TclOS2SetKey --
*
* This function sets the contents of a profile value. If
* the application or key does not exist, it will be created. If it
* does exist, then the data will be replaced.
* Only writing as binary data and string is possible.
*
* Results:
* Returns a normal Tcl result.
*
* Side effects:
* May create new apps or keys.
*
*----------------------------------------------------------------------
*/
static int
TclOS2SetKey(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *keyNameObj, /* Name of application. */
Tcl_Obj *valueNameObj, /* Name of value to set. */
Tcl_Obj *dataObj, /* Data to be written. */
Tcl_Obj *typeObj) /* Type of data to be written. */
{
char *buffer, *iniFile, *keyName, *valueName;
ULONG type;
HINI iniHandle;
int length;
Tcl_Obj *resultPtr;
#ifdef VERBOSE
printf("TclOS2SetKey()\n");
fflush(stdout);
#endif
keyName = Tcl_GetStringFromObj(keyNameObj, &length);
buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
valueName = valueNameObj != NULL
? Tcl_GetStringFromObj(valueNameObj, &length)
: NULL;
#ifdef VERBOSE
printf("TclOS2SetKey(%s, %s)\n", keyName, valueName);
fflush(stdout);
#endif
if (typeObj == NULL) {
type = STRING;
} else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
0, (int *) &type) != TCL_OK) {
if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
return TCL_ERROR;
}
Tcl_ResetResult(interp);
}
if (TclOS2OpenProfile(interp, buffer, &iniFile, &keyName, &iniHandle)
!= TCL_OK) {
ckfree(buffer);
return TCL_ERROR;
}
ckfree(buffer);
resultPtr = Tcl_GetObjResult(interp);
if (type == STRING || type == SZ) {
char *data = dataObj != NULL ? Tcl_GetStringFromObj(dataObj, &length)
: NULL;
ret = PrfWriteProfileData(iniHandle, keyName, (PSZ)valueName,
(PVOID)data, length);
#ifdef VERBOSE
printf("PrfWriteProfileData(%x, %s, %s, <data>, %d) returns %d\n",
iniHandle, keyName, valueName, length, ret);
fflush(stdout);
#endif
} else {
ULONG value;
if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
TclOS2CloseProfile(iniHandle);
return TCL_ERROR;
}
ret = PrfWriteProfileData(iniHandle, keyName, (PSZ)valueName,
(PVOID)&value, sizeof(value));
#ifdef VERBOSE
printf("PrfWriteProfileData(%x, %s, %s, %x, %d) returns %d\n",
iniHandle, keyName, valueName, value, sizeof(value), ret);
fflush(stdout);
#endif
}
TclOS2CloseProfile(iniHandle);
if (ret != TRUE) {
Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
AppendSystemError(interp, WinGetLastError(TclOS2GetHAB()));
return TCL_ERROR;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclOS2OpenProfile --
*
* This function parses a key name into the iniFile, application
* and key parts and if necessary opens the iniFile.
*
* Results:
* The pointers to the start of the iniFile, application and key
* names are returned in the iniFilePtr, keyNamePtr and valueNamePtr
* variables.
* The handle for the opened profile is returned in iniFilePtr.
* In the case of using both user and system profiles, the full
* of the user or system profiles are returned in iniFilePtr
* separated by '\0'.
* Returns a standard Tcl result.
*
*
* Side effects:
* Modifies the name string by inserting nulls.
* Opens any user specified profile.
* A not-yet existing profile will be created empty by OS/2.
*
*----------------------------------------------------------------------
*/
static int
TclOS2OpenProfile(
Tcl_Interp *interp, /* Current interpreter. */
char *name,
char **iniFilePtr,
char **keyNamePtr,
HINI *iniHandlePtr)
{
char *rootName;
int result, index;
Tcl_Obj *rootObj, *resultPtr = Tcl_GetObjResult(interp);
#ifdef VERBOSE
printf("TclOS2OpenProfile()\n");
fflush(stdout);
#endif
/*
* Split the key into host and root portions.
*/
*iniFilePtr = *keyNamePtr = NULL;
*iniHandlePtr = HINI_PROFILE;
rootName = name;
/*
* Split into iniFile and application portions.
*/
for (*keyNamePtr = rootName; **keyNamePtr != '\0'; (*keyNamePtr)++) {
if (**keyNamePtr == '\\') {
**keyNamePtr = '\0';
(*keyNamePtr)++;
break;
}
}
/*
* Look for a matching root name.
*/
#ifdef VERBOSE
printf(" rootName %s\n", rootName);
fflush(stdout);
#endif
rootObj = Tcl_NewStringObj(rootName, -1);
result = Tcl_GetIndexFromObj(NULL, rootObj, iniFileNames, "root name",
TCL_EXACT, &index);
Tcl_DecrRefCount(rootObj);
if (result != TCL_OK) {
/* Not BOTH, USER or SYSTEM, so assume a file name has been given */
*iniHandlePtr = PrfOpenProfile(TclOS2GetHAB(), rootName);
if (*iniHandlePtr == NULLHANDLE) {
#ifdef VERBOSE
printf(" PrfOpenProfile %s ERROR %x\n", rootName, *iniFilePtr);
fflush(stdout);
#endif
Tcl_AppendStringsToObj(resultPtr, "bad file name \"", rootName,
"\"", NULL);
return TCL_ERROR;
}
#ifdef VERBOSE
printf(" PrfOpenProfile %s: HINI %x\n", rootName, *iniHandlePtr);
fflush(stdout);
#endif
} else {
*iniHandlePtr = iniHandles[index];
/* Determine path of user/system profile */
*iniFilePtr = iniFileNames[index];
#ifdef VERBOSE
printf(" standard profile %s: HINI %x (%s)\n", rootName,
*iniHandlePtr, *iniFilePtr);
fflush(stdout);
#endif
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclOS2CloseProfile --
*
* This function closes an iniFile.
*
* Results:
* Only for a user-specified profile is actually closed; the user
* and system profiles stay open all the time and cannot be closed
* successfully anyway.
* Returns a standard Tcl result.
*
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TclOS2CloseProfile(
HINI iniHandle)
{
#ifdef VERBOSE
printf("TclOS2CloseProfile()\n");
fflush(stdout);
#endif
if ( iniHandle != HINI_PROFILE && iniHandle != HINI_USERPROFILE &&
iniHandle != HINI_SYSTEMPROFILE) {
ret = PrfCloseProfile(iniHandle);
if (ret != TRUE) {
#ifdef VERBOSE
printf("PrfCloseProfile(%d) ERROR %x\n", iniHandle,
WinGetLastError(TclOS2GetHAB()));
#endif
return TCL_ERROR; /* Ignored anyway */
}
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* AppendSystemError --
*
* This routine formats an OS/2 system error message and places
* it into the interpreter result.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
AppendSystemError(
Tcl_Interp *interp, /* Current interpreter. */
ULONG error) /* Result code from error. */
{
char msgbuf[64];
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
#ifdef VERBOSE
printf("AppendSystemError()\n");
fflush(stdout);
#endif
sprintf(msgbuf, "System Error %lx", error);
Tcl_SetErrorCode(interp, "OS/2", msgbuf, (char *) NULL);
Tcl_AppendToObj(resultPtr, msgbuf, -1);
}
/*
*----------------------------------------------------------------------
*
* TclOS2GetAppNames --
*
* This function enumerates the applications in a profile. If the
* optional pattern is supplied, then only keys that match the
* pattern will be returned.
*
* Results:
* Returns the list of applications in the result object of the
* interpreter, or an error message on failure.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TclOS2GetAppNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *iniFileObj, /* Profile to enumerate. */
Tcl_Obj *patternObj) /* Optional match pattern. */
{
char *p, *buffer, *iniFile, *appName, *pattern;
char appList[ENUM_APPS];
HINI iniHandle;
int length;
ULONG bufMax;
Tcl_Obj *resultPtr;
int result = TCL_OK;
#ifdef VERBOSE
printf("TclOS2GetAppNames()\n");
fflush(stdout);
#endif
iniFile = Tcl_GetStringFromObj(iniFileObj, &length);
buffer = ckalloc(length + 1);
strcpy(buffer, iniFile);
if (TclOS2OpenProfile(interp, buffer, &iniFile, &appName, &iniHandle)
!= TCL_OK) {
ckfree(buffer);
return TCL_ERROR;
}
ckfree(buffer);
bufMax = sizeof(appList);
if ( PrfQueryProfileData(iniHandle, NULL, NULL, &appList, &bufMax)
!= TRUE) {
#ifdef VERBOSE
printf(" PrfQueryProfileData ERROR %x\n",
WinGetLastError(TclOS2GetHAB()));
fflush(stdout);
#endif
TclOS2CloseProfile(iniHandle);
return TCL_ERROR;
}
/*
* appList now contains the names of the applications, separated by NULL
* characters; the last is terminated with two successive NULLs.
* bufMax now contains the total length of the list in appList excluding
* the final NULL character.
*/
#ifdef VERBOSE
printf(" PrfQueryProfileData returns %d in buffer (first %s)\n", bufMax,
appList);
fflush(stdout);
#endif
if (patternObj) {
pattern = Tcl_GetStringFromObj(patternObj, NULL);
} else {
pattern = NULL;
}
/*
* Enumerate over the apps until we get to the double NULL, indicating the
* end of the list.
*/
resultPtr = Tcl_GetObjResult(interp);
for (p = appList; *p != '\0'; p += strlen(p)+1) {
if (pattern && !Tcl_StringMatch(p, pattern)) {
#ifdef VERBOSE
printf(" Dismissing %s\n", p);
fflush(stdout);
#endif
continue;
}
#ifdef VERBOSE
printf(" Adding %s\n", p);
fflush(stdout);
#endif
result = Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(p, -1));
if (result != TCL_OK) {
break;
}
}
TclOS2CloseProfile(iniHandle);
return result;
}
/*
*----------------------------------------------------------------------
*
* TclOS2GetAppKeyNames --
*
* This function enumerates the keys of a given application in a
* profile. If the optional pattern is supplied, then only key
* names that match the pattern will be returned.
*
* Results:
* Returns the list of key names in the result object of the
* interpreter, or an error message on failure.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TclOS2GetAppKeyNames(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *appNameObj, /* App to enumerate. */
Tcl_Obj *patternObj) /* Optional match pattern. */
{
char *p, *buffer, *iniFile, *appName;
char keyList[ENUM_KEYS];
ULONG bufMax;
HINI iniHandle;
int length;
Tcl_Obj *resultPtr;
int result = TCL_OK;
char *pattern;
#ifdef VERBOSE
printf("TclOS2GetKeyNames()\n");
fflush(stdout);
#endif
appName = Tcl_GetStringFromObj(appNameObj, &length);
buffer = ckalloc(length + 1);
strcpy(buffer, appName);
if (TclOS2OpenProfile(interp, buffer, &iniFile, &appName, &iniHandle)
!= TCL_OK) {
ckfree(buffer);
return TCL_ERROR;
}
ckfree(buffer);
bufMax = sizeof(keyList);
if ( PrfQueryProfileData(iniHandle, appName, NULL, &keyList, &bufMax)
!= TRUE) {
#ifdef VERBOSE
printf(" PrfQueryProfileData ERROR %x\n",
WinGetLastError(TclOS2GetHAB()));
fflush(stdout);
#endif
TclOS2CloseProfile(iniHandle);
return TCL_ERROR;
}
/*
* keyList now contains the names of the keys, separated by NULL characters;
* the last is terminated with two successive NULLs.
* bufMax now contains the total length of the list in keyList excluding
* the final NULL character.
*/
#ifdef VERBOSE
printf(" PrfQueryProfileData returns %d in buffer (first %s)\n", bufMax,
keyList);
fflush(stdout);
#endif
if (patternObj) {
pattern = Tcl_GetStringFromObj(patternObj, NULL);
} else {
pattern = NULL;
}
/*
* Enumerate over the keys until we get to the double NULL, indicating the
* end of the list.
*/
resultPtr = Tcl_GetObjResult(interp);
for (p = keyList; *p != '\0'; p += strlen(p)+1) {
if (pattern && !Tcl_StringMatch(p, pattern)) {
#ifdef VERBOSE
printf(" Dismissing %s\n", p);
fflush(stdout);
#endif
continue;
}
#ifdef VERBOSE
printf(" Adding %s\n", p);
fflush(stdout);
#endif
result = Tcl_ListObjAppendElement(interp, resultPtr,
Tcl_NewStringObj(p, -1));
if (result != TCL_OK) {
break;
}
}
TclOS2CloseProfile(iniHandle);
return result;
}
/*
*----------------------------------------------------------------------
*
* TclOS2SetAppKey --
*
* This function sets the contents of a profile value. If
* the application or key does not exist, it will be created. If it
* does exist, then the data will be replaced.
* Only writing as binary data and string is possible.
*
* Results:
* Returns a normal Tcl result.
*
* Side effects:
* May create new apps or keys.
*
*----------------------------------------------------------------------
*/
static int
TclOS2SetAppKey(
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Obj *appNameObj, /* Name of application. */
Tcl_Obj *keyNameObj, /* Name of key to set. */
Tcl_Obj *dataObj, /* Data to be written. */
Tcl_Obj *typeObj) /* Type of data to be written. */
{
char *buffer, *iniFile, *appName, *keyName;
ULONG type;
HINI iniHandle;
int length;
Tcl_Obj *resultPtr;
#ifdef VERBOSE
printf("TclOS2SetKey()\n");
fflush(stdout);
#endif
appName = Tcl_GetStringFromObj(appNameObj, &length);
buffer = ckalloc(length + 1);
strcpy(buffer, appName);
keyName = keyNameObj != NULL ? Tcl_GetStringFromObj(keyNameObj, &length)
: NULL;
#ifdef VERBOSE
printf("TclOS2SetKey(%s, %s)\n", appName, keyName);
fflush(stdout);
#endif
if (typeObj == NULL) {
type = STRING;
} else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type",
0, (int *) &type) != TCL_OK) {
if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) {
return TCL_ERROR;
}
Tcl_ResetResult(interp);
}
if (TclOS2OpenProfile(interp, buffer, &iniFile, &appName, &iniHandle)
!= TCL_OK) {
ckfree(buffer);
return TCL_ERROR;
}
ckfree(buffer);
resultPtr = Tcl_GetObjResult(interp);
if (type == STRING || type == SZ) {
char *data = Tcl_GetStringFromObj(dataObj, &length);
ret = PrfWriteProfileData(iniHandle, appName, (PSZ)keyName, (PVOID)data,
length);
#ifdef VERBOSE
printf("PrfWriteProfileData(%x, %s, %s, <data>, %d) returns %d\n",
iniHandle, appName, keyName, length, ret);
fflush(stdout);
#endif
} else {
ULONG value;
if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
TclOS2CloseProfile(iniHandle);
return TCL_ERROR;
}
ret = PrfWriteProfileData(iniHandle, appName, (PSZ)keyName,
(PVOID)&value, sizeof(value));
#ifdef VERBOSE
printf("PrfWriteProfileData(%x, %s, %s, %x, %d) returns %d\n",
iniHandle, appName, keyName, value, sizeof(value), ret);
fflush(stdout);
#endif
}
TclOS2CloseProfile(iniHandle);
if (ret != TRUE) {
Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
AppendSystemError(interp, WinGetLastError(TclOS2GetHAB()));
return TCL_ERROR;
}
return TCL_OK;
}