#if HAVE_TCL_H
#include <tcl.h>
#elif HAVE_TCL_TCL_H
#include <tcl/tcl.h>
#endif
#include <assert.h>
#define SEP_STR "$"
static char *memory_error = "out of memory";
static TclHashTable *get_hash_table(Tcl_Interp *interp,
char *type)
{
static Tcl_HashTable *hash_table = 0;
if (! hash_table) {
if (! (hash_table = malloc(sizeof(*hash_table)))) {
Tcl_SetResult(interp, memory_error, TCL_STATIC);
return 0;
}
Tcl_InitHashTable(hash_table, TCL_STRING_KEYS);
}
return hash_table;
}
#define MAX_ID 999999999
#define ID_BUF_SIZE 10
static Tcl_HashEntry *get_new_handle(Tcl_Interp *interp,
char *type)
{
static unsigned long int id_counter = 0;
Tcl_DString *handle;
char int_buf[ID_BUF_SIZE];
if (! (handle = malloc(sizeof(*handle)))) {
Tcl_SetResult(interp, memory_error, TCL_STATIC);
return 0;
}
Tcl_DStringInit(handle);
assert(id_counter <= MAX_ID);
sprintf(int_buf, "%d", id_counter++);
Tcl_DStringAppend(handle, type, -1);
Tcl_DStringAppend(handle, SEP_STR, -1);
Tcl_DStringAppend(handle, int_buf, -1);
return handle;
}
Tcl_DString *tcl_krb5_create_object(Tcl_Interp *interp,
char *type,
ClientData datum)
{
Tcl_HashTable *table;
Tcl_DString *handle;
Tcl_HashEntry *entry;
int entry_created = 0;
if (! (table = get_hash_table(interp, type))) {
return 0;
}
if (! (handle = get_new_handle(interp, type))) {
return 0;
}
if (! (entry = Tcl_CreateHashEntry(table, handle, &entry_created))) {
Tcl_SetResult(interp, "error creating hash entry", TCL_STATIC);
Tcl_DStringFree(handle);
return TCL_ERROR;
}
assert(entry_created);
Tcl_SetHashValue(entry, datum);
return handle;
}
ClientData tcl_krb5_get_object(Tcl_Interp *interp,
char *handle)
{
char *myhandle, *id_ptr;
Tcl_HashTable *table;
Tcl_HashEntry *entry;
if (! (myhandle = strdup(handle))) {
Tcl_SetResult(interp, memory_error, TCL_STATIC);
return 0;
}
if (! (id_ptr = index(myhandle, *SEP_STR))) {
free(myhandle);
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "malformatted handle \"", handle,
"\"", 0);
return 0;
}
*id_ptr = '\0';
if (! (table = get_hash_table(interp, myhandle))) {
free(myhandle);
return 0;
}
free(myhandle);
if (! (entry = Tcl_FindHashEntry(table, handle))) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "no object corresponding to handle \"",
handle, "\"", 0);
return 0;
}
return(Tcl_GetHashValue(entry));
}