Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -30,15 +30,16 @@
tls::connection channel
tls::import channel ?options?
tls::unimport channel
tls::ciphers ?protocol? ?verbose? ?supported?
+ tls::digests
+ tls::macs
tls::protocols
tls::version
tls::digest type ?-bin|-hex? ?-key hmac_key? [-file filename | -chan channel | ?-data? data]
- tls::digests
tls::md4 data
tls::md5 data
tls::sha1 data
tls::sha256 data
@@ -70,15 +71,16 @@
tls::handshake channel
tls::import channel ?options?
tls::unimport channel
tls::ciphers ?protocol? ?verbose? ?supported?
+tls::digests
+tls::macs
tls::protocols
tls::version
tls::digest type ?-bin|-hex? ?-key hmac_key? [-file filename | -chan channel | ?-data? data]
-tls::digests
tls::md4 data
tls::md5 data
tls::sha1 data
tls::sha256 data
@@ -436,10 +438,17 @@
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. If supported
is specified as true, then only the ciphers supported for protocol
will be listed.
+
+ tls::digests
+ Returns a list of the hash algorithms for tls::digest command.
+
+ tls::macs
+ Returns a list of the available Message Authentication Codes (MAC) for
+ the tls::digest command.
tls::protocols
Returns a list of supported protocols. Valid values are:
ssl2, ssl3, tls1, tls1.1, tls1.2,
and tls1.3. Exact list depends on OpenSSL version and
@@ -461,13 +470,10 @@
To salt a password, append or prepend the salt text to the password.
Type can be any OpenSSL supported hash algorithm including: md4,
md5, sha1, sha256, sha512, sha3-256,
etc. See tls::digests command for a full list.
- tls::digests
- Returns a list of the hash algorithms for tls::digest command.
-
tls::md4 data
Returns the MD4 message-digest for data as a hex string.
tls::md5 data
Returns the MD5 message-digest for data as a hex string.
Index: generic/tlsInfo.c
==================================================================
--- generic/tlsInfo.c
+++ generic/tlsInfo.c
@@ -257,10 +257,36 @@
}
/*
*-------------------------------------------------------------------
*
+ * MacsObjCmd --
+ *
+ * Return a list of all valid message authentication codes (MAC).
+ *
+ * Results:
+ * A standard Tcl list.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------
+ */
+int MacsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cmac", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("hmac", -1));
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ clientData = clientData;
+ objc = objc;
+ objv = objv;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
* ProtocolsObjCmd --
*
* Return a list of the available or supported SSL/TLS protocols.
*
* Results:
@@ -356,8 +382,9 @@
*/
int Tls_InfoCommands(Tcl_Interp *interp) {
Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::digests", DigestsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::macs", MacsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
}
Index: tests/ciphers.csv
==================================================================
--- tests/ciphers.csv
+++ tests/ciphers.csv
@@ -13,10 +13,11 @@
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,"proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data ""\n""] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}",,,,,,,,,
command,"proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data ""\n""] {foreach digest $line {if {[string match ""-*"" $digest]} {lappend list [string trimleft $digest ""-""]}}};return [lsort $list]}",,,,,,,,,
+command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,,
command,proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result},,,,,,,,,
command,proc read_chan {md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set new [tls::digest $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new]};close $new;return $result},,,,,,,,,
,,,,,,,,,,
command,# Test list ciphers,,,,,,,,,
Ciphers List,All,,,lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]],,,missing {rc5 rc5-cbc rc5-cfb rc5-ecb rc5-ofb} unexpected {aes-128-ccm aes-128-gcm aes-192-ccm aes-192-gcm aes-256-ccm aes-256-gcm},,,
@@ -83,11 +84,14 @@
Digest HMAC,data,,,"tls::digest md5 -key ""Example key"" -data ""Example string for message digest tests.""",,,901DA6E6976A71650C77443C37FF9C7F,,,
Digest HMAC,file,,,"tls::digest md5 -key ""Example key"" -file md_data.dat",,,901DA6E6976A71650C77443C37FF9C7F,,,
Digest HMAC,channel,knownBug,,"read_chan md5 md_data.dat -key ""Example key""",,,901DA6E6976A71650C77443C37FF9C7F,,,
Digest HMAC,data bin,,,"string toupper [binary encode hex [tls::digest md5 -bin -key ""Example key"" -data ""Example string for message digest tests.""]]",,,901DA6E6976A71650C77443C37FF9C7F,,,
,,,,,,,,,,
+command,# Test list MACs,,,,,,,,,
+MAC List,All,,,lcompare [exec_get_macs] [tls::macs],,,missing {} unexpected {},,,
+,,,,,,,,,,
command,# Test list protocols,,,,,,,,,
Protocols,All,,,lcompare $protocols [::tls::protocols],,,missing {ssl2 ssl3} unexpected {},,,
,,,,,,,,,,
command,# Test show version,,,,,,,,,
Version,All,,,::tls::version,,glob,*,,,
Version,OpenSSL,OpenSSL,,::tls::version,,glob,OpenSSL*,,,
Index: tests/ciphers.test
==================================================================
--- tests/ciphers.test
+++ tests/ciphers.test
@@ -21,11 +21,11 @@
# 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]}
proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data "\n"] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}
proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data "\n"] {foreach digest $line {if {[string match "-*" $digest]} {lappend list [string trimleft $digest "-"]}}};return [lsort $list]}
-proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result}
+command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,,
proc read_chan {md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set new [tls::digest $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new]};close $new;return $result}
# Test list ciphers
test Ciphers_List-1.1 {All} -body {
@@ -231,25 +231,31 @@
} -result {901DA6E6976A71650C77443C37FF9C7F}
test Digest_HMAC-10.4 {data bin} -body {
string toupper [binary encode hex [tls::digest md5 -bin -key "Example key" -data "Example string for message digest tests."]]
} -result {901DA6E6976A71650C77443C37FF9C7F}
+# Test list MACs
+
+
+test MAC_List-11.1 {All} -body {
+ lcompare [exec_get_macs] [tls::macs]
+ } -result {missing {} unexpected {}}
# Test list protocols
-test Protocols-11.1 {All} -body {
+test Protocols-12.1 {All} -body {
lcompare $protocols [::tls::protocols]
} -result {missing {ssl2 ssl3} unexpected {}}
# Test show version
-test Version-12.1 {All} -body {
+test Version-13.1 {All} -body {
::tls::version
} -match {glob} -result {*}
-test Version-12.2 {OpenSSL} -constraints {OpenSSL} -body {
+test Version-13.2 {OpenSSL} -constraints {OpenSSL} -body {
::tls::version
} -match {glob} -result {OpenSSL*}
# Cleanup
::tcltest::cleanupTests
return