/* -*- mode: c; c-basic-offset: 4; indent-tabs-mode: nil -*- */
/*
 * 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));
}