src/kadmin/testing/util/tcl_kadm5.c

   1 /* -*- mode: c; c-basic-offset: 4; indent-tabs-mode: nil -*- */
   2 #include "autoconf.h"
   3 #include <stdio.h>
   4 #include <string.h>
   5 #if HAVE_TCL_H
   6 #include <tcl.h>
   7 #elif HAVE_TCL_TCL_H
   8 #include <tcl/tcl.h>
   9 #endif
  10 #define USE_KADM5_API_VERSION 2
  11 #include <kadm5/admin.h>
  12 #include <com_err.h>
  13 #include <errno.h>
  14 #include <stdlib.h>
  15 #include <adb_err.h>
  16 #include "tcl_kadm5.h"
  17
  18 struct flagval {
  19     char *name;
  20     krb5_flags val;
  21 };
  22
  23 /* XXX This should probably be in the hash table like server_handle */
  24 static krb5_context context;
  25
  26 static struct flagval krb5_flags_array[] = {
  27     {"KRB5_KDB_DISALLOW_POSTDATED", KRB5_KDB_DISALLOW_POSTDATED},
  28     {"KRB5_KDB_DISALLOW_FORWARDABLE", KRB5_KDB_DISALLOW_FORWARDABLE},
  29     {"KRB5_KDB_DISALLOW_TGT_BASED", KRB5_KDB_DISALLOW_TGT_BASED},
  30     {"KRB5_KDB_DISALLOW_RENEWABLE", KRB5_KDB_DISALLOW_RENEWABLE},
  31     {"KRB5_KDB_DISALLOW_PROXIABLE", KRB5_KDB_DISALLOW_PROXIABLE},
  32     {"KRB5_KDB_DISALLOW_DUP_SKEY", KRB5_KDB_DISALLOW_DUP_SKEY},
  33     {"KRB5_KDB_DISALLOW_ALL_TIX", KRB5_KDB_DISALLOW_ALL_TIX},
  34     {"KRB5_KDB_REQUIRES_PRE_AUTH", KRB5_KDB_REQUIRES_PRE_AUTH},
  35     {"KRB5_KDB_REQUIRES_HW_AUTH", KRB5_KDB_REQUIRES_HW_AUTH},
  36     {"KRB5_KDB_REQUIRES_PWCHANGE", KRB5_KDB_REQUIRES_PWCHANGE},
  37     {"KRB5_KDB_DISALLOW_SVR", KRB5_KDB_DISALLOW_SVR},
  38     {"KRB5_KDB_PWCHANGE_SERVICE", KRB5_KDB_PWCHANGE_SERVICE}
  39 };
  40
  41 static struct flagval aux_attributes[] = {
  42     {"KADM5_POLICY",   KADM5_POLICY}
  43 };
  44
  45 static struct flagval principal_mask_flags[] = {
  46     {"KADM5_PRINCIPAL", KADM5_PRINCIPAL},
  47     {"KADM5_PRINC_EXPIRE_TIME", KADM5_PRINC_EXPIRE_TIME},
  48     {"KADM5_PW_EXPIRATION", KADM5_PW_EXPIRATION},
  49     {"KADM5_LAST_PWD_CHANGE", KADM5_LAST_PWD_CHANGE},
  50     {"KADM5_ATTRIBUTES", KADM5_ATTRIBUTES},
  51     {"KADM5_MAX_LIFE", KADM5_MAX_LIFE},
  52     {"KADM5_MOD_TIME", KADM5_MOD_TIME},
  53     {"KADM5_MOD_NAME", KADM5_MOD_NAME},
  54     {"KADM5_KVNO", KADM5_KVNO},
  55     {"KADM5_MKVNO", KADM5_MKVNO},
  56     {"KADM5_AUX_ATTRIBUTES", KADM5_AUX_ATTRIBUTES},
  57     {"KADM5_POLICY", KADM5_POLICY},
  58     {"KADM5_POLICY_CLR", KADM5_POLICY_CLR},
  59     {"KADM5_MAX_RLIFE", KADM5_MAX_RLIFE},
  60     {"KADM5_LAST_SUCCESS", KADM5_LAST_SUCCESS},
  61     {"KADM5_LAST_FAILED", KADM5_LAST_FAILED},
  62     {"KADM5_FAIL_AUTH_COUNT", KADM5_FAIL_AUTH_COUNT},
  63     {"KADM5_KEY_DATA", KADM5_KEY_DATA},
  64     {"KADM5_TL_DATA", KADM5_TL_DATA},
  65     {"KADM5_PRINCIPAL_NORMAL_MASK", KADM5_PRINCIPAL_NORMAL_MASK}
  66 };
  67
  68 static struct flagval policy_mask_flags[] = {
  69     {"KADM5_POLICY", KADM5_POLICY},
  70     {"KADM5_PW_MAX_LIFE", KADM5_PW_MAX_LIFE},
  71     {"KADM5_PW_MIN_LIFE", KADM5_PW_MIN_LIFE},
  72     {"KADM5_PW_MIN_LENGTH", KADM5_PW_MIN_LENGTH},
  73     {"KADM5_PW_MIN_CLASSES", KADM5_PW_MIN_CLASSES},
  74     {"KADM5_PW_HISTORY_NUM", KADM5_PW_HISTORY_NUM},
  75     {"KADM5_REF_COUNT", KADM5_REF_COUNT},
  76     {"KADM5_PW_MAX_FAILURE", KADM5_PW_MAX_FAILURE},
  77     {"KADM5_PW_FAILURE_COUNT_INTERVAL", KADM5_PW_FAILURE_COUNT_INTERVAL},
  78     {"KADM5_PW_LOCKOUT_DURATION", KADM5_PW_LOCKOUT_DURATION},
  79 };
  80
  81 static struct flagval config_mask_flags[] = {
  82     {"KADM5_CONFIG_REALM", KADM5_CONFIG_REALM},
  83     {"KADM5_CONFIG_DBNAME", KADM5_CONFIG_DBNAME},
  84     {"KADM5_CONFIG_MKEY_NAME", KADM5_CONFIG_MKEY_NAME},
  85     {"KADM5_CONFIG_MAX_LIFE", KADM5_CONFIG_MAX_LIFE},
  86     {"KADM5_CONFIG_MAX_RLIFE", KADM5_CONFIG_MAX_RLIFE},
  87     {"KADM5_CONFIG_EXPIRATION", KADM5_CONFIG_EXPIRATION},
  88     {"KADM5_CONFIG_FLAGS", KADM5_CONFIG_FLAGS},
  89     {"KADM5_CONFIG_STASH_FILE", KADM5_CONFIG_STASH_FILE},
  90     {"KADM5_CONFIG_ENCTYPE", KADM5_CONFIG_ENCTYPE},
  91     {"KADM5_CONFIG_ADBNAME", KADM5_CONFIG_ADBNAME},
  92     {"KADM5_CONFIG_ADB_LOCKFILE", KADM5_CONFIG_ADB_LOCKFILE},
  93     {"KADM5_CONFIG_ACL_FILE", KADM5_CONFIG_ACL_FILE},
  94     {"KADM5_CONFIG_KADMIND_PORT", KADM5_CONFIG_KADMIND_PORT},
  95     {"KADM5_CONFIG_ENCTYPES", KADM5_CONFIG_ENCTYPES},
  96     {"KADM5_CONFIG_ADMIN_SERVER", KADM5_CONFIG_ADMIN_SERVER},
  97     {"KADM5_CONFIG_DICT_FILE", KADM5_CONFIG_DICT_FILE},
  98     {"KADM5_CONFIG_MKEY_FROM_KBD", KADM5_CONFIG_MKEY_FROM_KBD},
  99 };
 100
 101 static struct flagval priv_flags[] = {
 102     {"KADM5_PRIV_GET", KADM5_PRIV_GET},
 103     {"KADM5_PRIV_ADD", KADM5_PRIV_ADD},
 104     {"KADM5_PRIV_MODIFY", KADM5_PRIV_MODIFY},
 105     {"KADM5_PRIV_DELETE", KADM5_PRIV_DELETE}
 106 };
 107
 108
 109 static char *arg_error = "wrong # args";
 110
 111 static Tcl_HashTable *struct_table = 0;
 112
 113 static int put_server_handle(Tcl_Interp *interp, void *handle, char **name)
 114 {
 115     int i = 1, newPtr = 0;
 116     static char buf[20];
 117     Tcl_HashEntry *entry;
 118
 119     if (! struct_table) {
 120         if (! (struct_table =
 121                malloc(sizeof(*struct_table)))) {
 122             fprintf(stderr, "Out of memory!\n");
 123             exit(1); /* XXX */
 124         }
 125         Tcl_InitHashTable(struct_table, TCL_STRING_KEYS);
 126     }
 127
 128     do {
 129         sprintf(buf, "kadm5_handle%d", i);
 130         entry = Tcl_CreateHashEntry(struct_table, buf, &newPtr);
 131         i++;
 132     } while (! newPtr);
 133
 134     Tcl_SetHashValue(entry, handle);
 135
 136     *name = buf;
 137
 138     return TCL_OK;
 139 }
 140
 141 static int get_server_handle(Tcl_Interp *interp, const char *name,
 142                              void **handle)
 143 {
 144     Tcl_HashEntry *entry;
 145
 146     if(!strcasecmp(name, "null"))
 147         *handle = 0;
 148     else {
 149         if (! (struct_table &&
 150                (entry = Tcl_FindHashEntry(struct_table, name)))) {
 151             Tcl_AppendResult(interp, "unknown server handle ", name, 0);
 152             return TCL_ERROR;
 153         }
 154         *handle = (void *) Tcl_GetHashValue(entry);
 155     }
 156     return TCL_OK;
 157 }
 158
 159 static int remove_server_handle(Tcl_Interp *interp, const char *name)
 160 {
 161     Tcl_HashEntry *entry;
 162
 163     if (! (struct_table &&
 164            (entry = Tcl_FindHashEntry(struct_table, name)))) {
 165         Tcl_AppendResult(interp, "unknown server handle ", name, 0);
 166         return TCL_ERROR;
 167     }
 168
 169     Tcl_SetHashValue(entry, NULL);
 170     return TCL_OK;
 171 }
 172
 173 #define GET_HANDLE(num_args, ignored)                                   \
 174     void *server_handle;                                                \
 175     const char *whoami = argv[0];                                       \
 176     argv++, argc--;                                                     \
 177     if (argc != num_args + 1) {                                         \
 178         Tcl_AppendResult(interp, whoami, ": ", arg_error, 0);           \
 179         return TCL_ERROR;                                               \
 180     }                                                                   \
 181     {                                                                   \
 182         int ltcl_ret;                                                   \
 183         if ((ltcl_ret = get_server_handle(interp, argv[0], &server_handle)) \
 184             != TCL_OK) {                                                \
 185             return ltcl_ret;                                            \
 186         }                                                               \
 187     }                                                                   \
 188     argv++, argc--;
 189
 190 static Tcl_HashTable *create_flag_table(struct flagval *flags, int size)
 191 {
 192     Tcl_HashTable *table;
 193     Tcl_HashEntry *entry;
 194     int i;
 195
 196     if (! (table = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable)))) {
 197         fprintf(stderr, "Out of memory!\n");
 198         exit(1); /* XXX */
 199     }
 200
 201     Tcl_InitHashTable(table, TCL_STRING_KEYS);
 202
 203     for (i = 0; i < size; i++) {
 204         int newPtr;
 205
 206         if (! (entry = Tcl_CreateHashEntry(table, flags[i].name, &newPtr))) {
 207             fprintf(stderr, "Out of memory!\n");
 208             exit(1); /* XXX */
 209         }
 210
 211         Tcl_SetHashValue(entry, &flags[i].val);
 212     }
 213
 214     return table;
 215 }
 216
 217
 218 static Tcl_DString *unparse_str(char *in_str)
 219 {
 220     Tcl_DString *str;
 221
 222     if (! (str = malloc(sizeof(*str)))) {
 223         fprintf(stderr, "Out of memory!\n");
 224         exit(1); /* XXX */
 225     }
 226
 227     Tcl_DStringInit(str);
 228
 229     if (! in_str) {
 230         Tcl_DStringAppend(str, "null", -1);
 231     }
 232     else {
 233         Tcl_DStringAppend(str, in_str, -1);
 234     }
 235
 236     return str;
 237 }
 238
 239
 240
 241 static int parse_str(Tcl_Interp *interp, const char *in_str, char **out_str)
 242 {
 243     if (! in_str) {
 244         *out_str = 0;
 245     }
 246     else if (! strcasecmp(in_str, "null")) {
 247         *out_str = 0;
 248     }
 249     else {
 250         *out_str = (char *) in_str;
 251     }
 252     return TCL_OK;
 253 }
 254
 255
 256 static void set_ok(Tcl_Interp *interp, char *string)
 257 {
 258     Tcl_SetResult(interp, "OK", TCL_STATIC);
 259     Tcl_AppendElement(interp, "KADM5_OK");
 260     Tcl_AppendElement(interp, string);
 261 }
 262
 263
 264
 265 static Tcl_DString *unparse_err(kadm5_ret_t code)
 266 {
 267     char *code_string;
 268     const char *error_string;
 269     Tcl_DString *dstring;
 270
 271     switch (code) {
 272     case KADM5_FAILURE: code_string = "KADM5_FAILURE"; break;
 273     case KADM5_AUTH_GET: code_string = "KADM5_AUTH_GET"; break;
 274     case KADM5_AUTH_ADD: code_string = "KADM5_AUTH_ADD"; break;
 275     case KADM5_AUTH_MODIFY:
 276         code_string = "KADM5_AUTH_MODIFY"; break;
 277     case KADM5_AUTH_DELETE:
 278         code_string = "KADM5_AUTH_DELETE"; break;
 279     case KADM5_AUTH_INSUFFICIENT:
 280         code_string = "KADM5_AUTH_INSUFFICIENT"; break;
 281     case KADM5_BAD_DB: code_string = "KADM5_BAD_DB"; break;
 282     case KADM5_DUP: code_string = "KADM5_DUP"; break;
 283     case KADM5_RPC_ERROR: code_string = "KADM5_RPC_ERROR"; break;
 284     case KADM5_NO_SRV: code_string = "KADM5_NO_SRV"; break;
 285     case KADM5_BAD_HIST_KEY:
 286         code_string = "KADM5_BAD_HIST_KEY"; break;
 287     case KADM5_NOT_INIT: code_string = "KADM5_NOT_INIT"; break;
 288     case KADM5_INIT: code_string = "KADM5_INIT"; break;
 289     case KADM5_BAD_PASSWORD:
 290         code_string = "KADM5_BAD_PASSWORD"; break;
 291     case KADM5_UNK_PRINC: code_string = "KADM5_UNK_PRINC"; break;
 292     case KADM5_UNK_POLICY: code_string = "KADM5_UNK_POLICY"; break;
 293     case KADM5_BAD_MASK: code_string = "KADM5_BAD_MASK"; break;
 294     case KADM5_BAD_CLASS: code_string = "KADM5_BAD_CLASS"; break;
 295     case KADM5_BAD_LENGTH: code_string = "KADM5_BAD_LENGTH"; break;
 296     case KADM5_BAD_POLICY: code_string = "KADM5_BAD_POLICY"; break;
 297     case KADM5_BAD_HISTORY: code_string = "KADM5_BAD_HISTORY"; break;
 298     case KADM5_BAD_PRINCIPAL:
 299         code_string = "KADM5_BAD_PRINCIPAL"; break;
 300     case KADM5_BAD_AUX_ATTR:
 301         code_string = "KADM5_BAD_AUX_ATTR"; break;
 302     case KADM5_PASS_Q_TOOSHORT:
 303         code_string = "KADM5_PASS_Q_TOOSHORT"; break;
 304     case KADM5_PASS_Q_CLASS:
 305         code_string = "KADM5_PASS_Q_CLASS"; break;
 306     case KADM5_PASS_Q_DICT:
 307         code_string = "KADM5_PASS_Q_DICT"; break;
 308     case KADM5_PASS_REUSE: code_string = "KADM5_PASS_REUSE"; break;
 309     case KADM5_PASS_TOOSOON:
 310         code_string = "KADM5_PASS_TOOSOON"; break;
 311     case KADM5_POLICY_REF:
 312         code_string = "KADM5_POLICY_REF"; break;
 313     case KADM5_PROTECT_PRINCIPAL:
 314         code_string = "KADM5_PROTECT_PRINCIPAL"; break;
 315     case KADM5_BAD_SERVER_HANDLE:
 316         code_string = "KADM5_BAD_SERVER_HANDLE"; break;
 317     case KADM5_BAD_STRUCT_VERSION:
 318         code_string = "KADM5_BAD_STRUCT_VERSION"; break;
 319     case KADM5_OLD_STRUCT_VERSION:
 320         code_string = "KADM5_OLD_STRUCT_VERSION"; break;
 321     case KADM5_NEW_STRUCT_VERSION:
 322         code_string = "KADM5_NEW_STRUCT_VERSION"; break;
 323     case KADM5_BAD_API_VERSION:
 324         code_string = "KADM5_BAD_API_VERSION"; break;
 325     case KADM5_OLD_LIB_API_VERSION:
 326         code_string = "KADM5_OLD_LIB_API_VERSION"; break;
 327     case KADM5_OLD_SERVER_API_VERSION:
 328         code_string = "KADM5_OLD_SERVER_API_VERSION"; break;
 329     case KADM5_NEW_LIB_API_VERSION:
 330         code_string = "KADM5_NEW_LIB_API_VERSION"; break;
 331     case KADM5_NEW_SERVER_API_VERSION:
 332         code_string = "KADM5_NEW_SERVER_API_VERSION"; break;
 333     case KADM5_SECURE_PRINC_MISSING:
 334         code_string = "KADM5_SECURE_PRINC_MISSING"; break;
 335     case KADM5_NO_RENAME_SALT:
 336         code_string = "KADM5_NO_RENAME_SALT"; break;
 337     case KADM5_BAD_CLIENT_PARAMS:
 338         code_string = "KADM5_BAD_CLIENT_PARAMS"; break;
 339     case KADM5_BAD_SERVER_PARAMS:
 340         code_string = "KADM5_BAD_SERVER_PARAMS"; break;
 341     case KADM5_AUTH_LIST:
 342         code_string = "KADM5_AUTH_LIST"; break;
 343     case KADM5_AUTH_CHANGEPW:
 344         code_string = "KADM5_AUTH_CHANGEPW"; break;
 345     case KADM5_GSS_ERROR: code_string = "KADM5_GSS_ERROR"; break;
 346     case KADM5_BAD_TL_TYPE: code_string = "KADM5_BAD_TL_TYPE"; break;
 347     case KADM5_MISSING_CONF_PARAMS:
 348         code_string = "KADM5_MISSING_CONF_PARAMS"; break;
 349     case KADM5_BAD_SERVER_NAME:
 350         code_string = "KADM5_BAD_SERVER_NAME"; break;
 351     case KADM5_MISSING_KRB5_CONF_PARAMS:
 352         code_string = "KADM5_MISSING_KRB5_CONF_PARAMS"; break;
 353     case KADM5_XDR_FAILURE: code_string = "KADM5_XDR_FAILURE"; break;
 354     case KADM5_CANT_RESOLVE: code_string = "KADM5_CANT_RESOLVE"; break;
 355
 356
 357     case OSA_ADB_DUP: code_string = "OSA_ADB_DUP"; break;
 358     case OSA_ADB_NOENT: code_string = "ENOENT"; break;
 359     case OSA_ADB_DBINIT: code_string = "OSA_ADB_DBINIT"; break;
 360     case OSA_ADB_BAD_POLICY: code_string = "Bad policy name"; break;
 361     case OSA_ADB_BAD_PRINC: code_string = "Bad principal name"; break;
 362     case OSA_ADB_BAD_DB: code_string = "Invalid database."; break;
 363     case OSA_ADB_XDR_FAILURE: code_string = "OSA_ADB_XDR_FAILURE"; break;
 364     case OSA_ADB_BADLOCKMODE: code_string = "OSA_ADB_BADLOCKMODE"; break;
 365     case OSA_ADB_CANTLOCK_DB: code_string = "OSA_ADB_CANTLOCK_DB"; break;
 366     case OSA_ADB_NOTLOCKED: code_string = "OSA_ADB_NOTLOCKED"; break;
 367     case OSA_ADB_NOLOCKFILE: code_string = "OSA_ADB_NOLOCKFILE"; break;
 368     case OSA_ADB_NOEXCL_PERM: code_string = "OSA_ADB_NOEXCL_PERM"; break;
 369
 370     case KRB5_KDB_INUSE: code_string = "KRB5_KDB_INUSE"; break;
 371     case KRB5_KDB_UK_SERROR: code_string = "KRB5_KDB_UK_SERROR"; break;
 372     case KRB5_KDB_UK_RERROR: code_string = "KRB5_KDB_UK_RERROR"; break;
 373     case KRB5_KDB_UNAUTH: code_string = "KRB5_KDB_UNAUTH"; break;
 374     case KRB5_KDB_NOENTRY: code_string = "KRB5_KDB_NOENTRY"; break;
 375     case KRB5_KDB_ILL_WILDCARD: code_string = "KRB5_KDB_ILL_WILDCARD"; break;
 376     case KRB5_KDB_DB_INUSE: code_string = "KRB5_KDB_DB_INUSE"; break;
 377     case KRB5_KDB_DB_CHANGED: code_string = "KRB5_KDB_DB_CHANGED"; break;
 378     case KRB5_KDB_TRUNCATED_RECORD:
 379         code_string = "KRB5_KDB_TRUNCATED_RECORD"; break;
 380     case KRB5_KDB_RECURSIVELOCK:
 381         code_string = "KRB5_KDB_RECURSIVELOCK"; break;
 382     case KRB5_KDB_NOTLOCKED: code_string = "KRB5_KDB_NOTLOCKED"; break;
 383     case KRB5_KDB_BADLOCKMODE: code_string = "KRB5_KDB_BADLOCKMODE"; break;
 384     case KRB5_KDB_DBNOTINITED: code_string = "KRB5_KDB_DBNOTINITED"; break;
 385     case KRB5_KDB_DBINITED: code_string = "KRB5_KDB_DBINITED"; break;
 386     case KRB5_KDB_ILLDIRECTION: code_string = "KRB5_KDB_ILLDIRECTION"; break;
 387     case KRB5_KDB_NOMASTERKEY: code_string = "KRB5_KDB_NOMASTERKEY"; break;
 388     case KRB5_KDB_BADMASTERKEY: code_string = "KRB5_KDB_BADMASTERKEY"; break;
 389     case KRB5_KDB_INVALIDKEYSIZE:
 390         code_string = "KRB5_KDB_INVALIDKEYSIZE"; break;
 391     case KRB5_KDB_CANTREAD_STORED:
 392         code_string = "KRB5_KDB_CANTREAD_STORED"; break;
 393     case KRB5_KDB_BADSTORED_MKEY:
 394         code_string = "KRB5_KDB_BADSTORED_MKEY"; break;
 395     case KRB5_KDB_CANTLOCK_DB: code_string = "KRB5_KDB_CANTLOCK_DB"; break;
 396     case KRB5_KDB_DB_CORRUPT: code_string = "KRB5_KDB_DB_CORRUPT"; break;
 397
 398     case KRB5_PARSE_ILLCHAR: code_string = "KRB5_PARSE_ILLCHAR"; break;
 399     case KRB5_PARSE_MALFORMED: code_string = "KRB5_PARSE_MALFORMED"; break;
 400     case KRB5KDC_ERR_S_PRINCIPAL_UNKNOWN: code_string = "KRB5KDC_ERR_S_PRINCIPAL_UNKNOWN"; break;
 401     case KRB5_REALM_UNKNOWN: code_string = "KRB5_REALM_UNKNOWN"; break;
 402     case KRB5_KDC_UNREACH: code_string = "KRB5_KDC_UNREACH"; break;
 403     case KRB5_KDCREP_MODIFIED: code_string = "KRB5_KDCREP_MODIFIED"; break;
 404     case KRB5KRB_AP_ERR_BAD_INTEGRITY: code_string  = "KRB5KRB_AP_ERR_BAD_INTEGRITY"; break;
 405     case KRB5KDC_ERR_C_PRINCIPAL_UNKNOWN: code_string = "KRB5KDC_ERR_C_PRINCIPAL_UNKNOWN"; break;
 406     case KRB5_CONFIG_BADFORMAT: code_string = "KRB5_CONFIG_BADFORMAT"; break;
 407
 408     case KRB5_CC_NOTFOUND: code_string = "KRB5_CC_NOTFOUND"; break;
 409     case KRB5_FCC_NOFILE: code_string = "KRB5_FCC_NOFILE"; break;
 410
 411     case EINVAL: code_string = "EINVAL"; break;
 412     case ENOENT: code_string = "ENOENT"; break;
 413
 414     default:
 415         fprintf(stderr, "**** CODE %ld (%s) ***\n", (long) code,
 416                 error_message (code));
 417         code_string = "UNKNOWN";
 418         break;
 419     }
 420
 421     error_string = error_message(code);
 422
 423     if (! (dstring = (Tcl_DString *) malloc(sizeof(Tcl_DString)))) {
 424         fprintf(stderr, "Out of memory!\n");
 425         exit(1); /* XXX Do we really want to exit?  Ok if this is */
 426         /* just a test program, but what about if it gets */
 427         /* used for other things later? */
 428     }
 429
 430     Tcl_DStringInit(dstring);
 431
 432     if (! (Tcl_DStringAppendElement(dstring, "ERROR") &&
 433            Tcl_DStringAppendElement(dstring, code_string) &&
 434            Tcl_DStringAppendElement(dstring, error_string))) {
 435         fprintf(stderr, "Out of memory!\n");
 436         exit(1); /* XXX */
 437     }
 438
 439     return dstring;
 440 }
 441
 442
 443
 444 static void stash_error(Tcl_Interp *interp, krb5_error_code code)
 445 {
 446     Tcl_DString *dstring = unparse_err(code);
 447     Tcl_DStringResult(interp, dstring);
 448     Tcl_DStringFree(dstring);
 449     free(dstring);
 450 }
 451
 452 static Tcl_DString *unparse_key_data(krb5_key_data *key_data, int n_key_data)
 453 {
 454     Tcl_DString *str;
 455     char buf[2048];
 456     int i, j;
 457
 458     if (! (str = malloc(sizeof(*str)))) {
 459         fprintf(stderr, "Out of memory!\n");
 460         exit(1); /* XXX */
 461     }
 462
 463     Tcl_DStringInit(str);
 464     for (i = 0; i < n_key_data; i++) {
 465         krb5_key_data *key = &key_data[i];
 466
 467         Tcl_DStringStartSublist(str);
 468         sprintf(buf, "%d", key->key_data_type[0]);
 469         Tcl_DStringAppendElement(str, buf);
 470         sprintf(buf, "%d", key->key_data_ver > 1 ?
 471                 key->key_data_type[1] : -1);
 472         Tcl_DStringAppendElement(str, buf);
 473         if (key->key_data_contents[0]) {
 474             sprintf(buf, "0x");
 475             for (j = 0; j < key->key_data_length[0]; j++) {
 476                 sprintf(buf + 2*(j+1), "%02x",
 477                         key->key_data_contents[0][j]);
 478             }
 479         } else *buf = '\0';
 480         Tcl_DStringAppendElement(str, buf);
 481         Tcl_DStringEndSublist(str);
 482     }
 483
 484     return str;
 485 }
 486
 487 static Tcl_DString *unparse_tl_data(krb5_tl_data *tl_data, int n_tl_data)
 488 {
 489     Tcl_DString *str;
 490     char buf[2048];
 491
 492     if (! (str = malloc(sizeof(*str)))) {
 493         fprintf(stderr, "Out of memory!\n");
 494         exit(1); /* XXX */
 495     }
 496
 497     Tcl_DStringInit(str);
 498     Tcl_DStringStartSublist(str);
 499     for (; tl_data; tl_data = tl_data->tl_data_next) {
 500         Tcl_DStringStartSublist(str);
 501         sprintf(buf, "%d", tl_data->tl_data_type);
 502         Tcl_DStringAppendElement(str, buf);
 503         sprintf(buf, "%d", tl_data->tl_data_length);
 504         Tcl_DStringAppendElement(str, buf);
 505         Tcl_DStringAppend(str, " ", 1);
 506         Tcl_DStringAppend(str, (char *) tl_data->tl_data_contents,
 507                           tl_data->tl_data_length);
 508         Tcl_DStringEndSublist(str);
 509     }
 510     Tcl_DStringEndSublist(str);
 511
 512     return str;
 513 }
 514
 515 static Tcl_DString *unparse_flags(struct flagval *array, int size,
 516                                   krb5_int32 flags)
 517 {
 518     int i;
 519     Tcl_DString *str;
 520
 521     if (! (str = malloc(sizeof(*str)))) {
 522         fprintf(stderr, "Out of memory!\n");
 523         exit(1); /* XXX */
 524     }
 525
 526     Tcl_DStringInit(str);
 527
 528     for (i = 0; i < size; i++) {
 529         if (flags & array[i].val) {
 530             Tcl_DStringAppendElement(str, array[i].name);
 531         }
 532     }
 533
 534     return str;
 535 }
 536
 537
 538 static int parse_flags(Tcl_Interp *interp, Tcl_HashTable *table,
 539                        struct flagval *array, int size, const char *str,
 540                        krb5_flags *flags)
 541 {
 542     int tmp, argc, i, retcode = TCL_OK;
 543     const char **argv;
 544     Tcl_HashEntry *entry;
 545
 546     if (Tcl_GetInt(interp, str, &tmp) == TCL_OK) {
 547         *flags = tmp;
 548         return TCL_OK;
 549     }
 550     Tcl_ResetResult(interp);
 551
 552     if (Tcl_SplitList(interp, str, &argc, &argv) != TCL_OK) {
 553         return TCL_ERROR;
 554     }
 555
 556     if (! table) {
 557         table = create_flag_table(array, size);
 558     }
 559
 560     *flags = 0;
 561
 562     for (i = 0; i < argc; i++) {
 563         if (! (entry = Tcl_FindHashEntry(table, argv[i]))) {
 564             Tcl_AppendResult(interp, "unknown krb5 flag ", argv[i], 0);
 565             retcode = TCL_ERROR;
 566             break;
 567         }
 568         *flags |= *(krb5_flags *) Tcl_GetHashValue(entry);
 569     }
 570
 571     Tcl_Free((char *) argv);
 572     return(retcode);
 573 }
 574
 575 static Tcl_DString *unparse_privs(krb5_flags flags)
 576 {
 577     return unparse_flags(priv_flags, sizeof(priv_flags) /
 578                          sizeof(struct flagval), flags);
 579 }
 580
 581
 582 static Tcl_DString *unparse_krb5_flags(krb5_flags flags)
 583 {
 584     return unparse_flags(krb5_flags_array, sizeof(krb5_flags_array) /
 585                          sizeof(struct flagval), flags);
 586 }
 587
 588 static int parse_krb5_flags(Tcl_Interp *interp, const char *str,
 589                             krb5_flags *flags)
 590 {
 591     krb5_flags tmp;
 592     static Tcl_HashTable *table = 0;
 593     int tcl_ret;
 594
 595     if ((tcl_ret = parse_flags(interp, table, krb5_flags_array,
 596                                sizeof(krb5_flags_array) /
 597                                sizeof(struct flagval),
 598                                str, &tmp)) != TCL_OK) {
 599         return tcl_ret;
 600     }
 601
 602     *flags = tmp;
 603     return TCL_OK;
 604 }
 605
 606 static Tcl_DString *unparse_aux_attributes(krb5_int32 flags)
 607 {
 608     return unparse_flags(aux_attributes, sizeof(aux_attributes) /
 609                          sizeof(struct flagval), flags);
 610 }
 611
 612
 613 static int parse_aux_attributes(Tcl_Interp *interp, const char *str,
 614                                 long *flags)
 615 {
 616     krb5_flags tmp;
 617     static Tcl_HashTable *table = 0;
 618     int tcl_ret;
 619
 620     if ((tcl_ret = parse_flags(interp, table, aux_attributes,
 621                                sizeof(aux_attributes) /
 622                                sizeof(struct flagval),
 623                                str, &tmp)) != TCL_OK) {
 624         return tcl_ret;
 625     }
 626
 627     *flags = tmp;
 628     return TCL_OK;
 629 }
 630
 631 static int parse_principal_mask(Tcl_Interp *interp, const char *str,
 632                                 krb5_int32 *flags)
 633 {
 634     krb5_flags tmp;
 635     static Tcl_HashTable *table = 0;
 636     int tcl_ret;
 637
 638     if ((tcl_ret = parse_flags(interp, table, principal_mask_flags,
 639                                sizeof(principal_mask_flags) /
 640                                sizeof(struct flagval),
 641                                str, &tmp)) != TCL_OK) {
 642         return tcl_ret;
 643     }
 644
 645     *flags = tmp;
 646     return TCL_OK;
 647 }
 648
 649 static int parse_policy_mask(Tcl_Interp *interp, const char *str,
 650                              krb5_int32 *flags)
 651 {
 652     krb5_flags tmp;
 653     static Tcl_HashTable *table = 0;
 654     int tcl_ret;
 655
 656     if ((tcl_ret = parse_flags(interp, table, policy_mask_flags,
 657                                sizeof(policy_mask_flags) /
 658                                sizeof(struct flagval),
 659                                str, &tmp)) != TCL_OK) {
 660         return tcl_ret;
 661     }
 662
 663     *flags = tmp;
 664     return TCL_OK;
 665 }
 666
 667
 668 static Tcl_DString *unparse_principal_ent(kadm5_principal_ent_t princ,
 669                                           krb5_int32 mask)
 670 {
 671     Tcl_DString *str, *tmp_dstring;
 672     char *tmp;
 673     char buf[20];
 674     krb5_error_code krb5_ret;
 675
 676     if (! (str = malloc(sizeof(*str)))) {
 677         fprintf(stderr, "Out of memory!\n");
 678         exit(1); /* XXX */
 679     }
 680
 681     Tcl_DStringInit(str);
 682
 683     tmp = 0; /* It looks to me from looking at the library source */
 684     /* code for krb5_parse_name that the pointer passed into */
 685     /* it should be initialized to 0 if I want it do be */
 686     /* allocated automatically. */
 687     if (mask & KADM5_PRINCIPAL) {
 688         krb5_ret = krb5_unparse_name(context, princ->principal, &tmp);
 689         if (krb5_ret) {
 690             /* XXX Do we want to return an error?  Not sure. */
 691             Tcl_DStringAppendElement(str, "[unparseable principal]");
 692         }
 693         else {
 694             Tcl_DStringAppendElement(str, tmp);
 695             free(tmp);
 696         }
 697     } else
 698         Tcl_DStringAppendElement(str, "null");
 699
 700     sprintf(buf, "%u", (unsigned int)princ->princ_expire_time);
 701     Tcl_DStringAppendElement(str, buf);
 702
 703     sprintf(buf, "%u", (unsigned int)princ->last_pwd_change);
 704     Tcl_DStringAppendElement(str, buf);
 705
 706     sprintf(buf, "%u", (unsigned int)princ->pw_expiration);
 707     Tcl_DStringAppendElement(str, buf);
 708
 709     sprintf(buf, "%d", princ->max_life);
 710     Tcl_DStringAppendElement(str, buf);
 711
 712     tmp = 0;
 713     if (mask & KADM5_MOD_NAME) {
 714         if ((krb5_ret = krb5_unparse_name(context, princ->mod_name, &tmp))) {
 715             /* XXX */
 716             Tcl_DStringAppendElement(str, "[unparseable principal]");
 717         }
 718         else {
 719             Tcl_DStringAppendElement(str, tmp);
 720             free(tmp);
 721         }
 722     } else
 723         Tcl_DStringAppendElement(str, "null");
 724
 725     sprintf(buf, "%u", (unsigned int)princ->mod_date);
 726     Tcl_DStringAppendElement(str, buf);
 727
 728     if (mask & KADM5_ATTRIBUTES) {
 729         tmp_dstring = unparse_krb5_flags(princ->attributes);
 730         Tcl_DStringAppendElement(str, tmp_dstring->string);
 731         Tcl_DStringFree(tmp_dstring);
 732         free(tmp_dstring);
 733     } else
 734         Tcl_DStringAppendElement(str, "null");
 735
 736     sprintf(buf, "%d", princ->kvno);
 737     Tcl_DStringAppendElement(str, buf);
 738
 739     sprintf(buf, "%d", princ->mkvno);
 740     Tcl_DStringAppendElement(str, buf);
 741
 742     /* XXX This may be dangerous, because the contents of the policy */
 743     /* field are undefined if the POLICY bit isn't set.  However, I */
 744     /* think it's a bug for the field not to be null in that case */
 745     /* anyway, so we should assume that it will be null so that we'll */
 746     /* catch it if it isn't. */
 747
 748     tmp_dstring = unparse_str(princ->policy);
 749     Tcl_DStringAppendElement(str, tmp_dstring->string);
 750     Tcl_DStringFree(tmp_dstring);
 751     free(tmp_dstring);
 752
 753     tmp_dstring = unparse_aux_attributes(princ->aux_attributes);
 754     Tcl_DStringAppendElement(str, tmp_dstring->string);
 755     Tcl_DStringFree(tmp_dstring);
 756     free(tmp_dstring);
 757
 758     sprintf(buf, "%d", princ->max_renewable_life);
 759     Tcl_DStringAppendElement(str, buf);
 760
 761     sprintf(buf, "%u", (unsigned int)princ->last_success);
 762     Tcl_DStringAppendElement(str, buf);
 763
 764     sprintf(buf, "%u", (unsigned int)princ->last_failed);
 765     Tcl_DStringAppendElement(str, buf);
 766
 767     sprintf(buf, "%d", princ->fail_auth_count);
 768     Tcl_DStringAppendElement(str, buf);
 769
 770     sprintf(buf, "%d", princ->n_key_data);
 771     Tcl_DStringAppendElement(str, buf);
 772
 773     sprintf(buf, "%d", princ->n_tl_data);
 774     Tcl_DStringAppendElement(str, buf);
 775
 776     tmp_dstring = unparse_key_data(princ->key_data, princ->n_key_data);
 777     Tcl_DStringAppendElement(str, tmp_dstring->string);
 778     Tcl_DStringFree(tmp_dstring);
 779     free(tmp_dstring);
 780
 781     tmp_dstring = unparse_tl_data(princ->tl_data, princ->n_tl_data);
 782     Tcl_DStringAppendElement(str, tmp_dstring->string);
 783     Tcl_DStringFree(tmp_dstring);
 784     free(tmp_dstring);
 785
 786     return str;
 787 }
 788
 789 static int parse_keysalts(Tcl_Interp *interp, const char *list,
 790                           krb5_key_salt_tuple **keysalts,
 791                           int num_keysalts)
 792 {
 793     const char **argv, **argv1 = NULL;
 794     int i, tmp, argc, argc1, retcode;
 795
 796     *keysalts = NULL;
 797     if (list == NULL)
 798         return TCL_OK;
 799
 800     if ((retcode = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
 801         return retcode;
 802     }
 803     if (argc != num_keysalts) {
 804         Tcl_SetResult(interp, "wrong number of keysalts", TCL_STATIC);
 805         retcode = TCL_ERROR;
 806         goto finished;
 807     }
 808     *keysalts = (krb5_key_salt_tuple *)
 809         malloc(sizeof(krb5_key_salt_tuple)*num_keysalts);
 810     for (i = 0; i < num_keysalts; i++) {
 811         if ((retcode = Tcl_SplitList(interp, argv[i], &argc1, &argv1)) !=
 812             TCL_OK) {
 813             goto finished;
 814         }
 815         if (argc1 != 2) {
 816             Tcl_SetResult(interp, "wrong # of fields in keysalt", TCL_STATIC);
 817             retcode = TCL_ERROR;
 818             goto finished;
 819         }
 820         /* XXX this used to be argv1[1] too! */
 821         if ((retcode = Tcl_GetInt(interp, argv1[0], &tmp))
 822             != TCL_OK) {
 823             Tcl_AppendElement(interp, "while parsing ks_enctype");
 824             retcode = TCL_ERROR;
 825             goto finished;
 826         }
 827         (*keysalts)[i].ks_enctype = tmp;
 828         if ((retcode = Tcl_GetInt(interp, argv1[1], &tmp))
 829             != TCL_OK) {
 830             Tcl_AppendElement(interp, "while parsing ks_salttype");
 831             goto finished;
 832         }
 833         (*keysalts)[i].ks_salttype = tmp;
 834
 835         Tcl_Free((char *) argv1);
 836         argv1 = NULL;
 837     }
 838
 839 finished:
 840     if (argv1) {
 841         Tcl_Free((char *) argv1);
 842     }
 843     Tcl_Free((char *) argv);
 844     return retcode;
 845 }
 846
 847 static int parse_key_data(Tcl_Interp *interp, const char *list,
 848                           krb5_key_data **key_data,
 849                           int n_key_data)
 850 {
 851     const char **argv = NULL;
 852     int argc, retcode;
 853
 854     *key_data = NULL;
 855     if (list == NULL) {
 856         if (n_key_data != 0) {
 857             Tcl_SetResult(interp, "wrong number of key_datas", TCL_STATIC);
 858             retcode = TCL_ERROR;
 859             goto finished;
 860         } else
 861             return TCL_OK;
 862     }
 863
 864     if ((retcode = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
 865         return retcode;
 866     }
 867     if (argc != n_key_data) {
 868         Tcl_SetResult(interp, "wrong number of key_datas", TCL_STATIC);
 869         retcode = TCL_ERROR;
 870         goto finished;
 871     }
 872
 873     if (argc != 0) {
 874         Tcl_SetResult(interp, "cannot parse key_data yet", TCL_STATIC);
 875         retcode = TCL_ERROR;
 876         goto finished;
 877     }
 878
 879 finished:
 880     Tcl_Free((char *) argv);
 881     return retcode;
 882 }
 883
 884 static int parse_tl_data(Tcl_Interp *interp, const char *list,
 885                          krb5_tl_data **tlp,
 886                          int n_tl_data)
 887 {
 888     krb5_tl_data *tl, *tl2;
 889     const char **argv = NULL, **argv1 = NULL;
 890     int i, tmp, argc, argc1, retcode;
 891
 892     *tlp = NULL;
 893     if (list == NULL) {
 894         if (n_tl_data != 0) {
 895             Tcl_SetResult(interp, "wrong number of tl_datas", TCL_STATIC);
 896             retcode = TCL_ERROR;
 897             goto finished;
 898         } else
 899             return TCL_OK;
 900     }
 901
 902     if ((retcode = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
 903         return retcode;
 904     }
 905     if (argc != n_tl_data) {
 906         Tcl_SetResult(interp, "wrong number of tl_datas", TCL_STATIC);
 907         retcode = TCL_ERROR;
 908         goto finished;
 909     }
 910
 911     tl = tl2 = NULL;
 912     for (i = 0; i < n_tl_data; i++) {
 913         tl2 = (krb5_tl_data *) malloc(sizeof(krb5_tl_data));
 914         memset(tl2, 0, sizeof(krb5_tl_data));
 915         tl2->tl_data_next = tl;
 916         tl = tl2;
 917     }
 918     tl2 = tl;
 919
 920     for (i = 0; i < n_tl_data; i++) {
 921         if ((retcode = Tcl_SplitList(interp, argv[i], &argc1, &argv1)) !=
 922             TCL_OK) {
 923             goto finished;
 924         }
 925         if (argc1 != 3) {
 926             Tcl_SetResult(interp, "wrong # of fields in tl_data", TCL_STATIC);
 927             retcode = TCL_ERROR;
 928             goto finished;
 929         }
 930         if ((retcode = Tcl_GetInt(interp, argv1[0], &tmp))
 931             != TCL_OK) {
 932             Tcl_AppendElement(interp, "while parsing tl_data_type");
 933             retcode = TCL_ERROR;
 934             goto finished;
 935         }
 936         tl->tl_data_type = tmp;
 937         if ((retcode = Tcl_GetInt(interp, argv1[1], &tmp))
 938             != TCL_OK) {
 939             Tcl_AppendElement(interp, "while parsing tl_data_length");
 940             retcode = TCL_ERROR;
 941             goto finished;
 942         }
 943         tl->tl_data_length = tmp;
 944         if (tl->tl_data_length != strlen(argv1[2])) {
 945             Tcl_SetResult(interp, "length != string length", TCL_STATIC);
 946             retcode = TCL_ERROR;
 947             goto finished;
 948         }
 949         tl->tl_data_contents = (krb5_octet *) strdup(argv1[2]);
 950
 951         Tcl_Free((char *) argv1);
 952         argv1 = NULL;
 953         tl = tl->tl_data_next;
 954     }
 955     if (tl != NULL) {
 956         Tcl_SetResult(interp, "tl is not NULL!", TCL_STATIC);
 957         retcode = TCL_ERROR;
 958         goto finished;
 959     }
 960     *tlp = tl2;
 961
 962 finished:
 963     if (argv1) {
 964         Tcl_Free((char *) argv1);
 965     }
 966     Tcl_Free((char *) argv);
 967     return retcode;
 968 }
 969
 970 static int parse_config_params(Tcl_Interp *interp, char *list,
 971                                kadm5_config_params *params)
 972 {
 973     static Tcl_HashTable *table = 0;
 974     const char **argv = NULL;
 975     int tmp, argc, retcode;
 976
 977     memset(params, 0, sizeof(kadm5_config_params));
 978     if (list == NULL)
 979         return TCL_OK;
 980
 981     if ((retcode = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
 982         return retcode;
 983     }
 984
 985     if (argc != 20) {
 986         Tcl_SetResult(interp, "wrong # args in config params structure",
 987                       TCL_STATIC);
 988         retcode = TCL_ERROR;
 989         goto finished;
 990     }
 991
 992     if ((retcode = parse_flags(interp, table, config_mask_flags,
 993                                sizeof(config_mask_flags) /
 994                                sizeof(struct flagval),
 995                                argv[0], &tmp)) != TCL_OK) {
 996         goto finished;
 997     }
 998     params->mask = tmp;
 999
1000     if ((retcode = parse_str(interp, argv[1], &params->realm)) != TCL_OK) {
1001         Tcl_AppendElement(interp, "while parsing realm name");
1002         retcode = TCL_ERROR;
1003         goto finished;
1004     }
1005     if ((retcode = Tcl_GetInt(interp, argv[2], &tmp))
1006         != TCL_OK) {
1007         Tcl_AppendElement(interp, "while parsing kadmind_port");
1008         retcode = TCL_ERROR;
1009         goto finished;
1010     }
1011     params->kadmind_port = tmp;
1012     if ((retcode = parse_str(interp, argv[3], &params->admin_server))
1013         != TCL_OK) {
1014         Tcl_AppendElement(interp, "while parsing profile name");
1015         retcode = TCL_ERROR;
1016         goto finished;
1017     }
1018     if ((retcode = parse_str(interp, argv[4], &params->dbname)) != TCL_OK) {
1019         Tcl_AppendElement(interp, "while parsing profile name");
1020         retcode = TCL_ERROR;
1021         goto finished;
1022     }
1023     /* Ignore argv[5], which used to set the admin_dbname field.  */
1024     /* Ignore argv[6], which used to set the admin_lockfile field.  */
1025     /* Ignore argv[7], which used to set the admin_keytab field.  */
1026     if ((retcode = parse_str(interp, argv[8], &params->acl_file)) != TCL_OK) {
1027         Tcl_AppendElement(interp, "while parsing acl_file name");
1028         retcode = TCL_ERROR;
1029         goto finished;
1030     }
1031     if ((retcode = parse_str(interp, argv[9], &params->dict_file)) != TCL_OK) {
1032         Tcl_AppendElement(interp, "while parsing dict_file name");
1033         retcode = TCL_ERROR;
1034         goto finished;
1035     }
1036     if ((retcode = Tcl_GetInt(interp, argv[10], &tmp))
1037         != TCL_OK) {
1038         Tcl_AppendElement(interp, "while parsing mkey_from_kbd");
1039         retcode = TCL_ERROR;
1040         goto finished;
1041     }
1042     params->mkey_from_kbd = tmp;
1043     if ((retcode = parse_str(interp, argv[11], &params->stash_file)) != TCL_OK) {
1044         Tcl_AppendElement(interp, "while parsing stash_file name");
1045         retcode = TCL_ERROR;
1046         goto finished;
1047     }
1048     if ((retcode = parse_str(interp, argv[12], &params->mkey_name)) != TCL_OK) {
1049         Tcl_AppendElement(interp, "while parsing mkey_name name");
1050         retcode = TCL_ERROR;
1051         goto finished;
1052     }
1053     if ((retcode = Tcl_GetInt(interp, argv[13], &tmp))
1054         != TCL_OK) {
1055         Tcl_AppendElement(interp, "while parsing enctype");
1056         retcode = TCL_ERROR;
1057         goto finished;
1058     }
1059     params->enctype = tmp;
1060     if ((retcode = Tcl_GetInt(interp, argv[14], &tmp))
1061         != TCL_OK) {
1062         Tcl_AppendElement(interp, "while parsing max_life");
1063         retcode = TCL_ERROR;
1064         goto finished;
1065     }
1066     params->max_life = tmp;
1067     if ((retcode = Tcl_GetInt(interp, argv[15], &tmp))
1068         != TCL_OK) {
1069         Tcl_AppendElement(interp, "while parsing max_rlife");
1070         retcode = TCL_ERROR;
1071         goto finished;
1072     }
1073     params->max_rlife = tmp;
1074     if ((retcode = Tcl_GetInt(interp, argv[16], &tmp))
1075         != TCL_OK) {
1076         Tcl_AppendElement(interp, "while parsing expiration");
1077         retcode = TCL_ERROR;
1078         goto finished;
1079     }
1080     params->expiration = tmp;
1081     if ((retcode = parse_krb5_flags(interp, argv[17], &tmp))
1082         != TCL_OK) {
1083         Tcl_AppendElement(interp, "while parsing flags");
1084         retcode = TCL_ERROR;
1085         goto finished;
1086     }
1087     params->flags = tmp;
1088     if ((retcode = Tcl_GetInt(interp, argv[18], &tmp))
1089         != TCL_OK) {
1090         Tcl_AppendElement(interp, "while parsing num_keysalts");
1091         retcode = TCL_ERROR;
1092         goto finished;
1093     }
1094     params->num_keysalts = tmp;
1095     if ((retcode = parse_keysalts(interp, argv[19], &params->keysalts,
1096                                   params->num_keysalts)) != TCL_OK) {
1097         Tcl_AppendElement(interp, "while parsing keysalts");
1098         retcode = TCL_ERROR;
1099         goto finished;
1100     }
1101
1102 finished:
1103     return retcode;
1104 }
1105
1106 static int parse_principal_ent(Tcl_Interp *interp, char *list,
1107                                kadm5_principal_ent_t *out_princ)
1108 {
1109     kadm5_principal_ent_t princ = 0;
1110     krb5_error_code krb5_ret;
1111     int tcl_ret;
1112     int argc;
1113     const char **argv;
1114     int tmp;
1115     int retcode = TCL_OK;
1116
1117     if ((tcl_ret = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
1118         return tcl_ret;
1119     }
1120
1121     if (argc != 12 && argc != 20) {
1122         Tcl_SetResult(interp, "wrong # args in principal structure",
1123                       TCL_STATIC);
1124         retcode = TCL_ERROR;
1125         goto finished;
1126     }
1127
1128     if (! (princ = malloc(sizeof *princ))) {
1129         fprintf(stderr, "Out of memory!\n");
1130         exit(1); /* XXX */
1131     }
1132     memset(princ, 0, sizeof(*princ));
1133
1134     if ((krb5_ret = krb5_parse_name(context, argv[0], &princ->principal)) != 0) {
1135         stash_error(interp, krb5_ret);
1136         Tcl_AppendElement(interp, "while parsing principal");
1137         retcode = TCL_ERROR;
1138         goto finished;
1139     }
1140
1141     /*
1142      * All of the numerical values parsed here are parsed into an
1143      * "int" and then assigned into the structure in case the actual
1144      * width of the field in the Kerberos structure is different from
1145      * the width of an integer.
1146      */
1147
1148     if ((tcl_ret = Tcl_GetInt(interp, argv[1], &tmp))
1149         != TCL_OK) {
1150         Tcl_AppendElement(interp, "while parsing princ_expire_time");
1151         retcode = TCL_ERROR;
1152         goto finished;
1153     }
1154     princ->princ_expire_time = tmp;
1155
1156     if ((tcl_ret = Tcl_GetInt(interp, argv[2], &tmp))
1157         != TCL_OK) {
1158         Tcl_AppendElement(interp, "while parsing last_pwd_change");
1159         retcode = TCL_ERROR;
1160         goto finished;
1161     }
1162     princ->last_pwd_change = tmp;
1163
1164     if ((tcl_ret = Tcl_GetInt(interp, argv[3], &tmp))
1165         != TCL_OK) {
1166         Tcl_AppendElement(interp, "while parsing pw_expiration");
1167         retcode = TCL_ERROR;
1168         goto finished;
1169     }
1170     princ->pw_expiration = tmp;
1171
1172     if ((tcl_ret = Tcl_GetInt(interp, argv[4], &tmp))
1173         != TCL_OK) {
1174         Tcl_AppendElement(interp, "while parsing max_life");
1175         retcode = TCL_ERROR;
1176         goto finished;
1177     }
1178     princ->max_life = tmp;
1179
1180     if ((krb5_ret = krb5_parse_name(context, argv[5], &princ->mod_name)) != 0) {
1181         stash_error(interp, krb5_ret);
1182         Tcl_AppendElement(interp, "while parsing mod_name");
1183         retcode = TCL_ERROR;
1184         goto finished;
1185     }
1186
1187     if ((tcl_ret = Tcl_GetInt(interp, argv[6], &tmp))
1188         != TCL_OK) {
1189         Tcl_AppendElement(interp, "while parsing mod_date");
1190         retcode = TCL_ERROR;
1191         goto finished;
1192     }
1193     princ->mod_date = tmp;
1194
1195     if ((tcl_ret = parse_krb5_flags(interp, argv[7], &princ->attributes))
1196         != TCL_OK) {
1197         Tcl_AppendElement(interp, "while parsing attributes");
1198         retcode = TCL_ERROR;
1199         goto finished;
1200     }
1201
1202     if ((tcl_ret = Tcl_GetInt(interp, argv[8], &tmp))
1203         != TCL_OK) {
1204         Tcl_AppendElement(interp, "while parsing kvno");
1205         retcode = TCL_ERROR;
1206         goto finished;
1207     }
1208     princ->kvno = tmp;
1209
1210     if ((tcl_ret = Tcl_GetInt(interp, argv[9], &tmp))
1211         != TCL_OK) {
1212         Tcl_AppendElement(interp, "while parsing mkvno");
1213         retcode = TCL_ERROR;
1214         goto finished;
1215     }
1216     princ->mkvno = tmp;
1217
1218     if ((tcl_ret = parse_str(interp, argv[10], &princ->policy)) != TCL_OK) {
1219         Tcl_AppendElement(interp, "while parsing policy");
1220         retcode = TCL_ERROR;
1221         goto finished;
1222     }
1223     if(princ->policy != NULL) {
1224         if(!(princ->policy = strdup(princ->policy))) {
1225             fprintf(stderr, "Out of memory!\n");
1226             exit(1);
1227         }
1228     }
1229
1230     if ((tcl_ret = parse_aux_attributes(interp, argv[11],
1231                                         &princ->aux_attributes)) != TCL_OK) {
1232         Tcl_AppendElement(interp, "while parsing aux_attributes");
1233         retcode = TCL_ERROR;
1234         goto finished;
1235     }
1236
1237     if (argc == 12) goto finished;
1238
1239     if ((tcl_ret = Tcl_GetInt(interp, argv[12], &tmp))
1240         != TCL_OK) {
1241         Tcl_AppendElement(interp, "while parsing max_renewable_life");
1242         retcode = TCL_ERROR;
1243         goto finished;
1244     }
1245     princ->max_renewable_life = tmp;
1246
1247     if ((tcl_ret = Tcl_GetInt(interp, argv[13], &tmp))
1248         != TCL_OK) {
1249         Tcl_AppendElement(interp, "while parsing last_success");
1250         retcode = TCL_ERROR;
1251         goto finished;
1252     }
1253     princ->last_success = tmp;
1254
1255     if ((tcl_ret = Tcl_GetInt(interp, argv[14], &tmp))
1256         != TCL_OK) {
1257         Tcl_AppendElement(interp, "while parsing last_failed");
1258         retcode = TCL_ERROR;
1259         goto finished;
1260     }
1261     princ->last_failed = tmp;
1262
1263     if ((tcl_ret = Tcl_GetInt(interp, argv[15], &tmp))
1264         != TCL_OK) {
1265         Tcl_AppendElement(interp, "while parsing fail_auth_count");
1266         retcode = TCL_ERROR;
1267         goto finished;
1268     }
1269     princ->fail_auth_count = tmp;
1270
1271     if ((tcl_ret = Tcl_GetInt(interp, argv[16], &tmp))
1272         != TCL_OK) {
1273         Tcl_AppendElement(interp, "while parsing n_key_data");
1274         retcode = TCL_ERROR;
1275         goto finished;
1276     }
1277     princ->n_key_data = tmp;
1278
1279     if ((tcl_ret = Tcl_GetInt(interp, argv[17], &tmp))
1280         != TCL_OK) {
1281         Tcl_AppendElement(interp, "while parsing n_tl_data");
1282         retcode = TCL_ERROR;
1283         goto finished;
1284     }
1285     princ->n_tl_data = tmp;
1286
1287     if ((tcl_ret = parse_key_data(interp, argv[18],
1288                                   &princ->key_data,
1289                                   princ->n_key_data)) != TCL_OK) {
1290         Tcl_AppendElement(interp, "while parsing key_data");
1291         retcode = TCL_ERROR;
1292         goto finished;
1293     }
1294
1295     if ((tcl_ret = parse_tl_data(interp, argv[19],
1296                                  &princ->tl_data,
1297                                  princ->n_tl_data)) != TCL_OK) {
1298         Tcl_AppendElement(interp, "while parsing tl_data");
1299         retcode = TCL_ERROR;
1300         goto finished;
1301     }
1302     princ->n_tl_data = tmp;
1303
1304 finished:
1305     Tcl_Free((char *) argv);
1306     *out_princ = princ;
1307     return retcode;
1308 }
1309
1310
1311 static void free_principal_ent(kadm5_principal_ent_t *princ)
1312 {
1313     krb5_free_principal(context, (*princ)->principal);
1314     krb5_free_principal(context, (*princ)->mod_name);
1315     free((*princ)->policy);
1316     free(*princ);
1317     *princ = 0;
1318 }
1319
1320 static Tcl_DString *unparse_policy_ent(kadm5_policy_ent_t policy)
1321 {
1322     Tcl_DString *str, *tmp_dstring;
1323     char buf[20];
1324
1325     if (! (str = malloc(sizeof(*str)))) {
1326         fprintf(stderr, "Out of memory!\n");
1327         exit(1); /* XXX */
1328     }
1329
1330     Tcl_DStringInit(str);
1331
1332     tmp_dstring = unparse_str(policy->policy);
1333     Tcl_DStringAppendElement(str, tmp_dstring->string);
1334     Tcl_DStringFree(tmp_dstring);
1335     free(tmp_dstring);
1336
1337     sprintf(buf, "%ld", policy->pw_min_life);
1338     Tcl_DStringAppendElement(str, buf);
1339
1340     sprintf(buf, "%ld", policy->pw_max_life);
1341     Tcl_DStringAppendElement(str, buf);
1342
1343     sprintf(buf, "%ld", policy->pw_min_length);
1344     Tcl_DStringAppendElement(str, buf);
1345
1346     sprintf(buf, "%ld", policy->pw_min_classes);
1347     Tcl_DStringAppendElement(str, buf);
1348
1349     sprintf(buf, "%ld", policy->pw_history_num);
1350     Tcl_DStringAppendElement(str, buf);
1351
1352     sprintf(buf, "%ld", policy->policy_refcnt);
1353     Tcl_DStringAppendElement(str, buf);
1354
1355     sprintf(buf, "%d", policy->pw_max_fail);
1356     Tcl_DStringAppendElement(str, buf);
1357
1358     sprintf(buf, "%d", policy->pw_failcnt_interval);
1359     Tcl_DStringAppendElement(str, buf);
1360
1361     sprintf(buf, "%d", policy->pw_lockout_duration);
1362     Tcl_DStringAppendElement(str, buf);
1363
1364     return str;
1365 }
1366
1367
1368
1369 static int parse_policy_ent(Tcl_Interp *interp, char *list,
1370                             kadm5_policy_ent_t *out_policy)
1371 {
1372     kadm5_policy_ent_t policy = 0;
1373     int tcl_ret;
1374     int argc;
1375     const char **argv;
1376     int tmp;
1377     int retcode = TCL_OK;
1378
1379     if ((tcl_ret = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
1380         return tcl_ret;
1381     }
1382
1383     if (argc != 7 && argc != 10) {
1384         Tcl_SetResult(interp, "wrong # args in policy structure", TCL_STATIC);
1385         retcode = TCL_ERROR;
1386         goto finished;
1387     }
1388
1389     if (! (policy = malloc(sizeof *policy))) {
1390         fprintf(stderr, "Out of memory!\n");
1391         exit(1); /* XXX */
1392     }
1393
1394     if ((tcl_ret = parse_str(interp, argv[0], &policy->policy)) != TCL_OK) {
1395         Tcl_AppendElement(interp, "while parsing policy name");
1396         retcode = TCL_ERROR;
1397         goto finished;
1398     }
1399
1400     if(policy->policy != NULL) {
1401         if (! (policy->policy = strdup(policy->policy))) {
1402             fprintf(stderr, "Out of memory!\n");
1403             exit(1); /* XXX */
1404         }
1405     }
1406
1407     /*
1408      * All of the numerical values parsed here are parsed into an
1409      * "int" and then assigned into the structure in case the actual
1410      * width of the field in the Kerberos structure is different from
1411      * the width of an integer.
1412      */
1413
1414     if ((tcl_ret = Tcl_GetInt(interp, argv[1], &tmp))
1415         != TCL_OK) {
1416         Tcl_AppendElement(interp, "while parsing pw_min_life");
1417         retcode = TCL_ERROR;
1418         goto finished;
1419     }
1420     policy->pw_min_life = tmp;
1421
1422     if ((tcl_ret = Tcl_GetInt(interp, argv[2], &tmp))
1423         != TCL_OK) {
1424         Tcl_AppendElement(interp, "while parsing pw_max_life");
1425         retcode = TCL_ERROR;
1426         goto finished;
1427     }
1428     policy->pw_max_life = tmp;
1429
1430     if ((tcl_ret = Tcl_GetInt(interp, argv[3], &tmp))
1431         != TCL_OK) {
1432         Tcl_AppendElement(interp, "while parsing pw_min_length");
1433         retcode = TCL_ERROR;
1434         goto finished;
1435     }
1436     policy->pw_min_length = tmp;
1437
1438     if ((tcl_ret = Tcl_GetInt(interp, argv[4], &tmp))
1439         != TCL_OK) {
1440         Tcl_AppendElement(interp, "while parsing pw_min_classes");
1441         retcode = TCL_ERROR;
1442         goto finished;
1443     }
1444     policy->pw_min_classes = tmp;
1445
1446     if ((tcl_ret = Tcl_GetInt(interp, argv[5], &tmp))
1447         != TCL_OK) {
1448         Tcl_AppendElement(interp, "while parsing pw_history_num");
1449         retcode = TCL_ERROR;
1450         goto finished;
1451     }
1452     policy->pw_history_num = tmp;
1453
1454     if ((tcl_ret = Tcl_GetInt(interp, argv[6], &tmp))
1455         != TCL_OK) {
1456         Tcl_AppendElement(interp, "while parsing policy_refcnt");
1457         retcode = TCL_ERROR;
1458         goto finished;
1459     }
1460     policy->policy_refcnt = tmp;
1461
1462     if (argc == 7) goto finished;
1463
1464     if ((tcl_ret = Tcl_GetInt(interp, argv[7], &tmp))
1465         != TCL_OK) {
1466         Tcl_AppendElement(interp, "while parsing pw_max_fail");
1467         retcode = TCL_ERROR;
1468         goto finished;
1469     }
1470     policy->pw_max_fail = tmp;
1471
1472     if ((tcl_ret = Tcl_GetInt(interp, argv[8], &tmp))
1473         != TCL_OK) {
1474         Tcl_AppendElement(interp, "while parsing pw_failcnt_interval");
1475         retcode = TCL_ERROR;
1476         goto finished;
1477     }
1478     policy->pw_failcnt_interval = tmp;
1479
1480     if ((tcl_ret = Tcl_GetInt(interp, argv[9], &tmp))
1481         != TCL_OK) {
1482         Tcl_AppendElement(interp, "while parsing pw_lockout_duration");
1483         retcode = TCL_ERROR;
1484         goto finished;
1485     }
1486     policy->pw_lockout_duration = tmp;
1487
1488 finished:
1489     Tcl_Free((char *) argv);
1490     *out_policy = policy;
1491     return retcode;
1492 }
1493
1494
1495 static void free_policy_ent(kadm5_policy_ent_t *policy)
1496 {
1497     free((*policy)->policy);
1498     free(*policy);
1499     *policy = 0;
1500 }
1501
1502 static Tcl_DString *unparse_keytype(krb5_enctype enctype)
1503 {
1504     Tcl_DString *str;
1505     char buf[50];
1506
1507     if (! (str = malloc(sizeof(*str)))) {
1508         fprintf(stderr, "Out of memory!\n");
1509         exit(1); /* XXX */
1510     }
1511
1512     Tcl_DStringInit(str);
1513
1514     switch (enctype) {
1515         /* XXX is this right? */
1516     case ENCTYPE_NULL: Tcl_DStringAppend(str, "ENCTYPE_NULL", -1); break;
1517     case ENCTYPE_DES_CBC_CRC:
1518         Tcl_DStringAppend(str, "ENCTYPE_DES_CBC_CRC", -1); break;
1519     default:
1520         sprintf(buf, "UNKNOWN KEYTYPE (0x%x)", enctype);
1521         Tcl_DStringAppend(str, buf, -1);
1522         break;
1523     }
1524
1525     return str;
1526 }
1527
1528
1529 static Tcl_DString *unparse_keyblocks(krb5_keyblock *keyblocks, int num_keys)
1530 {
1531     Tcl_DString *str;
1532     Tcl_DString *keytype;
1533     unsigned int i;
1534     int j;
1535
1536     if (! (str = malloc(sizeof(*str)))) {
1537         fprintf(stderr, "Out of memory!\n");
1538         exit(1); /* XXX */
1539     }
1540
1541     Tcl_DStringInit(str);
1542
1543     for (j = 0; j < num_keys; j++) {
1544         krb5_keyblock *keyblock = &keyblocks[j];
1545
1546         Tcl_DStringStartSublist(str);
1547
1548         keytype = unparse_keytype(keyblock->enctype);
1549         Tcl_DStringAppendElement(str, keytype->string);
1550         Tcl_DStringFree(keytype);
1551         free(keytype);
1552         if (keyblock->length == 0) {
1553             Tcl_DStringAppendElement(str, "0x00");
1554         }
1555         else {
1556             Tcl_DStringAppendElement(str, "0x");
1557             for (i = 0; i < keyblock->length; i++) {
1558                 char buf[3];
1559                 sprintf(buf, "%02x", (int) keyblock->contents[i]);
1560                 Tcl_DStringAppend(str, buf, -1);
1561             }
1562         }
1563
1564         Tcl_DStringEndSublist(str);
1565     }
1566
1567
1568     return str;
1569 }
1570
1571 enum init_type { INIT_NONE, INIT_PASS, INIT_CREDS };
1572
1573 static int _tcl_kadm5_init_any(enum init_type init_type, ClientData clientData,
1574                                Tcl_Interp *interp, int argc, const char *argv[])
1575 {
1576     kadm5_ret_t ret;
1577     char *client_name, *pass, *service_name;
1578     int tcl_ret;
1579     krb5_ui_4 struct_version, api_version;
1580     const char *handle_var;
1581     void *server_handle;
1582     char *handle_name, *params_str;
1583     const char *whoami = argv[0];
1584     kadm5_config_params params;
1585
1586     argv++, argc--;
1587
1588     kadm5_init_krb5_context(&context);
1589
1590     if (argc != 7) {
1591         Tcl_AppendResult(interp, whoami, ": ", arg_error, 0);
1592         return TCL_ERROR;
1593     }
1594
1595     if (((tcl_ret = parse_str(interp, argv[0], &client_name)) != TCL_OK) ||
1596         ((tcl_ret = parse_str(interp, argv[1], &pass)) != TCL_OK) ||
1597         ((tcl_ret = parse_str(interp, argv[2], &service_name)) != TCL_OK) ||
1598         ((tcl_ret = parse_str(interp, argv[3], &params_str)) != TCL_OK) ||
1599         ((tcl_ret = parse_config_params(interp, params_str, &params))
1600          != TCL_OK) ||
1601         ((tcl_ret = Tcl_GetInt(interp, argv[4], (int *) &struct_version)) !=
1602          TCL_OK) ||
1603         ((tcl_ret = Tcl_GetInt(interp, argv[5], (int *) &api_version)) !=
1604          TCL_OK)) {
1605         return tcl_ret;
1606     }
1607
1608     handle_var = argv[6];
1609
1610     if (! (handle_var && *handle_var)) {
1611         Tcl_SetResult(interp, "must specify server handle variable name",
1612                       TCL_STATIC);
1613         return TCL_ERROR;
1614     }
1615
1616     if (init_type == INIT_CREDS) {
1617         krb5_ccache cc;
1618
1619         if (pass == NULL) {
1620             if ((ret = krb5_cc_default(context, &cc))) {
1621                 stash_error(interp, ret);
1622                 return TCL_ERROR;
1623             }
1624         } else {
1625             if ((ret = krb5_cc_resolve(context, pass, &cc))) {
1626                 stash_error(interp, ret);
1627                 return TCL_ERROR;
1628             }
1629         }
1630
1631         ret = kadm5_init_with_creds(context, client_name, cc, service_name,
1632                                     &params, struct_version,
1633                                     api_version, NULL, &server_handle);
1634
1635         (void) krb5_cc_close(context, cc);
1636     } else
1637         ret = kadm5_init(context, client_name, pass, service_name, &params,
1638                          struct_version, api_version, NULL, &server_handle);
1639
1640     /* The string fields of params are aliases into argv[3], but
1641      * params.keysalts is allocated, so clean it up. */
1642     free(params.keysalts);
1643
1644     if (ret != KADM5_OK) {
1645         stash_error(interp, ret);
1646         return TCL_ERROR;
1647     }
1648
1649     if ((tcl_ret = put_server_handle(interp, server_handle, &handle_name))
1650         != TCL_OK) {
1651         return tcl_ret;
1652     }
1653
1654     if (! Tcl_SetVar(interp, handle_var, handle_name, TCL_LEAVE_ERR_MSG)) {
1655         return TCL_ERROR;
1656     }
1657
1658     set_ok(interp, "KADM5 API initialized.");
1659     return TCL_OK;
1660 }
1661
1662 static int tcl_kadm5_init(ClientData clientData, Tcl_Interp *interp,
1663                           int argc, const char *argv[])
1664 {
1665     return _tcl_kadm5_init_any(INIT_PASS, clientData, interp, argc, argv);
1666 }
1667
1668 static int tcl_kadm5_init_with_creds(ClientData clientData, Tcl_Interp *interp,
1669                                      int argc, const char *argv[])
1670 {
1671     return _tcl_kadm5_init_any(INIT_CREDS, clientData, interp, argc, argv);
1672 }
1673
1674 static int tcl_kadm5_destroy(ClientData clientData, Tcl_Interp *interp,
1675                              int argc, const char *argv[])
1676 {
1677     kadm5_ret_t ret;
1678     int tcl_ret;
1679
1680     GET_HANDLE(0, 0);
1681
1682     ret = kadm5_destroy(server_handle);
1683
1684     if (ret != KADM5_OK) {
1685         stash_error(interp, ret);
1686         return TCL_ERROR;
1687     }
1688
1689     if ((tcl_ret = remove_server_handle(interp, argv[-1])) != TCL_OK) {
1690         return tcl_ret;
1691     }
1692
1693     set_ok(interp, "KADM5 API deinitialized.");
1694     return TCL_OK;
1695 }
1696
1697 static int tcl_kadm5_create_principal(ClientData clientData,
1698                                       Tcl_Interp *interp,
1699                                       int argc, const char *argv[])
1700 {
1701     int tcl_ret;
1702     kadm5_ret_t ret;
1703     int retcode = TCL_OK;
1704     char *princ_string;
1705     kadm5_principal_ent_t princ = 0;
1706     krb5_int32 mask;
1707     char *pw;
1708 #ifdef OVERRIDE
1709     int override_qual;
1710 #endif
1711
1712     GET_HANDLE(3, 0);
1713
1714     if ((tcl_ret = parse_str(interp, argv[0], &princ_string)) != TCL_OK) {
1715         Tcl_AppendElement(interp, "while parsing principal");
1716         return tcl_ret;
1717     }
1718
1719     if (princ_string &&
1720         ((tcl_ret = parse_principal_ent(interp, princ_string, &princ))
1721          != TCL_OK)) {
1722         return tcl_ret;
1723     }
1724
1725     if ((tcl_ret = parse_principal_mask(interp, argv[1], &mask)) != TCL_OK) {
1726         retcode = tcl_ret;
1727         goto finished;
1728     }
1729
1730     if ((tcl_ret = parse_str(interp, argv[2], &pw)) != TCL_OK) {
1731         retcode = tcl_ret;
1732         goto finished;
1733     }
1734 #ifdef OVERRIDE
1735     if ((tcl_ret = Tcl_GetBoolean(interp, argv[3], &override_qual)) !=
1736         TCL_OK) {
1737         retcode = tcl_ret;
1738         goto finished;
1739     }
1740 #endif
1741
1742 #ifdef OVERRIDE
1743     ret = kadm5_create_principal(server_handle, princ, mask, pw,
1744                                  override_qual);
1745 #else
1746     ret = kadm5_create_principal(server_handle, princ, mask, pw);
1747 #endif
1748
1749     if (ret != KADM5_OK) {
1750         stash_error(interp, ret);
1751         retcode = TCL_ERROR;
1752         goto finished;
1753     }
1754     else {
1755         set_ok(interp, "Principal created.");
1756     }
1757
1758 finished:
1759     if (princ) {
1760         free_principal_ent(&princ);
1761     }
1762     return retcode;
1763 }
1764
1765
1766
1767 static int tcl_kadm5_delete_principal(ClientData clientData,
1768                                       Tcl_Interp *interp,
1769                                       int argc, const char *argv[])
1770 {
1771     krb5_principal princ;
1772     krb5_error_code krb5_ret;
1773     kadm5_ret_t ret;
1774     int tcl_ret;
1775     char *name;
1776
1777     GET_HANDLE(1, 0);
1778
1779     if((tcl_ret = parse_str(interp, argv[0], &name)) != TCL_OK)
1780         return tcl_ret;
1781     if(name != NULL) {
1782         if ((krb5_ret = krb5_parse_name(context, name, &princ))) {
1783             stash_error(interp, krb5_ret);
1784             Tcl_AppendElement(interp, "while parsing principal");
1785             return TCL_ERROR;
1786         }
1787     } else princ = NULL;
1788     ret = kadm5_delete_principal(server_handle, princ);
1789
1790     if(princ != NULL)
1791         krb5_free_principal(context, princ);
1792
1793     if (ret != KADM5_OK) {
1794         stash_error(interp, ret);
1795         return TCL_ERROR;
1796     }
1797     else {
1798         set_ok(interp, "Principal deleted.");
1799         return TCL_OK;
1800     }
1801 }
1802
1803
1804
1805 static int tcl_kadm5_modify_principal(ClientData clientData,
1806                                       Tcl_Interp *interp,
1807                                       int argc, const char *argv[])
1808 {
1809     char *princ_string;
1810     kadm5_principal_ent_t princ = 0;
1811     int tcl_ret;
1812     krb5_int32 mask;
1813     int retcode = TCL_OK;
1814     kadm5_ret_t ret;
1815
1816     GET_HANDLE(2, 0);
1817
1818     if ((tcl_ret = parse_str(interp, argv[0], &princ_string)) != TCL_OK) {
1819         Tcl_AppendElement(interp, "while parsing principal");
1820         return tcl_ret;
1821     }
1822
1823     if (princ_string &&
1824         ((tcl_ret = parse_principal_ent(interp, princ_string, &princ))
1825          != TCL_OK)) {
1826         return tcl_ret;
1827     }
1828
1829     if ((tcl_ret = parse_principal_mask(interp, argv[1], &mask)) != TCL_OK) {
1830         retcode = TCL_ERROR;
1831         goto finished;
1832     }
1833
1834     ret = kadm5_modify_principal(server_handle, princ, mask);
1835
1836     if (ret != KADM5_OK) {
1837         stash_error(interp, ret);
1838         retcode = TCL_ERROR;
1839     }
1840     else {
1841         set_ok(interp, "Principal modified.");
1842     }
1843
1844 finished:
1845     if (princ) {
1846         free_principal_ent(&princ);
1847     }
1848     return retcode;
1849 }
1850
1851
1852 static int tcl_kadm5_rename_principal(ClientData clientData,
1853                                       Tcl_Interp *interp,
1854                                       int argc, const char *argv[])
1855 {
1856     krb5_principal source, target;
1857     krb5_error_code krb5_ret;
1858     kadm5_ret_t ret;
1859     int retcode = TCL_OK;
1860
1861     GET_HANDLE(2, 0);
1862
1863     if ((krb5_ret = krb5_parse_name(context, argv[0], &source)) != 0) {
1864         stash_error(interp, krb5_ret);
1865         Tcl_AppendElement(interp, "while parsing source");
1866         return TCL_ERROR;
1867     }
1868
1869     if ((krb5_ret = krb5_parse_name(context, argv[1], &target)) != 0) {
1870         stash_error(interp, krb5_ret);
1871         Tcl_AppendElement(interp, "while parsing target");
1872         krb5_free_principal(context, source);
1873         return TCL_ERROR;
1874     }
1875
1876     ret = kadm5_rename_principal(server_handle, source, target);
1877
1878     if (ret == KADM5_OK) {
1879         set_ok(interp, "Principal renamed.");
1880     }
1881     else {
1882         stash_error(interp, ret);
1883         retcode = TCL_ERROR;
1884     }
1885
1886     krb5_free_principal(context, source);
1887     krb5_free_principal(context, target);
1888     return retcode;
1889 }
1890
1891
1892
1893 static int tcl_kadm5_chpass_principal(ClientData clientData,
1894                                       Tcl_Interp *interp,
1895                                       int argc, const char *argv[])
1896 {
1897     krb5_principal princ;
1898     char *pw;
1899 #ifdef OVERRIDE
1900     int override_qual;
1901 #endif
1902     krb5_error_code krb5_ret;
1903     int retcode = TCL_OK;
1904     kadm5_ret_t ret;
1905
1906     GET_HANDLE(2, 0);
1907
1908     if ((krb5_ret = krb5_parse_name(context, argv[0], &princ)) != 0) {
1909         stash_error(interp, krb5_ret);
1910         Tcl_AppendElement(interp, "while parsing principal name");
1911         return TCL_ERROR;
1912     }
1913
1914     if (parse_str(interp, argv[1], &pw) != TCL_OK) {
1915         Tcl_AppendElement(interp, "while parsing password");
1916         retcode = TCL_ERROR;
1917         goto finished;
1918     }
1919
1920 #ifdef OVERRIDE
1921     if (Tcl_GetBoolean(interp, argv[2], &override_qual) != TCL_OK) {
1922         Tcl_AppendElement(interp, "while parsing override_qual");
1923         retcode = TCL_ERROR;
1924         goto finished;
1925     }
1926
1927     ret = kadm5_chpass_principal(server_handle,
1928                                  princ, pw, override_qual);
1929 #else
1930     ret = kadm5_chpass_principal(server_handle, princ, pw);
1931 #endif
1932
1933     if (ret == KADM5_OK) {
1934         set_ok(interp, "Password changed.");
1935         goto finished;
1936     }
1937     else {
1938         stash_error(interp, ret);
1939         retcode = TCL_ERROR;
1940     }
1941
1942 finished:
1943     krb5_free_principal(context, princ);
1944     return retcode;
1945 }
1946
1947
1948
1949 static int tcl_kadm5_chpass_principal_util(ClientData clientData,
1950                                            Tcl_Interp *interp,
1951                                            int argc, const char *argv[])
1952 {
1953     krb5_principal princ;
1954     char *new_pw;
1955 #ifdef OVERRIDE
1956     int override_qual;
1957 #endif
1958     char *pw_ret, *pw_ret_var;
1959     char msg_ret[1024], *msg_ret_var;
1960     krb5_error_code krb5_ret;
1961     kadm5_ret_t ret;
1962     int retcode = TCL_OK;
1963
1964     GET_HANDLE(4, 0);
1965
1966     if ((krb5_ret = krb5_parse_name(context, argv[0], &princ)) != 0) {
1967         stash_error(interp, krb5_ret);
1968         Tcl_AppendElement(interp, "while parsing principal name");
1969         return TCL_ERROR;
1970     }
1971
1972     if (parse_str(interp, argv[1], &new_pw) != TCL_OK) {
1973         Tcl_AppendElement(interp, "while parsing new password");
1974         retcode = TCL_ERROR;
1975         goto finished;
1976     }
1977 #ifdef OVERRIDE
1978     if (Tcl_GetBoolean(interp, argv[2], &override_qual) != TCL_OK) {
1979         Tcl_AppendElement(interp, "while parsing override_qual");
1980         retcode = TCL_ERROR;
1981         goto finished;
1982     }
1983 #endif
1984     if (parse_str(interp, argv[3], &pw_ret_var) != TCL_OK) {
1985         Tcl_AppendElement(interp, "while parsing pw_ret variable name");
1986         retcode = TCL_ERROR;
1987         goto finished;
1988     }
1989
1990     if (parse_str(interp, argv[4], &msg_ret_var) != TCL_OK) {
1991         Tcl_AppendElement(interp, "while parsing msg_ret variable name");
1992         retcode = TCL_ERROR;
1993         goto finished;
1994     }
1995
1996     ret = kadm5_chpass_principal_util(server_handle, princ, new_pw,
1997 #ifdef OVERRIDE
1998                                       override_qual,
1999 #endif
2000                                       pw_ret_var ? &pw_ret : 0,
2001                                       msg_ret_var ? msg_ret : 0,
2002                                       msg_ret_var ? sizeof(msg_ret) : 0);
2003
2004     if (ret == KADM5_OK) {
2005         if (pw_ret_var &&
2006             (! Tcl_SetVar(interp, pw_ret_var, pw_ret,
2007                           TCL_LEAVE_ERR_MSG))) {
2008             Tcl_AppendElement(interp, "while setting pw_ret variable");
2009             retcode = TCL_ERROR;
2010             goto finished;
2011         }
2012         if (msg_ret_var &&
2013             (! Tcl_SetVar(interp, msg_ret_var, msg_ret,
2014                           TCL_LEAVE_ERR_MSG))) {
2015             Tcl_AppendElement(interp,
2016                               "while setting msg_ret variable");
2017             retcode = TCL_ERROR;
2018             goto finished;
2019         }
2020         set_ok(interp, "Password changed.");
2021     }
2022     else {
2023         stash_error(interp, ret);
2024         retcode = TCL_ERROR;
2025     }
2026
2027 finished:
2028     krb5_free_principal(context, princ);
2029     return retcode;
2030 }
2031
2032
2033
2034 static int tcl_kadm5_randkey_principal(ClientData clientData,
2035                                        Tcl_Interp *interp,
2036                                        int argc, const char *argv[])
2037 {
2038     krb5_principal princ;
2039     krb5_keyblock *keyblocks;
2040     int num_keys;
2041     char *keyblock_var, *num_var, buf[50];
2042     Tcl_DString *keyblock_dstring = 0;
2043     krb5_error_code krb5_ret;
2044     kadm5_ret_t ret;
2045     int retcode = TCL_OK;
2046
2047     GET_HANDLE(3, 0);
2048
2049     if ((krb5_ret = krb5_parse_name(context, argv[0], &princ)) != 0) {
2050         stash_error(interp, krb5_ret);
2051         Tcl_AppendElement(interp, "while parsing principal name");
2052         return TCL_ERROR;
2053     }
2054
2055     if (parse_str(interp, argv[1], &keyblock_var) != TCL_OK) {
2056         Tcl_AppendElement(interp, "while parsing keyblock variable name");
2057         retcode = TCL_ERROR;
2058         goto finished;
2059     }
2060     if (parse_str(interp, argv[2], &num_var) != TCL_OK) {
2061         Tcl_AppendElement(interp, "while parsing keyblock variable name");
2062         retcode = TCL_ERROR;
2063         goto finished;
2064     }
2065
2066     ret = kadm5_randkey_principal(server_handle,
2067                                   princ, keyblock_var ? &keyblocks : 0,
2068                                   &num_keys);
2069
2070     if (ret == KADM5_OK) {
2071         if (keyblock_var) {
2072             keyblock_dstring = unparse_keyblocks(keyblocks, num_keys);
2073             if (! Tcl_SetVar(interp, keyblock_var,
2074                              keyblock_dstring->string,
2075                              TCL_LEAVE_ERR_MSG)) {
2076                 Tcl_AppendElement(interp,
2077                                   "while setting keyblock variable");
2078                 retcode = TCL_ERROR;
2079                 goto finished;
2080             }
2081         }
2082         if (num_var) {
2083             sprintf(buf, "%d", num_keys);
2084             if (! Tcl_SetVar(interp, num_var, buf,
2085                              TCL_LEAVE_ERR_MSG)) {
2086                 Tcl_AppendElement(interp,
2087                                   "while setting num_keys variable");
2088             }
2089         }
2090         set_ok(interp, "Key randomized.");
2091     }
2092     else {
2093         stash_error(interp, ret);
2094         retcode = TCL_ERROR;
2095     }
2096
2097 finished:
2098     krb5_free_principal(context, princ);
2099     if (keyblock_dstring) {
2100         Tcl_DStringFree(keyblock_dstring);
2101         free(keyblock_dstring);
2102     }
2103     return retcode;
2104 }
2105
2106
2107
2108 static int tcl_kadm5_get_principal(ClientData clientData, Tcl_Interp *interp,
2109                                    int argc, const char *argv[])
2110 {
2111     krb5_principal princ;
2112     kadm5_principal_ent_rec ent;
2113     Tcl_DString *ent_dstring = 0;
2114     char *ent_var;
2115     char *name;
2116     krb5_error_code krb5_ret;
2117     int tcl_ret;
2118     kadm5_ret_t ret = -1;
2119     krb5_int32 mask;
2120     int retcode = TCL_OK;
2121
2122     GET_HANDLE(3, 1);
2123
2124     if((tcl_ret = parse_str(interp, argv[0], &name)) != TCL_OK)
2125         return tcl_ret;
2126     if(name != NULL) {
2127         if ((krb5_ret = krb5_parse_name(context, name, &princ)) != 0) {
2128             stash_error(interp, krb5_ret);
2129             Tcl_AppendElement(interp, "while parsing principal name");
2130             return TCL_ERROR;
2131         }
2132     } else princ = NULL;
2133
2134     if ((tcl_ret = parse_str(interp, argv[1], &ent_var)) != TCL_OK) {
2135         Tcl_AppendElement(interp, "while parsing entry variable name");
2136         retcode = TCL_ERROR;
2137         goto finished;
2138     }
2139     if ((tcl_ret = parse_principal_mask(interp, argv[2], &mask)) != TCL_OK) {
2140         Tcl_AppendElement(interp, "while parsing principal mask");
2141         retcode = TCL_ERROR;
2142         goto finished;
2143     }
2144
2145     ret = kadm5_get_principal(server_handle, princ, ent_var ? &ent : 0,
2146                               mask);
2147
2148     if (ret == KADM5_OK) {
2149         if (ent_var) {
2150             ent_dstring = unparse_principal_ent(&ent, mask);
2151             if (! Tcl_SetVar(interp, ent_var, ent_dstring->string,
2152                              TCL_LEAVE_ERR_MSG)) {
2153                 Tcl_AppendElement(interp,
2154                                   "while setting entry variable");
2155                 retcode = TCL_ERROR;
2156                 goto finished;
2157             }
2158             set_ok(interp, "Principal retrieved.");
2159         }
2160     }
2161     else {
2162         stash_error(interp, ret);
2163         retcode = TCL_ERROR;
2164     }
2165
2166 finished:
2167     if (ent_dstring) {
2168         Tcl_DStringFree(ent_dstring);
2169         free(ent_dstring);
2170     }
2171     if(princ != NULL)
2172         krb5_free_principal(context, princ);
2173     if (ret == KADM5_OK && ent_var &&
2174         (ret = kadm5_free_principal_ent(server_handle, &ent)) &&
2175         (retcode == TCL_OK)) {
2176         stash_error(interp, ret);
2177         retcode = TCL_ERROR;
2178     }
2179     return retcode;
2180 }
2181
2182 static int tcl_kadm5_create_policy(ClientData clientData, Tcl_Interp *interp,
2183                                    int argc, const char *argv[])
2184 {
2185     int tcl_ret;
2186     kadm5_ret_t ret;
2187     int retcode = TCL_OK;
2188     char *policy_string;
2189     kadm5_policy_ent_t policy = 0;
2190     krb5_int32 mask;
2191
2192     GET_HANDLE(2, 0);
2193
2194     if ((tcl_ret = parse_str(interp, argv[0], &policy_string)) != TCL_OK) {
2195         Tcl_AppendElement(interp, "while parsing policy");
2196         return tcl_ret;
2197     }
2198
2199     if (policy_string &&
2200         ((tcl_ret = parse_policy_ent(interp, policy_string, &policy))
2201          != TCL_OK)) {
2202         return tcl_ret;
2203     }
2204
2205     if ((tcl_ret = parse_policy_mask(interp, argv[1], &mask)) != TCL_OK) {
2206         retcode = tcl_ret;
2207         goto finished;
2208     }
2209
2210     ret = kadm5_create_policy(server_handle, policy, mask);
2211
2212     if (ret != KADM5_OK) {
2213         stash_error(interp, ret);
2214         retcode = TCL_ERROR;
2215         goto finished;
2216     }
2217     else {
2218         set_ok(interp, "Policy created.");
2219     }
2220
2221 finished:
2222     if (policy) {
2223         free_policy_ent(&policy);
2224     }
2225     return retcode;
2226 }
2227
2228
2229
2230 static int tcl_kadm5_delete_policy(ClientData clientData, Tcl_Interp *interp,
2231                                    int argc, const char *argv[])
2232 {
2233     kadm5_ret_t ret;
2234     char *policy;
2235
2236     GET_HANDLE(1, 0);
2237
2238     if (parse_str(interp, argv[0], &policy) != TCL_OK) {
2239         Tcl_AppendElement(interp, "while parsing policy name");
2240         return TCL_ERROR;
2241     }
2242
2243     ret = kadm5_delete_policy(server_handle, policy);
2244
2245     if (ret != KADM5_OK) {
2246         stash_error(interp, ret);
2247         return TCL_ERROR;
2248     }
2249     else {
2250         set_ok(interp, "Policy deleted.");
2251         return TCL_OK;
2252     }
2253 }
2254
2255
2256
2257 static int tcl_kadm5_modify_policy(ClientData clientData, Tcl_Interp *interp,
2258                                    int argc, const char *argv[])
2259 {
2260     char *policy_string;
2261     kadm5_policy_ent_t policy = 0;
2262     int tcl_ret;
2263     krb5_int32 mask;
2264     int retcode = TCL_OK;
2265     kadm5_ret_t ret;
2266
2267     GET_HANDLE(2, 0);
2268
2269     if ((tcl_ret = parse_str(interp, argv[0], &policy_string)) != TCL_OK) {
2270         Tcl_AppendElement(interp, "while parsing policy");
2271         return tcl_ret;
2272     }
2273
2274     if (policy_string &&
2275         ((tcl_ret = parse_policy_ent(interp, policy_string, &policy))
2276          != TCL_OK)) {
2277         return tcl_ret;
2278     }
2279
2280     if ((tcl_ret = parse_policy_mask(interp, argv[1], &mask)) != TCL_OK) {
2281         retcode = TCL_ERROR;
2282         goto finished;
2283     }
2284
2285     ret = kadm5_modify_policy(server_handle, policy, mask);
2286
2287     if (ret != KADM5_OK) {
2288         stash_error(interp, ret);
2289         retcode = TCL_ERROR;
2290     }
2291     else {
2292         set_ok(interp, "Policy modified.");
2293     }
2294
2295 finished:
2296     if (policy) {
2297         free_policy_ent(&policy);
2298     }
2299     return retcode;
2300 }
2301
2302
2303 static int tcl_kadm5_get_policy(ClientData clientData, Tcl_Interp *interp,
2304                                 int argc, const char *argv[])
2305 {
2306     kadm5_policy_ent_rec ent;
2307     Tcl_DString *ent_dstring = 0;
2308     char *policy;
2309     char *ent_var;
2310     kadm5_ret_t ret;
2311     int retcode = TCL_OK;
2312
2313     GET_HANDLE(2, 1);
2314
2315     if (parse_str(interp, argv[0], &policy) != TCL_OK) {
2316         Tcl_AppendElement(interp, "while parsing policy name");
2317         return TCL_ERROR;
2318     }
2319
2320     if (parse_str(interp, argv[1], &ent_var) != TCL_OK) {
2321         Tcl_AppendElement(interp, "while parsing entry variable name");
2322         return TCL_ERROR;
2323     }
2324
2325     ret = kadm5_get_policy(server_handle, policy, ent_var ? &ent : 0);
2326
2327     if (ret == KADM5_OK) {
2328         if (ent_var) {
2329             ent_dstring = unparse_policy_ent(&ent);
2330             if (! Tcl_SetVar(interp, ent_var, ent_dstring->string,
2331                              TCL_LEAVE_ERR_MSG)) {
2332                 Tcl_AppendElement(interp,
2333                                   "while setting entry variable");
2334                 retcode = TCL_ERROR;
2335                 goto finished;
2336             }
2337             set_ok(interp, "Policy retrieved.");
2338         }
2339     }
2340     else {
2341         stash_error(interp, ret);
2342         retcode = TCL_ERROR;
2343     }
2344
2345 finished:
2346     if (ent_dstring) {
2347         Tcl_DStringFree(ent_dstring);
2348         free(ent_dstring);
2349     }
2350     if (ent_var && ret == KADM5_OK &&
2351         (ret = kadm5_free_policy_ent(server_handle, &ent)) &&
2352         (retcode == TCL_OK)) {
2353         stash_error(interp, ret);
2354         retcode = TCL_ERROR;
2355     }
2356     return retcode;
2357 }
2358
2359
2360
2361 static int tcl_kadm5_free_principal_ent(ClientData clientData,
2362                                         Tcl_Interp *interp,
2363                                         int argc, const char *argv[])
2364 {
2365     char *ent_name;
2366     kadm5_principal_ent_t ent;
2367     kadm5_ret_t ret;
2368
2369     GET_HANDLE(1, 0);
2370
2371     if (parse_str(interp, argv[0], &ent_name) != TCL_OK) {
2372         Tcl_AppendElement(interp, "while parsing entry name");
2373         return TCL_ERROR;
2374     }
2375
2376     if ((! ent_name) &&
2377         (ret = kadm5_free_principal_ent(server_handle, 0))) {
2378         stash_error(interp, ret);
2379         return TCL_ERROR;
2380     }
2381     else {
2382         Tcl_HashEntry *entry;
2383
2384         if (strncmp(ent_name, "principal", sizeof("principal")-1)) {
2385             Tcl_AppendResult(interp, "invalid principal handle \"",
2386                              ent_name, "\"", 0);
2387             return TCL_ERROR;
2388         }
2389         if (! struct_table) {
2390             if (! (struct_table = malloc(sizeof(*struct_table)))) {
2391                 fprintf(stderr, "Out of memory!\n");
2392                 exit(1); /* XXX */
2393             }
2394             Tcl_InitHashTable(struct_table, TCL_STRING_KEYS);
2395         }
2396
2397         if (! (entry = Tcl_FindHashEntry(struct_table, ent_name))) {
2398             Tcl_AppendResult(interp, "principal handle \"", ent_name,
2399                              "\" not found", 0);
2400             return TCL_ERROR;
2401         }
2402
2403         ent = (kadm5_principal_ent_t) Tcl_GetHashValue(entry);
2404
2405         ret = kadm5_free_principal_ent(server_handle, ent);
2406         if (ret != KADM5_OK) {
2407             stash_error(interp, ret);
2408             return TCL_ERROR;
2409         }
2410         Tcl_DeleteHashEntry(entry);
2411     }
2412     set_ok(interp, "Principal freed.");
2413     return TCL_OK;
2414 }
2415
2416
2417 static int tcl_kadm5_free_policy_ent(ClientData clientData,
2418                                      Tcl_Interp *interp,
2419                                      int argc, const char *argv[])
2420 {
2421     char *ent_name;
2422     kadm5_policy_ent_t ent;
2423     kadm5_ret_t ret;
2424
2425     GET_HANDLE(1, 0);
2426
2427     if (parse_str(interp, argv[0], &ent_name) != TCL_OK) {
2428         Tcl_AppendElement(interp, "while parsing entry name");
2429         return TCL_ERROR;
2430     }
2431
2432     if ((! ent_name) &&
2433         (ret = kadm5_free_policy_ent(server_handle, 0))) {
2434         stash_error(interp, ret);
2435         return TCL_ERROR;
2436     }
2437     else {
2438         Tcl_HashEntry *entry;
2439
2440         if (strncmp(ent_name, "policy", sizeof("policy")-1)) {
2441             Tcl_AppendResult(interp, "invalid principal handle \"",
2442                              ent_name, "\"", 0);
2443             return TCL_ERROR;
2444         }
2445         if (! struct_table) {
2446             if (! (struct_table = malloc(sizeof(*struct_table)))) {
2447                 fprintf(stderr, "Out of memory!\n");
2448                 exit(1); /* XXX */
2449             }
2450             Tcl_InitHashTable(struct_table, TCL_STRING_KEYS);
2451         }
2452
2453         if (! (entry = Tcl_FindHashEntry(struct_table, ent_name))) {
2454             Tcl_AppendResult(interp, "policy handle \"", ent_name,
2455                              "\" not found", 0);
2456             return TCL_ERROR;
2457         }
2458
2459         ent = (kadm5_policy_ent_t) Tcl_GetHashValue(entry);
2460
2461         if ((ret = kadm5_free_policy_ent(server_handle, ent)) != KADM5_OK) {
2462             stash_error(interp, ret);
2463             return TCL_ERROR;
2464         }
2465         Tcl_DeleteHashEntry(entry);
2466     }
2467     set_ok(interp, "Policy freed.");
2468     return TCL_OK;
2469 }
2470
2471
2472 static int tcl_kadm5_get_privs(ClientData clientData, Tcl_Interp *interp,
2473                                int argc, const char *argv[])
2474 {
2475     const char *set_ret;
2476     kadm5_ret_t ret;
2477     char *priv_var;
2478     long privs;
2479
2480     GET_HANDLE(1, 0);
2481
2482     if (parse_str(interp, argv[0], &priv_var) != TCL_OK) {
2483         Tcl_AppendElement(interp, "while parsing privs variable name");
2484         return TCL_ERROR;
2485     }
2486
2487     ret = kadm5_get_privs(server_handle, priv_var ? &privs : 0);
2488
2489     if (ret == KADM5_OK) {
2490         if (priv_var) {
2491             Tcl_DString *str = unparse_privs(privs);
2492             set_ret = Tcl_SetVar(interp, priv_var, str->string,
2493                                  TCL_LEAVE_ERR_MSG);
2494             Tcl_DStringFree(str);
2495             free(str);
2496             if (! set_ret) {
2497                 Tcl_AppendElement(interp, "while setting priv variable");
2498                 return TCL_ERROR;
2499             }
2500         }
2501         set_ok(interp, "Privileges retrieved.");
2502         return TCL_OK;
2503     }
2504     else {
2505         stash_error(interp, ret);
2506         return TCL_ERROR;
2507     }
2508 }
2509
2510
2511 void Tcl_kadm5_init(Tcl_Interp *interp)
2512 {
2513     char buf[20];
2514
2515     Tcl_SetVar(interp, "KADM5_ADMIN_SERVICE",
2516                KADM5_ADMIN_SERVICE, TCL_GLOBAL_ONLY);
2517     Tcl_SetVar(interp, "KADM5_CHANGEPW_SERVICE",
2518                KADM5_CHANGEPW_SERVICE, TCL_GLOBAL_ONLY);
2519     (void) sprintf(buf, "%d", KADM5_STRUCT_VERSION);
2520     Tcl_SetVar(interp, "KADM5_STRUCT_VERSION", buf, TCL_GLOBAL_ONLY);
2521     (void) sprintf(buf, "%d", KADM5_API_VERSION_2);
2522     Tcl_SetVar(interp, "KADM5_API_VERSION_2", buf, TCL_GLOBAL_ONLY);
2523     (void) sprintf(buf, "%d", KADM5_API_VERSION_3);
2524     Tcl_SetVar(interp, "KADM5_API_VERSION_3", buf, TCL_GLOBAL_ONLY);
2525     (void) sprintf(buf, "%d", KADM5_API_VERSION_4);
2526     Tcl_SetVar(interp, "KADM5_API_VERSION_4", buf, TCL_GLOBAL_ONLY);
2527     (void) sprintf(buf, "%d", KADM5_API_VERSION_MASK);
2528     Tcl_SetVar(interp, "KADM5_API_VERSION_MASK", buf, TCL_GLOBAL_ONLY);
2529     (void) sprintf(buf, "%d", KADM5_STRUCT_VERSION_MASK);
2530     Tcl_SetVar(interp, "KADM5_STRUCT_VERSION_MASK", buf,
2531                TCL_GLOBAL_ONLY);
2532
2533     Tcl_CreateCommand(interp, "kadm5_init", tcl_kadm5_init, 0, 0);
2534     Tcl_CreateCommand(interp, "kadm5_init_with_creds",
2535                       tcl_kadm5_init_with_creds, 0, 0);
2536     Tcl_CreateCommand(interp, "kadm5_destroy", tcl_kadm5_destroy, 0,
2537                       0);
2538     Tcl_CreateCommand(interp, "kadm5_create_principal",
2539                       tcl_kadm5_create_principal, 0, 0);
2540     Tcl_CreateCommand(interp, "kadm5_delete_principal",
2541                       tcl_kadm5_delete_principal, 0, 0);
2542     Tcl_CreateCommand(interp, "kadm5_modify_principal",
2543                       tcl_kadm5_modify_principal, 0, 0);
2544     Tcl_CreateCommand(interp, "kadm5_rename_principal",
2545                       tcl_kadm5_rename_principal, 0, 0);
2546     Tcl_CreateCommand(interp, "kadm5_chpass_principal",
2547                       tcl_kadm5_chpass_principal, 0, 0);
2548     Tcl_CreateCommand(interp, "kadm5_chpass_principal_util",
2549                       tcl_kadm5_chpass_principal_util, 0, 0);
2550     Tcl_CreateCommand(interp, "kadm5_randkey_principal",
2551                       tcl_kadm5_randkey_principal, 0, 0);
2552     Tcl_CreateCommand(interp, "kadm5_get_principal",
2553                       tcl_kadm5_get_principal, 0, 0);
2554     Tcl_CreateCommand(interp, "kadm5_create_policy",
2555                       tcl_kadm5_create_policy, 0, 0);
2556     Tcl_CreateCommand(interp, "kadm5_delete_policy",
2557                       tcl_kadm5_delete_policy, 0, 0);
2558     Tcl_CreateCommand(interp, "kadm5_modify_policy",
2559                       tcl_kadm5_modify_policy, 0, 0);
2560     Tcl_CreateCommand(interp, "kadm5_get_policy",
2561                       tcl_kadm5_get_policy, 0, 0);
2562     Tcl_CreateCommand(interp, "kadm5_free_principal_ent",
2563                       tcl_kadm5_free_principal_ent, 0, 0);
2564     Tcl_CreateCommand(interp, "kadm5_free_policy_ent",
2565                       tcl_kadm5_free_policy_ent, 0, 0);
2566     Tcl_CreateCommand(interp, "kadm5_get_privs",
2567                       tcl_kadm5_get_privs, 0, 0);
2568 }