TclPKCS11

Check-in [85de7abf4c]
Login

Check-in [85de7abf4c]

Overview
Comment:Updated to close session if we get a CKR_DEVICE_REMOVED on logout Win32-specific PKCS#11 definitions created Updated to retrieve function pointers using lookups rather than C_GetFunctionList on Win32 since ActivClient doesn't seem to return valid function pointers... Updated to return fake PKCS#11 error "MAYBE_LOGIN" if we are unable to find any private key objects Updated to try C_Encrypt for encryption before trying C_Sign. Updated to unpad (PKCS 1.5 mode 1 only) input when encrypting since some drivers require the input to be unpadded Minor cleanup Updated test driver to support logging in if MAYBE_LOGIN is recieved
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 85de7abf4cafb22d6b422a64781d870216138be99686414529f2ad8c73fd7607
User & Date: rkeene on 2010-10-11 04:59:30
Other Links: manifest | tags
Context
2010-10-11
13:41
Updated to use pragma pack on Win32 fixing issues experienced with C_GetFunctionList returning unusable data Updated to unload all active PKCS#11 modules on exit check-in: fcc22c8809 user: rkeene tags: trunk
04:59
Updated to close session if we get a CKR_DEVICE_REMOVED on logout Win32-specific PKCS#11 definitions created Updated to retrieve function pointers using lookups rather than C_GetFunctionList on Win32 since ActivClient doesn't seem to return valid function pointers... Updated to return fake PKCS#11 error "MAYBE_LOGIN" if we are unable to find any private key objects Updated to try C_Encrypt for encryption before trying C_Sign. Updated to unpad (PKCS 1.5 mode 1 only) input when encrypting since some drivers require the input to be unpadded Minor cleanup Updated test driver to support logging in if MAYBE_LOGIN is recieved check-in: 85de7abf4c user: rkeene tags: trunk
00:59
Updated to include path in loading Tclpkcs11 shared object to avoid searching in test driver check-in: 74cea1e174 user: rkeene tags: trunk
Changes

Modified tclpkcs11.c from [93a4e33898] to [f5446da071].

22
23
24
25
26
27
28

29
30
31
32

33







34
35
36
37
38
39
40
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48







+



-
+

+
+
+
+
+
+
+







#include <tcl.h>

#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 86
#  define TCL_INCLUDES_LOADFILE 1
#endif

/* PKCS#11 Definitions for the local platform */
#ifndef _WIN32
#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) CK_DECLARE_FUNCTION_POINTER(rv, func)
#define CK_CALLBACK_FUNCTION(rv, func) rv (CK_PTR func)
#define CK_NULL_PTR ((void *) 0)
#else
#define CK_PTR *
#define CK_DECLARE_FUNCTION(rv, func) rv __declspec(dllimport) func
#define CK_DECLARE_FUNCTION_POINTER(rv, func) rv __declspec(dllimport) (CK_PTR func)
#define CK_CALLBACK_FUNCTION(rv, func) rv (CK_PTR func)
#define CK_NULL_PTR ((void *) 0)
#endif
#include "pkcs11.h"

struct tclpkcs11_interpdata {
	/* Handle Hash Table */
	Tcl_HashTable handles;
	unsigned long handles_idx;
};
238
239
240
241
242
243
244
245

246
247
248
249
250
251
252
253

254
255
256
257
258
259
260
246
247
248
249
250
251
252

253
254
255
256
257
258
259
260

261
262
263
264
265
266
267
268







-
+







-
+







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(retval);
		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_NewByteArrayObj(buf, bufidx);
	retval = Tcl_NewByteArrayObj((unsigned char *) buf, bufidx);

	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];
478
479
480
481
482
483
484
485
486


487
488
489
490
491
492
493
486
487
488
489
490
491
492


493
494
495
496
497
498
499
500
501







-
-
+
+







	const char *pathname;
	Tcl_HashEntry *tcl_handle_entry;
	Tcl_Obj *tcl_handle;
	void *handle;
	int is_new_entry;

	CK_C_INITIALIZE_ARGS initargs;
	CK_RV (*getFuncList)(CK_FUNCTION_LIST_PTR_PTR ppFunctionList);
	CK_FUNCTION_LIST_PTR pkcs11_function_list;
	CK_RV (CK_PTR getFuncList)(CK_FUNCTION_LIST_PTR_PTR ppFunctionList);
	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);
	}
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540




















































































































































