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, "%d", princ->princ_expire_time);
 701     Tcl_DStringAppendElement(str, buf);
 702
 703     sprintf(buf, "%d", princ->last_pwd_change);
 704     Tcl_DStringAppendElement(str, buf);
 705
 706     sprintf(buf, "%d", 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, "%d", 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, "%d", princ->last_success);
 762     Tcl_DStringAppendElement(str, buf);
 763
 764     sprintf(buf, "%d", 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         sprintf(interp->result, "%d keysalts specified, "
 805                 "but num_keysalts is %d", argc, num_keysalts);
 806         retcode = TCL_ERROR;
 807         goto finished;
 808     }
 809     *keysalts = (krb5_key_salt_tuple *)
 810         malloc(sizeof(krb5_key_salt_tuple)*num_keysalts);
 811     for (i = 0; i < num_keysalts; i++) {
 812         if ((retcode = Tcl_SplitList(interp, argv[i], &argc1, &argv1)) !=
 813             TCL_OK) {
 814             goto finished;
 815         }
 816         if (argc1 != 2) {
 817             sprintf(interp->result, "wrong # fields in keysalt "
 818                     "(%d should be 2)", argc1);
 819             retcode = TCL_ERROR;
 820             goto finished;
 821         }
 822         /* XXX this used to be argv1[1] too! */
 823         if ((retcode = Tcl_GetInt(interp, argv1[0], &tmp))
 824             != TCL_OK) {
 825             Tcl_AppendElement(interp, "while parsing ks_enctype");
 826             retcode = TCL_ERROR;
 827             goto finished;
 828         }
 829         (*keysalts)[i].ks_enctype = tmp;
 830         if ((retcode = Tcl_GetInt(interp, argv1[1], &tmp))
 831             != TCL_OK) {
 832             Tcl_AppendElement(interp, "while parsing ks_salttype");
 833             goto finished;
 834         }
 835         (*keysalts)[i].ks_salttype = tmp;
 836
 837         Tcl_Free((char *) argv1);
 838         argv1 = NULL;
 839     }
 840
 841 finished:
 842     if (argv1) {
 843         Tcl_Free((char *) argv1);
 844     }
 845     Tcl_Free((char *) argv);
 846     return retcode;
 847 }
 848
 849 static int parse_key_data(Tcl_Interp *interp, const char *list,
 850                           krb5_key_data **key_data,
 851                           int n_key_data)
 852 {
 853     const char **argv = NULL;
 854     int argc, retcode;
 855
 856     *key_data = NULL;
 857     if (list == NULL) {
 858         if (n_key_data != 0) {
 859             sprintf(interp->result, "0 key_datas specified, "
 860                     "but n_key_data is %d", n_key_data);
 861             retcode = TCL_ERROR;
 862             goto finished;
 863         } else
 864             return TCL_OK;
 865     }
 866
 867     if ((retcode = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
 868         return retcode;
 869     }
 870     if (argc != n_key_data) {
 871         sprintf(interp->result, "%d key_datas specified, "
 872                 "but n_key_data is %d", argc, n_key_data);
 873         retcode = TCL_ERROR;
 874         goto finished;
 875     }
 876
 877     if (argc != 0) {
 878         sprintf(interp->result, "cannot parse key_data yet");
 879         retcode = TCL_ERROR;
 880         goto finished;
 881     }
 882
 883 finished:
 884     Tcl_Free((char *) argv);
 885     return retcode;
 886 }
 887
 888 static int parse_tl_data(Tcl_Interp *interp, const char *list,
 889                          krb5_tl_data **tlp,
 890                          int n_tl_data)
 891 {
 892     krb5_tl_data *tl, *tl2;
 893     const char **argv = NULL, **argv1 = NULL;
 894     int i, tmp, argc, argc1, retcode;
 895
 896     *tlp = NULL;
 897     if (list == NULL) {
 898         if (n_tl_data != 0) {
 899             sprintf(interp->result, "0 tl_datas specified, "
 900                     "but n_tl_data is %d", n_tl_data);
 901             retcode = TCL_ERROR;
 902             goto finished;
 903         } else
 904             return TCL_OK;
 905     }
 906
 907     if ((retcode = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
 908         return retcode;
 909     }
 910     if (argc != n_tl_data) {
 911         sprintf(interp->result, "%d tl_datas specified, "
 912                 "but n_tl_data is %d", argc, n_tl_data);
 913         retcode = TCL_ERROR;
 914         goto finished;
 915     }
 916
 917     tl = tl2 = NULL;
 918     for (i = 0; i < n_tl_data; i++) {
 919         tl2 = (krb5_tl_data *) malloc(sizeof(krb5_tl_data));
 920         memset(tl2, 0, sizeof(krb5_tl_data));
 921         tl2->tl_data_next = tl;
 922         tl = tl2;
 923     }
 924     tl2 = tl;
 925
 926     for (i = 0; i < n_tl_data; i++) {
 927         if ((retcode = Tcl_SplitList(interp, argv[i], &argc1, &argv1)) !=
 928             TCL_OK) {
 929             goto finished;
 930         }
 931         if (argc1 != 3) {
 932             sprintf(interp->result, "wrong # fields in tl_data "
 933                     "(%d should be 3)", argc1);
 934             retcode = TCL_ERROR;
 935             goto finished;
 936         }
 937         if ((retcode = Tcl_GetInt(interp, argv1[0], &tmp))
 938             != TCL_OK) {
 939             Tcl_AppendElement(interp, "while parsing tl_data_type");
 940             retcode = TCL_ERROR;
 941             goto finished;
 942         }
 943         tl->tl_data_type = tmp;
 944         if ((retcode = Tcl_GetInt(interp, argv1[1], &tmp))
 945             != TCL_OK) {
 946             Tcl_AppendElement(interp, "while parsing tl_data_length");
 947             retcode = TCL_ERROR;
 948             goto finished;
 949         }
 950         tl->tl_data_length = tmp;
 951         if (tl->tl_data_length != strlen(argv1[2])) {
 952             sprintf(interp->result, "specified length %d does not "
 953                     "match length %lu of string \"%s\"", tmp,
 954                     (unsigned long) strlen(argv1[2]), argv1[2]);
 955             retcode = TCL_ERROR;
 956             goto finished;
 957         }
 958         tl->tl_data_contents = (krb5_octet *) strdup(argv1[2]);
 959
 960         Tcl_Free((char *) argv1);
 961         argv1 = NULL;
 962         tl = tl->tl_data_next;
 963     }
 964     if (tl != NULL) {
 965         sprintf(interp->result, "tl is not NULL!");
 966         retcode = TCL_ERROR;
 967         goto finished;
 968     }
 969     *tlp = tl2;
 970
 971 finished:
 972     if (argv1) {
 973         Tcl_Free((char *) argv1);
 974     }
 975     Tcl_Free((char *) argv);
 976     return retcode;
 977 }
 978
 979 static int parse_config_params(Tcl_Interp *interp, char *list,
 980                                kadm5_config_params *params)
 981 {
 982     static Tcl_HashTable *table = 0;
 983     const char **argv = NULL;
 984     int tmp, argc, retcode;
 985
 986     memset(params, 0, sizeof(kadm5_config_params));
 987     if (list == NULL)
 988         return TCL_OK;
 989
 990     if ((retcode = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
 991         return retcode;
 992     }
 993
 994     if (argc != 20) {
 995         sprintf(interp->result,
 996                 "wrong # args in config params structure (%d should be 20)",
 997                 argc);
 998         retcode = TCL_ERROR;
 999         goto finished;
1000     }
1001
1002     if ((retcode = parse_flags(interp, table, config_mask_flags,
1003                                sizeof(config_mask_flags) /
1004                                sizeof(struct flagval),
1005                                argv[0], &tmp)) != TCL_OK) {
1006         goto finished;
1007     }
1008     params->mask = tmp;
1009
1010     if ((retcode = parse_str(interp, argv[1], &params->realm)) != TCL_OK) {
1011         Tcl_AppendElement(interp, "while parsing realm name");
1012         retcode = TCL_ERROR;
1013         goto finished;
1014     }
1015     if ((retcode = Tcl_GetInt(interp, argv[2], &tmp))
1016         != TCL_OK) {
1017         Tcl_AppendElement(interp, "while parsing kadmind_port");
1018         retcode = TCL_ERROR;
1019         goto finished;
1020     }
1021     params->kadmind_port = tmp;
1022     if ((retcode = parse_str(interp, argv[3], &params->admin_server))
1023         != TCL_OK) {
1024         Tcl_AppendElement(interp, "while parsing profile name");
1025         retcode = TCL_ERROR;
1026         goto finished;
1027     }
1028     if ((retcode = parse_str(interp, argv[4], &params->dbname)) != TCL_OK) {
1029         Tcl_AppendElement(interp, "while parsing profile name");
1030         retcode = TCL_ERROR;
1031         goto finished;
1032     }
1033     /* Ignore argv[5], which used to set the admin_dbname field.  */
1034     /* Ignore argv[6], which used to set the admin_lockfile field.  */
1035     /* Ignore argv[7], which used to set the admin_keytab field.  */
1036     if ((retcode = parse_str(interp, argv[8], &params->acl_file)) != TCL_OK) {
1037         Tcl_AppendElement(interp, "while parsing acl_file name");
1038         retcode = TCL_ERROR;
1039         goto finished;
1040     }
1041     if ((retcode = parse_str(interp, argv[9], &params->dict_file)) != TCL_OK) {
1042         Tcl_AppendElement(interp, "while parsing dict_file name");
1043         retcode = TCL_ERROR;
1044         goto finished;
1045     }
1046     if ((retcode = Tcl_GetInt(interp, argv[10], &tmp))
1047         != TCL_OK) {
1048         Tcl_AppendElement(interp, "while parsing mkey_from_kbd");
1049         retcode = TCL_ERROR;
1050         goto finished;
1051     }
1052     params->mkey_from_kbd = tmp;
1053     if ((retcode = parse_str(interp, argv[11], &params->stash_file)) != TCL_OK) {
1054         Tcl_AppendElement(interp, "while parsing stash_file name");
1055         retcode = TCL_ERROR;
1056         goto finished;
1057     }
1058     if ((retcode = parse_str(interp, argv[12], &params->mkey_name)) != TCL_OK) {
1059         Tcl_AppendElement(interp, "while parsing mkey_name name");
1060         retcode = TCL_ERROR;
1061         goto finished;
1062     }
1063     if ((retcode = Tcl_GetInt(interp, argv[13], &tmp))
1064         != TCL_OK) {
1065         Tcl_AppendElement(interp, "while parsing enctype");
1066         retcode = TCL_ERROR;
1067         goto finished;
1068     }
1069     params->enctype = tmp;
1070     if ((retcode = Tcl_GetInt(interp, argv[14], &tmp))
1071         != TCL_OK) {
1072         Tcl_AppendElement(interp, "while parsing max_life");
1073         retcode = TCL_ERROR;
1074         goto finished;
1075     }
1076     params->max_life = tmp;
1077     if ((retcode = Tcl_GetInt(interp, argv[15], &tmp))
1078         != TCL_OK) {
1079         Tcl_AppendElement(interp, "while parsing max_rlife");
1080         retcode = TCL_ERROR;
1081         goto finished;
1082     }
1083     params->max_rlife = tmp;
1084     if ((retcode = Tcl_GetInt(interp, argv[16], &tmp))
1085         != TCL_OK) {
1086         Tcl_AppendElement(interp, "while parsing expiration");
1087         retcode = TCL_ERROR;
1088         goto finished;
1089     }
1090     params->expiration = tmp;
1091     if ((retcode = parse_krb5_flags(interp, argv[17], &tmp))
1092         != TCL_OK) {
1093         Tcl_AppendElement(interp, "while parsing flags");
1094         retcode = TCL_ERROR;
1095         goto finished;
1096     }
1097     params->flags = tmp;
1098     if ((retcode = Tcl_GetInt(interp, argv[18], &tmp))
1099         != TCL_OK) {
1100         Tcl_AppendElement(interp, "while parsing num_keysalts");
1101         retcode = TCL_ERROR;
1102         goto finished;
1103     }
1104     params->num_keysalts = tmp;
1105     if ((retcode = parse_keysalts(interp, argv[19], &params->keysalts,
1106                                   params->num_keysalts)) != TCL_OK) {
1107         Tcl_AppendElement(interp, "while parsing keysalts");
1108         retcode = TCL_ERROR;
1109         goto finished;
1110     }
1111
1112 finished:
1113     return retcode;
1114 }
1115
1116 static int parse_principal_ent(Tcl_Interp *interp, char *list,
1117                                kadm5_principal_ent_t *out_princ)
1118 {
1119     kadm5_principal_ent_t princ = 0;
1120     krb5_error_code krb5_ret;
1121     int tcl_ret;
1122     int argc;
1123     const char **argv;
1124     int tmp;
1125     int retcode = TCL_OK;
1126
1127     if ((tcl_ret = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
1128         return tcl_ret;
1129     }
1130
1131     if (argc != 12 && argc != 20) {
1132         sprintf(interp->result,
1133                 "wrong # args in principal structure (%d should be 12 or 20)",
1134                 argc);
1135         retcode = TCL_ERROR;
1136         goto finished;
1137     }
1138
1139     if (! (princ = malloc(sizeof *princ))) {
1140         fprintf(stderr, "Out of memory!\n");
1141         exit(1); /* XXX */
1142     }
1143     memset(princ, 0, sizeof(*princ));
1144
1145     if ((krb5_ret = krb5_parse_name(context, argv[0], &princ->principal)) != 0) {
1146         stash_error(interp, krb5_ret);
1147         Tcl_AppendElement(interp, "while parsing principal");
1148         retcode = TCL_ERROR;
1149         goto finished;
1150     }
1151
1152     /*
1153      * All of the numerical values parsed here are parsed into an
1154      * "int" and then assigned into the structure in case the actual
1155      * width of the field in the Kerberos structure is different from
1156      * the width of an integer.
1157      */
1158
1159     if ((tcl_ret = Tcl_GetInt(interp, argv[1], &tmp))
1160         != TCL_OK) {
1161         Tcl_AppendElement(interp, "while parsing princ_expire_time");
1162         retcode = TCL_ERROR;
1163         goto finished;
1164     }
1165     princ->princ_expire_time = tmp;
1166
1167     if ((tcl_ret = Tcl_GetInt(interp, argv[2], &tmp))
1168         != TCL_OK) {
1169         Tcl_AppendElement(interp, "while parsing last_pwd_change");
1170         retcode = TCL_ERROR;
1171         goto finished;
1172     }
1173     princ->last_pwd_change = tmp;
1174
1175     if ((tcl_ret = Tcl_GetInt(interp, argv[3], &tmp))
1176         != TCL_OK) {
1177         Tcl_AppendElement(interp, "while parsing pw_expiration");
1178         retcode = TCL_ERROR;
1179         goto finished;
1180     }
1181     princ->pw_expiration = tmp;
1182
1183     if ((tcl_ret = Tcl_GetInt(interp, argv[4], &tmp))
1184         != TCL_OK) {
1185         Tcl_AppendElement(interp, "while parsing max_life");
1186         retcode = TCL_ERROR;
1187         goto finished;
1188     }
1189     princ->max_life = tmp;
1190
1191     if ((krb5_ret = krb5_parse_name(context, argv[5], &princ->mod_name)) != 0) {
1192         stash_error(interp, krb5_ret);
1193         Tcl_AppendElement(interp, "while parsing mod_name");
1194         retcode = TCL_ERROR;
1195         goto finished;
1196     }
1197
1198     if ((tcl_ret = Tcl_GetInt(interp, argv[6], &tmp))
1199         != TCL_OK) {
1200         Tcl_AppendElement(interp, "while parsing mod_date");
1201         retcode = TCL_ERROR;
1202         goto finished;
1203     }
1204     princ->mod_date = tmp;
1205
1206     if ((tcl_ret = parse_krb5_flags(interp, argv[7], &princ->attributes))
1207         != TCL_OK) {
1208         Tcl_AppendElement(interp, "while parsing attributes");
1209         retcode = TCL_ERROR;
1210         goto finished;
1211     }
1212
1213     if ((tcl_ret = Tcl_GetInt(interp, argv[8], &tmp))
1214         != TCL_OK) {
1215         Tcl_AppendElement(interp, "while parsing kvno");
1216         retcode = TCL_ERROR;
1217         goto finished;
1218     }
1219     princ->kvno = tmp;
1220
1221     if ((tcl_ret = Tcl_GetInt(interp, argv[9], &tmp))
1222         != TCL_OK) {
1223         Tcl_AppendElement(interp, "while parsing mkvno");
1224         retcode = TCL_ERROR;
1225         goto finished;
1226     }
1227     princ->mkvno = tmp;
1228
1229     if ((tcl_ret = parse_str(interp, argv[10], &princ->policy)) != TCL_OK) {
1230         Tcl_AppendElement(interp, "while parsing policy");
1231         retcode = TCL_ERROR;
1232         goto finished;
1233     }
1234     if(princ->policy != NULL) {
1235         if(!(princ->policy = strdup(princ->policy))) {
1236             fprintf(stderr, "Out of memory!\n");
1237             exit(1);
1238         }
1239     }
1240
1241     if ((tcl_ret = parse_aux_attributes(interp, argv[11],
1242                                         &princ->aux_attributes)) != TCL_OK) {
1243         Tcl_AppendElement(interp, "while parsing aux_attributes");
1244         retcode = TCL_ERROR;
1245         goto finished;
1246     }
1247
1248     if (argc == 12) goto finished;
1249
1250     if ((tcl_ret = Tcl_GetInt(interp, argv[12], &tmp))
1251         != TCL_OK) {
1252         Tcl_AppendElement(interp, "while parsing max_renewable_life");
1253         retcode = TCL_ERROR;
1254         goto finished;
1255     }
1256     princ->max_renewable_life = tmp;
1257
1258     if ((tcl_ret = Tcl_GetInt(interp, argv[13], &tmp))
1259         != TCL_OK) {
1260         Tcl_AppendElement(interp, "while parsing last_success");
1261         retcode = TCL_ERROR;
1262         goto finished;
1263     }
1264     princ->last_success = tmp;
1265
1266     if ((tcl_ret = Tcl_GetInt(interp, argv[14], &tmp))
1267         != TCL_OK) {
1268         Tcl_AppendElement(interp, "while parsing last_failed");
1269         retcode = TCL_ERROR;
1270         goto finished;
1271     }
1272     princ->last_failed = tmp;
1273
1274     if ((tcl_ret = Tcl_GetInt(interp, argv[15], &tmp))
1275         != TCL_OK) {
1276         Tcl_AppendElement(interp, "while parsing fail_auth_count");
1277         retcode = TCL_ERROR;
1278         goto finished;
1279     }
1280     princ->fail_auth_count = tmp;
1281
1282     if ((tcl_ret = Tcl_GetInt(interp, argv[16], &tmp))
1283         != TCL_OK) {
1284         Tcl_AppendElement(interp, "while parsing n_key_data");
1285         retcode = TCL_ERROR;
1286         goto finished;
1287     }
1288     princ->n_key_data = tmp;
1289
1290     if ((tcl_ret = Tcl_GetInt(interp, argv[17], &tmp))
1291         != TCL_OK) {
1292         Tcl_AppendElement(interp, "while parsing n_tl_data");
1293         retcode = TCL_ERROR;
1294         goto finished;
1295     }
1296     princ->n_tl_data = tmp;
1297
1298     if ((tcl_ret = parse_key_data(interp, argv[18],
1299                                   &princ->key_data,
1300                                   princ->n_key_data)) != TCL_OK) {
1301         Tcl_AppendElement(interp, "while parsing key_data");
1302         retcode = TCL_ERROR;
1303         goto finished;
1304     }
1305
1306     if ((tcl_ret = parse_tl_data(interp, argv[19],
1307                                  &princ->tl_data,
1308                                  princ->n_tl_data)) != TCL_OK) {
1309         Tcl_AppendElement(interp, "while parsing tl_data");
1310         retcode = TCL_ERROR;
1311         goto finished;
1312     }
1313     princ->n_tl_data = tmp;
1314
1315 finished:
1316     Tcl_Free((char *) argv);
1317     *out_princ = princ;
1318     return retcode;
1319 }
1320
1321
1322 static void free_principal_ent(kadm5_principal_ent_t *princ)
1323 {
1324     krb5_free_principal(context, (*princ)->principal);
1325     krb5_free_principal(context, (*princ)->mod_name);
1326     free(*princ);
1327     *princ = 0;
1328 }
1329
1330 static Tcl_DString *unparse_policy_ent(kadm5_policy_ent_t policy)
1331 {
1332     Tcl_DString *str, *tmp_dstring;
1333     char buf[20];
1334
1335     if (! (str = malloc(sizeof(*str)))) {
1336         fprintf(stderr, "Out of memory!\n");
1337         exit(1); /* XXX */
1338     }
1339
1340     Tcl_DStringInit(str);
1341
1342     tmp_dstring = unparse_str(policy->policy);
1343     Tcl_DStringAppendElement(str, tmp_dstring->string);
1344     Tcl_DStringFree(tmp_dstring);
1345     free(tmp_dstring);
1346
1347     sprintf(buf, "%ld", policy->pw_min_life);
1348     Tcl_DStringAppendElement(str, buf);
1349
1350     sprintf(buf, "%ld", policy->pw_max_life);
1351     Tcl_DStringAppendElement(str, buf);
1352
1353     sprintf(buf, "%ld", policy->pw_min_length);
1354     Tcl_DStringAppendElement(str, buf);
1355
1356     sprintf(buf, "%ld", policy->pw_min_classes);
1357     Tcl_DStringAppendElement(str, buf);
1358
1359     sprintf(buf, "%ld", policy->pw_history_num);
1360     Tcl_DStringAppendElement(str, buf);
1361
1362     sprintf(buf, "%ld", policy->policy_refcnt);
1363     Tcl_DStringAppendElement(str, buf);
1364
1365     sprintf(buf, "%d", policy->pw_max_fail);
1366     Tcl_DStringAppendElement(str, buf);
1367
1368     sprintf(buf, "%d", policy->pw_failcnt_interval);
1369     Tcl_DStringAppendElement(str, buf);
1370
1371     sprintf(buf, "%d", policy->pw_lockout_duration);
1372     Tcl_DStringAppendElement(str, buf);
1373
1374     return str;
1375 }
1376
1377
1378
1379 static int parse_policy_ent(Tcl_Interp *interp, char *list,
1380                             kadm5_policy_ent_t *out_policy)
1381 {
1382     kadm5_policy_ent_t policy = 0;
1383     int tcl_ret;
1384     int argc;
1385     const char **argv;
1386     int tmp;
1387     int retcode = TCL_OK;
1388
1389     if ((tcl_ret = Tcl_SplitList(interp, list, &argc, &argv)) != TCL_OK) {
1390         return tcl_ret;
1391     }
1392
1393     if (argc != 7 && argc != 10) {
1394         sprintf(interp->result, "wrong # args in policy structure (%d should be 7 or 10)",
1395                 argc);
1396         retcode = TCL_ERROR;
1397         goto finished;
1398     }
1399
1400     if (! (policy = malloc(sizeof *policy))) {
1401         fprintf(stderr, "Out of memory!\n");
1402         exit(1); /* XXX */
1403     }
1404
1405     if ((tcl_ret = parse_str(interp, argv[0], &policy->policy)) != TCL_OK) {
1406         Tcl_AppendElement(interp, "while parsing policy name");
1407         retcode = TCL_ERROR;
1408         goto finished;
1409     }
1410
1411     if(policy->policy != NULL) {
1412         if (! (policy->policy = strdup(policy->policy))) {
1413             fprintf(stderr, "Out of memory!\n");
1414             exit(1); /* XXX */
1415         }
1416     }
1417
1418     /*
1419      * All of the numerical values parsed here are parsed into an
1420      * "int" and then assigned into the structure in case the actual
1421      * width of the field in the Kerberos structure is different from
1422      * the width of an integer.
1423      */
1424
1425     if ((tcl_ret = Tcl_GetInt(interp, argv[1], &tmp))
1426         != TCL_OK) {
1427         Tcl_AppendElement(interp, "while parsing pw_min_life");
1428         retcode = TCL_ERROR;
1429         goto finished;
1430     }
1431     policy->pw_min_life = tmp;
1432
1433     if ((tcl_ret = Tcl_GetInt(interp, argv[2], &tmp))
1434         != TCL_OK) {
1435         Tcl_AppendElement(interp, "while parsing pw_max_life");
1436         retcode = TCL_ERROR;
1437         goto finished;
1438     }
1439     policy->pw_max_life = tmp;
1440
1441     if ((tcl_ret = Tcl_GetInt(interp, argv[3], &tmp))
1442         != TCL_OK) {
1443         Tcl_AppendElement(interp, "while parsing pw_min_length");
1444         retcode = TCL_ERROR;
1445         goto finished;
1446     }
1447     policy->pw_min_length = tmp;
1448
1449     if ((tcl_ret = Tcl_GetInt(interp, argv[4], &tmp))
1450         != TCL_OK) {
1451         Tcl_AppendElement(interp, "while parsing pw_min_classes");
1452         retcode = TCL_ERROR;
1453         goto finished;
1454     }
1455     policy->pw_min_classes = tmp;
1456
1457     if ((tcl_ret = Tcl_GetInt(interp, argv[5], &tmp))
1458         != TCL_OK) {
1459         Tcl_AppendElement(interp, "while parsing pw_history_num");
1460         retcode = TCL_ERROR;
1461         goto finished;
1462     }
1463     policy->pw_history_num = tmp;
1464
1465     if ((tcl_ret = Tcl_GetInt(interp, argv[6], &tmp))
1466         != TCL_OK) {
1467         Tcl_AppendElement(interp, "while parsing policy_refcnt");
1468         retcode = TCL_ERROR;
1469         goto finished;
1470     }
1471     policy->policy_refcnt = tmp;
1472
1473     if (argc == 7) goto finished;
1474
1475     if ((tcl_ret = Tcl_GetInt(interp, argv[7], &tmp))
1476         != TCL_OK) {
1477         Tcl_AppendElement(interp, "while parsing pw_max_fail");
1478         retcode = TCL_ERROR;
1479         goto finished;
1480     }
1481     policy->pw_max_fail = tmp;
1482
1483     if ((tcl_ret = Tcl_GetInt(interp, argv[8], &tmp))
1484         != TCL_OK) {
1485         Tcl_AppendElement(interp, "while parsing pw_failcnt_interval");
1486         retcode = TCL_ERROR;
1487         goto finished;
1488     }
1489     policy->pw_failcnt_interval = tmp;
1490
1491     if ((tcl_ret = Tcl_GetInt(interp, argv[9], &tmp))
1492         != TCL_OK) {
1493         Tcl_AppendElement(interp, "while parsing pw_lockout_duration");
1494         retcode = TCL_ERROR;
1495         goto finished;
1496     }
1497     policy->pw_lockout_duration = tmp;
1498
1499 finished:
1500     Tcl_Free((char *) argv);
1501     *out_policy = policy;
1502     return retcode;
1503 }
1504
1505
1506 static void free_policy_ent(kadm5_policy_ent_t *policy)
1507 {
1508     free(*policy);
1509     *policy = 0;
1510 }
1511
1512 static Tcl_DString *unparse_keytype(krb5_enctype enctype)
1513 {
1514     Tcl_DString *str;
1515     char buf[50];
1516
1517     if (! (str = malloc(sizeof(*str)))) {
1518         fprintf(stderr, "Out of memory!\n");
1519         exit(1); /* XXX */
1520     }
1521
1522     Tcl_DStringInit(str);
1523
1524     switch (enctype) {
1525         /* XXX is this right? */
1526     case ENCTYPE_NULL: Tcl_DStringAppend(str, "ENCTYPE_NULL", -1); break;
1527     case ENCTYPE_DES_CBC_CRC:
1528         Tcl_DStringAppend(str, "ENCTYPE_DES_CBC_CRC", -1); break;
1529     default:
1530         sprintf(buf, "UNKNOWN KEYTYPE (0x%x)", enctype);
1531         Tcl_DStringAppend(str, buf, -1);
1532         break;
1533     }
1534
1535     return str;
1536 }
1537
1538
1539 static Tcl_DString *unparse_keyblocks(krb5_keyblock *keyblocks, int num_keys)
1540 {
1541     Tcl_DString *str;
1542     Tcl_DString *keytype;
1543     unsigned int i;
1544     int j;
1545
1546     if (! (str = malloc(sizeof(*str)))) {
1547         fprintf(stderr, "Out of memory!\n");
1548         exit(1); /* XXX */
1549     }
1550
1551     Tcl_DStringInit(str);
1552
1553     for (j = 0; j < num_keys; j++) {
1554         krb5_keyblock *keyblock = &keyblocks[j];
1555
1556         Tcl_DStringStartSublist(str);
1557
1558         keytype = unparse_keytype(keyblock->enctype);
1559         Tcl_DStringAppendElement(str, keytype->string);
1560         Tcl_DStringFree(keytype);
1561         free(keytype);
1562         if (keyblock->length == 0) {
1563             Tcl_DStringAppendElement(str, "0x00");
1564         }
1565         else {
1566             Tcl_DStringAppendElement(str, "0x");
1567             for (i = 0; i < keyblock->length; i++) {
1568                 char buf[3];
1569                 sprintf(buf, "%02x", (int) keyblock->contents[i]);
1570                 Tcl_DStringAppend(str, buf, -1);
1571             }
1572         }
1573
1574         Tcl_DStringEndSublist(str);
1575     }
1576
1577
1578     return str;
1579 }
1580
1581 enum init_type { INIT_NONE, INIT_PASS, INIT_CREDS };
1582
1583 static int _tcl_kadm5_init_any(enum init_type init_type, ClientData clientData,
1584                                Tcl_Interp *interp, int argc, const char *argv[])
1585 {
1586     kadm5_ret_t ret;
1587     char *client_name, *pass, *service_name;
1588     int tcl_ret;
1589     krb5_ui_4 struct_version, api_version;
1590     const char *handle_var;
1591     void *server_handle;
1592     char *handle_name, *params_str;
1593     const char *whoami = argv[0];
1594     kadm5_config_params params;
1595
1596     argv++, argc--;
1597
1598     kadm5_init_krb5_context(&context);
1599
1600     if (argc != 7) {
1601         Tcl_AppendResult(interp, whoami, ": ", arg_error, 0);
1602         return TCL_ERROR;
1603     }
1604
1605     if (((tcl_ret = parse_str(interp, argv[0], &client_name)) != TCL_OK) ||
1606         ((tcl_ret = parse_str(interp, argv[1], &pass)) != TCL_OK) ||
1607         ((tcl_ret = parse_str(interp, argv[2], &service_name)) != TCL_OK) ||
1608         ((tcl_ret = parse_str(interp, argv[3], &params_str)) != TCL_OK) ||
1609         ((tcl_ret = parse_config_params(interp, params_str, &params))
1610          != TCL_OK) ||
1611         ((tcl_ret = Tcl_GetInt(interp, argv[4], (int *) &struct_version)) !=
1612          TCL_OK) ||
1613         ((tcl_ret = Tcl_GetInt(interp, argv[5], (int *) &api_version)) !=
1614          TCL_OK)) {
1615         return tcl_ret;
1616     }
1617
1618     handle_var = argv[6];
1619
1620     if (! (handle_var && *handle_var)) {
1621         Tcl_SetResult(interp, "must specify server handle variable name",
1622                       TCL_STATIC);
1623         return TCL_ERROR;
1624     }
1625
1626     if (init_type == INIT_CREDS) {
1627         krb5_ccache cc;
1628
1629         if (pass == NULL) {
1630             if ((ret = krb5_cc_default(context, &cc))) {
1631                 stash_error(interp, ret);
1632                 return TCL_ERROR;
1633             }
1634         } else {
1635             if ((ret = krb5_cc_resolve(context, pass, &cc))) {
1636                 stash_error(interp, ret);
1637                 return TCL_ERROR;
1638             }
1639         }
1640
1641         ret = kadm5_init_with_creds(context, client_name, cc, service_name,
1642                                     &params, struct_version,
1643                                     api_version, NULL, &server_handle);
1644
1645         (void) krb5_cc_close(context, cc);
1646     } else
1647         ret = kadm5_init(context, client_name, pass, service_name, &params,
1648                          struct_version, api_version, NULL, &server_handle);
1649
1650     if (ret != KADM5_OK) {
1651         stash_error(interp, ret);
1652         return TCL_ERROR;
1653     }
1654
1655     if ((tcl_ret = put_server_handle(interp, server_handle, &handle_name))
1656         != TCL_OK) {
1657         return tcl_ret;
1658     }
1659
1660     if (! Tcl_SetVar(interp, handle_var, handle_name, TCL_LEAVE_ERR_MSG)) {
1661         return TCL_ERROR;
1662     }
1663
1664     set_ok(interp, "KADM5 API initialized.");
1665     return TCL_OK;
1666 }
1667
1668 static int tcl_kadm5_init(ClientData clientData, Tcl_Interp *interp,
1669                           int argc, const char *argv[])
1670 {
1671     return _tcl_kadm5_init_any(INIT_PASS, clientData, interp, argc, argv);
1672 }
1673
1674 static int tcl_kadm5_init_with_creds(ClientData clientData, Tcl_Interp *interp,
1675                                      int argc, const char *argv[])
1676 {
1677     return _tcl_kadm5_init_any(INIT_CREDS, clientData, interp, argc, argv);
1678 }
1679
1680 static int tcl_kadm5_destroy(ClientData clientData, Tcl_Interp *interp,
1681                              int argc, const char *argv[])
1682 {
1683     kadm5_ret_t ret;
1684     int tcl_ret;
1685
1686     GET_HANDLE(0, 0);
1687
1688     ret = kadm5_destroy(server_handle);
1689
1690     if (ret != KADM5_OK) {
1691         stash_error(interp, ret);
1692         return TCL_ERROR;
1693     }
1694
1695     if ((tcl_ret = remove_server_handle(interp, argv[-1])) != TCL_OK) {
1696         return tcl_ret;
1697     }
1698
1699     set_ok(interp, "KADM5 API deinitialized.");
1700     return TCL_OK;
1701 }
1702
1703 static int tcl_kadm5_create_principal(ClientData clientData,
1704                                       Tcl_Interp *interp,
1705                                       int argc, const char *argv[])
1706 {
1707     int tcl_ret;
1708     kadm5_ret_t ret;
1709     int retcode = TCL_OK;
1710     char *princ_string;
1711     kadm5_principal_ent_t princ = 0;
1712     krb5_int32 mask;
1713     char *pw;
1714 #ifdef OVERRIDE
1715     int override_qual;
1716 #endif
1717
1718     GET_HANDLE(3, 0);
1719
1720     if ((tcl_ret = parse_str(interp, argv[0], &princ_string)) != TCL_OK) {
1721         Tcl_AppendElement(interp, "while parsing principal");
1722         return tcl_ret;
1723     }
1724
1725     if (princ_string &&
1726         ((tcl_ret = parse_principal_ent(interp, princ_string, &princ))
1727          != TCL_OK)) {
1728         return tcl_ret;
1729     }
1730
1731     if ((tcl_ret = parse_principal_mask(interp, argv[1], &mask)) != TCL_OK) {
1732         retcode = tcl_ret;
1733         goto finished;
1734     }
1735
1736     if ((tcl_ret = parse_str(interp, argv[2], &pw)) != TCL_OK) {
1737         retcode = tcl_ret;
1738         goto finished;
1739     }
1740 #ifdef OVERRIDE
1741     if ((tcl_ret = Tcl_GetBoolean(interp, argv[3], &override_qual)) !=
1742         TCL_OK) {
1743         retcode = tcl_ret;
1744         goto finished;
1745     }
1746 #endif
1747
1748 #ifdef OVERRIDE
1749     ret = kadm5_create_principal(server_handle, princ, mask, pw,
1750                                  override_qual);
1751 #else
1752     ret = kadm5_create_principal(server_handle, princ, mask, pw);
1753 #endif
1754
1755     if (ret != KADM5_OK) {
1756         stash_error(interp, ret);
1757         retcode = TCL_ERROR;
1758         goto finished;
1759     }
1760     else {
1761         set_ok(interp, "Principal created.");
1762     }
1763
1764 finished:
1765     if (princ) {
1766         free_principal_ent(&princ);
1767     }
1768     return retcode;
1769 }
1770
1771
1772
1773 static int tcl_kadm5_delete_principal(ClientData clientData,
1774                                       Tcl_Interp *interp,
1775                                       int argc, const char *argv[])
1776 {
1777     krb5_principal princ;
1778     krb5_error_code krb5_ret;
1779     kadm5_ret_t ret;
1780     int tcl_ret;
1781     char *name;
1782
1783     GET_HANDLE(1, 0);
1784
1785     if((tcl_ret = parse_str(interp, argv[0], &name)) != TCL_OK)
1786         return tcl_ret;
1787     if(name != NULL) {
1788         if ((krb5_ret = krb5_parse_name(context, name, &princ))) {
1789             stash_error(interp, krb5_ret);
1790             Tcl_AppendElement(interp, "while parsing principal");
1791             return TCL_ERROR;
1792         }
1793     } else princ = NULL;
1794     ret = kadm5_delete_principal(server_handle, princ);
1795
1796     if(princ != NULL)
1797         krb5_free_principal(context, princ);
1798
1799     if (ret != KADM5_OK) {
1800         stash_error(interp, ret);
1801         return TCL_ERROR;
1802     }
1803     else {
1804         set_ok(interp, "Principal deleted.");
1805         return TCL_OK;
1806     }
1807 }
1808
1809
1810
1811 static int tcl_kadm5_modify_principal(ClientData clientData,
1812                                       Tcl_Interp *interp,
1813                                       int argc, const char *argv[])
1814 {
1815     char *princ_string;
1816     kadm5_principal_ent_t princ = 0;
1817     int tcl_ret;
1818     krb5_int32 mask;
1819     int retcode = TCL_OK;
1820     kadm5_ret_t ret;
1821
1822     GET_HANDLE(2, 0);
1823
1824     if ((tcl_ret = parse_str(interp, argv[0], &princ_string)) != TCL_OK) {
1825         Tcl_AppendElement(interp, "while parsing principal");
1826         return tcl_ret;
1827     }
1828
1829     if (princ_string &&
1830         ((tcl_ret = parse_principal_ent(interp, princ_string, &princ))
1831          != TCL_OK)) {
1832         return tcl_ret;
1833     }
1834
1835     if ((tcl_ret = parse_principal_mask(interp, argv[1], &mask)) != TCL_OK) {
1836         retcode = TCL_ERROR;
1837         goto finished;
1838     }
1839
1840     ret = kadm5_modify_principal(server_handle, princ, mask);
1841
1842     if (ret != KADM5_OK) {
1843         stash_error(interp, ret);
1844         retcode = TCL_ERROR;
1845     }
1846     else {
1847         set_ok(interp, "Principal modified.");
1848     }
1849
1850 finished:
1851     if (princ) {
1852         free_principal_ent(&princ);
1853     }
1854     return retcode;
1855 }
1856
1857
1858 static int tcl_kadm5_rename_principal(ClientData clientData,
1859                                       Tcl_Interp *interp,
1860                                       int argc, const char *argv[])
1861 {
1862     krb5_principal source, target;
1863     krb5_error_code krb5_ret;
1864     kadm5_ret_t ret;
1865     int retcode = TCL_OK;
1866
1867     GET_HANDLE(2, 0);
1868
1869     if ((krb5_ret = krb5_parse_name(context, argv[0], &source)) != 0) {
1870         stash_error(interp, krb5_ret);
1871         Tcl_AppendElement(interp, "while parsing source");
1872         return TCL_ERROR;
1873     }
1874
1875     if ((krb5_ret = krb5_parse_name(context, argv[1], &target)) != 0) {
1876         stash_error(interp, krb5_ret);
1877         Tcl_AppendElement(interp, "while parsing target");
1878         krb5_free_principal(context, source);
1879         return TCL_ERROR;
1880     }
1881
1882     ret = kadm5_rename_principal(server_handle, source, target);
1883
1884     if (ret == KADM5_OK) {
1885         set_ok(interp, "Principal renamed.");
1886     }
1887     else {
1888         stash_error(interp, ret);
1889         retcode = TCL_ERROR;
1890     }
1891
1892     krb5_free_principal(context, source);
1893     krb5_free_principal(context, target);
1894     return retcode;
1895 }
1896
1897
1898
1899 static int tcl_kadm5_chpass_principal(ClientData clientData,
1900                                       Tcl_Interp *interp,
1901                                       int argc, const char *argv[])
1902 {
1903     krb5_principal princ;
1904     char *pw;
1905 #ifdef OVERRIDE
1906     int override_qual;
1907 #endif
1908     krb5_error_code krb5_ret;
1909     int retcode = TCL_OK;
1910     kadm5_ret_t ret;
1911
1912     GET_HANDLE(2, 0);
1913
1914     if ((krb5_ret = krb5_parse_name(context, argv[0], &princ)) != 0) {
1915         stash_error(interp, krb5_ret);
1916         Tcl_AppendElement(interp, "while parsing principal name");
1917         return TCL_ERROR;
1918     }
1919
1920     if (parse_str(interp, argv[1], &pw) != TCL_OK) {
1921         Tcl_AppendElement(interp, "while parsing password");
1922         retcode = TCL_ERROR;
1923         goto finished;
1924     }
1925
1926 #ifdef OVERRIDE
1927     if (Tcl_GetBoolean(interp, argv[2], &override_qual) != TCL_OK) {
1928         Tcl_AppendElement(interp, "while parsing override_qual");
1929         retcode = TCL_ERROR;
1930         goto finished;
1931     }
1932
1933     ret = kadm5_chpass_principal(server_handle,
1934                                  princ, pw, override_qual);
1935 #else
1936     ret = kadm5_chpass_principal(server_handle, princ, pw);
1937 #endif
1938
1939     if (ret == KADM5_OK) {
1940         set_ok(interp, "Password changed.");
1941         goto finished;
1942     }
1943     else {
1944         stash_error(interp, ret);
1945         retcode = TCL_ERROR;
1946     }
1947
1948 finished:
1949     krb5_free_principal(context, princ);
1950     return retcode;
1951 }
1952
1953
1954
1955 static int tcl_kadm5_chpass_principal_util(ClientData clientData,
1956                                            Tcl_Interp *interp,
1957                                            int argc, const char *argv[])
1958 {
1959     krb5_principal princ;
1960     char *new_pw;
1961 #ifdef OVERRIDE
1962     int override_qual;
1963 #endif
1964     char *pw_ret, *pw_ret_var;
1965     char msg_ret[1024], *msg_ret_var;
1966     krb5_error_code krb5_ret;
1967     kadm5_ret_t ret;
1968     int retcode = TCL_OK;
1969
1970     GET_HANDLE(4, 0);
1971
1972     if ((krb5_ret = krb5_parse_name(context, argv[0], &princ)) != 0) {
1973         stash_error(interp, krb5_ret);
1974         Tcl_AppendElement(interp, "while parsing principal name");
1975         return TCL_ERROR;
1976     }
1977
1978     if (parse_str(interp, argv[1], &new_pw) != TCL_OK) {
1979         Tcl_AppendElement(interp, "while parsing new password");
1980         retcode = TCL_ERROR;
1981         goto finished;
1982     }
1983 #ifdef OVERRIDE
1984     if (Tcl_GetBoolean(interp, argv[2], &override_qual) != TCL_OK) {
1985         Tcl_AppendElement(interp, "while parsing override_qual");
1986         retcode = TCL_ERROR;
1987         goto finished;
1988     }
1989 #endif
1990     if (parse_str(interp, argv[3], &pw_ret_var) != TCL_OK) {
1991         Tcl_AppendElement(interp, "while parsing pw_ret variable name");
1992         retcode = TCL_ERROR;
1993         goto finished;
1994     }
1995
1996     if (parse_str(interp, argv[4], &msg_ret_var) != TCL_OK) {
1997         Tcl_AppendElement(interp, "while parsing msg_ret variable name");
1998         retcode = TCL_ERROR;
1999         goto finished;
2000     }
2001
2002     ret = kadm5_chpass_principal_util(server_handle, princ, new_pw,
2003 #ifdef OVERRIDE
2004                                       override_qual,
2005 #endif
2006                                       pw_ret_var ? &pw_ret : 0,
2007                                       msg_ret_var ? msg_ret : 0,
2008                                       msg_ret_var ? sizeof(msg_ret) : 0);
2009
2010     if (ret == KADM5_OK) {
2011         if (pw_ret_var &&
2012             (! Tcl_SetVar(interp, pw_ret_var, pw_ret,
2013                           TCL_LEAVE_ERR_MSG))) {
2014             Tcl_AppendElement(interp, "while setting pw_ret variable");
2015             retcode = TCL_ERROR;
2016             goto finished;
2017         }
2018         if (msg_ret_var &&
2019             (! Tcl_SetVar(interp, msg_ret_var, msg_ret,
2020                           TCL_LEAVE_ERR_MSG))) {
2021             Tcl_AppendElement(interp,
2022                               "while setting msg_ret variable");
2023             retcode = TCL_ERROR;
2024             goto finished;
2025         }
2026         set_ok(interp, "Password changed.");
2027     }
2028     else {
2029         stash_error(interp, ret);
2030         retcode = TCL_ERROR;
2031     }
2032
2033 finished:
2034     krb5_free_principal(context, princ);
2035     return retcode;
2036 }
2037
2038
2039
2040 static int tcl_kadm5_randkey_principal(ClientData clientData,
2041                                        Tcl_Interp *interp,
2042                                        int argc, const char *argv[])
2043 {
2044     krb5_principal princ;
2045     krb5_keyblock *keyblocks;
2046     int num_keys;
2047     char *keyblock_var, *num_var, buf[50];
2048     Tcl_DString *keyblock_dstring = 0;
2049     krb5_error_code krb5_ret;
2050     kadm5_ret_t ret;
2051     int retcode = TCL_OK;
2052
2053     GET_HANDLE(3, 0);
2054
2055     if ((krb5_ret = krb5_parse_name(context, argv[0], &princ)) != 0) {
2056         stash_error(interp, krb5_ret);
2057         Tcl_AppendElement(interp, "while parsing principal name");
2058         return TCL_ERROR;
2059     }
2060
2061     if (parse_str(interp, argv[1], &keyblock_var) != TCL_OK) {
2062         Tcl_AppendElement(interp, "while parsing keyblock variable name");
2063         retcode = TCL_ERROR;
2064         goto finished;
2065     }
2066     if (parse_str(interp, argv[2], &num_var) != TCL_OK) {
2067         Tcl_AppendElement(interp, "while parsing keyblock variable name");
2068         retcode = TCL_ERROR;
2069         goto finished;
2070     }
2071
2072     ret = kadm5_randkey_principal(server_handle,
2073                                   princ, keyblock_var ? &keyblocks : 0,
2074                                   &num_keys);
2075
2076     if (ret == KADM5_OK) {
2077         if (keyblock_var) {
2078             keyblock_dstring = unparse_keyblocks(keyblocks, num_keys);
2079             if (! Tcl_SetVar(interp, keyblock_var,
2080                              keyblock_dstring->string,
2081                              TCL_LEAVE_ERR_MSG)) {
2082                 Tcl_AppendElement(interp,
2083                                   "while setting keyblock variable");
2084                 retcode = TCL_ERROR;
2085                 goto finished;
2086             }
2087         }
2088         if (num_var) {
2089             sprintf(buf, "%d", num_keys);
2090             if (! Tcl_SetVar(interp, num_var, buf,
2091                              TCL_LEAVE_ERR_MSG)) {
2092                 Tcl_AppendElement(interp,
2093                                   "while setting num_keys variable");
2094             }
2095         }
2096         set_ok(interp, "Key randomized.");
2097     }
2098     else {
2099         stash_error(interp, ret);
2100         retcode = TCL_ERROR;
2101     }
2102
2103 finished:
2104     krb5_free_principal(context, princ);
2105     if (keyblock_dstring) {
2106         Tcl_DStringFree(keyblock_dstring);
2107         free(keyblock_dstring);
2108     }
2109     return retcode;
2110 }
2111
2112
2113
2114 static int tcl_kadm5_get_principal(ClientData clientData, Tcl_Interp *interp,
2115                                    int argc, const char *argv[])
2116 {
2117     krb5_principal princ;
2118     kadm5_principal_ent_rec ent;
2119     Tcl_DString *ent_dstring = 0;
2120     char *ent_var;
2121     char *name;
2122     krb5_error_code krb5_ret;
2123     int tcl_ret;
2124     kadm5_ret_t ret = -1;
2125     krb5_int32 mask;
2126     int retcode = TCL_OK;
2127
2128     GET_HANDLE(3, 1);
2129
2130     if((tcl_ret = parse_str(interp, argv[0], &name)) != TCL_OK)
2131         return tcl_ret;
2132     if(name != NULL) {
2133         if ((krb5_ret = krb5_parse_name(context, name, &princ)) != 0) {
2134             stash_error(interp, krb5_ret);
2135             Tcl_AppendElement(interp, "while parsing principal name");
2136             return TCL_ERROR;
2137         }
2138     } else princ = NULL;
2139
2140     if ((tcl_ret = parse_str(interp, argv[1], &ent_var)) != TCL_OK) {
2141         Tcl_AppendElement(interp, "while parsing entry variable name");
2142         retcode = TCL_ERROR;
2143         goto finished;
2144     }
2145     if ((tcl_ret = parse_principal_mask(interp, argv[2], &mask)) != TCL_OK) {
2146         Tcl_AppendElement(interp, "while parsing principal mask");
2147         retcode = TCL_ERROR;
2148         goto finished;
2149     }
2150
2151     ret = kadm5_get_principal(server_handle, princ, ent_var ? &ent : 0,
2152                               mask);
2153
2154     if (ret == KADM5_OK) {
2155         if (ent_var) {
2156             ent_dstring = unparse_principal_ent(&ent, mask);
2157             if (! Tcl_SetVar(interp, ent_var, ent_dstring->string,
2158                              TCL_LEAVE_ERR_MSG)) {
2159                 Tcl_AppendElement(interp,
2160                                   "while setting entry variable");
2161                 retcode = TCL_ERROR;
2162                 goto finished;
2163             }
2164             set_ok(interp, "Principal retrieved.");
2165         }
2166     }
2167     else {
2168         stash_error(interp, ret);
2169         retcode = TCL_ERROR;
2170     }
2171
2172 finished:
2173     if (ent_dstring) {
2174         Tcl_DStringFree(ent_dstring);
2175         free(ent_dstring);
2176     }
2177     if(princ != NULL)
2178         krb5_free_principal(context, princ);
2179     if (ret == KADM5_OK && ent_var &&
2180         (ret = kadm5_free_principal_ent(server_handle, &ent)) &&
2181         (retcode == TCL_OK)) {
2182         stash_error(interp, ret);
2183         retcode = TCL_ERROR;
2184     }
2185     return retcode;
2186 }
2187
2188 static int tcl_kadm5_create_policy(ClientData clientData, Tcl_Interp *interp,
2189                                    int argc, const char *argv[])
2190 {
2191     int tcl_ret;
2192     kadm5_ret_t ret;
2193     int retcode = TCL_OK;
2194     char *policy_string;
2195     kadm5_policy_ent_t policy = 0;
2196     krb5_int32 mask;
2197
2198     GET_HANDLE(2, 0);
2199
2200     if ((tcl_ret = parse_str(interp, argv[0], &policy_string)) != TCL_OK) {
2201         Tcl_AppendElement(interp, "while parsing policy");
2202         return tcl_ret;
2203     }
2204
2205     if (policy_string &&
2206         ((tcl_ret = parse_policy_ent(interp, policy_string, &policy))
2207          != TCL_OK)) {
2208         return tcl_ret;
2209     }
2210
2211     if ((tcl_ret = parse_policy_mask(interp, argv[1], &mask)) != TCL_OK) {
2212         retcode = tcl_ret;
2213         goto finished;
2214     }
2215
2216     ret = kadm5_create_policy(server_handle, policy, mask);
2217
2218     if (ret != KADM5_OK) {
2219         stash_error(interp, ret);
2220         retcode = TCL_ERROR;
2221         goto finished;
2222     }
2223     else {
2224         set_ok(interp, "Policy created.");
2225     }
2226
2227 finished:
2228     if (policy) {
2229         free_policy_ent(&policy);
2230     }
2231     return retcode;
2232 }
2233
2234
2235
2236 static int tcl_kadm5_delete_policy(ClientData clientData, Tcl_Interp *interp,
2237                                    int argc, const char *argv[])
2238 {
2239     kadm5_ret_t ret;
2240     char *policy;
2241
2242     GET_HANDLE(1, 0);
2243
2244     if (parse_str(interp, argv[0], &policy) != TCL_OK) {
2245         Tcl_AppendElement(interp, "while parsing policy name");
2246         return TCL_ERROR;
2247     }
2248
2249     ret = kadm5_delete_policy(server_handle, policy);
2250
2251     if (ret != KADM5_OK) {
2252         stash_error(interp, ret);
2253         return TCL_ERROR;
2254     }
2255     else {
2256         set_ok(interp, "Policy deleted.");
2257         return TCL_OK;
2258     }
2259 }
2260
2261
2262
2263 static int tcl_kadm5_modify_policy(ClientData clientData, Tcl_Interp *interp,
2264                                    int argc, const char *argv[])
2265 {
2266     char *policy_string;
2267     kadm5_policy_ent_t policy = 0;
2268     int tcl_ret;
2269     krb5_int32 mask;
2270     int retcode = TCL_OK;
2271     kadm5_ret_t ret;
2272
2273     GET_HANDLE(2, 0);
2274
2275     if ((tcl_ret = parse_str(interp, argv[0], &policy_string)) != TCL_OK) {
2276         Tcl_AppendElement(interp, "while parsing policy");
2277         return tcl_ret;
2278     }
2279
2280     if (policy_string &&
2281         ((tcl_ret = parse_policy_ent(interp, policy_string, &policy))
2282          != TCL_OK)) {
2283         return tcl_ret;
2284     }
2285
2286     if ((tcl_ret = parse_policy_mask(interp, argv[1], &mask)) != TCL_OK) {
2287         retcode = TCL_ERROR;
2288         goto finished;
2289     }
2290
2291     ret = kadm5_modify_policy(server_handle, policy, mask);
2292
2293     if (ret != KADM5_OK) {
2294         stash_error(interp, ret);
2295         retcode = TCL_ERROR;
2296     }
2297     else {
2298         set_ok(interp, "Policy modified.");
2299     }
2300
2301 finished:
2302     if (policy) {
2303         free_policy_ent(&policy);
2304     }
2305     return retcode;
2306 }
2307
2308
2309 static int tcl_kadm5_get_policy(ClientData clientData, Tcl_Interp *interp,
2310                                 int argc, const char *argv[])
2311 {
2312     kadm5_policy_ent_rec ent;
2313     Tcl_DString *ent_dstring = 0;
2314     char *policy;
2315     char *ent_var;
2316     kadm5_ret_t ret;
2317     int retcode = TCL_OK;
2318
2319     GET_HANDLE(2, 1);
2320
2321     if (parse_str(interp, argv[0], &policy) != TCL_OK) {
2322         Tcl_AppendElement(interp, "while parsing policy name");
2323         return TCL_ERROR;
2324     }
2325
2326     if (parse_str(interp, argv[1], &ent_var) != TCL_OK) {
2327         Tcl_AppendElement(interp, "while parsing entry variable name");
2328         return TCL_ERROR;
2329     }
2330
2331     ret = kadm5_get_policy(server_handle, policy, ent_var ? &ent : 0);
2332
2333     if (ret == KADM5_OK) {
2334         if (ent_var) {
2335             ent_dstring = unparse_policy_ent(&ent);
2336             if (! Tcl_SetVar(interp, ent_var, ent_dstring->string,
2337                              TCL_LEAVE_ERR_MSG)) {
2338                 Tcl_AppendElement(interp,
2339                                   "while setting entry variable");
2340                 retcode = TCL_ERROR;
2341                 goto finished;
2342             }
2343             set_ok(interp, "Policy retrieved.");
2344         }
2345     }
2346     else {
2347         stash_error(interp, ret);
2348         retcode = TCL_ERROR;
2349     }
2350
2351 finished:
2352     if (ent_dstring) {
2353         Tcl_DStringFree(ent_dstring);
2354         free(ent_dstring);
2355     }
2356     if (ent_var && ret == KADM5_OK &&
2357         (ret = kadm5_free_policy_ent(server_handle, &ent)) &&
2358         (retcode == TCL_OK)) {
2359         stash_error(interp, ret);
2360         retcode = TCL_ERROR;
2361     }
2362     return retcode;
2363 }
2364
2365
2366
2367 static int tcl_kadm5_free_principal_ent(ClientData clientData,
2368                                         Tcl_Interp *interp,
2369                                         int argc, const char *argv[])
2370 {
2371     char *ent_name;
2372     kadm5_principal_ent_t ent;
2373     kadm5_ret_t ret;
2374
2375     GET_HANDLE(1, 0);
2376
2377     if (parse_str(interp, argv[0], &ent_name) != TCL_OK) {
2378         Tcl_AppendElement(interp, "while parsing entry name");
2379         return TCL_ERROR;
2380     }
2381
2382     if ((! ent_name) &&
2383         (ret = kadm5_free_principal_ent(server_handle, 0))) {
2384         stash_error(interp, ret);
2385         return TCL_ERROR;
2386     }
2387     else {
2388         Tcl_HashEntry *entry;
2389
2390         if (strncmp(ent_name, "principal", sizeof("principal")-1)) {
2391             Tcl_AppendResult(interp, "invalid principal handle \"",
2392                              ent_name, "\"", 0);
2393             return TCL_ERROR;
2394         }
2395         if (! struct_table) {
2396             if (! (struct_table = malloc(sizeof(*struct_table)))) {
2397                 fprintf(stderr, "Out of memory!\n");
2398                 exit(1); /* XXX */
2399             }
2400             Tcl_InitHashTable(struct_table, TCL_STRING_KEYS);
2401         }
2402
2403         if (! (entry = Tcl_FindHashEntry(struct_table, ent_name))) {
2404             Tcl_AppendResult(interp, "principal handle \"", ent_name,
2405                              "\" not found", 0);
2406             return TCL_ERROR;
2407         }
2408
2409         ent = (kadm5_principal_ent_t) Tcl_GetHashValue(entry);
2410
2411         ret = kadm5_free_principal_ent(server_handle, ent);
2412         if (ret != KADM5_OK) {
2413             stash_error(interp, ret);
2414             return TCL_ERROR;
2415         }
2416         Tcl_DeleteHashEntry(entry);
2417     }
2418     set_ok(interp, "Principal freed.");
2419     return TCL_OK;
2420 }
2421
2422
2423 static int tcl_kadm5_free_policy_ent(ClientData clientData,
2424                                      Tcl_Interp *interp,
2425                                      int argc, const char *argv[])
2426 {
2427     char *ent_name;
2428     kadm5_policy_ent_t ent;
2429     kadm5_ret_t ret;
2430
2431     GET_HANDLE(1, 0);
2432
2433     if (parse_str(interp, argv[0], &ent_name) != TCL_OK) {
2434         Tcl_AppendElement(interp, "while parsing entry name");
2435         return TCL_ERROR;
2436     }
2437
2438     if ((! ent_name) &&
2439         (ret = kadm5_free_policy_ent(server_handle, 0))) {
2440         stash_error(interp, ret);
2441         return TCL_ERROR;
2442     }
2443     else {
2444         Tcl_HashEntry *entry;
2445
2446         if (strncmp(ent_name, "policy", sizeof("policy")-1)) {
2447             Tcl_AppendResult(interp, "invalid principal handle \"",
2448                              ent_name, "\"", 0);
2449             return TCL_ERROR;
2450         }
2451         if (! struct_table) {
2452             if (! (struct_table = malloc(sizeof(*struct_table)))) {
2453                 fprintf(stderr, "Out of memory!\n");
2454                 exit(1); /* XXX */
2455             }
2456             Tcl_InitHashTable(struct_table, TCL_STRING_KEYS);
2457         }
2458
2459         if (! (entry = Tcl_FindHashEntry(struct_table, ent_name))) {
2460             Tcl_AppendResult(interp, "policy handle \"", ent_name,
2461                              "\" not found", 0);
2462             return TCL_ERROR;
2463         }
2464
2465         ent = (kadm5_policy_ent_t) Tcl_GetHashValue(entry);
2466
2467         if ((ret = kadm5_free_policy_ent(server_handle, ent)) != KADM5_OK) {
2468             stash_error(interp, ret);
2469             return TCL_ERROR;
2470         }
2471         Tcl_DeleteHashEntry(entry);
2472     }
2473     set_ok(interp, "Policy freed.");
2474     return TCL_OK;
2475 }
2476
2477
2478 static int tcl_kadm5_get_privs(ClientData clientData, Tcl_Interp *interp,
2479                                int argc, const char *argv[])
2480 {
2481     const char *set_ret;
2482     kadm5_ret_t ret;
2483     char *priv_var;
2484     long privs;
2485
2486     GET_HANDLE(1, 0);
2487
2488     if (parse_str(interp, argv[0], &priv_var) != TCL_OK) {
2489         Tcl_AppendElement(interp, "while parsing privs variable name");
2490         return TCL_ERROR;
2491     }
2492
2493     ret = kadm5_get_privs(server_handle, priv_var ? &privs : 0);
2494
2495     if (ret == KADM5_OK) {
2496         if (priv_var) {
2497             Tcl_DString *str = unparse_privs(privs);
2498             set_ret = Tcl_SetVar(interp, priv_var, str->string,
2499                                  TCL_LEAVE_ERR_MSG);
2500             Tcl_DStringFree(str);
2501             free(str);
2502             if (! set_ret) {
2503                 Tcl_AppendElement(interp, "while setting priv variable");
2504                 return TCL_ERROR;
2505             }
2506         }
2507         set_ok(interp, "Privileges retrieved.");
2508         return TCL_OK;
2509     }
2510     else {
2511         stash_error(interp, ret);
2512         return TCL_ERROR;
2513     }
2514 }
2515
2516
2517 void Tcl_kadm5_init(Tcl_Interp *interp)
2518 {
2519     char buf[20];
2520
2521     Tcl_SetVar(interp, "KADM5_ADMIN_SERVICE",
2522                KADM5_ADMIN_SERVICE, TCL_GLOBAL_ONLY);
2523     Tcl_SetVar(interp, "KADM5_CHANGEPW_SERVICE",
2524                KADM5_CHANGEPW_SERVICE, TCL_GLOBAL_ONLY);
2525     (void) sprintf(buf, "%d", KADM5_STRUCT_VERSION);
2526     Tcl_SetVar(interp, "KADM5_STRUCT_VERSION", buf, TCL_GLOBAL_ONLY);
2527     (void) sprintf(buf, "%d", KADM5_API_VERSION_2);
2528     Tcl_SetVar(interp, "KADM5_API_VERSION_2", buf, TCL_GLOBAL_ONLY);
2529     (void) sprintf(buf, "%d", KADM5_API_VERSION_3);
2530     Tcl_SetVar(interp, "KADM5_API_VERSION_3", buf, TCL_GLOBAL_ONLY);
2531     (void) sprintf(buf, "%d", KADM5_API_VERSION_MASK);
2532     Tcl_SetVar(interp, "KADM5_API_VERSION_MASK", buf, TCL_GLOBAL_ONLY);
2533     (void) sprintf(buf, "%d", KADM5_STRUCT_VERSION_MASK);
2534     Tcl_SetVar(interp, "KADM5_STRUCT_VERSION_MASK", buf,
2535                TCL_GLOBAL_ONLY);
2536
2537     Tcl_CreateCommand(interp, "kadm5_init", tcl_kadm5_init, 0, 0);
2538     Tcl_CreateCommand(interp, "kadm5_init_with_creds",
2539                       tcl_kadm5_init_with_creds, 0, 0);
2540     Tcl_CreateCommand(interp, "kadm5_destroy", tcl_kadm5_destroy, 0,
2541                       0);
2542     Tcl_CreateCommand(interp, "kadm5_create_principal",
2543                       tcl_kadm5_create_principal, 0, 0);
2544     Tcl_CreateCommand(interp, "kadm5_delete_principal",
2545                       tcl_kadm5_delete_principal, 0, 0);
2546     Tcl_CreateCommand(interp, "kadm5_modify_principal",
2547                       tcl_kadm5_modify_principal, 0, 0);
2548     Tcl_CreateCommand(interp, "kadm5_rename_principal",
2549                       tcl_kadm5_rename_principal, 0, 0);
2550     Tcl_CreateCommand(interp, "kadm5_chpass_principal",
2551                       tcl_kadm5_chpass_principal, 0, 0);
2552     Tcl_CreateCommand(interp, "kadm5_chpass_principal_util",
2553                       tcl_kadm5_chpass_principal_util, 0, 0);
2554     Tcl_CreateCommand(interp, "kadm5_randkey_principal",
2555                       tcl_kadm5_randkey_principal, 0, 0);
2556     Tcl_CreateCommand(interp, "kadm5_get_principal",
2557                       tcl_kadm5_get_principal, 0, 0);
2558     Tcl_CreateCommand(interp, "kadm5_create_policy",
2559                       tcl_kadm5_create_policy, 0, 0);
2560     Tcl_CreateCommand(interp, "kadm5_delete_policy",
2561                       tcl_kadm5_delete_policy, 0, 0);
2562     Tcl_CreateCommand(interp, "kadm5_modify_policy",
2563                       tcl_kadm5_modify_policy, 0, 0);
2564     Tcl_CreateCommand(interp, "kadm5_get_policy",
2565                       tcl_kadm5_get_policy, 0, 0);
2566     Tcl_CreateCommand(interp, "kadm5_free_principal_ent",
2567                       tcl_kadm5_free_principal_ent, 0, 0);
2568     Tcl_CreateCommand(interp, "kadm5_free_policy_ent",
2569                       tcl_kadm5_free_policy_ent, 0, 0);
2570     Tcl_CreateCommand(interp, "kadm5_get_privs",
2571                       tcl_kadm5_get_privs, 0, 0);
2572 }