Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -254,13 +254,18 @@
SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.
sbits n
The number of bits used for the session key.
signatureHashAlgorithm algorithm
The signature hash algorithm.
- signature_type type
+ signatureType type
The signature type value.
- verification result
+ verifyDepth n
+ Maximum depth for the certificate chain verification.
+ Default is -1, to check all.
+ verifyMode list
+ List of certificate verification modes.
+ verifyResult result
Certificate verification result.
ca_names list
List of the Certificate Authorities used to create the certificate.
Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -116,26 +116,26 @@
*
*-------------------------------------------------------------------
*/
static int
EvalCallback(Tcl_Interp *interp, State *statePtr, Tcl_Obj *cmdPtr) {
- int code, ok;
+ int code, ok = 0;
Tcl_Preserve((ClientData) interp);
Tcl_Preserve((ClientData) statePtr);
/* Eval callback with success for ok or return value 1, fail for error or return value 0 */
+ Tcl_ResetResult(interp);
code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
if (code == TCL_OK) {
/* Check result for return value */
Tcl_Obj *result = Tcl_GetObjResult(interp);
if (result == NULL || Tcl_GetIntFromObj(interp, result, &ok) != TCL_OK) {
ok = 1;
}
} else {
/* Error - reject the certificate */
- ok = 0;
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
Tcl_BackgroundError(interp);
#else
Tcl_BackgroundException(interp, code);
#endif
@@ -384,10 +384,12 @@
if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) {
return ok;
} else {
return 1;
}
+ } else if (cert == NULL || ssl == NULL) {
+ return 0;
}
/* Create command to eval */
cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1));
@@ -855,11 +857,11 @@
dprintf("Called");
if (statePtr->vcmd == (Tcl_Obj*)NULL) {
return SSL_CLIENT_HELLO_SUCCESS;
- } else if (ssl == NULL || arg == NULL) {
+ } else if (ssl == (const SSL *)NULL || arg == (void *)NULL) {
return SSL_CLIENT_HELLO_ERROR;
}
/* Get names */
if (!SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining) || remaining <= 2) {
@@ -952,10 +954,11 @@
SSL_CTX *ctx = NULL;
SSL *ssl = NULL;
STACK_OF(SSL_CIPHER) *sk;
char *cp, buf[BUFSIZ];
int index, verbose = 0, use_supported = 0;
+ const SSL_METHOD *method;
dprintf("Called");
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?");
@@ -977,53 +980,56 @@
case TLS_SSL2:
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
return TCL_ERROR;
#else
- ctx = SSL_CTX_new(SSLv2_method()); break;
+ method = SSLv2_method(); break;
#endif
case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
return TCL_ERROR;
#else
- ctx = SSL_CTX_new(SSLv3_method()); break;
+ method = SSLv3_method(); break;
#endif
case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
return TCL_ERROR;
#else
- ctx = SSL_CTX_new(TLSv1_method()); break;
+ method = TLSv1_method(); break;
#endif
case TLS_TLS1_1:
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
return TCL_ERROR;
#else
- ctx = SSL_CTX_new(TLSv1_1_method()); break;
+ method = TLSv1_1_method(); break;
#endif
case TLS_TLS1_2:
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
return TCL_ERROR;
#else
- ctx = SSL_CTX_new(TLSv1_2_method()); break;
+ method = TLSv1_2_method(); break;
#endif
case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
return TCL_ERROR;
#else
- ctx = SSL_CTX_new(TLS_method());
+ method = TLS_method();
SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
break;
#endif
default:
+ method = TLS_method();
break;
}
+
+ ctx = SSL_CTX_new(method);
if (ctx == NULL) {
Tcl_AppendResult(interp, REASON(), NULL);
return TCL_ERROR;
}
@@ -2072,25 +2078,31 @@
if (objc == 2) {
peer = SSL_get_peer_certificate(statePtr->ssl);
} else {
peer = SSL_get_certificate(statePtr->ssl);
}
+ /* Get X509 certificate info */
if (peer) {
objPtr = Tls_NewX509Obj(interp, peer);
- if (objc == 2) { X509_free(peer); }
+ if (objc == 2) {
+ X509_free(peer);
+ peer = NULL;
+ }
} else {
objPtr = Tcl_NewListObj(0, NULL);
}
/* Peer cert chain (client only) */
STACK_OF(X509)* ssl_certs = SSL_get_peer_cert_chain(statePtr->ssl);
- if (!peer && (ssl_certs == NULL || sk_X509_num(ssl_certs) == 0)) {
+ if (ssl_certs == NULL || sk_X509_num(ssl_certs) == 0) {
Tcl_SetErrorCode(interp, "TLS", "STATUS", "CERTIFICATE", (char *) NULL);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
}
- /* Peer name from cert */
+ /* Peer name */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("peername", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get0_peername(statePtr->ssl), -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("sbits", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_cipher_bits(statePtr->ssl, NULL)));
@@ -2100,14 +2112,42 @@
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(ciphers, -1));
}
/* Verify the X509 certificate presented by the peer */
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("verification", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("verifyResult", -1));
Tcl_ListObjAppendElement(interp, objPtr,
Tcl_NewStringObj(X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)), -1));
+ /* Verify mode */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("verifyMode", -1));
+ /* SSL_CTX_get_verify_mode(ctx) */
+ mode = SSL_get_verify_mode(statePtr->ssl);
+ if (mode && SSL_VERIFY_NONE) {
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("none", -1));
+ } else {
+ Tcl_Obj *listObjPtr = Tcl_NewListObj(0, NULL);
+ if (mode && SSL_VERIFY_PEER) {
+ Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("peer", -1));
+ }
+ if (mode && SSL_VERIFY_FAIL_IF_NO_PEER_CERT) {
+ Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("fail if no peer cert", -1));
+ }
+ if (mode && SSL_VERIFY_CLIENT_ONCE) {
+ Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("client once", -1));
+ }
+ if (mode && SSL_VERIFY_POST_HANDSHAKE) {
+ Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj("post handshake", -1));
+ }
+ Tcl_ListObjAppendElement(interp, objPtr, listObjPtr);
+ }
+
+ /* Verify mode depth */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("verifyDepth", -1));
+ /* SSL_CTX_get_verify_depth(ctx) */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_verify_depth(statePtr->ssl)));
+
/* Report the selected protocol as a result of the negotiation */
SSL_get0_alpn_selected(statePtr->ssl, &proto, &len);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int) len));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1));
@@ -2118,11 +2158,11 @@
if (objc == 2 ? SSL_get_peer_signature_nid(statePtr->ssl, &nid) : SSL_get_signature_nid(statePtr->ssl, &nid)) {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(OBJ_nid2ln(nid), -1));
} else {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("", -1));
}
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("signature_type", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("signatureType", -1));
if (objc == 2 ? SSL_get_peer_signature_type_nid(statePtr->ssl, &nid) : SSL_get_signature_type_nid(statePtr->ssl, &nid)) {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(OBJ_nid2ln(nid), -1));
} else {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("", -1));
}
@@ -2144,15 +2184,14 @@
*/
static int ConnectionInfoObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
Tcl_Channel chan; /* The channel to set a mode on. */
State *statePtr; /* client state for ssl socket */
- Tcl_Obj *objPtr;
+ Tcl_Obj *objPtr, *listPtr;
const SSL *ssl;
const SSL_CIPHER *cipher;
const SSL_SESSION *session;
- const unsigned char *proto;
long mode;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
return(TCL_ERROR);
@@ -2218,13 +2257,13 @@
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_name(cipher), -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("standard_name", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_standard_name(cipher), -1));
bits = SSL_CIPHER_get_bits(cipher, &alg_bits);
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("bits", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("secret_bits", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(bits));
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("secret_bits", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("algorithm_bits", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(alg_bits));
/* alg_bits is actual key secret bits. If use bits and secret (algorithm) bits differ,
the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("min_version", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_version(cipher), -1));
@@ -2243,11 +2282,11 @@
session = SSL_get_session(ssl);
if (session != NULL) {
const unsigned char *ticket;
size_t len2;
unsigned int ulen;
- const unsigned char *session_id;
+ const unsigned char *session_id, *proto;
char buffer[SSL_MAX_MASTER_KEY_LENGTH];
/* Report the selected protocol as a result of the ALPN negotiation */
SSL_SESSION_get0_alpn_selected(session, &proto, &len2);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
@@ -2274,15 +2313,20 @@
/* Session ticket lifetime hint (in seconds) */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("lifetime", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_ticket_lifetime_hint(session)));
- /* Session id */
+ /* Session id - TLSv1.2 and below only */
session_id = SSL_SESSION_get_id(session, &ulen);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_id", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewByteArrayObj(session_id, (int) ulen));
+ /* Session context */
+ session_id = SSL_SESSION_get0_id_context(session, &ulen);
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_context", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewByteArrayObj(session_id, (int) ulen));
+
/* Session ticket - client only */
SSL_SESSION_get0_ticket(session, &ticket, &len2);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_ticket", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewByteArrayObj(ticket, (int) len2));
@@ -2315,24 +2359,45 @@
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("NONE", -1));
#endif
}
/* Server info */
- mode = SSL_CTX_get_session_cache_mode(statePtr->ctx);
- if (mode & SSL_SESS_CACHE_OFF) {
- proto = "off";
- } else if (mode & SSL_SESS_CACHE_CLIENT) {
- proto = "client";
- } else if (mode & SSL_SESS_CACHE_SERVER) {
- proto = "server";
- } else if (mode & SSL_SESS_CACHE_BOTH) {
- proto = "both";
- } else {
- proto = "unknown";
- }
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_cache_mode", -1));
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(proto, -1));
+ {
+ mode = SSL_CTX_get_session_cache_mode(statePtr->ctx);
+ char *msg;
+
+ if (mode & SSL_SESS_CACHE_OFF) {
+ msg = "off";
+ } else if (mode & SSL_SESS_CACHE_CLIENT) {
+ msg = "client";
+ } else if (mode & SSL_SESS_CACHE_SERVER) {
+ msg = "server";
+ } else if (mode & SSL_SESS_CACHE_BOTH) {
+ msg = "both";
+ } else {
+ msg = "unknown";
+ }
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_cache_mode", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(msg, -1));
+ }
+
+ /* CA List */
+ /* IF not a server, same as SSL_get0_peer_CA_list. If server same as SSL_CTX_get_client_CA_list */
+ listPtr = Tcl_NewListObj(0, NULL);
+ STACK_OF(X509_NAME) *ca_list;
+ if ((ca_list = SSL_get_client_CA_list(ssl)) != NULL) {
+ char buffer[BUFSIZ];
+ for (int i = 0; i < sk_X509_NAME_num(ca_list); i++) {
+ X509_NAME *name = sk_X509_NAME_value(ca_list, i);
+ if (name) {
+ X509_NAME_oneline(name, buffer, BUFSIZ);
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1));
+ }
+ }
+ }
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("caList", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, listPtr);
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
Index: generic/tlsIO.c
==================================================================
--- generic/tlsIO.c
+++ generic/tlsIO.c
@@ -144,11 +144,11 @@
}
return(-1);
}
for (;;) {
- /* Not initialized yet! */
+ /* Not initialized yet! Also calls SSL_do_handshake. */
if (statePtr->flags & TLS_TCL_SERVER) {
dprintf("Calling SSL_accept()");
err = SSL_accept(statePtr->ssl);
} else {
Index: generic/tlsX509.c
==================================================================
--- generic/tlsX509.c
+++ generic/tlsX509.c
@@ -10,80 +10,64 @@
#include
#include
#include
#include "tlsInt.h"
-/*
- * Ensure these are not macros - known to be defined on Win32
- */
-#ifdef min
-#undef min
-#endif
-
-#ifdef max
-#undef max
-#endif
-
-static int min(int a, int b)
-{
- return (a < b) ? a : b;
-}
-
-static int max(int a, int b)
-{
- return (a > b) ? a : b;
-}
-
-/*
- * ASN1_UTCTIME_tostr --
- */
-static char *
-ASN1_UTCTIME_tostr(ASN1_UTCTIME *tm)
-{
- static char bp[128];
- char *v;
- int gmt=0;
- static char *mon[12]={
- "Jan","Feb","Mar","Apr","May","Jun", "Jul","Aug","Sep","Oct","Nov","Dec"};
- int i;
- int y=0,M=0,d=0,h=0,m=0,s=0;
-
- i=tm->length;
- v=(char *)tm->data;
-
- if (i < 10) goto err;
- if (v[i-1] == 'Z') gmt=1;
- for (i=0; i<10; i++)
- if ((v[i] > '9') || (v[i] < '0')) goto err;
- y= (v[0]-'0')*10+(v[1]-'0');
- if (y < 70) y+=100;
- M= (v[2]-'0')*10+(v[3]-'0');
- if ((M > 12) || (M < 1)) goto err;
- d= (v[4]-'0')*10+(v[5]-'0');
- h= (v[6]-'0')*10+(v[7]-'0');
- m= (v[8]-'0')*10+(v[9]-'0');
- if ((v[10] >= '0') && (v[10] <= '9') && (v[11] >= '0') && (v[11] <= '9'))
- s= (v[10]-'0')*10+(v[11]-'0');
-
- sprintf(bp,"%s %2d %02d:%02d:%02d %d%s", mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":"");
- return bp;
- err:
- return "Bad time value";
-}
-
-/*
- * Binary string to hex string
- */
-int String_to_Hex(char* input, int len, char *output, int max) {
- int count = 0;
-
- for (int i = 0; i < len && count < max - 1; i++, count += 2) {
+/* Define maximum certificate size. Max PEM size 100kB and DER size is 24kB. */
+#define CERT_STR_SIZE 32768
+
+/* Common macros */
+#define LAPPEND_STR(interp, obj, text, value, size) {\
+ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(value, size)); \
+}
+#define LAPPEND_INT(interp, obj, text, value) {\
+ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewIntObj(value)); \
+}
+#define LAPPEND_LONG(interp, obj, text, value) {\
+ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewLongObj(value)); \
+}
+#define LAPPEND_BOOL(interp, obj, text, value) {\
+ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
+ Tcl_ListObjAppendElement(interp, obj, Tcl_NewBooleanObj(value)); \
+}
+#define LAPPEND_LIST(interp, obj, text, listObj) {\
+ if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
+ Tcl_ListObjAppendElement(interp, obj, listObj); \
+}
+
+/*
+ * Binary string to hex string
+ */
+int String_to_Hex(char* input, int len, char *output, int size) {
+ int count = 0;
+
+ for (int i = 0; i < len && count < size - 1; i++, count += 2) {
sprintf(output + count, "%02X", input[i] & 0xff);
}
output[count] = 0;
return count;
}
+
+/*
+ * BIO to Buffer
+ */
+int BIO_to_Buffer(int result, BIO *bio, void *buffer, int size) {
+ int len = 0;
+ int pending = BIO_pending(bio);
+
+ if (result) {
+ len = BIO_read(bio, buffer, (pending < size) ? pending : size);
+ (void)BIO_flush(bio);
+ if (len < 0) {
+ len = 0;
+ }
+ }
+ return len;
+}
/*
*------------------------------------------------------*
*
* Tls_NewX509Obj --
@@ -90,178 +74,138 @@
*
* ------------------------------------------------*
* Converts a X509 certificate into a Tcl_Obj
* ------------------------------------------------*
*
- * Sideeffects:
+ * Side effects:
* None
*
* Result:
* A Tcl List Object representing the provided
* X509 certificate.
*
*------------------------------------------------------*
*/
-#define CERT_STR_SIZE 32768
-
Tcl_Obj*
Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert) {
- Tcl_Obj *certPtr = Tcl_NewListObj(0, NULL);
- BIO *bio;
- int n;
- unsigned long flags;
- char subject[BUFSIZ];
- char issuer[BUFSIZ];
- char serial[BUFSIZ];
- char notBefore[BUFSIZ];
- char notAfter[BUFSIZ];
+ Tcl_Obj *certPtr = Tcl_NewListObj(0, NULL), *listPtr;
+ BIO *bio = BIO_new(BIO_s_mem());
+ int mdnid, pknid, bits, len;
+ uint32_t xflags, usage;
char buffer[BUFSIZ];
- char certStr[CERT_STR_SIZE], *certStr_p;
- int certStr_len, toRead;
- unsigned char sha1_hash_binary[SHA_DIGEST_LENGTH];
- unsigned char sha256_hash_binary[SHA256_DIGEST_LENGTH];
- int nid, pknid, bits, num_of_exts, len;
- uint32_t xflags;
- STACK_OF(GENERAL_NAME) *san;
-
- certStr[0] = 0;
- if ((bio = BIO_new(BIO_s_mem())) == NULL) {
- subject[0] = 0;
- issuer[0] = 0;
- serial[0] = 0;
- } else {
- flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
- flags &= ~ASN1_STRFLGS_ESC_MSB;
-
- X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags);
- n = BIO_read(bio, subject, min(BIO_pending(bio), BUFSIZ - 1));
- n = max(n, 0);
- subject[n] = 0;
- (void)BIO_flush(bio);
-
- X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags);
- n = BIO_read(bio, issuer, min(BIO_pending(bio), BUFSIZ - 1));
- n = max(n, 0);
- issuer[n] = 0;
- (void)BIO_flush(bio);
-
- i2a_ASN1_INTEGER(bio, X509_get0_serialNumber(cert));
- n = BIO_read(bio, serial, min(BIO_pending(bio), BUFSIZ - 1));
- n = max(n, 0);
- serial[n] = 0;
- (void)BIO_flush(bio);
-
- /* Get certificate */
- if (PEM_write_bio_X509(bio, cert)) {
- certStr_p = certStr;
- certStr_len = 0;
- while (1) {
- toRead = min(BIO_pending(bio), CERT_STR_SIZE - certStr_len - 1);
- toRead = min(toRead, BUFSIZ);
- if (toRead == 0) {
- break;
- }
- dprintf("Reading %i bytes from the certificate...", toRead);
- n = BIO_read(bio, certStr_p, toRead);
- if (n <= 0) {
- break;
- }
- certStr_len += n;
- certStr_p += n;
- }
- *certStr_p = '\0';
- (void)BIO_flush(bio);
- }
-
- /* All */
- if (X509_print_ex(bio, cert, flags, 0)) {
- char all[65536];
- n = BIO_read(bio, all, min(BIO_pending(bio), 65535));
- n = max(n, 0);
- all[n] = 0;
- (void)BIO_flush(bio);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("all", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(all, n));
- }
-
- BIO_free(bio);
- }
-
- strcpy(notBefore, ASN1_UTCTIME_tostr(X509_get0_notBefore(cert)));
- strcpy(notAfter, ASN1_UTCTIME_tostr(X509_get0_notAfter(cert)));
-
- /* Version */
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("version", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewLongObj(X509_get_version(cert)+1));
-
- /* Signature algorithm */
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("signature", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(OBJ_nid2ln(X509_get_signature_nid(cert)),-1));
-
+ unsigned char md[EVP_MAX_MD_SIZE];
+ STACK_OF(GENERAL_NAME) *names;
+ STACK_OF(DIST_POINT) *crl;
+ STACK_OF(OPENSSL_STRING) *ocsp;
+ unsigned long flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
+ flags &= ~ASN1_STRFLGS_ESC_MSB;
+
+ if (bio == NULL || certPtr == NULL) {
+ return NULL;
+ }
+
+ /* Signature algorithm and value - RFC 5280 section 4.1.1.2 and 4.1.1.3 */
+ /* signatureAlgorithm is the id of the cryptographic algorithm used by the
+ CA to sign this cert. signatureValue is the digital signature computed
+ upon the ASN.1 DER encoded tbsCertificate. */
+ {
+ const X509_ALGOR *sig_alg;
+ const ASN1_BIT_STRING *sig;
+ int sig_nid;
+
+ X509_get0_signature(&sig, &sig_alg, cert);
+ /* sig_nid = X509_get_signature_nid(cert) */
+ sig_nid = OBJ_obj2nid(sig_alg->algorithm);
+ LAPPEND_STR(interp, certPtr, "signatureAlgorithm", OBJ_nid2ln(sig_nid), -1);
+ len = (sig_nid != NID_undef) ? String_to_Hex(sig->data, sig->length, buffer, BUFSIZ) : 0;
+ LAPPEND_STR(interp, certPtr, "signatureValue", buffer, len);
+ }
+
+ /* Version of the encoded certificate - RFC 5280 section 4.1.2.1 */
+ LAPPEND_LONG(interp, certPtr, "version", X509_get_version(cert)+1);
+
+ /* Unique number assigned by CA to certificate - RFC 5280 section 4.1.2.2 */
+ len = BIO_to_Buffer(i2a_ASN1_INTEGER(bio, X509_get0_serialNumber(cert)), bio, buffer, BUFSIZ);
+ LAPPEND_STR(interp, certPtr, "serialNumber", buffer, len);
+
+ /* Signature algorithm used by the CA to sign the certificate. Must match
+ signatureAlgorithm. RFC 5280 section 4.1.2.3 */
+ LAPPEND_STR(interp, certPtr, "signature", OBJ_nid2ln(X509_get_signature_nid(cert)), -1);
+
+ /* Issuer identifies the entity that signed and issued the cert. RFC 5280 section 4.1.2.4 */
+ len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags), bio, buffer, BUFSIZ);
+ LAPPEND_STR(interp, certPtr, "issuer", buffer, len);
+
+ /* Certificate validity period is the interval the CA warrants that it will
+ maintain info on the status of the certificate. RFC 5280 section 4.1.2.5 */
+ /* Get Validity - Not Before */
+ len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notBefore(cert)), bio, buffer, BUFSIZ);
+ LAPPEND_STR(interp, certPtr, "notBefore", buffer, len);
+
+ /* Get Validity - Not After */
+ len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notAfter(cert)), bio, buffer, BUFSIZ);
+ LAPPEND_STR(interp, certPtr, "notAfter", buffer, len);
+
+ /* Subject identifies the entity associated with the public key stored in
+ the subject public key field. RFC 5280 section 4.1.2.6 */
+ len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags), bio, buffer, BUFSIZ);
+ LAPPEND_STR(interp, certPtr, "subject", buffer, len);
+
/* SHA1 Fingerprint of cert - DER representation */
- X509_digest(cert, EVP_sha1(), sha1_hash_binary, &len);
- len = String_to_Hex(sha1_hash_binary, len, buffer, BUFSIZ);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("sha1_hash", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(buffer, len));
+ if (X509_digest(cert, EVP_sha1(), md, &len)) {
+ len = String_to_Hex(md, len, buffer, BUFSIZ);
+ LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, len);
+ }
/* SHA256 Fingerprint of cert - DER representation */
- X509_digest(cert, EVP_sha256(), sha256_hash_binary, &len);
- len = String_to_Hex(sha256_hash_binary, len, buffer, BUFSIZ);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("sha256_hash", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(buffer, len));
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("subject", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(subject, -1));
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuer", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(issuer, -1));
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("notBefore", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(notBefore, -1));
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("notAfter", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(notAfter, -1));
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("serialNumber", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(serial, -1));
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("certificate", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(certStr, -1));
-
- num_of_exts = X509_get_ext_count(cert);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("num_extensions", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewIntObj(num_of_exts));
-
- /* Information about the signature of certificate cert */
- if (X509_get_signature_info(cert, &nid, &pknid, &bits, &xflags) == 1) {
+ if (X509_digest(cert, EVP_sha256(), md, &len)) {
+ len = String_to_Hex(md, len, buffer, BUFSIZ);
+ LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, len);
+ }
+
+ /* Subject Public Key Info specifies the public key and identifies the
+ algorithm with which the key is used. RFC 5280 section 4.1.2.7 */
+ if (X509_get_signature_info(cert, &mdnid, &pknid, &bits, &xflags)) {
ASN1_BIT_STRING *key;
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("signingDigest", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(OBJ_nid2ln(nid),-1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("publicKeyAlgorithm", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(OBJ_nid2ln(pknid),-1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("bits", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewIntObj(bits));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("extension_flags", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewIntObj(xflags));
-
- /* Public key - X509_get0_pubkey */
+ unsigned int n;
+
+ LAPPEND_STR(interp, certPtr, "signingDigest", OBJ_nid2ln(mdnid), -1);
+ LAPPEND_STR(interp, certPtr, "publicKeyAlgorithm", OBJ_nid2ln(pknid), -1);
+ LAPPEND_INT(interp, certPtr, "bits", bits); /* Effective security bits */
+
key = X509_get0_pubkey_bitstr(cert);
len = String_to_Hex(key->data, key->length, buffer, BUFSIZ);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("publicKey", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(buffer, len));
-
+ LAPPEND_STR(interp, certPtr, "publicKey", buffer, len);
+
+ len = 0;
+ if (X509_pubkey_digest(cert, EVP_get_digestbynid(pknid), md, &n)) {
+ len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
+ }
+ LAPPEND_STR(interp, certPtr, "publicKeyHash", buffer, len);
+
+ len = 0;
+ if (X509_digest(cert, EVP_get_digestbynid(mdnid), md, &n)) {
+ len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
+ }
+ LAPPEND_STR(interp, certPtr, "signatureHash", buffer, len);
+ }
+
+ /* Get extensions flags */
+ xflags = X509_get_extension_flags(cert);
+ LAPPEND_INT(interp, certPtr, "extFlags", xflags);
+
/* Check if cert was issued by CA cert issuer or self signed */
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("self_signed", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewBooleanObj(X509_check_issued(cert, cert) == X509_V_OK));
- }
+ LAPPEND_BOOL(interp, certPtr, "selfIssued", xflags & EXFLAG_SI);
+ LAPPEND_BOOL(interp, certPtr, "selfSigned", xflags & EXFLAG_SS);
- /* Unique Ids */
+ /* The Unique Ids are used to handle the possibility of reuse of subject
+ and/or issuer names over time. RFC 5280 section 4.1.2.8 */
{
const ASN1_BIT_STRING *iuid, *suid;
X509_get0_uids(cert, &iuid, &suid);
+
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1));
if (iuid != NULL) {
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, iuid->length));
} else {
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
@@ -273,122 +217,291 @@
} else {
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
}
}
- /* Get extensions */
- if (num_of_exts > 0) {
- Tcl_Obj *extsPtr = Tcl_NewListObj(0, NULL);
- const STACK_OF(X509_EXTENSION) *exts;
- exts = X509_get0_extensions(cert);
-
- for (int i=0; i < num_of_exts; i++) {
- X509_EXTENSION *ex = sk_X509_EXTENSION_value(exts, i);
- ASN1_OBJECT *obj = X509_EXTENSION_get_object(ex);
- unsigned nid2 = OBJ_obj2nid(obj);
- Tcl_ListObjAppendElement(interp, extsPtr, Tcl_NewStringObj(OBJ_nid2ln(nid2), -1));
- }
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("extensions", -1));
- Tcl_ListObjAppendElement(interp, certPtr, extsPtr);
- }
-
- /* Subject Alternative Name (SAN) extension. Additional host names for a single SSL certificate. */
- san = X509_get_ext_d2i(cert, NID_subject_alt_name, NULL, NULL);
- if (san) {
- Tcl_Obj *namesPtr = Tcl_NewListObj(0, NULL);
-
- for (int i=0; i < sk_GENERAL_NAME_num(san); i++) {
- const GENERAL_NAME *name = sk_GENERAL_NAME_value(san, i);
- size_t len2;
-
- if (name) {
- if (name->type == GEN_DNS) {
- char *dns_name;
- if ((len2 = ASN1_STRING_to_UTF8(&dns_name, name->d.dNSName)) > 0) {
- Tcl_ListObjAppendElement(interp, namesPtr, Tcl_NewStringObj(dns_name, (int)len2));
- OPENSSL_free (dns_name);
- }
- } else if (name->type == GEN_IPADD) {
- /* name->d.iPAddress */
- }
- }
- }
- sk_GENERAL_NAME_pop_free(san, GENERAL_NAME_free);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("subjectAltName", -1));
- Tcl_ListObjAppendElement(interp, certPtr, namesPtr);
- }
-
- /* Certificate Alias */
- {
- unsigned char *bstring;
- len = 0;
- bstring = X509_alias_get0(cert, &len);
- len = String_to_Hex(bstring, len, buffer, BUFSIZ);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("alias", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(buffer, len));
- }
-
- /* Get Subject Key id, Authority Key id */
- {
- ASN1_OCTET_STRING *astring;
- /* X509_keyid_get0 */
- astring = X509_get0_subject_key_id(cert);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("subjectKeyIdentifier", -1));
- if (astring != NULL) {
- len = String_to_Hex((char *)ASN1_STRING_get0_data(astring), ASN1_STRING_length(astring), buffer, BUFSIZ);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj(buffer, len));
- } else {
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
- }
-
- astring = X509_get0_authority_key_id(cert);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("authorityKeyIdentifier", -1));
- if (astring != NULL) {
- len = String_to_Hex((char *)ASN1_STRING_get0_data(astring), ASN1_STRING_length(astring), buffer, BUFSIZ);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj(buffer, len));
- } else {
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
- }
-
- /* const GENERAL_NAMES *X509_get0_authority_issuer(cert);
- const ASN1_INTEGER *X509_get0_authority_serial(cert); */
- }
-
- /* Get OSCP URL */
- {
- STACK_OF(OPENSSL_STRING) *str_stack = X509_get1_ocsp(cert);
- Tcl_Obj *urlsPtr = Tcl_NewListObj(0, NULL);
-
- for (int i = 0; i < sk_OPENSSL_STRING_num(str_stack); i++) {
- Tcl_ListObjAppendElement(interp, urlsPtr,
- Tcl_NewStringObj(sk_OPENSSL_STRING_value(str_stack, i), -1));
- }
-
- X509_email_free(str_stack);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("ocsp", -1));
- Tcl_ListObjAppendElement(interp, certPtr, urlsPtr);
- }
-
- /* Signature algorithm and value */
- {
- const X509_ALGOR *sig_alg;
- const ASN1_BIT_STRING *sig;
- int sig_nid;
-
- X509_get0_signature(&sig, &sig_alg, cert);
- /* sig_nid = X509_get_signature_nid(cert) */
- sig_nid = OBJ_obj2nid(sig_alg->algorithm);
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("signatureAlgorithm", -1));
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(OBJ_nid2ln(sig_nid),-1));
-
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("signatureValue", -1));
- if (sig_nid != NID_undef) {
- len = String_to_Hex(sig->data, sig->length, buffer, BUFSIZ);
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj(buffer, len));
- } else {
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
- }
- }
-
+ /* X509 v3 Extensions - RFC 5280 section 4.1.2.9 */
+ len = X509_get_ext_count(cert);
+ listPtr = Tcl_NewListObj(0, NULL);
+ if (len > 0) {
+ const STACK_OF(X509_EXTENSION) *exts = X509_get0_extensions(cert);
+
+ for (int i=0; i < len; i++) {
+ X509_EXTENSION *ex = sk_X509_EXTENSION_value(exts, i);
+ ASN1_OBJECT *obj = X509_EXTENSION_get_object(ex);
+
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(OBJ_nid2ln(OBJ_obj2nid(obj)), -1));
+ }
+ }
+ LAPPEND_INT(interp, certPtr, "extCount", len);
+ LAPPEND_LIST(interp, certPtr, "extensions", listPtr);
+
+ /* Authority Key Identifier (AKI) is the Subject Key Identifier (SKI) of
+ its signer (the CA). RFC 5280 section 4.2.1.1, NID_authority_key_identifier */
+ {
+ ASN1_OCTET_STRING *astring = X509_get0_authority_key_id(cert);
+ len = 0;
+ if (astring != NULL) {
+ len = String_to_Hex((char *)ASN1_STRING_get0_data(astring),
+ ASN1_STRING_length(astring), buffer, BUFSIZ);
+ }
+ LAPPEND_STR(interp, certPtr, "authorityKeyIdentifier", buffer, len);
+ }
+
+ /* Subject Key Identifier (SKI) is used to dentify certificates that contain
+ a particular public key. RFC 5280 section 4.2.1.2, NID_subject_key_identifier */
+ {
+ ASN1_OCTET_STRING *astring = X509_get0_subject_key_id(cert);
+ len = 0;
+ if (astring != NULL) {
+ len = String_to_Hex((char *)ASN1_STRING_get0_data(astring),
+ ASN1_STRING_length(astring), buffer, BUFSIZ);
+ }
+ LAPPEND_STR(interp, certPtr, "subjectKeyIdentifier", buffer, len);
+ }
+
+ /* Key usage extension defines the purpose (e.g., encipherment, signature, certificate
+ signing) of the key contained in the certificate. RFC 5280 section 4.2.1.3, NID_key_usage */
+ listPtr = Tcl_NewListObj(0, NULL);
+ usage = X509_get_key_usage(cert);
+ if ((xflags & EXFLAG_KUSAGE) && usage < 0xffffff) {
+ if (usage & KU_DIGITAL_SIGNATURE) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Digital Signature", -1));
+ }
+ if (usage & KU_NON_REPUDIATION) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Non-Repudiation", -1));
+ }
+ if (usage & KU_KEY_ENCIPHERMENT) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Key Encipherment", -1));
+ }
+ if (usage & KU_DATA_ENCIPHERMENT) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Data Encipherment", -1));
+ }
+ if (usage & KU_KEY_AGREEMENT) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Key Agreement", -1));
+ }
+ if (usage & KU_KEY_CERT_SIGN) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Certificate Signing", -1));
+ }
+ if (usage & KU_CRL_SIGN) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("CRL Signing", -1));
+ }
+ if (usage & KU_ENCIPHER_ONLY) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Encipher Only", -1));
+ }
+ if (usage & KU_DECIPHER_ONLY) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Decipher Only", -1));
+ }
+ }
+ LAPPEND_LIST(interp, certPtr, "keyUsage", listPtr);
+
+ /* Certificate Purpose */
+ {
+ char *purpose = NULL;
+
+ if (X509_check_purpose(cert, X509_PURPOSE_SSL_CLIENT, 0) > 0) {
+ purpose = "SSL Client";
+ } else if (X509_check_purpose(cert, X509_PURPOSE_SSL_SERVER, 0) > 0) {
+ purpose = "SSL Server";
+ } else if (X509_check_purpose(cert, X509_PURPOSE_NS_SSL_SERVER, 0) > 0) {
+ purpose = "MSS SSL Server";
+ } else if (X509_check_purpose(cert, X509_PURPOSE_SMIME_SIGN, 0) > 0) {
+ purpose = "SMIME Signing";
+ } else if (X509_check_purpose(cert, X509_PURPOSE_SMIME_ENCRYPT, 0) > 0) {
+ purpose = "SMIME Encryption";
+ } else if (X509_check_purpose(cert, X509_PURPOSE_CRL_SIGN, 0) > 0) {
+ purpose = "CRL Signing";
+ } else if (X509_check_purpose(cert, X509_PURPOSE_ANY, 0) > 0) {
+ purpose = "Any";
+ } else if (X509_check_purpose(cert, X509_PURPOSE_OCSP_HELPER, 0) > 0) {
+ purpose = "OCSP Helper";
+ } else if (X509_check_purpose(cert, X509_PURPOSE_TIMESTAMP_SIGN, 0) > 0) {
+ purpose = "Timestamp Signing";
+ } else {
+ purpose = "";
+ }
+ LAPPEND_STR(interp, certPtr, "purpose", purpose, -1);
+ }
+
+ /* Get purposes */
+ listPtr = Tcl_NewListObj(0, NULL);
+ for (int j = 0; j < X509_PURPOSE_get_count(); j++) {
+ X509_PURPOSE *ptmp = X509_PURPOSE_get0(j);
+ Tcl_Obj *tmpPtr = Tcl_NewListObj(0, NULL);
+
+ for (int i = 0; i < 2; i++) {
+ int idret = X509_check_purpose(cert, X509_PURPOSE_get_id(ptmp), i);
+ Tcl_ListObjAppendElement(interp, tmpPtr, Tcl_NewStringObj(i ? "CA" : "nonCA", -1));
+ Tcl_ListObjAppendElement(interp, tmpPtr, Tcl_NewStringObj(idret == 1 ? "Yes" : "No", -1));
+ }
+ LAPPEND_LIST(interp, listPtr, X509_PURPOSE_get0_name(ptmp), tmpPtr);
+ }
+ LAPPEND_LIST(interp, certPtr, "certificatePurpose", listPtr);
+
+ /* Certificate Policies - indicates the issuing CA considers its issuerDomainPolicy
+ equivalent to the subject CA's subjectDomainPolicy. RFC 5280 section 4.2.1.4, NID_certificate_policies */
+ if (xflags & EXFLAG_INVALID_POLICY) {
+ /* Reject cert */
+ }
+
+ /* Policy Mappings - RFC 5280 section 4.2.1.5, NID_policy_mappings */
+
+ /* Subject Alternative Name (SAN) contains additional URLs, DNS names, or IP
+ addresses bound to certificate. RFC 5280 section 4.2.1.6, NID_subject_alt_name */
+ listPtr = Tcl_NewListObj(0, NULL);
+ if (names = X509_get_ext_d2i(cert, NID_subject_alt_name, NULL, NULL)) {
+ for (int i=0; i < sk_GENERAL_NAME_num(names); i++) {
+ const GENERAL_NAME *name = sk_GENERAL_NAME_value(names, i);
+
+ len = BIO_to_Buffer(name && GENERAL_NAME_print(bio, name), bio, buffer, BUFSIZ);
+ LAPPEND_STR(interp, listPtr, NULL, buffer, len);
+ }
+ sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);
+ }
+ LAPPEND_LIST(interp, certPtr, "subjectAltName", listPtr);
+
+ /* Issuer Alternative Name is used to associate Internet style identities
+ with the certificate issuer. RFC 5280 section 4.2.1.7, NID_issuer_alt_name */
+ listPtr = Tcl_NewListObj(0, NULL);
+ if (names = X509_get_ext_d2i(cert, NID_issuer_alt_name, NULL, NULL)) {
+ for (int i=0; i < sk_GENERAL_NAME_num(names); i++) {
+ const GENERAL_NAME *name = sk_GENERAL_NAME_value(names, i);
+
+ len = BIO_to_Buffer(name && GENERAL_NAME_print(bio, name), bio, buffer, BUFSIZ);
+ LAPPEND_STR(interp, listPtr, NULL, buffer, len);
+ }
+ sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);
+ }
+ LAPPEND_LIST(interp, certPtr, "issuerAltName", listPtr);
+
+ /* Subject Directory Attributes provides identification attributes (e.g., nationality)
+ of the subject. RFC 5280 section 4.2.1.8 (subjectDirectoryAttributes) */
+
+ /* Basic Constraints identifies whether the subject of the cert is a CA and
+ the max depth of valid cert paths for this cert. RFC 5280 section 4.2.1.9, NID_basic_constraints */
+ if (xflags & EXFLAG_BCONS) {
+ LAPPEND_LONG(interp, certPtr, "pathLen", X509_get_pathlen(cert));
+ }
+ LAPPEND_BOOL(interp, certPtr, "basicConstraintsCA", xflags & EXFLAG_CA);
+ LAPPEND_BOOL(interp, certPtr, "basicConstraintsCritical", xflags & EXFLAG_CRITICAL);
+
+ /* Name Constraints is only used in CA certs to indicate the name space for
+ all subject names in subsequent certificates in a certification path
+ MUST be located. RFC 5280 section 4.2.1.10, NID_name_constraints */
+
+ /* Policy Constraints is only used in CA certs to limit the length of a
+ cert chain for that CA. RFC 5280 section 4.2.1.11, NID_policy_constraints */
+
+ /* Extended Key Usage indicates the purposes the certified public key may be
+ used, beyond the basic purposes. RFC 5280 section 4.2.1.12, NID_ext_key_usage */
+ listPtr = Tcl_NewListObj(0, NULL);
+ if (xflags & EXFLAG_XKUSAGE) {
+ usage = X509_get_extended_key_usage(cert);
+
+ if (usage & XKU_SSL_SERVER) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("TLS Web Server Authentication", -1));
+ }
+ if (usage & XKU_SSL_CLIENT) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("TLS Web Client Authentication", -1));
+ }
+ if (usage & XKU_SMIME) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("E-mail Protection", -1));
+ }
+ if (usage & XKU_CODE_SIGN) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Code Signing", -1));
+ }
+ if (usage & XKU_SGC) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("SGC", -1));
+ }
+ if (usage & XKU_OCSP_SIGN) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("OCSP Signing", -1));
+ }
+ if (usage & XKU_TIMESTAMP) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Time Stamping", -1));
+ }
+ if (usage & XKU_DVCS ) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("DVCS", -1));
+ }
+ if (usage & XKU_ANYEKU) {
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("Any Extended Key Usage", -1));
+ }
+ }
+ LAPPEND_LIST(interp, certPtr, "extendedKeyUsage", listPtr);
+
+ /* CRL Distribution Points identifies where CRL information can be obtained.
+ RFC 5280 section 4.2.1.13*/
+ listPtr = Tcl_NewListObj(0, NULL);
+ if (crl = X509_get_ext_d2i(cert, NID_crl_distribution_points, NULL, NULL)) {
+ Tcl_Obj *namesPtr = Tcl_NewListObj(0, NULL);
+
+ for (int i=0; i < sk_DIST_POINT_num(crl); i++) {
+ DIST_POINT *dp = sk_DIST_POINT_value(crl, i);
+ DIST_POINT_NAME *distpoint = dp->distpoint;
+
+ if (distpoint->type == 0) {
+ /* fullname GENERALIZEDNAME */
+ for (int j = 0; j < sk_GENERAL_NAME_num(distpoint->name.fullname); j++) {
+ GENERAL_NAME *gen = sk_GENERAL_NAME_value(distpoint->name.fullname, j);
+ int type;
+ ASN1_STRING *uri = GENERAL_NAME_get0_value(gen, &type);
+ if (type == GEN_URI) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj((char*)ASN1_STRING_get0_data(uri), ASN1_STRING_length(uri)));
+ }
+ }
+ } else if (distpoint->type == 1) {
+ /* relativename X509NAME */
+ STACK_OF(X509_NAME_ENTRY) *sk_relname = distpoint->name.relativename;
+ for (int j = 0; j < sk_X509_NAME_ENTRY_num(sk_relname); j++) {
+ X509_NAME_ENTRY *e = sk_X509_NAME_ENTRY_value(sk_relname, j);
+ ASN1_STRING *d = X509_NAME_ENTRY_get_data(e);
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj((char*)ASN1_STRING_data(d), ASN1_STRING_length(d)));
+ }
+ }
+ }
+ CRL_DIST_POINTS_free(crl);
+ }
+ LAPPEND_LIST(interp, certPtr, "crlDistributionPoints", listPtr);
+
+ /* Freshest CRL extension */
+ if (xflags & EXFLAG_FRESHEST) {
+ }
+
+ /* Authority Information Access indicates how to access info and services
+ for the certificate issuer. RFC 5280 section 4.2.2.1, NID_info_access */
+ /* Get On-line Certificate Status Protocol (OSCP) URL */
+ listPtr = Tcl_NewListObj(0, NULL);
+ if (ocsp = X509_get1_ocsp(cert)) {
+ for (int i = 0; i < sk_OPENSSL_STRING_num(ocsp); i++) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj(sk_OPENSSL_STRING_value(ocsp, i), -1));
+ }
+ X509_email_free(ocsp);
+ }
+ LAPPEND_LIST(interp, certPtr, "ocsp", listPtr);
+
+ /* CA Issuers URL caIssuers */
+
+ /* Subject Information Access - RFC 5280 section 4.2.2.2, NID_sinfo_access */
+
+ /* Certificate Alias. If uses a PKCS#12 structure, alias will reflect the
+ friendlyName attribute (RFC 2985). */
+ len = 0;
+ LAPPEND_STR(interp, certPtr, "alias", X509_alias_get0(cert, &len), len);
+
+ /* Certificate and dump all data */
+ {
+ char certStr[CERT_STR_SIZE];
+
+ /* Get certificate */
+ len = BIO_to_Buffer(PEM_write_bio_X509(bio, cert), bio, certStr, CERT_STR_SIZE);
+ LAPPEND_STR(interp, certPtr, "certificate", certStr, len);
+
+ /* Get all cert info */
+ len = BIO_to_Buffer(X509_print_ex(bio, cert, flags, 0), bio, certStr, CERT_STR_SIZE);
+ LAPPEND_STR(interp, certPtr, "all", certStr, len);
+ }
+
+ BIO_free(bio);
return certPtr;
}