Index: ChangeLog
==================================================================
--- ChangeLog
+++ ChangeLog
@@ -1,5 +1,12 @@
+2003-07-07  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* tls.c (Tls_Init):   added tls::misc command provided by
+	* tlsX509.c:          Wojciech Kocjan (wojciech kocjan.org)
+	* tests/keytest1.tcl: to expose more low-level SSL commands
+	* tests/keytest2.tcl:
+
 2003-05-15  Dan Razzell	<research@starfishsystems.ca> 
 
 	* tls.tcl:
 	* tlsInt.h:
 	* tls.c: add support for binding a password callback to the socket.

ADDED   tests/keytest1.tcl
Index: tests/keytest1.tcl
==================================================================
--- /dev/null
+++ tests/keytest1.tcl
@@ -0,0 +1,23 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not tcl \
+exec tclsh "$0" ${1+"$@"}
+
+package require tls
+
+proc creadable {s} {
+    puts "LINE=[gets $s]"
+    after 2000
+    exit
+}
+
+proc myserv {s args} {
+    fileevent $s readable [list creadable $s]
+}
+
+tls::misc req 1024 $keyfile $certfile [list C CCC ST STTT L LLLL O OOOO OU OUUUU CN CNNNN Email some@email.com days 730 serial 12]
+
+tls::socket -keyfile $keyfile -certfile $certfile -server myserv 12300
+
+puts "Now run keytest2.tcl"
+vwait forever
+

ADDED   tests/keytest2.tcl
Index: tests/keytest2.tcl
==================================================================
--- /dev/null
+++ tests/keytest2.tcl
@@ -0,0 +1,8 @@
+package require tls
+
+set s [tls::socket 127.0.0.1 12300]
+puts $s "A line"
+flush $s
+puts [join [tls::status $s] \n]
+exit
+

Index: tls.c
==================================================================
--- tls.c
+++ tls.c
@@ -3,11 +3,11 @@
  * some modifications:
  *	Copyright (C) 2000 Ajuba Solutions
  *	Copyright (C) 2002 ActiveState Corporation
  *	Copyright (C) 2003 Starfish Systems 
  *
- * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.16 2003/05/15 21:02:10 razzell Exp $
+ * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.17 2003/07/07 20:24:49 hobbs Exp $
  *
  * TLS (aka SSL) Channel - can be layered on any bi-directional
  * Tcl_Channel (Note: Requires Trf Core Patch)
  *
  * This was built (almost) from scratch based upon observation of
