src/kadmin/testing/util/tcl_kadm5.c

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