tcl_krb5_hash.c   [plain text]

/*
 * All of the TCL krb5 functions which return (or place into output
 * variables) structures or pointers to structures that can't be
 * represented as tcl native types, do so by returning a handle for
 * the appropriate structure.  The handle is a string of the form
 * "type$id", where "type" is the type of datum represented by the
 * handle and "id" is a unique identifier for it.  This handle can
 * then be used later by the caller to refer to the object, and
 * internally to retrieve the actually datum from the appropriate hash
 * table.
 *
 * The functions in this file do four things:
 * 
 * 1) Given a pointer to a datum and a string representing the type of
 * datum to which the pointer refers, create a new handle for the
 * datum, store the datum in the hash table using the new handle as
 * its key, and return the new handle.
 *
 * 2) Given a handle, locate and return the appropriate hash table
 * datum.
 *
 * 3) Given a handle, look through a table of types and unparse
 * functions to figure out what function to call to get a string
 * representation of the datum, call it with the appropriate pointer
 * (obtained from the hash table) as an argument, and return the
 * resulting string as the unparsed form of the datum.
 *
 * 4) Given a handle, remove that handle and its associated datum from
 * the hash table (but don't free it -- it's assumed to have already
 * been freed by the caller).
 */

#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";

/*
 * Right now, we're only using one hash table.  However, at some point
 * in the future, we might decide to use a separate hash table for
 * every type.  Therefore, I'm putting this function in as an
 * abstraction so it's the only thing we'll have to change if we
 * decide to do that.
 *
 * Also, this function allows us to put in just one place the code for
 * checking to make sure that the hash table exists and initializing
 * it if it doesn't.
 */

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));
}