@@ -52,10 +52,13 @@
 static int	StatusObjCmd _ANSI_ARGS_ ((ClientData clientData,
 			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 
 static int	VersionObjCmd _ANSI_ARGS_ ((ClientData clientData,
 			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+static int	MiscObjCmd _ANSI_ARGS_ ((ClientData clientData,
+			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
 
 static SSL_CTX *CTX_Init _ANSI_ARGS_((State *statePtr, int proto, char *key,
 			char *cert, char *CAdir, char *CAfile, char *ciphers));
 
 #define TLS_PROTO_SSL2	0x01
@@ -69,17 +72,17 @@
 
 #ifndef NO_DH
 /* from openssl/apps/s_server.c */
 
 static unsigned char dh512_p[]={
-        0xDA,0x58,0x3C,0x16,0xD9,0x85,0x22,0x89,0xD0,0xE4,0xAF,0x75,
-        0x6F,0x4C,0xCA,0x92,0xDD,0x4B,0xE5,0x33,0xB8,0x04,0xFB,0x0F,
-        0xED,0x94,0xEF,0x9C,0x8A,0x44,0x03,0xED,0x57,0x46,0x50,0xD3,
-        0x69,0x99,0xDB,0x29,0xD7,0x76,0x27,0x6B,0xA2,0xD3,0xD4,0x12,
-        0xE2,0x18,0xF4,0xDD,0x1E,0x08,0x4C,0xF6,0xD8,0x00,0x3E,0x7C,
-        0x47,0x74,0xE8,0x33,
-        };
+	0xDA,0x58,0x3C,0x16,0xD9,0x85,0x22,0x89,0xD0,0xE4,0xAF,0x75,
+	0x6F,0x4C,0xCA,0x92,0xDD,0x4B,0xE5,0x33,0xB8,0x04,0xFB,0x0F,
+	0xED,0x94,0xEF,0x9C,0x8A,0x44,0x03,0xED,0x57,0x46,0x50,0xD3,
+	0x69,0x99,0xDB,0x29,0xD7,0x76,0x27,0x6B,0xA2,0xD3,0xD4,0x12,
+	0xE2,0x18,0xF4,0xDD,0x1E,0x08,0x4C,0xF6,0xD8,0x00,0x3E,0x7C,
+	0x47,0x74,0xE8,0x33,
+	};
 static unsigned char dh512_g[]={
 	0x02,
 };
 
 static DH *get_dh512()
@@ -389,11 +392,11 @@
     int result;
 
     if (statePtr->password == NULL) {
 	if (Tcl_Eval(interp, "tls::password") == TCL_OK) {
 	    char *ret = (char *) Tcl_GetStringResult(interp);
-            strncpy(buf, ret, size);
+	    strncpy(buf, ret, size);
 	    return strlen(ret);
 	} else {
 	    return -1;
 	}
     }
@@ -413,11 +416,11 @@
     Tcl_Release((ClientData) statePtr);
     Tcl_Release((ClientData) statePtr->interp);
 
     if (result == TCL_OK) {
 	char *ret = (char *) Tcl_GetStringResult(interp);
-        strncpy(buf, ret, size);
+	strncpy(buf, ret, size);
 	return strlen(ret);
     } else {
 	return -1;
     }
 }
@@ -459,11 +462,11 @@
     char *cp, buf[BUFSIZ];
     int index, verbose = 0;
 
     if (objc < 2 || objc > 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
     if (Tcl_GetIndexFromObj( interp, objv[1], protocols, "protocol", 0,
 	&index) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -567,27 +570,27 @@
     State *statePtr;		/* client state for ssl socket */
     int ret = 1;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channel");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
     if (chan == (Tcl_Channel) NULL) {
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
     if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
 	/*
 	 * Make sure to operate on the topmost channel
 	 */
 	chan = Tcl_GetTopChannel(chan);
     }
     if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
-        Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
-                "\": not a TLS channel", NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
+		"\": not a TLS channel", NULL);
+	return TCL_ERROR;
     }
     statePtr = (State *)Tcl_GetChannelInstanceData(chan);
 
     if (!SSL_is_init_finished(statePtr->ssl)) {
 	int err;
@@ -596,11 +599,11 @@
 	    CONST char *errStr = statePtr->err;
 	    Tcl_ResetResult(interp);
 	    Tcl_SetErrno(err);
 
 	    if (!errStr || *errStr == 0) {
-	        errStr = Tcl_PosixError(interp);
+		errStr = Tcl_PosixError(interp);
 	    }
 
 	    Tcl_AppendResult(interp, "handshake failed: ", errStr,
 		    (char *) NULL);
 	    return TCL_ERROR;
@@ -668,16 +671,16 @@
     int proto = 0;
     int verify = 0, require = 0, request = 1;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
     if (chan == (Tcl_Channel) NULL) {
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
     if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
 	/*
 	 * Make sure to operate on the topmost channel
 	 */
@@ -708,13 +711,13 @@
 
 	OPTBAD( "option", "-cadir, -cafile, -certfile, -cipher, -command, -keyfile, -model, -password, -require, -request, -server, -ssl2, -ssl3, or -tls1");
 
 	return TCL_ERROR;
     }
-    if (request)            verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
+    if (request)	    verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
     if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
-    if (verify == 0)        verify = SSL_VERIFY_NONE;
+    if (verify == 0)	verify = SSL_VERIFY_NONE;
 
     proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
     proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);
     proto |= (tls1 ? TLS_PROTO_TLS1 : 0);
 
@@ -817,24 +820,24 @@
     if (statePtr->self == (Tcl_Channel) NULL) {
 	/*
 	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
 	 */
 	Tls_Free((char *) statePtr);
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * SSL Initialization
      */
 
     statePtr->ssl = SSL_new(statePtr->ctx);
     if (!statePtr->ssl) {
-        /* SSL library error */
-        Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(),
+	/* SSL library error */
+	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(),
 		(char *) NULL);
 	Tls_Free((char *) statePtr);
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * SSL Callbacks
      */
@@ -952,64 +955,64 @@
 
     /* set our certificate */
     if (cert != NULL) {
 	Tcl_DStringInit(&ds);
 
-        if (SSL_CTX_use_certificate_file(ctx, F2N( cert, &ds),
+	if (SSL_CTX_use_certificate_file(ctx, F2N( cert, &ds),
 					SSL_FILETYPE_PEM) <= 0) {
 	    Tcl_DStringFree(&ds);
-            Tcl_AppendResult(interp,
-                             "unable to set certificate file ", cert, ": ",
-                             REASON(), (char *) NULL);
-            SSL_CTX_free(ctx);
-            return (SSL_CTX *)0;
-        }
-
-        /* get the private key associated with this certificate */
-        if (key == NULL) key=cert;
-
-        if (SSL_CTX_use_PrivateKey_file(ctx, F2N( key, &ds),
+	    Tcl_AppendResult(interp,
+			     "unable to set certificate file ", cert, ": ",
+			     REASON(), (char *) NULL);
+	    SSL_CTX_free(ctx);
+	    return (SSL_CTX *)0;
+	}
+
+	/* get the private key associated with this certificate */
+	if (key == NULL) key=cert;
+
+	if (SSL_CTX_use_PrivateKey_file(ctx, F2N( key, &ds),
 					SSL_FILETYPE_PEM) <= 0) {
 	    Tcl_DStringFree(&ds);
 	    /* flush the passphrase which might be left in the result */
 	    Tcl_SetResult(interp, NULL, TCL_STATIC);
-            Tcl_AppendResult(interp,
-                             "unable to set public key file ", key, " ",
-                             REASON(), (char *) NULL);
-            SSL_CTX_free(ctx);
-            return (SSL_CTX *)0;
-        }
+	    Tcl_AppendResult(interp,
+			     "unable to set public key file ", key, " ",
+			     REASON(), (char *) NULL);
+	    SSL_CTX_free(ctx);
+	    return (SSL_CTX *)0;
+	}
 	Tcl_DStringFree(&ds);
-        /* Now we know that a key and cert have been set against
-         * the SSL context */
-        if (!SSL_CTX_check_private_key(ctx)) {
-            Tcl_AppendResult(interp,
-                             "private key does not match the certificate public key",
-                             (char *) NULL);
-            SSL_CTX_free(ctx);
-            return (SSL_CTX *)0;
-        }
+	/* Now we know that a key and cert have been set against
+	 * the SSL context */
+	if (!SSL_CTX_check_private_key(ctx)) {
+	    Tcl_AppendResult(interp,
+			     "private key does not match the certificate public key",
+			     (char *) NULL);
+	    SSL_CTX_free(ctx);
+	    return (SSL_CTX *)0;
+	}
     } else {
-        cert = (char*)X509_get_default_cert_file();
+	cert = (char*)X509_get_default_cert_file();
 
-        if (SSL_CTX_use_certificate_file(ctx, cert,
+	if (SSL_CTX_use_certificate_file(ctx, cert,
 					SSL_FILETYPE_PEM) <= 0) {
 #if 0
 	    Tcl_DStringFree(&ds);
-            Tcl_AppendResult(interp,
-                             "unable to use default certificate file ", cert, ": ",
-                             REASON(), (char *) NULL);
-            SSL_CTX_free(ctx);
-            return (SSL_CTX *)0;
+	    Tcl_AppendResult(interp,
+			     "unable to use default certificate file ", cert, ": ",
+			     REASON(), (char *) NULL);
+	    SSL_CTX_free(ctx);
+	    return (SSL_CTX *)0;
 #endif
-        }
+	}
     }
 	
     Tcl_DStringInit(&ds);
     Tcl_DStringInit(&ds1);
     if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CAdir, &ds1)) ||
-        !SSL_CTX_set_default_verify_paths(ctx)) {
+	!SSL_CTX_set_default_verify_paths(ctx)) {
 #if 0
 	Tcl_DStringFree(&ds);
 	Tcl_DStringFree(&ds1);
 	/* Don't currently care if this fails */
 	Tcl_AppendResult(interp, "SSL default verify paths: ",
@@ -1077,13 +1080,13 @@
 	 * Make sure to operate on the topmost channel
 	 */
 	chan = Tcl_GetTopChannel(chan);
     }
     if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
-        Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
-                "\": not a TLS channel", NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
+		"\": not a TLS channel", NULL);
+	return TCL_ERROR;
     }
     statePtr	= (State *) Tcl_GetChannelInstanceData(chan);
     if (objc == 2)
 	peer	= SSL_get_peer_certificate(statePtr->ssl);
     else
@@ -1135,10 +1138,170 @@
     objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
 
     Tcl_SetObjResult(interp, objPtr);
     return TCL_OK;
 }
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * MiscObjCmd -- misc commands
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *-------------------------------------------------------------------
+ */
+static int
+MiscObjCmd(clientData, interp, objc, objv)
+    ClientData clientData;	/* Not used. */
+    Tcl_Interp *interp;
+    int objc;
+    Tcl_Obj	*CONST objv[];
+{
+    const char *commands [] = { "req", NULL };
+    enum command { C_REQ, C_DUMMY };
+    int cmd;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], commands,
+	    "command", 0,&cmd) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    switch ((enum command) cmd) {
+	case C_REQ: {
+	    EVP_PKEY *pkey=NULL;
+	    X509 *cert=NULL;
+	    X509_NAME *name=NULL;
+	    Tcl_Obj **listv;
+	    int listc,i;
+
+	    BIO *in=NULL,*out=NULL;
+
+	    char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
+	    char *keyout,*pemout,*str;
+	    int keysize,serial=0,days=365;
+	    
+	    if ((objc<5) || (objc>6)) {
+		Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?");
+		return TCL_ERROR;
+	    }
+
+	    if (Tcl_GetIntFromObj(interp, objv[2], &keysize) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    keyout=Tcl_GetString(objv[3]);
+	    pemout=Tcl_GetString(objv[4]);
+
+	    if (objc>=6) {
+		if (Tcl_ListObjGetElements(interp, objv[5],
+			&listc, &listv) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+
+		if ((listc%2) != 0) {
+		    Tcl_SetResult(interp,"Information list must have even number of arguments",NULL);
+		    return TCL_ERROR;
+		}
+		for (i=0; i<listc; i+=2) {
+		    str=Tcl_GetString(listv[i]);
+		    if (strcmp(str,"days")==0) {
+			if (Tcl_GetIntFromObj(interp,listv[i+1],&days)!=TCL_OK)
+			    return TCL_ERROR;
+		    } else if (strcmp(str,"serial")==0) {
+			if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK)
+			    return TCL_ERROR;
+		    } else if (strcmp(str,"serial")==0) {
+			if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK)
+			    return TCL_ERROR;
+		    } else if (strcmp(str,"C")==0) {
+			k_C=Tcl_GetString(listv[i+1]);
+		    } else if (strcmp(str,"ST")==0) {
+			k_ST=Tcl_GetString(listv[i+1]);
+		    } else if (strcmp(str,"L")==0) {
+			k_L=Tcl_GetString(listv[i+1]);
+		    } else if (strcmp(str,"O")==0) {
+			k_O=Tcl_GetString(listv[i+1]);
+		    } else if (strcmp(str,"OU")==0) {
+			k_OU=Tcl_GetString(listv[i+1]);
+		    } else if (strcmp(str,"CN")==0) {
+			k_CN=Tcl_GetString(listv[i+1]);
+		    } else if (strcmp(str,"Email")==0) {
+			k_Email=Tcl_GetString(listv[i+1]);
+		    } else {
+			Tcl_SetResult(interp,"Unknown parameter",NULL);
+			return TCL_ERROR;
+		    }
+		}
+	    }
+	    if ((pkey = EVP_PKEY_new()) != NULL) {
+		if (!EVP_PKEY_assign_RSA(pkey,
+			RSA_generate_key(keysize, 0x10001, NULL, NULL))) {
+		    Tcl_SetResult(interp,"Error generating private key",NULL);
+		    EVP_PKEY_free(pkey);
+		    return TCL_ERROR;
+		}
+		out=BIO_new(BIO_s_file());
+		BIO_write_filename(out,keyout);
+		PEM_write_bio_PrivateKey(out,pkey,NULL,NULL,0,NULL,NULL);
+		BIO_free_all(out);
+
+		if ((cert=X509_new())==NULL) {
+		    Tcl_SetResult(interp,"Error generating certificate request",NULL);
+		    EVP_PKEY_free(pkey);
+		    return(TCL_ERROR);
+		}
+
+		X509_set_version(cert,2);
+		ASN1_INTEGER_set(X509_get_serialNumber(cert),serial);
+		X509_gmtime_adj(X509_get_notBefore(cert),0);
+		X509_gmtime_adj(X509_get_notAfter(cert),(long)60*60*24*days);
+		X509_set_pubkey(cert,pkey);
+		
+		name=X509_get_subject_name(cert);
+
+		X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, k_C, -1, -1, 0);
+		X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, k_ST, -1, -1, 0);
+		X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, k_L, -1, -1, 0);
+		X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, k_O, -1, -1, 0);
+		X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, k_OU, -1, -1, 0);
+		X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, k_CN, -1, -1, 0);
+		X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, k_Email, -1, -1, 0);
+
+		X509_set_subject_name(cert,name);
+
+		if (!X509_sign(cert,pkey,EVP_md5())) {
+		    X509_free(cert);
+		    EVP_PKEY_free(pkey);
+		    Tcl_SetResult(interp,"Error signing certificate",NULL);
+		    return TCL_ERROR;
+		}
+
+		out=BIO_new(BIO_s_file());
+		BIO_write_filename(out,pemout);
+
+		PEM_write_bio_X509(out,cert);
+		BIO_free_all(out);
+
+		X509_free(cert);
+		EVP_PKEY_free(pkey);
+	    } else {
+		Tcl_SetResult(interp,"Error generating private key",NULL);
+		return TCL_ERROR;
+	    }
+	}
+	break;
+    }
+    return TCL_OK;
+}
 
 /*
  *-------------------------------------------------------------------
  *
  * Tls_Free --
@@ -1228,11 +1391,11 @@
  *-------------------------------------------------------------------
  */
 
 int
 Tls_Init(Tcl_Interp *interp)		/* Interpreter in which the package is
-                                         * to be made available. */
+					 * to be made available. */
 {
     int major, minor, patchlevel, release, i;
     char rnd_seed[16] = "GrzSlplKqUdnnzP!";	/* 16 bytes */
 
     /*
@@ -1246,11 +1409,11 @@
 	Tcl_InitStubs(interp, "8.2", 0)
 #else
 	Tcl_PkgRequire(interp, "Tcl", "8.2", 0)
 #endif
 	== NULL) {
-        return TCL_ERROR;
+	return TCL_ERROR;
     }
 
     /*
      * Get the version so we can runtime switch on available functionality.
      * TLS should really only be used in 8.3.2+, but the other works for
@@ -1265,11 +1428,11 @@
 	/* 8.2.0 - 8.3.1 */
 	channelTypeVersion = TLS_CHANNEL_VERSION_1;
     }
 
     if (SSL_library_init() != 1) {
-        Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
+	Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
 	return TCL_ERROR;
     }
     SSL_load_error_strings();
     ERR_load_crypto_strings();
 
