1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
/* -*- 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));
}
|