#ifdef HAVE_UNISTD_H # include #endif #ifdef HAVE_STDLIB_H # include #endif #ifdef HAVE_STRING_H # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_DLFCN_H # include #endif #ifdef HAVE_DL_H # include #endif #ifdef _WIN32 # include #endif #include #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 86 # define TCL_INCLUDES_LOADFILE 1 #endif /* PKCS#11 Definitions for the local platform */ #define CK_PTR * #define CK_DECLARE_FUNCTION(rv, func) rv func #define CK_DECLARE_FUNCTION_POINTER(rv, func) rv (CK_PTR func) #define CK_CALLBACK_FUNCTION(rv, func) rv (CK_PTR func) #define CK_NULL_PTR ((void *) 0) #ifdef _WIN32 # pragma pack(push, cryptoki, 1) #endif #include "pkcs11.h" #ifdef _WIN32 # pragma pack(pop, cryptoki) #endif struct tclpkcs11_interpdata { /* Handle Hash Table */ Tcl_HashTable handles; unsigned long handles_idx; }; struct tclpkcs11_handle { /* PKCS11 Module Pointers */ void *base; CK_FUNCTION_LIST_PTR pkcs11; /* Session Management */ int session_active; CK_SLOT_ID session_slot; CK_SESSION_HANDLE session; }; /* * Tcl <--> PKCS11 Bridge Functions */ #define tclpkcs11_pkcs11_error(x) INTtclpkcs11_pkcs11_error(x, __LINE__) MODULE_SCOPE Tcl_Obj *INTtclpkcs11_pkcs11_error(CK_RV errorCode, int lineNumber) { Tcl_Obj *retval; switch (errorCode) { case CKR_OK: retval = Tcl_NewStringObj("PKCS11_OK OK", -1); break; case CKR_CANCEL: retval = Tcl_NewStringObj("PKCS11_ERROR CANCEL", -1); break; case CKR_HOST_MEMORY: retval = Tcl_NewStringObj("PKCS11_ERROR HOST_MEMORY", -1); break; case CKR_SLOT_ID_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR SLOT_ID_INVALID", -1); break; case CKR_GENERAL_ERROR: retval = Tcl_NewStringObj("PKCS11_ERROR GENERAL_ERROR", -1); break; case CKR_FUNCTION_FAILED: retval = Tcl_NewStringObj("PKCS11_ERROR FUNCTION_FAILED", -1); break; case CKR_ARGUMENTS_BAD: retval = Tcl_NewStringObj("PKCS11_ERROR ARGUMENTS_BAD", -1); break; case CKR_NO_EVENT: retval = Tcl_NewStringObj("PKCS11_ERROR NO_EVENT", -1); break; case CKR_NEED_TO_CREATE_THREADS: retval = Tcl_NewStringObj("PKCS11_ERROR NEED_TO_CREATE_THREADS", -1); break; case CKR_CANT_LOCK: retval = Tcl_NewStringObj("PKCS11_ERROR CANT_LOCK", -1); break; case CKR_ATTRIBUTE_READ_ONLY: retval = Tcl_NewStringObj("PKCS11_ERROR ATTRIBUTE_READ_ONLY", -1); break; case CKR_ATTRIBUTE_SENSITIVE: retval = Tcl_NewStringObj("PKCS11_ERROR ATTRIBUTE_SENSITIVE", -1); break; case CKR_ATTRIBUTE_TYPE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR ATTRIBUTE_TYPE_INVALID", -1); break; case CKR_ATTRIBUTE_VALUE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR ATTRIBUTE_VALUE_INVALID", -1); break; case CKR_DATA_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR DATA_INVALID", -1); break; case CKR_DATA_LEN_RANGE: retval = Tcl_NewStringObj("PKCS11_ERROR DATA_LEN_RANGE", -1); break; case CKR_DEVICE_ERROR: retval = Tcl_NewStringObj("PKCS11_ERROR DEVICE_ERROR", -1); break; case CKR_DEVICE_MEMORY: retval = Tcl_NewStringObj("PKCS11_ERROR DEVICE_MEMORY", -1); break; case CKR_DEVICE_REMOVED: retval = Tcl_NewStringObj("PKCS11_ERROR DEVICE_REMOVED", -1); break; case CKR_ENCRYPTED_DATA_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR ENCRYPTED_DATA_INVALID", -1); break; case CKR_ENCRYPTED_DATA_LEN_RANGE: retval = Tcl_NewStringObj("PKCS11_ERROR ENCRYPTED_DATA_LEN_RANGE", -1); break; case CKR_FUNCTION_CANCELED: retval = Tcl_NewStringObj("PKCS11_ERROR FUNCTION_CANCELED", -1); break; case CKR_FUNCTION_NOT_PARALLEL: retval = Tcl_NewStringObj("PKCS11_ERROR FUNCTION_NOT_PARALLEL", -1); break; case CKR_FUNCTION_NOT_SUPPORTED: retval = Tcl_NewStringObj("PKCS11_ERROR FUNCTION_NOT_SUPPORTED", -1); break; case CKR_KEY_HANDLE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_HANDLE_INVALID", -1); break; case CKR_KEY_SIZE_RANGE: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_SIZE_RANGE", -1); break; case CKR_KEY_TYPE_INCONSISTENT: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_TYPE_INCONSISTENT", -1); break; case CKR_KEY_NOT_NEEDED: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_NOT_NEEDED", -1); break; case CKR_KEY_CHANGED: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_CHANGED", -1); break; case CKR_KEY_NEEDED: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_NEEDED", -1); break; case CKR_KEY_INDIGESTIBLE: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_INDIGESTIBLE", -1); break; case CKR_KEY_FUNCTION_NOT_PERMITTED: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_FUNCTION_NOT_PERMITTED", -1); break; case CKR_KEY_NOT_WRAPPABLE: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_NOT_WRAPPABLE", -1); break; case CKR_KEY_UNEXTRACTABLE: retval = Tcl_NewStringObj("PKCS11_ERROR KEY_UNEXTRACTABLE", -1); break; case CKR_MECHANISM_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR MECHANISM_INVALID", -1); break; case CKR_MECHANISM_PARAM_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR MECHANISM_PARAM_INVALID", -1); break; case CKR_OBJECT_HANDLE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR OBJECT_HANDLE_INVALID", -1); break; case CKR_OPERATION_ACTIVE: retval = Tcl_NewStringObj("PKCS11_ERROR OPERATION_ACTIVE", -1); break; case CKR_OPERATION_NOT_INITIALIZED: retval = Tcl_NewStringObj("PKCS11_ERROR OPERATION_NOT_INITIALIZED", -1); break; case CKR_PIN_INCORRECT: retval = Tcl_NewStringObj("PKCS11_ERROR PIN_INCORRECT", -1); break; case CKR_PIN_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR PIN_INVALID", -1); break; case CKR_PIN_LEN_RANGE: retval = Tcl_NewStringObj("PKCS11_ERROR PIN_LEN_RANGE", -1); break; case CKR_PIN_EXPIRED: retval = Tcl_NewStringObj("PKCS11_ERROR PIN_EXPIRED", -1); break; case CKR_PIN_LOCKED: retval = Tcl_NewStringObj("PKCS11_ERROR PIN_LOCKED", -1); break; case CKR_SESSION_CLOSED: retval = Tcl_NewStringObj("PKCS11_ERROR SESSION_CLOSED", -1); break; case CKR_SESSION_COUNT: retval = Tcl_NewStringObj("PKCS11_ERROR SESSION_COUNT", -1); break; case CKR_SESSION_HANDLE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR SESSION_HANDLE_INVALID", -1); break; case CKR_SESSION_PARALLEL_NOT_SUPPORTED: retval = Tcl_NewStringObj("PKCS11_ERROR SESSION_PARALLEL_NOT_SUPPORTED", -1); break; case CKR_SESSION_READ_ONLY: retval = Tcl_NewStringObj("PKCS11_ERROR SESSION_READ_ONLY", -1); break; case CKR_SESSION_EXISTS: retval = Tcl_NewStringObj("PKCS11_ERROR SESSION_EXISTS", -1); break; case CKR_SESSION_READ_ONLY_EXISTS: retval = Tcl_NewStringObj("PKCS11_ERROR SESSION_READ_ONLY_EXISTS", -1); break; case CKR_SESSION_READ_WRITE_SO_EXISTS: retval = Tcl_NewStringObj("PKCS11_ERROR SESSION_READ_WRITE_SO_EXISTS", -1); break; case CKR_SIGNATURE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR SIGNATURE_INVALID", -1); break; case CKR_SIGNATURE_LEN_RANGE: retval = Tcl_NewStringObj("PKCS11_ERROR SIGNATURE_LEN_RANGE", -1); break; case CKR_TEMPLATE_INCOMPLETE: retval = Tcl_NewStringObj("PKCS11_ERROR TEMPLATE_INCOMPLETE", -1); break; case CKR_TEMPLATE_INCONSISTENT: retval = Tcl_NewStringObj("PKCS11_ERROR TEMPLATE_INCONSISTENT", -1); break; case CKR_TOKEN_NOT_PRESENT: retval = Tcl_NewStringObj("PKCS11_ERROR TOKEN_NOT_PRESENT", -1); break; case CKR_TOKEN_NOT_RECOGNIZED: retval = Tcl_NewStringObj("PKCS11_ERROR TOKEN_NOT_RECOGNIZED", -1); break; case CKR_TOKEN_WRITE_PROTECTED: retval = Tcl_NewStringObj("PKCS11_ERROR TOKEN_WRITE_PROTECTED", -1); break; case CKR_UNWRAPPING_KEY_HANDLE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR UNWRAPPING_KEY_HANDLE_INVALID", -1); break; case CKR_UNWRAPPING_KEY_SIZE_RANGE: retval = Tcl_NewStringObj("PKCS11_ERROR UNWRAPPING_KEY_SIZE_RANGE", -1); break; case CKR_UNWRAPPING_KEY_TYPE_INCONSISTENT: retval = Tcl_NewStringObj("PKCS11_ERROR UNWRAPPING_KEY_TYPE_INCONSISTENT", -1); break; case CKR_USER_ALREADY_LOGGED_IN: retval = Tcl_NewStringObj("PKCS11_ERROR USER_ALREADY_LOGGED_IN", -1); break; case CKR_USER_NOT_LOGGED_IN: retval = Tcl_NewStringObj("PKCS11_ERROR USER_NOT_LOGGED_IN", -1); break; case CKR_USER_PIN_NOT_INITIALIZED: retval = Tcl_NewStringObj("PKCS11_ERROR USER_PIN_NOT_INITIALIZED", -1); break; case CKR_USER_TYPE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR USER_TYPE_INVALID", -1); break; case CKR_USER_ANOTHER_ALREADY_LOGGED_IN: retval = Tcl_NewStringObj("PKCS11_ERROR USER_ANOTHER_ALREADY_LOGGED_IN", -1); break; case CKR_USER_TOO_MANY_TYPES: retval = Tcl_NewStringObj("PKCS11_ERROR USER_TOO_MANY_TYPES", -1); break; case CKR_WRAPPED_KEY_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR WRAPPED_KEY_INVALID", -1); break; case CKR_WRAPPED_KEY_LEN_RANGE: retval = Tcl_NewStringObj("PKCS11_ERROR WRAPPED_KEY_LEN_RANGE", -1); break; case CKR_WRAPPING_KEY_HANDLE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR WRAPPING_KEY_HANDLE_INVALID", -1); break; case CKR_WRAPPING_KEY_SIZE_RANGE: retval = Tcl_NewStringObj("PKCS11_ERROR WRAPPING_KEY_SIZE_RANGE", -1); break; case CKR_WRAPPING_KEY_TYPE_INCONSISTENT: retval = Tcl_NewStringObj("PKCS11_ERROR WRAPPING_KEY_TYPE_INCONSISTENT", -1); break; case CKR_RANDOM_SEED_NOT_SUPPORTED: retval = Tcl_NewStringObj("PKCS11_ERROR RANDOM_SEED_NOT_SUPPORTED", -1); break; case CKR_RANDOM_NO_RNG: retval = Tcl_NewStringObj("PKCS11_ERROR RANDOM_NO_RNG", -1); break; case CKR_DOMAIN_PARAMS_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR DOMAIN_PARAMS_INVALID", -1); break; case CKR_BUFFER_TOO_SMALL: retval = Tcl_NewStringObj("PKCS11_ERROR BUFFER_TOO_SMALL", -1); break; case CKR_SAVED_STATE_INVALID: retval = Tcl_NewStringObj("PKCS11_ERROR SAVED_STATE_INVALID", -1); break; case CKR_INFORMATION_SENSITIVE: retval = Tcl_NewStringObj("PKCS11_ERROR INFORMATION_SENSITIVE", -1); break; case CKR_STATE_UNSAVEABLE: retval = Tcl_NewStringObj("PKCS11_ERROR STATE_UNSAVEABLE", -1); break; case CKR_CRYPTOKI_NOT_INITIALIZED: retval = Tcl_NewStringObj("PKCS11_ERROR CRYPTOKI_NOT_INITIALIZED", -1); break; case CKR_CRYPTOKI_ALREADY_INITIALIZED: retval = Tcl_NewStringObj("PKCS11_ERROR CRYPTOKI_ALREADY_INITIALIZED", -1); break; case CKR_MUTEX_BAD: retval = Tcl_NewStringObj("PKCS11_ERROR MUTEX_BAD", -1); break; case CKR_MUTEX_NOT_LOCKED: retval = Tcl_NewStringObj("PKCS11_ERROR MUTEX_NOT_LOCKED", -1); break; case CKR_NEW_PIN_MODE: retval = Tcl_NewStringObj("PKCS11_ERROR NEW_PIN_MODE", -1); break; case CKR_NEXT_OTP: retval = Tcl_NewStringObj("PKCS11_ERROR NEXT_OTP", -1); break; case CKR_FUNCTION_REJECTED: retval = Tcl_NewStringObj("PKCS11_ERROR FUNCTION_REJECTED", -1); break; case CKR_VENDOR_DEFINED: retval = Tcl_NewStringObj("PKCS11_ERROR VENDOR_DEFINED", -1); break; } if (!retval) { retval = Tcl_NewStringObj("PKCS11_ERROR UNKNOWN", -1); } Tcl_AppendPrintfToObj(retval, " LINE %i", lineNumber); return(retval); } MODULE_SCOPE Tcl_Obj *tclpkcs11_bytearray_to_string(const unsigned char *data, unsigned long datalen) { static char alphabet[] = "0123456789abcdef"; unsigned long idx, bufidx; Tcl_Obj *retval; char buf[1024]; if (data == NULL) { return(Tcl_NewObj()); } for (bufidx = idx = 0; (idx < datalen) && (bufidx < sizeof(buf)); idx++) { buf[bufidx++] = alphabet[(data[idx] >> 4) & 0xf]; buf[bufidx++] = alphabet[data[idx] & 0xf]; } retval = Tcl_NewStringObj(buf, bufidx); return(retval); } MODULE_SCOPE Tcl_Obj *tclpkcs11_bytearray_to_string_from_obj(Tcl_Obj *data) { unsigned char *buf; int buflen; Tcl_Obj *retval; if (data == NULL) { return(Tcl_NewObj()); } buf = Tcl_GetByteArrayFromObj(data, &buflen); retval = tclpkcs11_bytearray_to_string(buf, buflen); return(retval); } MODULE_SCOPE unsigned long tclpkcs11_string_to_bytearray(Tcl_Obj *data, unsigned char *outbuf, unsigned long outbuflen) { unsigned long outbufidx = 0; char tmpbuf[5]; char *str; int tmpint; int tcl_rv; if (outbuf == NULL) { return(0); } str = Tcl_GetString(data); if (!str) { return(0); } tmpbuf[0] = '0'; tmpbuf[1] = 'x'; tmpbuf[4] = '\0'; for (str = Tcl_GetString(data); *str; str++) { tmpbuf[2] = *str; str++; if (!*str) { break; } tmpbuf[3] = *str; tcl_rv = Tcl_GetInt(NULL, tmpbuf, &tmpint); if (tcl_rv != TCL_OK) { return(0); } outbuf[outbufidx] = tmpint; outbufidx++; if (outbufidx >= outbuflen) { break; } } return(outbufidx); } /* PKCS#11 Mutex functions implementation that use Tcl Mutexes */ MODULE_SCOPE CK_RV tclpkcs11_create_mutex(void **mutex) { Tcl_Mutex *retval; if (!mutex) { return(CKR_GENERAL_ERROR); } retval = (Tcl_Mutex *) ckalloc(sizeof(*retval)); memset(retval, 0, sizeof(*retval)); *mutex = retval; return(CKR_OK); } MODULE_SCOPE CK_RV tclpkcs11_lock_mutex(void *mutex) { Tcl_Mutex *tcl_mutex; if (!mutex) { return(CKR_GENERAL_ERROR); } tcl_mutex = mutex; Tcl_MutexLock(tcl_mutex); return(CKR_OK); } MODULE_SCOPE CK_RV tclpkcs11_unlock_mutex(void *mutex) { Tcl_Mutex *tcl_mutex; if (!mutex) { return(CKR_GENERAL_ERROR); } tcl_mutex = mutex; Tcl_MutexUnlock(tcl_mutex); return(CKR_OK); } MODULE_SCOPE CK_RV tclpkcs11_destroy_mutex(void *mutex) { Tcl_Mutex *tcl_mutex; if (!mutex) { return(CKR_GENERAL_ERROR); } tcl_mutex = mutex; Tcl_MutexFinalize(tcl_mutex); ckfree(mutex); return(CKR_OK); } /* Convience function to start a session if one is not already active */ MODULE_SCOPE int tclpkcs11_start_session(struct tclpkcs11_handle *handle, CK_SLOT_ID slot) { CK_SESSION_HANDLE tmp_session; CK_RV chk_rv; if (handle->session_active) { if (handle->session_slot == slot) { return(CKR_OK); } /* Close the existing session and create a new one */ handle->session_active = 0; chk_rv = handle->pkcs11->C_CloseSession(handle->session); if (chk_rv != CKR_OK) { return(chk_rv); } } chk_rv = handle->pkcs11->C_OpenSession(slot, CKF_SERIAL_SESSION, NULL, NULL, &tmp_session); if (chk_rv != CKR_OK) { handle->pkcs11->C_CloseSession(handle->session); return(chk_rv); } handle->session = tmp_session; handle->session_slot = slot; handle->session_active = 1; return(CKR_OK); } MODULE_SCOPE int tclpkcs11_close_session(struct tclpkcs11_handle *handle) { CK_RV chk_rv; if (handle->session_active) { handle->session_active = 0; chk_rv = handle->pkcs11->C_CloseSession(handle->session); if (chk_rv != CKR_OK) { return(chk_rv); } } return(CKR_OK); } /* * Platform Specific Functions */ MODULE_SCOPE void *tclpkcs11_int_load_module(const char *pathname, Tcl_Interp *interp) { #if defined(TCL_INCLUDES_LOADFILE) int tcl_rv; Tcl_Obj *pathnameObj; Tcl_LoadHandle *new_handle; new_handle = (Tcl_LoadHandle *) ckalloc(sizeof(*new_handle)); pathnameObj = Tcl_NewStringObj(pathname, -1); Tcl_IncrRefCount(pathnameObj); tcl_rv = Tcl_LoadFile(interp, pathnameObj, NULL, 0, NULL, new_handle); Tcl_DecrRefCount(pathnameObj); if (tcl_rv != TCL_OK) { return(NULL); } return(new_handle); #elif defined(HAVE_DLOPEN) return(dlopen(pathname, RTLD_NOW | RTLD_GLOBAL)); #elif defined(HAVE_SHL_LOAD) return(shl_load(pathname, BIND_DEFERRED, 0L)); #elif defined(_WIN32) return(LoadLibrary(pathname)); #endif return(NULL); } MODULE_SCOPE void tclpkcs11_int_unload_module(void *handle) { #if defined(TCL_INCLUDES_LOADFILE) Tcl_LoadHandle *tcl_handle; tcl_handle = handle; Tcl_FSUnloadFile(NULL, *tcl_handle); ckfree(handle); #elif defined(HAVE_DLOPEN) dlclose(handle); #elif defined(HAVE_SHL_LOAD) shl_unload(handle); #elif defined(_WIN32) FreeLibrary(handle); #endif return; } MODULE_SCOPE void *tclpkcs11_int_lookup_sym(void *handle, const char *sym) { #if defined(TCL_INCLUDES_LOADFILE) Tcl_LoadHandle *tcl_handle; void *retval; tcl_handle = handle; retval = Tcl_FindSymbol(NULL, *tcl_handle, sym); return(retval); #elif defined(HAVE_DLOPEN) return(dlsym(handle, sym)); #elif defined(HAVE_SHL_LOAD) void *retval; int shl_findsym_ret; shl_findsym_ret = shl_findsym(handle, sym, TYPE_PROCEDURE, &retval); if (shl_findsym_ret != 0) { return(NULL); } return(retval); #elif defined(_WIN32) return(GetProcAddress(handle, sym)); #endif return(NULL); } /* * Tcl Commands */ MODULE_SCOPE int tclpkcs11_load_module(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *new_handle; const char *pathname; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *tcl_handle; void *handle; int is_new_entry; CK_C_INITIALIZE_ARGS initargs; CK_C_GetFunctionList getFuncList; CK_FUNCTION_LIST_PTR pkcs11_function_list = NULL; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata\n", -1)); return(TCL_ERROR); } if (objc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::loadmodule filename\"", -1)); return(TCL_ERROR); } pathname = Tcl_GetString(objv[1]); if (!pathname) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid pathname", -1)); return(TCL_ERROR); } handle = tclpkcs11_int_load_module(pathname, interp); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to load", -1)); return(TCL_ERROR); } getFuncList = tclpkcs11_int_lookup_sym(handle, "C_GetFunctionList"); if (!getFuncList) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to locate C_GetFunctionList symbol in PKCS#11 module", -1)); tclpkcs11_int_unload_module(handle); return(TCL_ERROR); } chk_rv = getFuncList(&pkcs11_function_list); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); tclpkcs11_int_unload_module(handle); return(TCL_ERROR); } if (!pkcs11_function_list) { Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned invalid data", -1)); tclpkcs11_int_unload_module(handle); return(TCL_ERROR); } if (!pkcs11_function_list->C_Initialize) { Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data", -1)); tclpkcs11_int_unload_module(handle); return(TCL_ERROR); } initargs.CreateMutex = tclpkcs11_create_mutex; initargs.DestroyMutex = tclpkcs11_destroy_mutex; initargs.LockMutex = tclpkcs11_lock_mutex; initargs.UnlockMutex = tclpkcs11_unlock_mutex; initargs.flags = 0; initargs.LibraryFlags = NULL; initargs.pReserved = NULL; chk_rv = pkcs11_function_list->C_Initialize(&initargs); if (chk_rv == CKR_CANT_LOCK) { /* * If the PKCS#11 module rejects using our locking * functions, retry with OS locking functions. */ initargs.CreateMutex = NULL; initargs.DestroyMutex = NULL; initargs.LockMutex = NULL; initargs.UnlockMutex = NULL; initargs.flags = CKF_OS_LOCKING_OK; initargs.LibraryFlags = NULL; initargs.pReserved = NULL; chk_rv = pkcs11_function_list->C_Initialize(&initargs); } if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); tclpkcs11_int_unload_module(handle); return(TCL_ERROR); } interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle = Tcl_NewStringObj("pkcsmod", -1); Tcl_AppendObjToObj(tcl_handle, Tcl_NewLongObj(interpdata->handles_idx)); (interpdata->handles_idx)++; tcl_handle_entry = Tcl_CreateHashEntry(&interpdata->handles, (const char *) tcl_handle, &is_new_entry); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to create new hash entry", -1)); if (pkcs11_function_list->C_Finalize) { pkcs11_function_list->C_Finalize(NULL); } tclpkcs11_int_unload_module(handle); return(TCL_ERROR); } /* Allocate the per-handle structure */ new_handle = (struct tclpkcs11_handle *) ckalloc(sizeof(*new_handle)); /* Initialize the per-handle structure */ new_handle->base = handle; new_handle->pkcs11 = pkcs11_function_list; new_handle->session_active = 0; Tcl_SetHashValue(tcl_handle_entry, (ClientData) new_handle); Tcl_SetObjResult(interp, tcl_handle); return(TCL_OK); } MODULE_SCOPE int tclpkcs11_unload_module(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *tcl_handle; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata", -1)); return(TCL_ERROR); } if (objc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::unloadmodule handle\"", -1)); return(TCL_ERROR); } tcl_handle = objv[1]; interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle_entry = Tcl_FindHashEntry(&interpdata->handles, (const char *) tcl_handle); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } /* Log out of the PKCS11 module */ handle->pkcs11->C_Logout(handle->session); /* Close the session, cleaning up all the session objects */ tclpkcs11_close_session(handle); /* Ask the PKCS#11 Provider to terminate */ chk_rv = handle->pkcs11->C_Finalize(NULL); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } /* Delete our hash entry */ Tcl_DeleteHashEntry(tcl_handle_entry); /* Attempt to unload the module */ tclpkcs11_int_unload_module(handle->base); /* Free our allocated handle */ ckfree((char *) handle); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); return(TCL_OK); } MODULE_SCOPE int tclpkcs11_list_slots(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *tcl_handle; Tcl_Obj *ret_list, *curr_item_list, *flags_list, *slot_desc; CK_SLOT_ID_PTR slots; CK_SLOT_INFO slotInfo; CK_TOKEN_INFO tokenInfo; CK_ULONG numSlots, currSlot; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata", -1)); return(TCL_ERROR); } if (objc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::listslots handle\"", -1)); return(TCL_ERROR); } tcl_handle = objv[1]; interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle_entry = Tcl_FindHashEntry(&interpdata->handles, (const char *) tcl_handle); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } chk_rv = handle->pkcs11->C_GetSlotList(FALSE, NULL, &numSlots); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } slots = (CK_SLOT_ID_PTR) ckalloc(sizeof(*slots) * numSlots); chk_rv = handle->pkcs11->C_GetSlotList(FALSE, slots, &numSlots); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } ret_list = Tcl_NewObj(); for (currSlot = 0; currSlot < numSlots; currSlot++) { chk_rv = handle->pkcs11->C_GetSlotInfo(slots[currSlot], &slotInfo); curr_item_list = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewLongObj(slots[currSlot])); flags_list = Tcl_NewObj(); if (chk_rv != CKR_OK) { /* Add an empty string as the token label */ Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("", 0)); /* Add the list of existing flags (none) */ Tcl_ListObjAppendElement(interp, curr_item_list, flags_list); /* Add this item to the list */ Tcl_ListObjAppendElement(interp, ret_list, curr_item_list); continue; } slot_desc = NULL; if ((slotInfo.flags & CKF_TOKEN_PRESENT) == CKF_TOKEN_PRESENT) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("TOKEN_PRESENT", -1)); chk_rv = handle->pkcs11->C_GetTokenInfo(slots[currSlot], &tokenInfo); if (chk_rv == CKR_OK) { /* Add the token label as the slot label */ if (!slot_desc) { slot_desc = Tcl_NewStringObj((const char *) tokenInfo.label, 32); } if ((tokenInfo.flags & CKF_RNG) == CKF_RNG) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("RNG", -1)); } if ((tokenInfo.flags & CKF_WRITE_PROTECTED) == CKF_WRITE_PROTECTED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("WRITE_PROTECTED", -1)); } if ((tokenInfo.flags & CKF_LOGIN_REQUIRED) == CKF_LOGIN_REQUIRED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("LOGIN_REQUIRED", -1)); } if ((tokenInfo.flags & CKF_USER_PIN_INITIALIZED) == CKF_USER_PIN_INITIALIZED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("USER_PIN_INITIALIZED", -1)); } if ((tokenInfo.flags & CKF_RESTORE_KEY_NOT_NEEDED) == CKF_RESTORE_KEY_NOT_NEEDED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("RESTORE_KEY_NOT_NEEDED", -1)); } if ((tokenInfo.flags & CKF_CLOCK_ON_TOKEN) == CKF_CLOCK_ON_TOKEN) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("CLOCK_ON_TOKEN", -1)); } if ((tokenInfo.flags & CKF_PROTECTED_AUTHENTICATION_PATH) == CKF_PROTECTED_AUTHENTICATION_PATH) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("PROTECTED_AUTHENTICATION_PATH", -1)); } if ((tokenInfo.flags & CKF_DUAL_CRYPTO_OPERATIONS) == CKF_DUAL_CRYPTO_OPERATIONS) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("DUAL_CRYPTO_OPERATIONS", -1)); } if ((tokenInfo.flags & CKF_TOKEN_INITIALIZED) == CKF_TOKEN_INITIALIZED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("TOKEN_INITIALIZED", -1)); } if ((tokenInfo.flags & CKF_SECONDARY_AUTHENTICATION) == CKF_SECONDARY_AUTHENTICATION) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("SECONDARY_AUTHENTICATION", -1)); } if ((tokenInfo.flags & CKF_USER_PIN_COUNT_LOW) == CKF_USER_PIN_COUNT_LOW) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("USER_PIN_COUNT_LOW", -1)); } if ((tokenInfo.flags & CKF_USER_PIN_FINAL_TRY) == CKF_USER_PIN_FINAL_TRY) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("USER_PIN_FINAL_TRY", -1)); } if ((tokenInfo.flags & CKF_USER_PIN_LOCKED) == CKF_USER_PIN_LOCKED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("USER_PIN_LOCKED", -1)); } if ((tokenInfo.flags & CKF_USER_PIN_TO_BE_CHANGED) == CKF_USER_PIN_TO_BE_CHANGED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("USER_PIN_TO_BE_CHANGED", -1)); } if ((tokenInfo.flags & CKF_SO_PIN_COUNT_LOW) == CKF_SO_PIN_COUNT_LOW) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("SO_PIN_COUNT_LOW", -1)); } if ((tokenInfo.flags & CKF_SO_PIN_FINAL_TRY) == CKF_SO_PIN_FINAL_TRY) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("SO_PIN_FINAL_TRY", -1)); } if ((tokenInfo.flags & CKF_SO_PIN_LOCKED) == CKF_SO_PIN_LOCKED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("SO_PIN_LOCKED", -1)); } if ((tokenInfo.flags & CKF_SO_PIN_TO_BE_CHANGED) == CKF_SO_PIN_TO_BE_CHANGED) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("SO_PIN_TO_BE_CHANGED", -1)); } } } /* Add additional slot flags */ if ((slotInfo.flags & CKF_REMOVABLE_DEVICE) == CKF_REMOVABLE_DEVICE) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("REMOVABLE_DEVICE", -1)); } if ((slotInfo.flags & CKF_HW_SLOT) == CKF_HW_SLOT) { Tcl_ListObjAppendElement(interp, flags_list, Tcl_NewStringObj("HW_SLOT", -1)); } if (slot_desc) { /* If we found a more descriptive slot description, use it */ Tcl_ListObjAppendElement(interp, curr_item_list, slot_desc); } else { /* Add the slot description as the label for tokens with nothing in them */ Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj((const char *) slotInfo.slotDescription, 32)); } Tcl_ListObjAppendElement(interp, curr_item_list, flags_list); Tcl_ListObjAppendElement(interp, ret_list, curr_item_list); } Tcl_SetObjResult(interp, ret_list); return(TCL_OK); } MODULE_SCOPE int tclpkcs11_list_certs(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *tcl_handle, *tcl_slotid; long slotid_long; Tcl_Obj *obj_label, *obj_cert, *obj_id; Tcl_Obj *ret_list, *curr_item_list; Tcl_Obj *parse_cert_cmd; int tcl_rv; CK_SLOT_ID slotid; CK_OBJECT_HANDLE hObject; CK_ULONG ulObjectCount; CK_ATTRIBUTE template[] = { {CKA_CLASS, NULL, 0}, {CKA_LABEL, NULL, 0}, {CKA_ID, NULL, 0}, {CKA_VALUE, NULL, 0} }, *curr_attr; CK_ULONG curr_attr_idx; CK_OBJECT_CLASS objectclass, *objectclass_p; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata", -1)); return(TCL_ERROR); } if (objc != 3) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::listcerts handle slot\"", -1)); return(TCL_ERROR); } tcl_handle = objv[1]; tcl_slotid = objv[2]; interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle_entry = Tcl_FindHashEntry(&interpdata->handles, (const char *) tcl_handle); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } tcl_rv = Tcl_GetLongFromObj(interp, tcl_slotid, &slotid_long); if (tcl_rv != TCL_OK) { return(tcl_rv); } slotid = slotid_long; chk_rv = tclpkcs11_start_session(handle, slotid); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } chk_rv = handle->pkcs11->C_FindObjectsInit(handle->session, NULL, 0); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } ret_list = Tcl_NewObj(); while (1) { chk_rv = handle->pkcs11->C_FindObjects(handle->session, &hObject, 1, &ulObjectCount); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); handle->pkcs11->C_FindObjectsFinal(handle->session); return(TCL_ERROR); } if (ulObjectCount == 0) { break; } if (ulObjectCount != 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("FindObjects() returned a weird number of objects.", -1)); handle->pkcs11->C_FindObjectsFinal(handle->session); return(TCL_ERROR); } for (curr_attr_idx = 0; curr_attr_idx < (sizeof(template) / sizeof(template[0])); curr_attr_idx++) { curr_attr = &template[curr_attr_idx]; if (curr_attr->pValue) { ckfree(curr_attr->pValue); } curr_attr->pValue = NULL; curr_attr->ulValueLen = 0; } /* Determine size of values to allocate */ chk_rv = handle->pkcs11->C_GetAttributeValue(handle->session, hObject, template, sizeof(template) / sizeof(template[0])); if (chk_rv == CKR_ATTRIBUTE_TYPE_INVALID || chk_rv == CKR_ATTRIBUTE_SENSITIVE || chk_rv == CKR_BUFFER_TOO_SMALL) { chk_rv = CKR_OK; } if (chk_rv != CKR_OK) { /* Skip this object if we are not able to process it */ continue; } /* Allocate values */ for (curr_attr_idx = 0; curr_attr_idx < (sizeof(template) / sizeof(template[0])); curr_attr_idx++) { curr_attr = &template[curr_attr_idx]; if (((CK_LONG) curr_attr->ulValueLen) != ((CK_LONG) -1)) { curr_attr->pValue = (void *) ckalloc(curr_attr->ulValueLen); } } /* Populate template values */ chk_rv = handle->pkcs11->C_GetAttributeValue(handle->session, hObject, template, sizeof(template) / sizeof(template[0])); if (chk_rv != CKR_OK && chk_rv != CKR_ATTRIBUTE_SENSITIVE && chk_rv != CKR_ATTRIBUTE_TYPE_INVALID && chk_rv != CKR_BUFFER_TOO_SMALL) { /* Return an error if we are unable to process this entry due to unexpected errors */ for (curr_attr_idx = 0; curr_attr_idx < (sizeof(template) / sizeof(template[0])); curr_attr_idx++) { curr_attr = &template[curr_attr_idx]; if (curr_attr->pValue) { ckfree(curr_attr->pValue); } } Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); handle->pkcs11->C_FindObjectsFinal(handle->session); return(TCL_ERROR); } /* Extract certificate data */ obj_label = NULL; obj_id = NULL; obj_cert = NULL; objectclass_p = NULL; for (curr_attr_idx = 0; curr_attr_idx < (sizeof(template) / sizeof(template[0])); curr_attr_idx++) { curr_attr = &template[curr_attr_idx]; if (!curr_attr->pValue) { continue; } if (curr_attr->type != CKA_CLASS && !objectclass_p) { ckfree(curr_attr->pValue); curr_attr->pValue = NULL; continue; } switch (curr_attr->type) { case CKA_CLASS: objectclass_p = (CK_OBJECT_CLASS *) curr_attr->pValue; objectclass = *objectclass_p; break; case CKA_LABEL: obj_label = Tcl_NewStringObj(curr_attr->pValue, curr_attr->ulValueLen); break; case CKA_ID: /* Convert the ID into a readable string */ obj_id = tclpkcs11_bytearray_to_string(curr_attr->pValue, curr_attr->ulValueLen); break; case CKA_VALUE: obj_cert = Tcl_NewByteArrayObj(curr_attr->pValue, curr_attr->ulValueLen); break; } ckfree(curr_attr->pValue); curr_attr->pValue = NULL; } /* Add this certificate data to return list, if all found */ if (obj_label == NULL || obj_id == NULL || obj_cert == NULL) { continue; } if (objectclass != CKO_CERTIFICATE) { continue; } /* Create the current item list */ curr_item_list = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11_handle", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, tcl_handle); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11_slotid", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, tcl_slotid); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11_id", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, obj_id); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11_label", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, obj_label); /* Call "::pki::x509::parse_cert" to parse the cert */ parse_cert_cmd = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, parse_cert_cmd, Tcl_NewStringObj("::pki::x509::parse_cert", -1)); Tcl_ListObjAppendElement(interp, parse_cert_cmd, obj_cert); tcl_rv = Tcl_EvalObjEx(interp, parse_cert_cmd, 0); if (tcl_rv != TCL_OK) { continue; } /* Add results of [parse_cert] to our return value */ Tcl_ListObjAppendList(interp, curr_item_list, Tcl_GetObjResult(interp)); /* * Override the "type" so that [array set] returns our new * type, but we can still parse through the list and figure * out the real subordinate type */ Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("type", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11", -1)); /* Add the current item to the return value list */ Tcl_ListObjAppendElement(interp, ret_list, curr_item_list); } /* Terminate search */ handle->pkcs11->C_FindObjectsFinal(handle->session); /* Return */ Tcl_SetObjResult(interp, ret_list); return(TCL_OK); } /* XXX:TODO: Merge this with list_certs */ MODULE_SCOPE int tclpkcs11_list_keys(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *tcl_handle, *tcl_slotid; long slotid_long; Tcl_Obj *obj_label, *obj_id, *obj_exponent, *obj_modulus; Tcl_Obj *ret_list, *curr_item_list; int tcl_rv; CK_SLOT_ID slotid; CK_OBJECT_HANDLE hObject; CK_ULONG ulObjectCount; CK_ATTRIBUTE template[] = { {CKA_CLASS, NULL, 0}, {CKA_LABEL, NULL, 0}, {CKA_ID, NULL, 0}, {CKA_KEY_TYPE, NULL, 0}, {CKA_PUBLIC_EXPONENT, NULL, 0}, {CKA_MODULUS, NULL, 0} }; CK_ATTRIBUTE *curr_attr; CK_ULONG curr_attr_idx; CK_OBJECT_CLASS objectclass, *objectclass_p; CK_KEY_TYPE keytype; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata", -1)); return(TCL_ERROR); } if (objc != 3) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::listkeys handle slot\"", -1)); return(TCL_ERROR); } tcl_handle = objv[1]; tcl_slotid = objv[2]; interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle_entry = Tcl_FindHashEntry(&interpdata->handles, (const char *) tcl_handle); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } tcl_rv = Tcl_GetLongFromObj(interp, tcl_slotid, &slotid_long); if (tcl_rv != TCL_OK) { return(tcl_rv); } slotid = slotid_long; chk_rv = tclpkcs11_start_session(handle, slotid); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } chk_rv = handle->pkcs11->C_FindObjectsInit(handle->session, NULL, 0); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } ret_list = Tcl_NewObj(); while (1) { chk_rv = handle->pkcs11->C_FindObjects(handle->session, &hObject, 1, &ulObjectCount); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); handle->pkcs11->C_FindObjectsFinal(handle->session); return(TCL_ERROR); } if (ulObjectCount == 0) { break; } if (ulObjectCount != 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("FindObjects() returned a weird number of objects.", -1)); handle->pkcs11->C_FindObjectsFinal(handle->session); return(TCL_ERROR); } for (curr_attr_idx = 0; curr_attr_idx < (sizeof(template) / sizeof(template[0])); curr_attr_idx++) { curr_attr = &template[curr_attr_idx]; if (curr_attr->pValue) { ckfree(curr_attr->pValue); } curr_attr->pValue = NULL; curr_attr->ulValueLen = 0; } /* Determine size of values to allocate */ chk_rv = handle->pkcs11->C_GetAttributeValue(handle->session, hObject, template, sizeof(template) / sizeof(template[0])); if (chk_rv == CKR_ATTRIBUTE_TYPE_INVALID || chk_rv == CKR_ATTRIBUTE_SENSITIVE || chk_rv == CKR_BUFFER_TOO_SMALL) { chk_rv = CKR_OK; } if (chk_rv != CKR_OK) { /* Skip this object if we are not able to process it */ continue; } /* Allocate values */ for (curr_attr_idx = 0; curr_attr_idx < (sizeof(template) / sizeof(template[0])); curr_attr_idx++) { curr_attr = &template[curr_attr_idx]; if (((CK_LONG) curr_attr->ulValueLen) != ((CK_LONG) -1)) { curr_attr->pValue = (void *) ckalloc(curr_attr->ulValueLen); } } /* Populate template values */ chk_rv = handle->pkcs11->C_GetAttributeValue(handle->session, hObject, template, sizeof(template) / sizeof(template[0])); if (chk_rv != CKR_OK && chk_rv != CKR_ATTRIBUTE_SENSITIVE && chk_rv != CKR_ATTRIBUTE_TYPE_INVALID && chk_rv != CKR_BUFFER_TOO_SMALL) { /* Return an error if we are unable to process this entry due to unexpected errors */ for (curr_attr_idx = 0; curr_attr_idx < (sizeof(template) / sizeof(template[0])); curr_attr_idx++) { curr_attr = &template[curr_attr_idx]; if (curr_attr->pValue) { ckfree(curr_attr->pValue); } } Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); handle->pkcs11->C_FindObjectsFinal(handle->session); return(TCL_ERROR); } /* Extract key data */ obj_label = NULL; obj_id = NULL; objectclass_p = NULL; obj_exponent = NULL; obj_modulus = NULL; keytype = -1; for (curr_attr_idx = 0; curr_attr_idx < (sizeof(template) / sizeof(template[0])); curr_attr_idx++) { curr_attr = &template[curr_attr_idx]; if (!curr_attr->pValue) { continue; } if (curr_attr->type != CKA_CLASS && !objectclass) { ckfree(curr_attr->pValue); curr_attr->pValue = NULL; continue; } switch (curr_attr->type) { case CKA_CLASS: objectclass_p = (CK_OBJECT_CLASS *) curr_attr->pValue; objectclass = *objectclass_p; break; case CKA_LABEL: obj_label = Tcl_NewStringObj(curr_attr->pValue, curr_attr->ulValueLen); break; case CKA_ID: /* Convert the ID into a readable string */ obj_id = tclpkcs11_bytearray_to_string(curr_attr->pValue, curr_attr->ulValueLen); break; case CKA_KEY_TYPE: /* Convert the ID into a readable string */ keytype = *((CK_KEY_TYPE *) curr_attr->pValue); break; case CKA_MODULUS: obj_modulus = Tcl_NewByteArrayObj(curr_attr->pValue, curr_attr->ulValueLen); break; case CKA_PUBLIC_EXPONENT: obj_exponent = Tcl_NewByteArrayObj(curr_attr->pValue, curr_attr->ulValueLen); break; } ckfree(curr_attr->pValue); curr_attr->pValue = NULL; } /* Add this certificate data to return list, if all found */ if (obj_label == NULL || obj_id == NULL || obj_exponent == NULL || obj_modulus == NULL || keytype == -1) { continue; } if (objectclass != CKO_PUBLIC_KEY) { continue; } if (keytype != CKK_RSA) { continue; } /* Create the current item list */ curr_item_list = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11_handle", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, tcl_handle); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11_slotid", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, tcl_slotid); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11_id", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, obj_id); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11_label", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, obj_label); /* Add the RSA key to the list */ Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("n", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_ObjPrintf("0x%s", Tcl_GetString(tclpkcs11_bytearray_to_string_from_obj(obj_modulus)))); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("e", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_ObjPrintf("0x%s", Tcl_GetString(tclpkcs11_bytearray_to_string_from_obj(obj_exponent)))); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("l", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_ObjPrintf("%i", Tcl_GetCharLength(obj_modulus) * 8)); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("type", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("rsa", -1)); /* * Override the "type" so that [array set] returns our new * type, but we can still parse through the list and figure * out the real subordinate type */ Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("type", -1)); Tcl_ListObjAppendElement(interp, curr_item_list, Tcl_NewStringObj("pkcs11", -1)); /* Add the current item to the return value list */ Tcl_ListObjAppendElement(interp, ret_list, curr_item_list); } /* Terminate search */ handle->pkcs11->C_FindObjectsFinal(handle->session); /* Return */ Tcl_SetObjResult(interp, ret_list); return(TCL_OK); } MODULE_SCOPE int tclpkcs11_login(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *tcl_handle, *tcl_slotid, *tcl_password; long slotid_long; char *password; int password_len; int tcl_rv; CK_SLOT_ID slotid; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata", -1)); return(TCL_ERROR); } if (objc != 4) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::login handle slot password\"", -1)); return(TCL_ERROR); } tcl_handle = objv[1]; tcl_slotid = objv[2]; tcl_password = objv[3]; interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle_entry = Tcl_FindHashEntry(&interpdata->handles, (const char *) tcl_handle); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } tcl_rv = Tcl_GetLongFromObj(interp, tcl_slotid, &slotid_long); if (tcl_rv != TCL_OK) { return(tcl_rv); } slotid = slotid_long; chk_rv = tclpkcs11_start_session(handle, slotid); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } password = Tcl_GetStringFromObj(tcl_password, &password_len); chk_rv = handle->pkcs11->C_Login(handle->session, CKU_USER, (CK_UTF8CHAR_PTR) password, password_len); switch (chk_rv) { case CKR_OK: case CKR_USER_ALREADY_LOGGED_IN: Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); break; case CKR_PIN_INCORRECT: Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); break; default: Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } return(TCL_OK); } MODULE_SCOPE int tclpkcs11_logout(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *tcl_handle, *tcl_slotid; long slotid_long; int tcl_rv; CK_SLOT_ID slotid; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata", -1)); return(TCL_ERROR); } if (objc != 3) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::login handle slot\"", -1)); return(TCL_ERROR); } tcl_handle = objv[1]; tcl_slotid = objv[2]; interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle_entry = Tcl_FindHashEntry(&interpdata->handles, (const char *) tcl_handle); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } tcl_rv = Tcl_GetLongFromObj(interp, tcl_slotid, &slotid_long); if (tcl_rv != TCL_OK) { return(tcl_rv); } slotid = slotid_long; chk_rv = tclpkcs11_start_session(handle, slotid); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } chk_rv = handle->pkcs11->C_Logout(handle->session); if (chk_rv != CKR_OK) { if (chk_rv == CKR_DEVICE_REMOVED) { handle->session_active = 0; handle->pkcs11->C_CloseSession(handle->session); } else { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); return(TCL_OK); } MODULE_SCOPE int tclpkcs11_perform_pki(int encrypt, ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; unsigned char *input, resultbuf[1024], *dummybuf; unsigned long tcl_strtobytearray_rv; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *pki_real_cmd; Tcl_Obj *tcl_keylist, **tcl_keylist_values, *tcl_keylist_key, *tcl_keylist_val; Tcl_Obj *tcl_mode, *tcl_input; Tcl_Obj *tcl_handle = NULL, *tcl_slotid = NULL, *tcl_objid = NULL; Tcl_Obj *tcl_result; long slotid_long; int tcl_keylist_llength, idx; int input_len; CK_ULONG resultbuf_len, dummybuf_len; int sign, terminate; int tcl_rv; CK_SLOT_ID slotid; CK_OBJECT_HANDLE hObject; CK_ULONG foundObjs; CK_OBJECT_CLASS objectclass_pk; CK_ATTRIBUTE template[] = { {CKA_ID, NULL, 0}, {CKA_CLASS, NULL, 0}, }; CK_MECHANISM mechanism = {CKM_RSA_PKCS, NULL, 0}; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata", -1)); return(TCL_ERROR); } if (objc != 4) { if (encrypt) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::encrypt mode input keylist\"", -1)); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::decrypt mode input keylist\"", -1)); } return(TCL_ERROR); } tcl_mode = objv[1]; tcl_input = objv[2]; tcl_keylist = objv[3]; /* * Parse the "keylist" argument and remove the extraneous "type * pkcs11" entry so we can pass it to around as needed * * Also, while we are here, pick out the elements we can */ /* Duplicate the object so we can modify it */ if (Tcl_IsShared(tcl_keylist)) { tcl_keylist = Tcl_DuplicateObj(tcl_keylist); } tcl_rv = Tcl_ListObjGetElements(interp, tcl_keylist, &tcl_keylist_llength, &tcl_keylist_values); if (tcl_rv != TCL_OK) { return(tcl_rv); } if ((tcl_keylist_llength % 2) != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list must have an even number of elements", -1)); return(TCL_ERROR); } for (idx = 0; idx < tcl_keylist_llength; idx += 2) { tcl_keylist_key = tcl_keylist_values[idx]; tcl_keylist_val = tcl_keylist_values[idx + 1]; if (strcmp(Tcl_GetString(tcl_keylist_key), "type") == 0) { if (strcmp(Tcl_GetString(tcl_keylist_val), "pkcs11") == 0) { /* Remove "type pkcs11" from list */ tcl_rv = Tcl_ListObjReplace(interp, tcl_keylist, idx, 2, 0, NULL); } continue; } if (strcmp(Tcl_GetString(tcl_keylist_key), "pkcs11_handle") == 0) { tcl_handle = tcl_keylist_val; continue; } if (strcmp(Tcl_GetString(tcl_keylist_key), "pkcs11_slotid") == 0) { tcl_slotid = tcl_keylist_val; continue; } if (strcmp(Tcl_GetString(tcl_keylist_key), "pkcs11_id") == 0) { tcl_objid = tcl_keylist_val; continue; } } if (strcmp(Tcl_GetString(tcl_mode), "pub") == 0) { /* Public Key Operations can be performed by the Tcl PKI Module */ pki_real_cmd = Tcl_NewObj(); if (encrypt) { Tcl_ListObjAppendElement(interp, pki_real_cmd, Tcl_NewStringObj("::pki::encrypt", -1)); Tcl_ListObjAppendElement(interp, pki_real_cmd, Tcl_NewStringObj("-nopad", -1)); } else { Tcl_ListObjAppendElement(interp, pki_real_cmd, Tcl_NewStringObj("::pki::decrypt", -1)); Tcl_ListObjAppendElement(interp, pki_real_cmd, Tcl_NewStringObj("-nounpad", -1)); } Tcl_ListObjAppendElement(interp, pki_real_cmd, Tcl_NewStringObj("-pub", -1)); Tcl_ListObjAppendElement(interp, pki_real_cmd, Tcl_NewStringObj("-binary", -1)); Tcl_ListObjAppendElement(interp, pki_real_cmd, Tcl_NewStringObj("--", -1)); Tcl_ListObjAppendElement(interp, pki_real_cmd, tcl_input); Tcl_ListObjAppendElement(interp, pki_real_cmd, tcl_keylist); return(Tcl_EvalObjEx(interp, pki_real_cmd, 0)); } if (!tcl_handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("could not find element named \"pkcs11_handle\" in keylist", -1)); return(TCL_ERROR); } if (!tcl_slotid) { Tcl_SetObjResult(interp, Tcl_NewStringObj("could not find element named \"pkcs11_slotid\" in keylist", -1)); return(TCL_ERROR); } if (!tcl_objid) { Tcl_SetObjResult(interp, Tcl_NewStringObj("could not find element named \"pkcs11_id\" in keylist", -1)); return(TCL_ERROR); } interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle_entry = Tcl_FindHashEntry(&interpdata->handles, (const char *) tcl_handle); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } /* * Find the PKCS#11 object ID that cooresponds to this certificate's * private key */ tcl_rv = Tcl_GetLongFromObj(interp, tcl_slotid, &slotid_long); if (tcl_rv != TCL_OK) { return(tcl_rv); } slotid = slotid_long; chk_rv = tclpkcs11_start_session(handle, slotid); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } /* CKA_ID */ template[0].pValue = ckalloc(Tcl_GetCharLength(tcl_objid) / 2); tcl_strtobytearray_rv = tclpkcs11_string_to_bytearray(tcl_objid, template[0].pValue, Tcl_GetCharLength(tcl_objid) / 2); template[0].ulValueLen = tcl_strtobytearray_rv; /* CKA_CLASS */ objectclass_pk = CKO_PRIVATE_KEY; template[1].pValue = &objectclass_pk; template[1].ulValueLen = sizeof(objectclass_pk); chk_rv = handle->pkcs11->C_FindObjectsInit(handle->session, template, sizeof(template) / sizeof(template[0])); if (chk_rv != CKR_OK) { tclpkcs11_close_session(handle); Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } foundObjs = 0; chk_rv = handle->pkcs11->C_FindObjects(handle->session, &hObject, 1, &foundObjs); if (chk_rv != CKR_OK) { handle->pkcs11->C_FindObjectsFinal(handle->session); tclpkcs11_close_session(handle); Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } /* Terminate Search */ handle->pkcs11->C_FindObjectsFinal(handle->session); if (foundObjs < 1) { tclpkcs11_close_session(handle); Tcl_SetObjResult(interp, Tcl_NewStringObj("PKCS11_ERROR MAYBE_LOGIN", -1)); return(TCL_ERROR); } /* Perform the PKI operation (encrypt/decrypt) */ input = Tcl_GetByteArrayFromObj(tcl_input, &input_len); if (encrypt) { sign = 0; chk_rv = handle->pkcs11->C_EncryptInit(handle->session, &mechanism, hObject); if (chk_rv != CKR_OK) { sign = 1; chk_rv = handle->pkcs11->C_SignInit(handle->session, &mechanism, hObject); } if (chk_rv != CKR_OK) { tclpkcs11_close_session(handle); Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } resultbuf_len = sizeof(resultbuf); if (!sign) { chk_rv = handle->pkcs11->C_Encrypt(handle->session, input, input_len, resultbuf, &resultbuf_len); } else { /* Some PKCS#11 drivers will not accept pre-padded input, so we must unpad it here */ if (input_len > 3) { if (input[0] == 0x00 && input[1] == 0x01) { input = input + 2; input_len -= 2; while (*input == 0xff && input_len > 0) { input++; input_len--; } if (input_len) { if (input[0] == 0x00) { input++; input_len--; } } } } chk_rv = handle->pkcs11->C_Sign(handle->session, input, input_len, resultbuf, &resultbuf_len); } terminate = 1; if (chk_rv == CKR_OK || chk_rv == CKR_BUFFER_TOO_SMALL) { terminate = 0; } if (terminate) { dummybuf = (unsigned char *) ""; dummybuf_len = 0; if (!sign) { handle->pkcs11->C_EncryptFinal(handle->session, dummybuf, &dummybuf_len); } else { handle->pkcs11->C_SignFinal(handle->session, dummybuf, &dummybuf_len); } } if (chk_rv != CKR_OK) { tclpkcs11_close_session(handle); Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } } else { chk_rv = handle->pkcs11->C_DecryptInit(handle->session, &mechanism, hObject); if (chk_rv != CKR_OK) { tclpkcs11_close_session(handle); Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } resultbuf_len = sizeof(resultbuf); chk_rv = handle->pkcs11->C_Decrypt(handle->session, input, input_len, resultbuf, &resultbuf_len); if (chk_rv != CKR_OK) { tclpkcs11_close_session(handle); if (chk_rv == CKR_BUFFER_TOO_SMALL) { /* Terminate decryption operation */ handle->pkcs11->C_DecryptFinal(handle->session, NULL, 0); } Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } } tclpkcs11_close_session(handle); tcl_result = Tcl_NewByteArrayObj(resultbuf, resultbuf_len); Tcl_SetObjResult(interp, tcl_result); return(TCL_OK); } MODULE_SCOPE int tclpkcs11_encrypt(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { return(tclpkcs11_perform_pki(1, cd, interp, objc, objv)); } MODULE_SCOPE int tclpkcs11_decrypt(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { return(tclpkcs11_perform_pki(0, cd, interp, objc, objv)); } MODULE_SCOPE int tclpkcs11_setpin(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; Tcl_HashEntry *tcl_handle_entry; Tcl_Obj *tcl_handle, *tcl_slotid, *tcl_oldpassword, *tcl_newpassword; long slotid_long; char *oldpassword, *newpassword; int oldpassword_len, newpassword_len; int tcl_rv; CK_SLOT_ID slotid; CK_RV chk_rv; if (!cd) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid clientdata", -1)); return(TCL_ERROR); } if (objc != 5) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"pki::pkcs11::setpin handle slot oldpassword newpassword\"", -1)); return(TCL_ERROR); } tcl_handle = objv[1]; tcl_slotid = objv[2]; tcl_oldpassword = objv[3]; tcl_newpassword = objv[4]; interpdata = (struct tclpkcs11_interpdata *) cd; tcl_handle_entry = Tcl_FindHashEntry(&interpdata->handles, (const char *) tcl_handle); if (!tcl_handle_entry) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (!handle) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid handle", -1)); return(TCL_ERROR); } tcl_rv = Tcl_GetLongFromObj(interp, tcl_slotid, &slotid_long); if (tcl_rv != TCL_OK) { return(tcl_rv); } slotid = slotid_long; chk_rv = tclpkcs11_start_session(handle, slotid); if (chk_rv != CKR_OK) { Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } oldpassword = Tcl_GetStringFromObj(tcl_oldpassword, &oldpassword_len); newpassword = Tcl_GetStringFromObj(tcl_newpassword, &newpassword_len); chk_rv = handle->pkcs11->C_SetPIN(handle->session, (CK_UTF8CHAR_PTR) oldpassword, oldpassword_len, (CK_UTF8CHAR_PTR) newpassword, newpassword_len); switch (chk_rv) { case CKR_OK: case CKR_USER_ALREADY_LOGGED_IN: Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); break; case CKR_PIN_INCORRECT: Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); break; default: Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv)); return(TCL_ERROR); } return(TCL_OK); } MODULE_SCOPE void tclpkcs11_unloadall(ClientData cd) { struct tclpkcs11_interpdata *interpdata; struct tclpkcs11_handle *handle; Tcl_HashEntry *tcl_handle_entry; Tcl_HashSearch search; if (!cd) { return; } interpdata = (struct tclpkcs11_interpdata *) cd; for ( tcl_handle_entry = Tcl_FirstHashEntry(&interpdata->handles, &search); tcl_handle_entry; tcl_handle_entry = Tcl_NextHashEntry(&search) ) { handle = (struct tclpkcs11_handle *) Tcl_GetHashValue(tcl_handle_entry); if (handle->pkcs11 && handle->pkcs11->C_Finalize) { handle->pkcs11->C_Finalize(NULL); } tclpkcs11_int_unload_module(handle->base); ckfree((char *) handle); } return; } /* * Tcl Loadable Module Initialization */ int Tclpkcs11_Init(Tcl_Interp *interp) { struct tclpkcs11_interpdata *interpdata; Tcl_Command tclCreatComm_ret; const char *tclPkgReq_ret; int tclPkgProv_ret; #ifdef USE_TCL_STUBS const char *tclInitStubs_ret; /* Initialize Stubs */ tclInitStubs_ret = Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0); if (!tclInitStubs_ret) { return(TCL_ERROR); } #endif tclPkgReq_ret = Tcl_PkgRequire(interp, "pki", "0.1", 0); if (!tclPkgReq_ret) { return(TCL_ERROR); } interpdata = (struct tclpkcs11_interpdata *) ckalloc(sizeof(*interpdata)); /* Initialize InterpData structure */ Tcl_InitObjHashTable(&interpdata->handles); interpdata->handles_idx = 0; tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::loadmodule", tclpkcs11_load_module, interpdata, NULL); if (!tclCreatComm_ret) { ckfree((char *) interpdata); return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::unloadmodule", tclpkcs11_unload_module, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::listslots", tclpkcs11_list_slots, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::listcerts", tclpkcs11_list_certs, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::listkeys", tclpkcs11_list_keys, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::login", tclpkcs11_login, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::logout", tclpkcs11_logout, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::encrypt", tclpkcs11_encrypt, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::decrypt", tclpkcs11_decrypt, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } tclCreatComm_ret = Tcl_CreateObjCommand(interp, "pki::pkcs11::setpin", tclpkcs11_setpin, interpdata, NULL); if (!tclCreatComm_ret) { return(TCL_ERROR); } /* Create an exit handler to unload and close all PKCS#11 modules */ Tcl_CreateExitHandler(tclpkcs11_unloadall, interpdata); /* Register PKI handlers */ Tcl_ObjSetVar2(interp, Tcl_NewStringObj("pki::handlers", -1), Tcl_NewStringObj("pkcs11", -1), Tcl_NewStringObj("::pki::pkcs11::encrypt ::pki::pkcs11::decrypt", -1), TCL_GLOBAL_ONLY ); tclPkgProv_ret = Tcl_PkgProvide(interp, "pki::pkcs11", PACKAGE_VERSION); if (tclPkgProv_ret != TCL_OK) { return(tclPkgProv_ret); } return(TCL_OK); }