@@ -1303,10 +1466,13 @@
     Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
 
     Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+
+    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
 
     return Tcl_PkgProvide(interp, PACKAGE, VERSION);
 }
 
 /*

Index: tlsX509.c
==================================================================
--- tlsX509.c
+++ tlsX509.c
@@ -1,10 +1,10 @@
 /*
  * Copyright (C) 1997-2000 Sensus Consulting Ltd.
  * Matt Newman <matt@sensus.org>
  *
- * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsX509.c,v 1.2 2000/01/20 01:53:14 aborr Exp $
+ * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tlsX509.c,v 1.3 2003/07/07 20:24:49 hobbs Exp $
  */
 #include "tlsInt.h"
 
 /*
  * ASN1_UTCTIME_tostr --
@@ -74,18 +74,35 @@
     int serial;
     char subject[BUFSIZ];
     char issuer[BUFSIZ];
     char notBefore[BUFSIZ];
     char notAfter[BUFSIZ];
+#ifndef NO_SSL_SHA
+    int shai;
+    char sha_hash[SHA_DIGEST_LENGTH*2];
+    const char *shachars="0123456789ABCDEF";
+#endif
 
     serial = ASN1_INTEGER_get(X509_get_serialNumber(cert));
     X509_NAME_oneline(X509_get_subject_name(cert),subject,sizeof(subject));
     X509_NAME_oneline(X509_get_issuer_name(cert),issuer,sizeof(issuer));
 
     strcpy( notBefore, ASN1_UTCTIME_tostr( X509_get_notBefore(cert) ));
     strcpy( notAfter, ASN1_UTCTIME_tostr( X509_get_notAfter(cert) ));
 
+#ifndef NO_SSL_SHA
+    for (shai=0;shai<SHA_DIGEST_LENGTH;shai++)
+    {
+        sha_hash[shai * 2]=shachars[(cert->sha1_hash[shai] & 0xF0) >> 4];
+        sha_hash[shai * 2 + 1]=shachars[(cert->sha1_hash[shai] & 0x0F)];
+    }
+    Tcl_ListObjAppendElement( interp, certPtr,
+	    Tcl_NewStringObj( "sha1_hash", -1) );
+    Tcl_ListObjAppendElement( interp, certPtr,
+	    Tcl_NewStringObj( sha_hash, SHA_DIGEST_LENGTH*2) );
+
+#endif
     Tcl_ListObjAppendElement( interp, certPtr,
 	    Tcl_NewStringObj( "subject", -1) );
     Tcl_ListObjAppendElement( interp, certPtr,
 	    Tcl_NewStringObj( subject, -1) );