int Sqlite_vtable_Init(Tcl_Interp *interp)
{
VTableInterpContext *vticP;
#ifdef USE_TCL_STUBS
Tcl_InitStubs(interp, "8.5", 0);
#endif
/*
* Initialize the cache of Tcl type pointers (used when converting
* to sqlite types). It's OK if any of these return NULL.
*/
gTclBooleanTypeP = Tcl_GetObjType("boolean");
gTclBooleanStringTypeP = Tcl_GetObjType("booleanString");
gTclByteArrayTypeP = Tcl_GetObjType("bytearray");
gTclDoubleTypeP = Tcl_GetObjType("double");
gTclWideIntTypeP = Tcl_GetObjType("wideInt");
gTclIntTypeP = Tcl_GetObjType("int");
vticP = VTICNew(interp);
VTICRef(vticP, 1); // VTIC is passed to interpreter commands as ClientData
Tcl_CreateObjCommand(interp, PACKAGE_NAME "::attach_connection",
AttachConnectionObjCmd, vticP, 0);
Tcl_CallWhenDeleted(interp, DetachFromInterp, vticP);
Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
return TCL_OK;
}
/*
* Tclduktape_Init -- Called when Tcl loads the extension.
*/
int DLLEXPORT
Tclduktape_Init(Tcl_Interp *interp)
{
Tcl_Namespace *nsPtr;
struct DuktapeData *duktape_data;
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
#endif
duktape_data = (struct DuktapeData *) ckalloc(sizeof(struct DuktapeData));
/* Create the namespace. */
if (Tcl_FindNamespace(interp, NS, NULL, 0) == NULL) {
nsPtr = Tcl_CreateNamespace(interp, NS, NULL, NULL);
if (nsPtr == NULL) {
return TCL_ERROR;
}
}
duktape_data->counter = 0;
Tcl_InitHashTable(&duktape_data->table, TCL_STRING_KEYS);
Tcl_CreateObjCommand(interp, NS INIT, Init_Cmd, duktape_data, NULL);
Tcl_CreateObjCommand(interp, NS CLOSE, Close_Cmd, duktape_data, NULL);
Tcl_CreateObjCommand(interp, NS EVAL, Eval_Cmd, duktape_data, NULL);
Tcl_CreateObjCommand(interp, NS CALL_METHOD,
CallMethod_Cmd, duktape_data, NULL);
Tcl_CallWhenDeleted(interp, cleanup_interp, duktape_data);
Tcl_PkgProvide(interp, PACKAGE, VERSION);
return TCL_OK;
}
int Ow_Init(Tcl_Interp * interp)
{
int i;
/* This defines the static chars tkTable(Safe)InitScript */
#include "owtclInitScript.h"
if (
#ifdef USE_TCL_STUBS
Tcl_InitStubs(interp, "8.1", 0)
#else
Tcl_PkgRequire(interp, "Tcl", "8.1", 0)
#endif
== NULL)
return TCL_ERROR;
OwtclState.used = 0;
/* Initialize the new Tcl commands */
i = 0;
while (OwtclCmdList[i].name != NULL) {
Tcl_CreateObjCommand(interp, OwtclCmdList[i].name, (Tcl_ObjCmdProc *) OwtclCmdList[i].func,
(ClientData) & OwtclState, (Tcl_CmdDeleteProc *) NULL);
i++;
}
/* Callback - clean up procs left open on interpreter deletetion. */
Tcl_CallWhenDeleted(interp, (Tcl_InterpDeleteProc *) Owtcl_Delete, (ClientData) & OwtclState);
/* Announce successful package loading to "package require". */
if (Tcl_PkgProvide(interp, "ow", OWTCL_VERSION) != TCL_OK)
return TCL_ERROR;
/*
* The init script can't make certain calls in a safe interpreter,
* so we always have to use the embedded runtime for it
*/
return Tcl_Eval(interp, Tcl_IsSafe(interp) ? owtclSafeInitScript : owtclInitScript);
}
int
Tk_CreateConsoleWindow(
Tcl_Interp *interp) /* Interpreter to use for prompting. */
{
Tcl_Channel chan;
ConsoleInfo *info;
Tk_Window mainWindow;
Tcl_Command token;
int result = TCL_OK;
int haveConsoleChannel = 1;
/* Init an interp with Tcl and Tk */
Tcl_Interp *consoleInterp = Tcl_CreateInterp();
if (Tcl_Init(consoleInterp) != TCL_OK) {
goto error;
}
if (Tk_Init(consoleInterp) != TCL_OK) {
goto error;
}
/*
* Fetch the instance data from whatever std channel is a
* console channel. If none, create fresh instance data.
*/
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
} else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
} else {
haveConsoleChannel = 0;
}
if (haveConsoleChannel) {
ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
info = data->info;
if (info->consoleInterp) {
/* New ConsoleInfo for a new console window */
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
/* Update any console channels to make use of the new console */
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
== &consoleChannelType) {
data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
data->info->refCount--;
data->info = info;
data->info->refCount++;
}
}
} else {
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
info->refCount = 0;
}
info->consoleInterp = consoleInterp;
info->interp = interp;
Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
info->refCount++;
Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);
/*
* Add console commands to the interp
*/
token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info,
ConsoleDeleteProc);
info->refCount++;
/*
* We don't have to count the ref held by the [consoleinterp] command
* in the consoleInterp. The ref held by the consoleInterp delete
* handler takes care of us.
*/
Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
info, NULL);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
info->refCount++;
}
Tcl_Preserve(consoleInterp);
result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl");
if (result == TCL_ERROR) {
Tcl_SetReturnOptions(interp,
Tcl_GetReturnOptions(consoleInterp, result));
Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
}
Tcl_Release(consoleInterp);
if (result == TCL_ERROR) {
Tcl_DeleteCommandFromToken(interp, token);
mainWindow = Tk_MainWindow(interp);
if (mainWindow) {
Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
ConsoleEventProc, info);
if (--info->refCount <= 0) {
ckfree((char *) info);
}
}
goto error;
}
return TCL_OK;
error:
Tcl_AddErrorInfo(interp, "\n (creating console window)");
if (!Tcl_InterpDeleted(consoleInterp)) {
Tcl_DeleteInterp(consoleInterp);
}
return TCL_ERROR;
}
/*++
Alcoext_Init
Initialises the extension for a regular interpreter.
Arguments:
interp - Current interpreter.
Return Value:
A standard Tcl result.
--*/
int
Alcoext_Init(
Tcl_Interp *interp
)
{
ExtState *statePtr;
StateList *stateListPtr;
// Wide integer support was added in Tcl 8.4.
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
return TCL_ERROR;
}
#else // USE_TCL_STUBS
if (Tcl_PkgRequire(interp, "Tcl", "8.4", 0) == NULL) {
return TCL_ERROR;
}
#endif // USE_TCL_STUBS
if (Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK) {
return TCL_ERROR;
}
//
// Check if the library is already initialised before locking
// the global initialisation mutex (improves loading time).
//
if (!initialised) {
Tcl_MutexLock(&initMutex);
// Check initialisation status again now that we're in the mutex.
if (!initialised) {
#ifdef _WINDOWS
// Initialise the OS version structure.
osVersion.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
GetVersionExA(&osVersion);
ZeroMemory(&winProcs, sizeof(WinProcs));
winProcs.module = LoadLibraryA("kernel32.dll");
if (winProcs.module != NULL) {
//
// These functions must be resolved on run-time for backwards
// compatibility on older Windows systems (earlier than NT v5).
//
winProcs.getDiskFreeSpaceEx = (GetDiskFreeSpaceExProc)
GetProcAddress(winProcs.module, "GetDiskFreeSpaceExA");
winProcs.findFirstVolumeMountPoint = (FindFirstVolumeMountPointProc)
GetProcAddress(winProcs.module, "FindFirstVolumeMountPointA");
winProcs.findNextVolumeMountPoint = (FindNextVolumeMountPointProc)
GetProcAddress(winProcs.module, "FindNextVolumeMountPointA");
winProcs.findVolumeMountPointClose = (FindVolumeMountPointCloseProc)
GetProcAddress(winProcs.module, "FindVolumeMountPointClose");
winProcs.getVolumeNameForVolumeMountPoint = (GetVolumeNameForVolumeMountPointProc)
GetProcAddress(winProcs.module, "GetVolumeNameForVolumeMountPointA");
}
//
// If GetVolumeInformation() is called on a floppy drive or a CD-ROM
// drive that does not have a disk inserted, the system will display
// a message box asking the user to insert one.
//
SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
#endif // _WINDOWS
// An exit handler must only be registered once.
Tcl_CreateExitHandler(ExitHandler, NULL);
// Register ciphers, hashes, and PRNGs for LibTomCrypt.
register_cipher(&des3_desc);
register_cipher(&aes_desc);
register_cipher(&anubis_desc);
register_cipher(&blowfish_desc);
register_cipher(&cast5_desc);
register_cipher(&des_desc);
register_cipher(&khazad_desc);
register_cipher(&noekeon_desc);
register_cipher(&rc2_desc);
register_cipher(&rc5_desc);
register_cipher(&rc6_desc);
register_cipher(&saferp_desc);
register_cipher(&safer_k128_desc);
register_cipher(&safer_k64_desc);
register_cipher(&safer_sk128_desc);
register_cipher(&safer_sk64_desc);
register_cipher(&skipjack_desc);
register_cipher(&twofish_desc);
register_cipher(&xtea_desc);
register_hash(&md2_desc);
register_hash(&md4_desc);
register_hash(&md5_desc);
register_hash(&rmd128_desc);
register_hash(&rmd160_desc);
register_hash(&sha1_desc);
register_hash(&sha224_desc);
register_hash(&sha256_desc);
register_hash(&sha384_desc);
register_hash(&sha512_desc);
register_hash(&tiger_desc);
register_hash(&whirlpool_desc);
register_prng(&fortuna_desc);
register_prng(&rc4_desc);
register_prng(&sober128_desc);
register_prng(&sprng_desc);
register_prng(&yarrow_desc);
initialised = 1;
}
Tcl_MutexUnlock(&initMutex);
}
// Allocate state structures.
stateListPtr = (StateList *)ckalloc(sizeof(StateList));
statePtr = (ExtState *)ckalloc(sizeof(ExtState));
statePtr->cryptTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(statePtr->cryptTable, TCL_STRING_KEYS);
#ifndef _WINDOWS
statePtr->glftpdTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(statePtr->glftpdTable, TCL_STRING_KEYS);
#endif // !_WINDOWS
//
// Since callbacks registered with Tcl_CallWhenDeleted() are not executed in
// certain situations (calling Tcl_Finalize() or invoking the "exit" command),
// these resources must be freed by an exit handler registered with
// Tcl_CreateExitHandler().
//
stateListPtr->interp = interp;
stateListPtr->state = statePtr;
stateListPtr->next = NULL;
stateListPtr->prev = NULL;
Tcl_MutexLock(&stateMutex);
// Insert at the list head.
if (stateListHead == NULL) {
stateListHead = stateListPtr;
} else {
stateListPtr->next = stateListHead;
stateListHead->prev = stateListPtr;
stateListHead = stateListPtr;
}
Tcl_MutexUnlock(&stateMutex);
// Clean up state on interpreter deletion.
Tcl_CallWhenDeleted(interp, InterpDeleteHandler, (ClientData)statePtr);
// Create Tcl commands.
Tcl_CreateObjCommand(interp, "::alcoholicz::compress", CompressObjCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "::alcoholicz::crypt", CryptObjCmd,
(ClientData)statePtr, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "::alcoholicz::decode", EncodingObjCmd,
(ClientData)decodeFuncts, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "::alcoholicz::encode", EncodingObjCmd,
(ClientData)encodeFuncts, (Tcl_CmdDeleteProc *)NULL);
//
// These commands are not created for safe interpreters because
// they interact with the file system and/or other processes.
//
if (!Tcl_IsSafe(interp)) {
Tcl_CreateObjCommand(interp, "::alcoholicz::volume", VolumeObjCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
#ifdef _WINDOWS
Tcl_CreateObjCommand(interp, "::alcoholicz::ioftpd", IoFtpdObjCmd,
(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
#else // _WINDOWS
Tcl_CreateObjCommand(interp, "::alcoholicz::glftpd", GlFtpdObjCmd,
(ClientData)statePtr, (Tcl_CmdDeleteProc *)NULL);
#endif // _WINDOWS
}
Tcl_Eval(interp, "namespace eval ::alcoholicz {"
"namespace export compress crypt encode decode volume "
#ifdef _WINDOWS
"ioftpd"
#else
"glftpd"
#endif // _WINDOWS
"}"
);
return TCL_OK;
}
int Twapi_base_Init(Tcl_Interp *interp)
{
TwapiInterpContext *ticP;
HRESULT hr;
/* IMPORTANT */
/* MUST BE FIRST CALL as it initializes Tcl stubs - should this be the
done for EVERY interp creation or move into one-time above ? TBD
*/
/* TBD dgp says this #ifdef USE_TCL_STUBS is not needed and indeed
that seems to be the case for Tcl_InitStubs. But Tcl_TomMath_InitStubs
crashes on a static build not using stubs
*/
#ifdef USE_TCL_STUBS
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_TomMath_InitStubs(interp, 0) == NULL) {
return TCL_ERROR;
}
#endif
/* Init unless already done. */
if (! TwapiDoOneTimeInit(&gTwapiInitialized, TwapiOneTimeInit, interp))
return TCL_ERROR;
/* NOTE: no point setting Tcl_SetResult for errors as they are not
looked at when DLL is being loaded */
/*
* Per interp initialization
*/
if (TwapiTlsInit() != TCL_OK)
return TCL_ERROR;
/*
* Single-threaded COM model - note some Shell extensions
* require this if functions such as ShellExecute are
* invoked. TBD - should we do this lazily in com and mstask modules ?
*
* TBD - recent MSDN docs states:
* "Avoid the COM single-threaded apartment model, as it is incompatible
* with the thread pool. STA creates thread state which can affect the
* next work item for the thread. STA is generally long-lived and has
* thread affinity, which is the opposite of the thread pool."
* Since we use thread pools, does this mean we should not be
* using STA? Or does that only apply when making COM calls from
* a thread pool thread in which case it would not apply to us?
*/
hr = CoInitializeEx(
NULL, COINIT_APARTMENTTHREADED | COINIT_DISABLE_OLE1DDE);
if (hr != S_OK && hr != S_FALSE)
return TCL_ERROR;
/* Create the name space and some variables. Not sure if this is explicitly needed */
Tcl_CreateNamespace(interp, "::twapi", NULL, NULL);
Tcl_SetVar2(interp, "::twapi::version", MODULENAME, MODULEVERSION, 0);
Tcl_SetVar2(interp, "::twapi::settings", "log_limit", "100", 0);
Tcl_LinkVar(interp, "::twapi::settings(use_unicode_obj)", (char *)&gBaseSettings.use_unicode_obj, TCL_LINK_ULONG);
/* Allocate a context that will be passed around in all interpreters */
ticP = TwapiRegisterModule(interp, gTwapiModuleHandle, &gBaseModule, NEW_TIC);
if (ticP == NULL)
return TCL_ERROR;
ticP->module.data.pval = TwapiAlloc(sizeof(TwapiBaseSpecificContext));
/* Cache of commonly used objects */
Tcl_InitHashTable(&BASE_CONTEXT(ticP)->atoms, TCL_STRING_KEYS);
/* Pointer registration table */
Tcl_InitHashTable(&BASE_CONTEXT(ticP)->pointers, TCL_ONE_WORD_KEYS);
/* Trap stack */
BASE_CONTEXT(ticP)->trapstack = ObjNewList(0, NULL);
ObjIncrRefs(BASE_CONTEXT(ticP)->trapstack);
Tcl_CallWhenDeleted(interp, Twapi_InterpCleanup, NULL);
return TwapiLoadStaticModules(interp);
}
/*++
Alcoext_Init
Initialises the extension for a regular interpreter.
Arguments:
interp - Current interpreter.
Return Value:
A standard Tcl result.
--*/
int
Alcoext_Init(
Tcl_Interp *interp
)
{
int i;
ExtState *state;
Tcl_CmdInfo cmdInfo;
DebugPrint("Init: interp=%p\n", interp);
// Wide integer support was added in Tcl 8.4.
if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK) {
return TCL_ERROR;
}
Initialise();
// Allocate state structure.
state = (ExtState *)ckalloc(sizeof(ExtState));
memset(state, 0, sizeof(ExtState));
state->interp = interp;
state->cryptTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(state->cryptTable, TCL_STRING_KEYS);
#ifndef _WINDOWS
state->glftpdTable = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(state->glftpdTable, TCL_STRING_KEYS);
#endif
Tcl_MutexLock(&stateListMutex);
// Insert at the list head.
if (stateHead == NULL) {
stateHead = state;
} else {
state->next = stateHead;
stateHead->prev = state;
stateHead = state;
}
Tcl_MutexUnlock(&stateListMutex);
// Clean up state on interpreter deletion.
Tcl_CallWhenDeleted(interp, InterpDeleted, (ClientData)state);
// Create Tcl commands.
state->cmds[0] = Tcl_CreateObjCommand(interp, "compress", CompressObjCmd, NULL, CmdDeleted);
state->cmds[1] = Tcl_CreateObjCommand(interp, "crypt", CryptObjCmd, (ClientData)state, CmdDeleted);
state->cmds[2] = Tcl_CreateObjCommand(interp, "decode", EncodingObjCmd, (ClientData)decodeFuncts, CmdDeleted);
state->cmds[3] = Tcl_CreateObjCommand(interp, "encode", EncodingObjCmd, (ClientData)encodeFuncts, CmdDeleted);
//
// These commands are not created for safe interpreters because
// they interact with the file system and/or other processes.
//
if (!Tcl_IsSafe(interp)) {
state->cmds[4] = Tcl_CreateObjCommand(interp, "volume", VolumeObjCmd, NULL, CmdDeleted);
#ifdef _WINDOWS
state->cmds[5] = Tcl_CreateObjCommand(interp, "ioftpd", IoFtpdObjCmd, NULL, CmdDeleted);
#else
state->cmds[5] = Tcl_CreateObjCommand(interp, "glftpd", GlFtpdObjCmd, (ClientData)state, CmdDeleted);
#endif
}
// Pass the address of the command token to the deletion handler.
for (i = 0; i < ARRAYSIZE(state->cmds); i++) {
if (Tcl_GetCommandInfoFromToken(state->cmds[i], &cmdInfo)) {
cmdInfo.deleteData = (ClientData)&state->cmds[i];
Tcl_SetCommandInfoFromToken(state->cmds[i], &cmdInfo);
}
}
return TCL_OK;
}