541
542
543
544
545
546
547
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704







+



















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	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));

		return(TCL_ERROR);
	}

#ifndef _WIN32
	chk_rv = getFuncList(&pkcs11_function_list);
	if (chk_rv != CKR_OK) {
		Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv));

		return(TCL_ERROR);
	}

	if (!pkcs11_function_list) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned invalid data", -1));

		return(TCL_ERROR);
	}

	if (!pkcs11_function_list->C_Initialize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data", -1));

		return(TCL_ERROR);
	}

#else
	/*
	 * Retreiving the functions from C_GetFunctionList does not seem to be
	 *reliable on Win32
	 */
	pkcs11_function_list = (CK_FUNCTION_LIST_PTR) ckalloc(sizeof(*pkcs11_function_list));

	pkcs11_function_list->C_CloseSession = tclpkcs11_int_lookup_sym(handle, "C_CloseSession");
	if (pkcs11_function_list->C_CloseSession == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_CloseSession)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_Decrypt = tclpkcs11_int_lookup_sym(handle, "C_Decrypt");
	if (pkcs11_function_list->C_Decrypt == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_Decrypt)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_DecryptFinal = tclpkcs11_int_lookup_sym(handle, "C_DecryptFinal");
	if (pkcs11_function_list->C_DecryptFinal == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_DecryptFinal)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_DecryptInit = tclpkcs11_int_lookup_sym(handle, "C_DecryptInit");
	if (pkcs11_function_list->C_DecryptInit == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_DecryptInit)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_Encrypt = tclpkcs11_int_lookup_sym(handle, "C_Encrypt");
	if (pkcs11_function_list->C_Encrypt == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_Encrypt)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_EncryptInit = tclpkcs11_int_lookup_sym(handle, "C_EncryptInit");
	if (pkcs11_function_list->C_EncryptInit == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_EncryptInit)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_Finalize = tclpkcs11_int_lookup_sym(handle, "C_Finalize");
	if (pkcs11_function_list->C_Finalize == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_Finalize)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_FindObjects = tclpkcs11_int_lookup_sym(handle, "C_FindObjects");
	if (pkcs11_function_list->C_FindObjects == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_FindObjects)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_FindObjectsFinal = tclpkcs11_int_lookup_sym(handle, "C_FindObjectsFinal");
	if (pkcs11_function_list->C_FindObjectsFinal == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_FindObjectsFinal)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_FindObjectsInit = tclpkcs11_int_lookup_sym(handle, "C_FindObjectsInit");
	if (pkcs11_function_list->C_FindObjectsInit == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_FindObjectsInit)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_GetAttributeValue = tclpkcs11_int_lookup_sym(handle, "C_GetAttributeValue");
	if (pkcs11_function_list->C_GetAttributeValue == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_GetAttributeValue)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_GetSlotInfo = tclpkcs11_int_lookup_sym(handle, "C_GetSlotInfo");
	if (pkcs11_function_list->C_GetSlotInfo == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_GetSlotInfo)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_GetSlotList = tclpkcs11_int_lookup_sym(handle, "C_GetSlotList");
	if (pkcs11_function_list->C_GetSlotList == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_GetSlotList)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_GetTokenInfo = tclpkcs11_int_lookup_sym(handle, "C_GetTokenInfo");
	if (pkcs11_function_list->C_GetTokenInfo == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_GetTokenInfo)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_Initialize = tclpkcs11_int_lookup_sym(handle, "C_Initialize");
	if (pkcs11_function_list->C_Initialize == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_Initialize)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_Login = tclpkcs11_int_lookup_sym(handle, "C_Login");
	if (pkcs11_function_list->C_Login == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_Login)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_Logout = tclpkcs11_int_lookup_sym(handle, "C_Logout");
	if (pkcs11_function_list->C_Logout == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_Logout)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_OpenSession = tclpkcs11_int_lookup_sym(handle, "C_OpenSession");
	if (pkcs11_function_list->C_OpenSession == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_OpenSession)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_Sign = tclpkcs11_int_lookup_sym(handle, "C_Sign");
	if (pkcs11_function_list->C_Sign == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_Sign)", -1));

		return(TCL_ERROR);
	}

	pkcs11_function_list->C_SignInit = tclpkcs11_int_lookup_sym(handle, "C_SignInit");
	if (pkcs11_function_list->C_SignInit == NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("C_GetFunctionList returned incomplete data (missing C_SignInit)", -1));

		return(TCL_ERROR);
	}
