Index: doc/tls.html ================================================================== --- doc/tls.html +++ doc/tls.html @@ -28,11 +28,11 @@
tls::status ?-local? channel
tls::connection channel
tls::import channel ?options?
tls::unimport channel
 
-
tls::ciphers protocol ?verbose?
+
tls::ciphers protocol ?verbose? ?supported?
tls::protocols
tls::version
COMMANDS
@@ -61,11 +61,11 @@ tls::connection channel
tls::handshake channel
tls::import channel ?options?
tls::unimport channel

-tls::ciphers protocol ?verbose?
+tls::ciphers protocol ?verbose? ?supported?
tls::protocols tls::version

DESCRIPTION

@@ -135,12 +135,19 @@ the SSL_CERT_FILE environment variable.
-cert filename
Specify the contents of a certificate to use, as a DER encoded binary value (X.509 DER).
-cipher string
-
List of ciphers to use. See OpenSSL documentation for the full - list of valid values.
+
List of ciphers to use. String is a colon (":") separated list + of ciphers or cipher suites. Cipher suites can be combined + using the + character. Prefixes can be used to permanently + remove ("!"), delete ("-"), or move a cypher to the end of + the list ("+"). Keywords @STRENGTH (sort by algorithm + key length), @SECLEVEL=n (set security level to + n), and DEFAULT (use default cipher list, at start only) + can also be specified. See OpenSSL documentation for the full + list of valid values. (TLS 1.2 and earlier only)
-command callback
Callback to invoke at several points during the handshake. This is used to pass errors and tracing information, and it can allow Tcl scripts to perform their own certificate validation in place of the default validation provided by @@ -283,16 +290,18 @@
Whether the session has been reused or not.
tls::ciphers - protocol ?verbose?
+ protocol ?verbose? ?supported?
Returns a list of supported ciphers available for protocol, where protocol must be one of ssl2, ssl3, tls1, tls1.1, tls1.2, or tls1.3. If verbose is specified as true then a verbose, human readable list is returned with - additional information on the cipher.
+ additional information on the cipher. If supported + is specified as true, then only the ciphers supported for protocol + will be listed.
tls::protocols
Returns a list of supported protocols. Valid values are: ssl2, ssl3, tls1, tls1.1, tls1.2, and tls1.3.
Index: generic/tls.c ================================================================== --- generic/tls.c +++ generic/tls.c @@ -498,32 +498,36 @@ TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE }; static int CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr; + Tcl_Obj *objPtr = NULL; SSL_CTX *ctx = NULL; SSL *ssl = NULL; STACK_OF(SSL_CIPHER) *sk; char *cp, buf[BUFSIZ]; - int index, verbose = 0; + int index, verbose = 0, use_supported = 0; dprintf("Called"); - if ((objc < 2) || (objc > 3)) { - Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?"); + if ((objc < 2) || (objc > 4)) { + Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) { return TCL_ERROR; } if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) { return TCL_ERROR; } + if ((objc > 3) && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum protocol)index) { case TLS_SSL2: -#if OPENSSL_VERSION_NUMBER >= 0x10101000L || defined(NO_SSL2) || defined(OPENSSL_NO_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; #endif @@ -570,38 +574,54 @@ } if (ctx == NULL) { Tcl_AppendResult(interp, REASON(), NULL); return TCL_ERROR; } + ssl = SSL_new(ctx); if (ssl == NULL) { Tcl_AppendResult(interp, REASON(), NULL); SSL_CTX_free(ctx); return TCL_ERROR; } - objPtr = Tcl_NewListObj(0, NULL); - - if (!verbose) { - for (index = 0; ; index++) { - cp = (char*)SSL_get_cipher_list(ssl, index); - if (cp == NULL) break; - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1)); - } + + /* Use list and order as would be sent in a ClientHello or all available ciphers */ + if (use_supported) { + sk = SSL_get1_supported_ciphers(ssl); } else { sk = SSL_get_ciphers(ssl); + } - for (index = 0; index < sk_SSL_CIPHER_num(sk); index++) { - register size_t i; - SSL_CIPHER_description(sk_SSL_CIPHER_value(sk, index), buf, sizeof(buf)); - for (i = strlen(buf) - 1; i ; i--) { - if ((buf[i] == ' ') || (buf[i] == '\n') || (buf[i] == '\r') || (buf[i] == '\t')) { - buf[i] = '\0'; + if (sk != NULL) { + if (!verbose) { + objPtr = Tcl_NewListObj(0, NULL); + for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) { + const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i); + if (c == NULL) continue; + + /* cipher name or (NONE) */ + cp = SSL_CIPHER_get_name(c); + if (cp == NULL) break; + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1)); + } + + } else { + objPtr = Tcl_NewStringObj("",0); + for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) { + const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i); + if (c == NULL) continue; + + /* textual description of the cipher */ + if (SSL_CIPHER_description(c, buf, sizeof(buf)) != NULL) { + Tcl_AppendToObj(objPtr, buf, strlen(buf)); } else { - break; + Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8); } } - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1)); + } + if (use_supported) { + sk_SSL_CIPHER_free(sk); } } SSL_free(ssl); SSL_CTX_free(ctx); @@ -637,11 +657,11 @@ return TCL_ERROR; } objPtr = Tcl_NewListObj(0, NULL); -#if OPENSSL_VERSION_NUMBER < 0x10101000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2) +#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL2], -1)); #endif #if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1)); #endif @@ -990,11 +1010,11 @@ } } if (alpn) { /* Convert a Tcl list into a protocol-list in wire-format */ unsigned char *protos, *p; - unsigned int protoslen = 0; + unsigned int protos_len = 0; int i, len, cnt; Tcl_Obj **list; if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) { Tls_Free((char *) statePtr); return TCL_ERROR; @@ -1005,23 +1025,23 @@ if (len > 255) { Tcl_AppendResult(interp, "alpn protocol name too long", (char *) NULL); Tls_Free((char *) statePtr); return TCL_ERROR; } - protoslen += 1 + len; + protos_len += 1 + len; } /* Build the complete protocol-list */ - protos = ckalloc(protoslen); + protos = ckalloc(protos_len); /* protocol-lists consist of 8-bit length-prefixed, byte strings */ for (i = 0, p = protos; i < cnt; i++) { char *str = Tcl_GetStringFromObj(list[i], &len); *p++ = len; memcpy(p, str, len); p += len; } /* Note: This functions reverses the return value convention */ - if (SSL_set_alpn_protos(statePtr->ssl, protos, protoslen)) { + if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) { Tcl_AppendResult(interp, "failed to set alpn protocols", (char *) NULL); Tls_Free((char *) statePtr); ckfree(protos); return TCL_ERROR; } ADDED tests/README.txt Index: tests/README.txt ================================================================== --- /dev/null +++ tests/README.txt @@ -0,0 +1,17 @@ +Create Test Cases + +1. Create test case *.csv file. You can use multiple files. Generally it's a good idea to group like functions in the same file. + +2. Add test cases to *.csv files. + Each test case is on a separate line. Each column defines the equivalent input the tcltest tool expects. + +3. Define any common functions in common.tcl or in *.csv file. + +4. To create the test cases script, execute make_test_files.tcl. This will use the *.csv files to create the *.test files. + +Execute Test Suite + +5. To run the test suite, execute the all.tcl file. The results will be output to the stdoutlog.txt file. + On Windows you can also use the run_all_tests.bat file. + +6. Review stdoutlog.txt for the count of test cases executed successfully and view details of those that failed. ADDED tests/ciphers.csv Index: tests/ciphers.csv ================================================================== --- /dev/null +++ tests/ciphers.csv @@ -0,0 +1,46 @@ +# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes +command,package require tls,,,,,,,,, +command,,,,,,,,,, +command,# Make sure path includes location of OpenSSL executable,,,,,,,,, +command,"if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] "";"" $::env(path)}",,,,,,,,, +command,,,,,,,,,, +command,# Constraints,,,,,,,,, +command,set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3],,,,,,,,, +command,foreach protocol $protocols {::tcltest::testConstraint $protocol 0},,,,,,,,, +command,foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1},,,,,,,,, +command,"::tcltest::testConstraint OpenSSL [string match ""OpenSSL*"" [::tls::version]]",,,,,,,,, +,,,,,,,,,, +command,# Helper functions,,,,,,,,, +command,"proc lcompare {list1 list2} {set m """";set u """";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list ""missing"" $m ""unexpected"" $u]}",,,,,,,,, +command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,, +,,,,,,,,,, +command,# Test protocols,,,,,,,,, +Protocols,All,,,lcompare $protocols [::tls::protocols],,,missing {ssl2 ssl3} unexpected {},,, +,,,,,,,,,, +command,# Test ciphers,,,,,,,,, +CiphersAll,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2] [::tls::ciphers ssl2]",,,missing {} unexpected {},,, +CiphersAll,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3] [::tls::ciphers ssl3]",,,missing {} unexpected {},,, +CiphersAll,TLS1,tls1,,"lcompare [exec_get "":"" ciphers -tls1] [::tls::ciphers tls1]",,,missing {} unexpected {},,, +CiphersAll,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1] [::tls::ciphers tls1.1]",,,missing {} unexpected {},,, +CiphersAll,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2] [::tls::ciphers tls1.2]",,,missing {} unexpected {},,, +CiphersAll,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3] [::tls::ciphers tls1.3]",,,missing {} unexpected {},,, +,,,,,,,,,, +command,# Test cipher descriptions,,,,,,,,, +CiphersDesc,SSL2,ssl2,,"lcompare [exec_get ""\r\n"" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]",,,missing {} unexpected {},,, +CiphersDesc,SSL3,ssl3,,"lcompare [exec_get ""\r\n"" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]",,,missing {} unexpected {},,, +CiphersDesc,TLS1,tls1,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,, +CiphersDesc,TLS1.1,tls1.1,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,, +CiphersDesc,TLS1.2,tls1.2,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,, +CiphersDesc,TLS1.3,tls1.3,,"lcompare [exec_get ""\r\n"" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]",,,missing {} unexpected {},,, +,,,,,,,,,, +command,# Test protocol specific ciphers,,,,,,,,, +CiphersSpecific,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]",,,missing {} unexpected {},,, +CiphersSpecific,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]",,,missing {} unexpected {},,, +CiphersSpecific,TLS1,tls1,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,, +CiphersSpecific,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,, +CiphersSpecific,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,, +CiphersSpecific,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,, +,,,,,,,,,, +command,# Test version,,,,,,,,, +Version,All,,,::tls::version,,glob,*,,, +Version,OpenSSL,OpenSSL,,::tls::version,,glob,OpenSSL*,,, Index: tests/ciphers.test ================================================================== --- tests/ciphers.test +++ tests/ciphers.test @@ -1,157 +1,121 @@ -# Commands covered: tls::ciphers -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# - -# All rights reserved. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import ::tcltest::* -} - -# The build dir is added as the first element of $PATH +# Auto generated test cases for ciphers_and_protocols.csv + +# Load Tcl Test package +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest + namespace import ::tcltest::* +} + +set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path] + package require tls -# One of these should == 1, depending on what type of ssl library -# tls was compiled against. (RSA BSAFE SSL-C or OpenSSL). -# -set ::tcltest::testConstraints(rsabsafe) 0 -set ::tcltest::testConstraints(openssl) [string match "OpenSSL*" [tls::version]] - -set ::EXPECTEDCIPHERS(rsabsafe) { - EDH-DSS-RC4-SHA - EDH-RSA-DES-CBC3-SHA - EDH-DSS-DES-CBC3-SHA - DES-CBC3-SHA - RC4-SHA - RC4-MD5 - EDH-RSA-DES-CBC-SHA - EDH-DSS-DES-CBC-SHA - DES-CBC-SHA - EXP-EDH-DSS-DES-56-SHA - EXP-EDH-DSS-RC4-56-SHA - EXP-DES-56-SHA - EXP-RC4-56-SHA - EXP-EDH-RSA-DES-CBC-SHA - EXP-EDH-DSS-DES-CBC-SHA - EXP-DES-CBC-SHA - EXP-RC2-CBC-MD5 - EXP-RC4-MD5 -} - -set ::EXPECTEDCIPHERS(openssl) { - AES128-SHA - AES256-SHA - DES-CBC-SHA - DES-CBC3-SHA - DHE-DSS-AES128-SHA - DHE-DSS-AES256-SHA - DHE-DSS-RC4-SHA - DHE-RSA-AES128-SHA - DHE-RSA-AES256-SHA - EDH-DSS-DES-CBC-SHA - EDH-DSS-DES-CBC3-SHA - EDH-RSA-DES-CBC-SHA - EDH-RSA-DES-CBC3-SHA - EXP-DES-CBC-SHA - EXP-EDH-DSS-DES-CBC-SHA - EXP-EDH-RSA-DES-CBC-SHA - EXP-RC2-CBC-MD5 - EXP-RC4-MD5 - EXP1024-DES-CBC-SHA - EXP1024-DHE-DSS-DES-CBC-SHA - EXP1024-DHE-DSS-RC4-SHA - EXP1024-RC2-CBC-MD5 - EXP1024-RC4-MD5 - EXP1024-RC4-SHA - IDEA-CBC-SHA - RC4-MD5 - RC4-SHA -} - -set ::EXPECTEDCIPHERS(openssl0.9.8) { - DHE-RSA-AES256-SHA - DHE-DSS-AES256-SHA - AES256-SHA - EDH-RSA-DES-CBC3-SHA - EDH-DSS-DES-CBC3-SHA - DES-CBC3-SHA - DHE-RSA-AES128-SHA - DHE-DSS-AES128-SHA - AES128-SHA - IDEA-CBC-SHA - RC4-SHA - RC4-MD5 - EDH-RSA-DES-CBC-SHA - EDH-DSS-DES-CBC-SHA - DES-CBC-SHA - EXP-EDH-RSA-DES-CBC-SHA - EXP-EDH-DSS-DES-CBC-SHA - EXP-DES-CBC-SHA - EXP-RC2-CBC-MD5 - EXP-RC4-MD5 -} - -set version "" -if {[string match "OpenSSL*" [tls::version]]} { - regexp {OpenSSL ([\d\.]+)} [tls::version] -> version -} -if {![info exists ::EXPECTEDCIPHERS(openssl$version)]} { - set version "" -} - -proc listcompare {wants haves} { - array set want {} - array set have {} - foreach item $wants { set want($item) 1 } - foreach item $haves { set have($item) 1 } - foreach item [lsort -dictionary [array names have]] { - if {[info exists want($item)]} { - unset want($item) have($item) - } - } - if {[array size want] || [array size have]} { - return [list MISSING [array names want] UNEXPECTED [array names have]] - } -} - -test ciphers-1.1 {Tls::ciphers for ssl3} {rsabsafe} { - # This will fail if you compiled against OpenSSL. - # Change the constraint setting above. - listcompare $::EXPECTEDCIPHERS(rsabsafe) [tls::ciphers ssl3] -} {} - -test ciphers-1.2 {Tls::ciphers for tls1} {rsabsafe} { - # This will fail if you compiled against OpenSSL. - # Change the constraint setting above. - listcompare $::EXPECTEDCIPHERS(rsabsafe) [tls::ciphers tls1] -} {} - -test ciphers-1.3 {Tls::ciphers for ssl3} {openssl} { - # This will fail if you compiled against RSA bsafe or with a - # different set of defines than the default. - # Change the constraint setting above. - listcompare $::EXPECTEDCIPHERS(openssl$version) [tls::ciphers ssl3] -} {} - -# This version of the test is correct for OpenSSL only. -# An equivalent test for the RSA BSAFE SSL-C is earlier in this file. - -test ciphers-1.4 {Tls::ciphers for tls1} {openssl} { - # This will fail if you compiled against RSA bsafe or with a - # different set of defines than the default. - # Change the constraint setting in all.tcl - listcompare $::EXPECTEDCIPHERS(openssl$version) [tls::ciphers tls1] -} {} - - -# cleanup +# Make sure path includes location of OpenSSL executable +if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] ";" $::env(path)} + +# Constraints +set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3] +foreach protocol $protocols {::tcltest::testConstraint $protocol 0} +foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1} +::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]] +# Helper functions +proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]} +proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]} +# Test protocols + + +test Protocols-1.1 {All} -body { + lcompare $protocols [::tls::protocols] + } -result {missing {ssl2 ssl3} unexpected {}} +# Test ciphers + + +test CiphersAll-2.1 {SSL2} -constraints {ssl2} -body { + lcompare [exec_get ":" ciphers -ssl2] [::tls::ciphers ssl2] + } -result {missing {} unexpected {}} + +test CiphersAll-2.2 {SSL3} -constraints {ssl3} -body { + lcompare [exec_get ":" ciphers -ssl3] [::tls::ciphers ssl3] + } -result {missing {} unexpected {}} + +test CiphersAll-2.3 {TLS1} -constraints {tls1} -body { + lcompare [exec_get ":" ciphers -tls1] [::tls::ciphers tls1] + } -result {missing {} unexpected {}} + +test CiphersAll-2.4 {TLS1.1} -constraints {tls1.1} -body { + lcompare [exec_get ":" ciphers -tls1_1] [::tls::ciphers tls1.1] + } -result {missing {} unexpected {}} + +test CiphersAll-2.5 {TLS1.2} -constraints {tls1.2} -body { + lcompare [exec_get ":" ciphers -tls1_2] [::tls::ciphers tls1.2] + } -result {missing {} unexpected {}} + +test CiphersAll-2.6 {TLS1.3} -constraints {tls1.3} -body { + lcompare [exec_get ":" ciphers -tls1_3] [::tls::ciphers tls1.3] + } -result {missing {} unexpected {}} +# Test cipher descriptions + + +test CiphersDesc-3.1 {SSL2} -constraints {ssl2} -body { + lcompare [exec_get "\r\n" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n] + } -result {missing {} unexpected {}} + +test CiphersDesc-3.2 {SSL3} -constraints {ssl3} -body { + lcompare [exec_get "\r\n" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n] + } -result {missing {} unexpected {}} + +test CiphersDesc-3.3 {TLS1} -constraints {tls1} -body { + lcompare [exec_get "\r\n" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n] + } -result {missing {} unexpected {}} + +test CiphersDesc-3.4 {TLS1.1} -constraints {tls1.1} -body { + lcompare [exec_get "\r\n" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n] + } -result {missing {} unexpected {}} + +test CiphersDesc-3.5 {TLS1.2} -constraints {tls1.2} -body { + lcompare [exec_get "\r\n" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n] + } -result {missing {} unexpected {}} + +test CiphersDesc-3.6 {TLS1.3} -constraints {tls1.3} -body { + lcompare [exec_get "\r\n" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n] + } -result {missing {} unexpected {}} +# Test protocol specific ciphers + + +test CiphersSpecific-4.1 {SSL2} -constraints {ssl2} -body { + lcompare [exec_get ":" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1] + } -result {missing {} unexpected {}} + +test CiphersSpecific-4.2 {SSL3} -constraints {ssl3} -body { + lcompare [exec_get ":" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1] + } -result {missing {} unexpected {}} + +test CiphersSpecific-4.3 {TLS1} -constraints {tls1} -body { + lcompare [exec_get ":" ciphers -tls1 -s] [::tls::ciphers tls1 0 1] + } -result {missing {} unexpected {}} + +test CiphersSpecific-4.4 {TLS1.1} -constraints {tls1.1} -body { + lcompare [exec_get ":" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1] + } -result {missing {} unexpected {}} + +test CiphersSpecific-4.5 {TLS1.2} -constraints {tls1.2} -body { + lcompare [exec_get ":" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1] + } -result {missing {} unexpected {}} + +test CiphersSpecific-4.6 {TLS1.3} -constraints {tls1.3} -body { + lcompare [exec_get ":" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1] + } -result {missing {} unexpected {}} +# Test version + + +test Version-5.1 {All} -body { + ::tls::version + } -match {glob} -result {*} + +test Version-5.2 {OpenSSL} -constraints {OpenSSL} -body { + ::tls::version + } -match {glob} -result {OpenSSL*} + +# Cleanup ::tcltest::cleanupTests return ADDED tests/make_test_files.tcl Index: tests/make_test_files.tcl ================================================================== --- /dev/null +++ tests/make_test_files.tcl @@ -0,0 +1,123 @@ +# +# Name: Make Test Files From CSV Files +# Version: 0.2 +# Date: August 6, 2022 +# Author: Brian O'Hagan +# Email: brian199@comcast.net +# Legal Notice: (c) Copyright 2020 by Brian O'Hagan +# Released under the Apache v2.0 license. I would appreciate a copy of any modifications +# made to this package for possible incorporation in a future release. +# + +# +# Convert test case file into test files +# +proc process_config_file {filename} { + set prev "" + set test 0 + + # Open file with test case indo + set in [open $filename r] + array set cases [list] + + # Open output test file + set out [open [format %s.test [file rootname $filename]] w] + array set cases [list] + + # Add setup commands to test file + puts $out [format "# Auto generated test cases for %s" [file tail $filename]] + #puts $out [format "# Auto generated test cases for %s created on %s" [file tail $filename] [clock format [clock seconds]]] + + # Package requires + puts $out "\n# Load Tcl Test package" + puts $out [subst -nocommands {if {[lsearch [namespace children] ::tcltest] == -1} {\n\tpackage require tcltest\n\tnamespace import ::tcltest::*\n}\n}] + puts $out {set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]} + puts $out "" + + # Generate test cases and add to test file + while {[gets $in data] > -1} { + # Skip comments + set data [string trim $data] + if {[string match "#*" $data]} continue + + # Split comma separated fields with quotes + set list [list] + while {[string length $data] > 0} { + if {[string index $data 0] eq "\""} { + # Quoted + set end [string first "\"," $data] + if {$end == -1} {set end [expr {[string length $data]+1}]} + lappend list [string map [list {""} \"] [string range $data 1 [incr end -1]]] + set data [string range $data [incr end 3] end] + + } else { + # Not quoted, so no embedded NL, quotes, or commas + set index [string first "," $data] + if {$index == -1} {set index [expr {[string length $data]+1}]} + lappend list [string range $data 0 [incr index -1]] + set data [string range $data [incr index 2] end] + } + } + + # Get command or test case + foreach {group name constraints setup body cleanup match result output errorOutput returnCodes} $list { + if {$group eq "command"} { + # Pass-through command + puts $out $name + + } elseif {$group ne "" && $body ne ""} { + set group [string map [list " " "_"] $group] + if {$group ne $prev} { + incr test + set prev $group + puts $out "" + } + + # Test case + set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name] + foreach opt [list -constraints -setup -body -cleanup -match -result -output -errorOutput -returnCodes] { + set cmd [string trim [set [string trimleft $opt "-"]]] + if {$cmd ne ""} { + if {$opt in [list -setup -body -cleanup]} { + append buffer " " $opt " \{\n" + foreach line [split $cmd ";"] { + append buffer \t [string trim $line] \n + } + append buffer " \}" + } elseif {$opt in [list -output -errorOutput]} { + append buffer " " $opt " {" $cmd \n "}" + } elseif {$opt in [list -result]} { + if {[string index $cmd 0] in [list \[ \" \{]} { + append buffer " " $opt " " $cmd + } elseif {[string match {*[\\$]*} $cmd]} { + append buffer " " $opt " \"" [string map [list \\\\\" \\\"] [string map [list \" \\\" ] $cmd]] "\"" + } else { + append buffer " " $opt " {" $cmd "}" + } + } else { + append buffer " " $opt " {" $cmd "}" + } + } + } + puts $out $buffer + + } else { + # Empty line + } + break + } + } + + # Output clean-up commands + puts $out "\n# Cleanup\n::tcltest::cleanupTests\nreturn" + close $out + close $in +} + +# +# Call script +# +foreach file [glob *.csv] { + process_config_file $file +} +exit