#endif

	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;
928
929
930
931
932
933
934

935
936
937
938
939
940
941
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099







+







		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;
		}
1203
1204
1205
1206
1207
1208
1209





1210

1211
1212


1213
1214
1215
1216
1217
1218
1219
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372

1373
1374

1375
1376
1377
1378
1379
1380
1381
1382
1383







+
+
+
+
+
-
+

-
+
+







		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->pkcs11->C_CloseSession(handle->session);
			handle->session = -1;
			handle->session_slot = -1;
		} else {
		Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv));
			Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv));

		return(TCL_ERROR);
			return(TCL_ERROR);
		}
	}

	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));

	return(TCL_OK);
}

1228
1229
1230
1231
1232
1233
1234

1235
1236
1237
1238
1239
1240
1241
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406







+







	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;
	int sign;
	int tcl_rv;

	CK_SLOT_ID slotid;
	CK_OBJECT_HANDLE hObject;
	CK_ULONG foundObjs;
	CK_OBJECT_CLASS objectclass_pk;
	CK_ATTRIBUTE template[] = {
1415
1416
1417
1418
1419
1420
1421
1422

1423
1424
1425
1426
1427
1428
1429





1430
1431
1432



1433
1434
1435
1436





1437






















1438


1439
1440
1441
1442
1443
1444
1445
1580
1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599



1600
1601
1602
1603



1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631

1632
1633
1634
1635
1636
1637
1638
1639
1640







-
+







+
+
+
+
+
-
-
-
+
+
+

-
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+







		return(TCL_ERROR);
	}

	/* Terminate Search */
	handle->pkcs11->C_FindObjectsFinal(handle->session);

	if (foundObjs < 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to find private key that cooresponds to this certificate", -1));
		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) {
			if (chk_rv == CKR_FUNCTION_NOT_SUPPORTED) {
				sign = 1;
		chk_rv = handle->pkcs11->C_SignInit(handle->session, &mechanism, hObject);
		if (chk_rv != CKR_OK) {
			Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv));
				chk_rv = handle->pkcs11->C_SignInit(handle->session, &mechanism, hObject);
				if (chk_rv != CKR_OK) {
					Tcl_SetObjResult(interp, tclpkcs11_pkcs11_error(chk_rv));

			return(TCL_ERROR);
		}

					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);
			chk_rv = handle->pkcs11->C_Sign(handle->session, input, input_len, resultbuf, &resultbuf_len);
		}
		if (chk_rv != CKR_OK) {
			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));

Modified test.tcl from [7d82b853df] to [ce581f0c53].

40
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66







-
+











-
+







	puts "Cert: $certinfo(pkcs11_label) / $certinfo(subject)"

	set cipher [pki::encrypt -binary -pub -- $orig $certinfo_list]

	if {[catch {
		set plain  [pki::decrypt -binary -priv -- $cipher $certinfo_list]
	} err]} {
		if {$err == "PKCS11_ERROR USER_NOT_LOGGED_IN"} {
		if {$err == "PKCS11_ERROR USER_NOT_LOGGED_IN" || $err == "PKCS11_ERROR MAYBE_LOGIN"} {
			# Login and try it again...
			puts -nonewline " *** ENTER PIN: "
			flush stdout

			gets stdin password
			pki::pkcs11::login $handle $token_slotid $password

			set plain  [pki::decrypt -binary -priv -- $cipher $certinfo_list]
		} else {
			puts stderr "$::errorInfo"

			exit 1
			break
		}
	}

	if {$plain != $orig} {
		puts "Decryption error!  Expected \"$orig\", got \"$plain\""

		exit 1