Index: configure
==================================================================
--- configure
+++ configure
@@ -5394,11 +5394,11 @@
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------
- vars="tls.c tlsBIO.c tlsIO.c tlsX509.c"
+ vars="tls.c tlsBIO.c tlsDigest.c tlsEncrypt.c tlsInfo.c tlsIO.c tlsX509.c"
for i in $vars; do
case $i in
\$*)
# allow $-var names
PKG_SOURCES="$PKG_SOURCES $i"
Index: configure.ac
==================================================================
--- configure.ac
+++ configure.ac
@@ -69,11 +69,11 @@
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------
-TEA_ADD_SOURCES([tls.c tlsBIO.c tlsIO.c tlsX509.c])
+TEA_ADD_SOURCES([tls.c tlsBIO.c tlsDigest.c tlsEncrypt.c tlsInfo.c tlsIO.c tlsX509.c])
TEA_ADD_HEADERS([generic/tls.h])
TEA_ADD_INCLUDES([])
TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
TEA_ADD_STUB_SOURCES([])
ADDED doc/cryptography.html
Index: doc/cryptography.html
==================================================================
--- /dev/null
+++ doc/cryptography.html
@@ -0,0 +1,457 @@
+
+
+
+The Tcl Cryptography Package
+Tcl Cryptography Documentation
+
+
+ NAME
+ tls - binding to OpenSSL toolkit.DESCRIPTION SYNOPSIS
+ package require Tcl ?8.5-? package require tls
+ tls::cipher name tls::ciphers ?protocol? ?verbose? ?supported? tls::digests ?name? tls::macs tls::protocols tls::version
+ tls::cmac -cipher name -key key ?options? tls::hmac -digest name -key key ?options? tls::md -digest name ?options? tls::md4 data tls::md5 data tls::sha1 data tls::sha256 data tls::sha512 data tls::unstack channelId
+ tls::encrypt -cipher name -key key ?options? tls::decrypt -cipher name -key key ?options?
+ OPTIONS COMMANDS GLOSSARY EXAMPLES SPECIAL CONSIDERATIONS
+
+tls - binding to OpenSSL toolkit.
+
+
+
+This extension provides a generic interface to the
+OpenSSL cryptography functions. The
+provided commands can be used to ensure the confidentiality, authenticity,
+and integrity of messages and data.
+
+package require Tcl 8.5- package require tls tls::cipher name tls::ciphers ?protocol? ?verbose? ?supported? tls::digests ?name? tls::macs tls::protocols tls::version tls::cmac -cipher name -key key ?options? tls::hmac -digest name -key key ?options? tls::md -digest name ?options? tls::md4 data tls::md5 data tls::sha1 data tls::sha256 data tls::sha512 data tls::unstack channelId tls::encrypt -cipher name -key key ?options? tls::decrypt -cipher name -key key ?options?
+
+The following options are used by the cryptography commands.
+Cryptographic Options
+
+
+ -cipher name Name of cryptographic cipher to use. Used by encrypt/decrypt command
+ and CMAC & GMAC hash algorithms. For CMAC it must be one of AES-128-CBC,
+ AES-192-CBC, AES-256-CBC or DES-EDE3-CBC. For GMAC it should be a GCM mode
+ cipher e.g. AES-128-GCM. See tls::ciphers
+
+
+
+ -digest name Name of hash function (aka message digest) to use.
+ See tls::digests
+
+
+
+ -iterations count Number (integer) of iterations on the password to use in deriving the
+ encryption key. Default is 10000. Some KDF implementations require an
+ iteration count.
+
+
+
+ -iv string Initialization vector (IV) to use. Required for some ciphers and GMAC.
+ Cipher modes CBC, CFB, OFB and CTR all need an IV while ECB mode does not.
+ A new, random IV should be created for each use. Think of the IV as a nonce
+ (number used once), it's public but random and unpredictable. See the
+ tls::cipher
+
+
+
+ -key string Encryption key to use for cryptography function. Can be a binary or
+ text string. Longer keys provide better protection. Used by ciphers, HMAC,
+ some CMAC, and some KDF implementations. Key lengths less than key_length
+ size may be padded or rejected. See the
+ tls::cipher
+
+
+
+ -mac name Name of Message Authentication Code (MAC) to use.
+ See tls::macs
+
+
+
+ -password string Password to use for some KDF functions.
+
+
+
+ -properties list List of additional properties to pass to cryptography function.
+
+
+
+ -salt string Specifies salt value to use when encrypting data. Default is to use a
+ randomly generated value. This option is used by BLAKE2 MAC and some KDF
+ implementations use a non-secret unique cryptographic salt.
+
+
+
+ -size number Set the output hash size in bytes. Used by KMAC128 or KMAC256 to specify
+ an output length. The default sizes are 32 or 64 bytes respectively.
+
+
+
+ -xof boolean Set whether to use XOF. This option is used by KMAC.
+
+
+Input/Output Options
+
+
+ -chan channelId -channel channelId Add the cryptographic transformation on top of channel
+ channelId . Automatically sets channel to binary mode. Works
+ like chan push to create a stacked channel. If the command
+ fileevent is to be used for channel event monitoring, all
+ channels in the stack should be set to non-blocking mode. If not,
+ the system may hang while waiting for data. When done, use either the
+ close command or tls::unstack
+
+ set ch [open test_file.txt rb]
+ -command cmdName Create and return cmdName which is used to incrementally add
+ data to a cryptographic function. To add data to the function, call
+ "cmdName update data ", where
+ data is the data to add. When done, call
+ "cmdName finalize " to return the resulting
+ value and delete cmdName . Example code:
+
+ set cmd [::tls::digest -digest sha256 -command ::tls::temp]
+ -data string Perform the cryptographic function on data and return the
+ result. Example code:
+
+ set md [::tls::digest sha256 "Some example data."]
+ -file filename -filename filename Perform the cryptographic function on file filename and return
+ the result. This operation will open file, read the file data, close the
+ file, and return the result using the TCL file APIs, so VFS files are
+ supported. Example code:
+
+ set md [::tls::digest -digest sha256 -file test_file.txt]
+ -infile filename Specifies the file to use as data input source. This option uses the
+ TCL file APIs, so VFS files are supported. Example code:
+
+ ::tls::encrypt -cipher aes-128-cbc -key "Test key"
+ -infile unencrypted.txt -outfile encrypted.dat
+
+ -outfile filename Specifies the file to output the encryption results to. This option
+ uses the TCL file APIs, so VFS files are supported. Example code:
+
+ ::tls::decrypt -cipher aes-128-cbc -key "Test key"
+ -infile encrypted.dat -outfile unencrypted.txt
+
+ -keyfile filename Specifies the file to get the encryption key from.
+
+Format Options
+
+
+ -base64 Base64 encode data after encryption or decode before decryption.
+
+
+
+ -bin -binary Output result of function as a binary string.
+
+
+
+ -hex -hexadecimal Output result of function as a hexadecimal string. This is the default
+ option unless otherwise specified.
+
+
+The following commands provide access to the OpenSSL cryptography functions.
+
+
+
+Info Commands
+
+ tls::cipher name Return a list of property names and values describing cipher
+ name . Properties include name, description, block_size,
+ key_length, iv_length, type, and mode list.
+
+ tls::ciphers
+ ?protocol? ?verbose? ?supported? Without any args, returns a list of all symmetric ciphers for use with
+ the -cipher protocol ,
+ only the ciphers supported for that protocol are returned. See
+ tls::protocols command for the supported protocols. 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 ?name? Without name , returns a list of the supported message digests
+ (aka hash algorithms) for use with the -digest name , returns a list of
+ property names and values describing message digest name . Properties
+ include name, description, size, block_size, type, and flags list.
+
+ tls::kdfs Returns a list of the available Key Derivation Function (KDF)
+ algorithms.
+
+ tls::macs Returns a list of the available Message Authentication Codes (MAC)
+ for use with the -key
+
+ 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
+ compile time flags.
+
+ tls::version Returns the OpenSSL version string.
+
+Message Digest (MD) and Message Authentication Code (MAC) Commands
+
+ tls::cmac
+ ? -cipher ? name
+ -key key ? -bin |-hex ?
+ [ -chan channelId | -command cmdName |
+ -file filename | ? -data ? data] Calculate the Cipher-based Message Authentication Code (CMAC) where
+ key is a shared key and output the result per the I/O options
+ in the specified format. MACs are used to ensure authenticity and the
+ integrity of data. See options -key is only used for some ciphers.
+
+ tls::hmac
+ ? -digest ? name
+ -key key ? -bin |-hex ?
+ [ -chan channelId | -command cmdName |
+ -file filename | ? -data ? data] Calculate the Hash-based Message Authentication Code (HMAC) where
+ key is a shared secret key and output the result per the I/O
+ options in the specified format. The cryptographic strength depends
+ upon the size of the key and the security of the hash function used.
+ See options
+
+ tls::mac
+ ? -mac ? name -cipher name
+ -digest name -key key ?
+ -bin |-hex ?
+ [ -chan channelId | -command cmdName |
+ -file filename | ? -data ? data] (OpenSSL 3.0+) Calculate the Message Authentication Code (MAC) where
+ key is a shared key and output the result per the I/O options
+ in the specified format. MACs are used to ensure authenticity and
+ the integrity of data. See options
+
+ tls::md
+ ? -digest ? name ? -bin |-hex ?
+ [ -chan channelId | -command cmdName |
+ -file filename | ? -data ? data] Calculate the message digest (MD) using hash function name
+ and output the result per the I/O options in the specified format.
+ MDs are used to ensure the integrity of data. See
+ options
+
+ 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.
+
+ tls::sha1 data Returns the SHA1 secure hash algorithm digest for data as a hex string.
+
+ tls::sha256 data Returns the SHA-2 SHA256 secure hash algorithm digest for data as a hex string.
+
+ tls::sha512 data Returns the SHA-2 SHA512 secure hash algorithm digest for data as a hex string.
+
+ tls::unstack channelId Removes the top level cryptographic transform from channel channelId .
+
+Encryption and Decryption Commands
+
+ tls::encrypt
+ -cipher name -key key ? -iv string?
+ [ -chan channelId | -command cmdName |
+ -infile filename -outfile filename |
+ -data data] Encrypt the data using cipher cipher and output the result per
+ the I/O options. Ciphers are used to create the cipher text from the
+ input data. See options -iv is only used for some ciphers. See the
+ "tls::cipher cipher " command for key and iv
+ sizes and when the iv is used (iv_length > 0).
+
+ tls::decrypt
+ -cipher name -key key ? -iv string?
+ [ -chan channelId | -command cmdName |
+ -infile filename -outfile filename |
+ -data data] Decrypt the data using cipher cipher and output the result per
+ the I/O options. This command is the opposite of the tls::encrypt
+ command. See options -iv is only used for some ciphers. See the
+ "tls::cipher cipher " command for key and iv
+ sizes and when the iv is used (iv_length > 0).
+
+
+The following is a list of the terminology used in this package along with
+brief definitions. For more details, please consult with the OpenSSL documentation.
+
+
+TBS
+
+
+package require http
+package require tls
+
+http::register https 443 [list ::tls::socket -autoservername true -require true -cadir /etc/ssl/certs]
+
+set tok [http::geturl https://www.tcl.tk/]
+The capabilities of this package can vary enormously based upon how your
+OpenSSL library was configured and built. New versions may obsolete older
+ciphers, digests, MACs, etc. or change default values. Use the
+info commands to obtain the supported values.
+
+Copyright © 2023 Brian O'Hagan.
+
+
+
ADDED doc/docs.css
Index: doc/docs.css
==================================================================
--- /dev/null
+++ doc/docs.css
@@ -0,0 +1,1 @@
+body,div,p,th,td,li,dd,ul,ol,dl,dt,blockquote{font-family:Verdana,sans-serif}pre,code{font-family:courier new,Courier,monospace}pre{background-color:#f6fcec;border-top:1px solid #6a6a6a;border-bottom:1px solid #6a6a6a;padding:1em;overflow:auto}body{background-color:#fff;font-size:12px;line-height:1.25;letter-spacing:.2px;padding-left:.5em}h1,h2,h3,h4{font-family:Georgia,serif;padding-left:1em;margin-top:1em}h1{font-size:18px;color:#11577b;border-bottom:1px dotted #11577b;margin-top:0}h2{font-size:14px;color:#11577b;background-color:#c5dce8;padding-left:1em;border:1px solid #6a6a6a}h3,h4{color:#1674a4;background-color:#e8f2f6;border-bottom:1px dotted #11577b;border-top:1px dotted #11577b}h3{font-size:12px}h4{font-size:11px}.keylist dt,.arguments dt{width:20em;float:left;padding:2px;border-top:1px solid #999}.keylist dt{font-weight:700}.keylist dd,.arguments dd{margin-left:20em;padding:2px;border-top:1px solid #999}.copy{background-color:#f6fcfc;white-space:pre;font-size:80%;border-top:1px solid #6a6a6a;margin-top:2em}.tablecell{font-size:12px;padding-left:.5em;padding-right:.5em}
Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -1,39 +1,40 @@
-
-
-
-
+
+
TLS (SSL) Tcl Commands
+TLS (SSL) TCL Commands
+Tcl Tls Extension Documentation
NAME
- tls - binding to OpenSSL toolkit.tls - binding to OpenSSL library
+ for socket and I/O channel communications.
SYNOPSIS
- package require Tcl ?8.4? package require Tcl ?8.5? package require tls
tls::init ?options? tls::socket ?options? host port tls::socket ?-server command? ?options? port tls::socket ?-server command? ?options? port tls::handshake channel tls::status ?-local? channel tls::connection channel tls::status ?-local? channel tls::connection channel tls::import channel ?options? tls::unimport channel
- tls::ciphers protocol ?verbose? ?supported? tls::protocols tls::version
COMMANDS tls - binding to OpenSSL
-toolkit.
+tls - binding to OpenSSL library
+for socket and I/O channel communications.
-package require Tcl 8.4
package require Tcl 8.5 package require tls tls::init ?options? tls::socket ?options? host port tls::socket ?-server command? ?options? port tls::connection channel tls::handshake channel tls::import channel ?options? tls::unimport channel tls::ciphers protocol ?verbose? ?supported? tls::protocols tls::version tls::protocols tls::version
This extension provides a generic binding to
tls::socket ?-server command? ?options? port This is a helper function that utilizes the underlying
commands (tls::import ). It behaves
exactly the same as the native Tcl socket
- command except that the options can include any of the
+ command except the options can also include any of the
applicable tls:import
-autoservername bool Automatically send the -servername as the host argument
- (default is false )
+ Automatically set the -servername argument to the host
+ argument (default is false ).
tls::import channel
?options? SSL-enable a regular Tcl channel - it need not be a
- socket, but must provide bi-directional flow. Also
- setting session parameters for SSL handshake.
+ Add SSL/TLS encryption to a regular Tcl channel. It need
+ not be a socket, but must provide bi-directional flow. Also
+ set session parameters for SSL handshake.
-alpn list List of protocols to offer during Application-Layer
@@ -137,11 +137,11 @@
-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. String is a colon (":") separated list
- of ciphers or cipher suites. Cipher suites can be combined
+ of ciphers. Ciphers 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)
@@ -149,11 +149,11 @@
list of valid values. (TLS 1.2 and earlier only)
-ciphersuites string List of cipher suites to use. String is a colon (":")
separated list of cipher suite names. (TLS 1.3 only)
-command callback Callback to invoke at several points during the handshake.
+ Callback command 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
OpenSSL. See CALLBACK OPTIONS
for further discussion.
@@ -167,12 +167,12 @@
-model channel Force this channel to share the same SSL_CTX channel , and
therefore share callbacks etc.
-password callback Callback to invoke when OpenSSL needs to obtain a password,
- typically to unlock the private key of a certificate. The
+ Callback command to invoke when OpenSSL needs to obtain a password.
+ Typically used to unlock the private key of a certificate. The
callback should return a string which represents the password
to be used. See CALLBACK OPTIONS
for further discussion.
-post_handshake bool Allow post-handshake ticket updates.
@@ -180,26 +180,29 @@
Request a certificate from peer during SSL handshake.
(default is true )
-require bool Require a valid certificate from peer during SSL handshake.
If this is set to true, then -request must
- also be set to true. (default is false )
- -securitylevel integer false )
+ -security_level integer Set security level. Must be 0 to 5. The security level affects
- cipher suite encryption algorithms, supported ECC curves,
+ the cipher suite encryption algorithms, supported ECC curves,
supported signature algorithms, DH parameter sizes, certificate
key sizes and signature algorithms. The default is 1.
Level 3 and higher disable support for session tickets and only
accept cipher suites that provide forward secrecy.
-server bool Handshake as server if true, else handshake as
- client. (default is false )
+ Set to act as a server and respond with a server handshake when
+ a client connects and provides a client handshake.
+ (default is false )
-servername host Specify server hostname. Only available if the OpenSSL library
- the package is linked against supports the TLS hostname extension
- for 'Server Name Indication' (SNI). Use to name the logical host
- we are talking to and expecting a certificate for.
+ Specify server's hostname. Used to set the TLS 'Server Name
+ Indication' (SNI) extension. Set to the expected servername
+ in the server's certificate or one of the subjectAltName
+ alternates.
-session_id string Session id to resume session.
-ssl2 bool Enable use of SSL v2. (default is false )
-ssl3 bool -tls1.2 bool
Enable use of TLS v1.2 (default is true )
-tls1.3 bool
Enable use of TLS v1.3 (default is true )
-validatecommand callback Callback to invoke to verify or validate protocol config
+ Callback command to invoke to verify or validate protocol config
parameters during the protocol negotiation phase. See
CALLBACK OPTIONS
for further discussion.
tls::unimport channel Provided for symmetry to tls::import , this
- unstacks the SSL-enabling of a regular Tcl channel. An error
+ unstacks the encryption of a regular Tcl channel. An error
is thrown if TLS is not the top stacked channel type.
- tls::handshake channel tls::handshake
+ channel Forces handshake to take place, and returns 0 if
handshake is still in progress (non-blocking), or 1 if
the handshake was successful. If the handshake failed
this routine will throw an error.
tls::status
- ?-local? channel Returns the current status of the certificate for an SSL
- channel. The result is a list of key-value pairs describing
- the certificate. If the result is an empty list then the
- SSL handshake has not yet completed. If -local is
- specified, then the local certificate is used.
+ ? -local ? channel
+ Returns the current status of an SSL channel. The result is a list
+ of key-value pairs describing the SSL, certificate, and certificate
+ verification status. If the SSL handshake has not yet completed,
+ an empty list is returned. If -local is specified, then the
+ local certificate is used.
SSL Status
alpn protocol The protocol selected after Application-Layer Protocol
Negotiation (ALPN).
cipher cipher The current cipher in use between the client and
- server channels.
+ The current cipher in use between for the channel.
peername name The peername from the certificate.
protocol version The protocol version used for the connection:
SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.
@@ -276,11 +279,11 @@
Dump of all certificate info.
version value The certificate version.
serialNumber n The serial number of the certificate as hex string.
+ The serial number of the certificate as a hex string.
signature algorithm Cipher algorithm used for certificate signature.
issuer dn The distinguished name (DN) of the certificate issuer.
notBefore date Number of certificate extensions.
extensions list List of certificate extension names.
authorityKeyIdentifier string (AKI) Key identifier of the Issuing CA certificate that signed
- the SSL certificate as hex string. This value matches the SKI
+ the SSL certificate as a hex string. This value matches the SKI
value of the Intermediate CA certificate.
subjectKeyIdentifier string (SKI) Hash of the public key inside the certificate as hex
+ (SKI) Hash of the public key inside the certificate as a hex
string. Used to identify certificates that contain a particular
public key.
subjectAltName list List of all of the alternative domain names, sub domains,
and IP addresses that are secured by the certificate.
@@ -316,36 +319,35 @@
certificate cert The PEM encoded certificate.
signatureAlgorithm algorithm Cipher algorithm used for certificate signature.
+ Cipher algorithm used for the certificate signature.
signatureValue string Certificate signature as hex string.
+ Certificate signature as a hex string.
signatureDigest version Certificate signing digest.
+ Certificate signing digest as a hex string.
publicKeyAlgorithm algorithm Certificate signature public key algorithm.
publicKey string Certificate signature public key as hex string.
+ Certificate signature public key as a hex string.
bits n Number of bits used for certificate signature key
+ Number of bits used for certificate signature key.
self_signed boolean Is certificate signature self signed.
+ Whether the certificate signature is self signed.
sha1_hash hash The SHA1 hash of the certificate as hex string.
+ The SHA1 hash of the certificate as a hex string.
sha256_hash hash The SHA256 hash of the certificate as hex string.
+ The SHA256 hash of the certificate as a hex string.
tls::connection
channel Returns the current connection status of an SSL channel. The
- result is a list of key-value pairs describing the
- connected peer.
+ result is a list of key-value pairs describing the connection.
SSL Status
state state State of the connection.
@@ -352,51 +354,58 @@
servername name The name of the connected to server.
protocol version The protocol version used for the connection:
SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.
- renegotiation boolean renegotiation_allowed boolean Whether protocol renegotiation is supported or not.
- securitylevel level security_level level The security level used for selection of ciphers, key size, etc.
session_reused boolean Whether the session has been reused or not.
is_server boolean Whether the connection is configured as a server (1) or client (0).
compression mode Compression method.
expansion mode Expansion method.
+ caList list List of Certificate Authorities (CA) for X.509 certificate.
Cipher Info
cipher cipher The current cipher in use for the connection.
standard_name name The standard RFC name of cipher.
- bits n algorithm_bits n The number of processed bits used for cipher.
secret_bits n The number of secret bits used for cipher.
min_version version The minimum protocol version for cipher.
- id id cipher_is_aead boolean Whether the cipher is Authenticated Encryption with
+ Associated Data (AEAD).
+ cipher_id id The OpenSSL cipher id.
description string A text description of the cipher.
+ handshake_digest boolean Digest used during handshake.
Session Info
alpn protocol The protocol selected after Application-Layer Protocol
Negotiation (ALPN).
resumable boolean Can the session be resumed or not.
+ Whether the session can be resumed or not.
start_time seconds Time since session started in seconds since epoch.
timeout seconds Max duration of session in seconds before time-out.
lifetime seconds session_cache_mode mode Server cache mode (client, server, or both).
- tls::ciphers
- 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. 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:
+ Returns a list of the supported protocols. Valid values are:
ssl2 , ssl3 , tls1 , tls1.1 , tls1.2 ,
and tls1.3 . Exact list depends on OpenSSL version and
compile time flags.
tls::version -command , -password , and
-validate_command options passed to either of
tls::socket or tls::import .
-If the callback generates an error, the bgerror command with be
+If the callback generates an error, the bgerror command will be
invoked with the error information.
@@ -648,41 +647,41 @@
to call tls::password .
The difference between these two behaviors is a consequence of maintaining
compatibility with earlier implementations.
-
-The tls::debug variable provides some additional
-control over these reference callbacks. Its value is zero by default.
-Higher values produce more diagnostic output, and will also force the
-verify method in tls::callback to accept the
-certificate, even when it is invalid.
-
-
The use of the reference callbacks tls::callback ,
tls::password , and tls::validate_command
is not recommended. They may be removed from future releases.
-
-
-The use of the variable tls::debug is not recommended.
-It may be removed from future releases.
-
-
-
TLS key logging can be enabled by setting the environment variable
SSLKEYLOGFILE to the name of the file to log to. Then whenever TLS
key material is generated or received it will be logged to the file. This
is useful for logging key data for network logging tools to use to
decrypt the data.
+
+The tls::debug variable provides some additional
+control over these reference callbacks. Its value is zero by default.
+Higher values produce more diagnostic output, and will also force the
+verify method in tls::callback to accept the
+certificate, even when it is invalid.
+
+
+
+
+The use of the variable tls::debug is not recommended.
+It may be removed from future releases.
+
+
+
This example uses a sample server.pem provided with the TLS release,
courtesy of the OpenSSL project.
@@ -695,15 +694,15 @@
set tok [http::geturl https://www.tcl.tk/]
-The capabilities of this package can vary enormously based upon how your
-OpenSSL library was configured and built. New versions may obsolete older
-protocol versions, add or remove ciphers, change default values, etc. Use the
-tls::ciphers and tls::protocols commands to
-obtain the supported versions.
+The capabilities of this package can vary enormously based upon how the
+linked to OpenSSL library was configured and built. New versions may obsolete
+older protocol versions, add or remove ciphers, change default values, etc.
+Use the tls::protocols commands to obtain the supported
+protocol versions.
socket , fileevent, OpenSSL
Index: generic/tclOpts.h
==================================================================
--- generic/tclOpts.h
+++ generic/tclOpts.h
@@ -5,10 +5,16 @@
* external vars: opt, idx, objc, objv
*/
#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H
+
+#define OPTFLAG(option, var, val) \
+ if (strcmp(opt, (option)) == 0) { \
+ var = val; \
+ continue; \
+ }
#define OPT_PROLOG(option) \
if (strcmp(opt, (option)) == 0) { \
if (++idx >= objc) { \
Tcl_AppendResult(interp, \
@@ -15,13 +21,15 @@
"no argument given for ", \
(option), " option", \
(char *) NULL); \
return TCL_ERROR; \
}
+
#define OPT_POSTLOG() \
continue; \
}
+
#define OPTOBJ(option, var) \
OPT_PROLOG(option) \
var = objv[idx]; \
OPT_POSTLOG()
@@ -44,11 +52,11 @@
&(var)) != TCL_OK) { \
return TCL_ERROR; \
} \
OPT_POSTLOG()
-#define OPTBYTE(option, var, lvar) \
+#define OPTBYTE(option, var, lvar) \
OPT_PROLOG(option) \
var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
OPT_POSTLOG()
#define OPTBAD(type, list) \
Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -24,10 +24,14 @@
#include "tlsInt.h"
#include "tclOpts.h"
#include
#include
+#include
+#include
+#include
+#include
#include
#include
/* Min OpenSSL version */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
@@ -43,11 +47,10 @@
*/
#define F2N(key, dsp) \
(((key) == NULL) ? (char *) NULL : \
Tcl_TranslateFileName(interp, (key), (dsp)))
-#define REASON() ERR_reason_error_string(ERR_get_error())
static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key,
char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile,
char *ciphers, char *ciphersuites, int level, char *DHparams);
@@ -444,11 +447,11 @@
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
if (msg != NULL) {
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));
- } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), (Tcl_Size *)NULL)) != NULL) {
+ } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL)) != NULL) {
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));
} else {
listPtr = Tcl_NewListObj(0, NULL);
while ((err = ERR_get_error()) != 0) {
@@ -551,19 +554,19 @@
Tcl_Release((ClientData) statePtr);
/* If successful, pass back password string and truncate if too long */
if (code == TCL_OK) {
- Tcl_Size len;
+ int len;
char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
- if (len > (Tcl_Size) size-1) {
- len = (Tcl_Size) size-1;
+ if (len > size-1) {
+ len = size-1;
}
strncpy(buf, ret, (size_t) len);
buf[len] = '\0';
Tcl_Release((ClientData) interp);
- return((int) len);
+ return(len);
}
Tcl_Release((ClientData) interp);
return -1;
}
@@ -613,15 +616,15 @@
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
/* Session id */
session_id = SSL_SESSION_get_id(session, &ulen);
- Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (Tcl_Size) ulen));
+ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (int) ulen));
/* Session ticket */
SSL_SESSION_get0_ticket(session, &ticket, &len2);
- Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(ticket, (Tcl_Size) len2));
+ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(ticket, (int) len2));
/* Lifetime - number of seconds */
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session)));
@@ -902,11 +905,11 @@
/* Create command to eval */
cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1));
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
- Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (Tcl_Size) len));
+ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (int) len));
/* Eval callback command */
Tcl_IncrRefCount(cmdPtr);
if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) {
res = SSL_CLIENT_HELLO_RETRY;
@@ -923,226 +926,10 @@
/********************/
/* Commands */
/********************/
-/*
- *-------------------------------------------------------------------
- *
- * CiphersObjCmd -- list available ciphers
- *
- * This procedure is invoked to process the "tls::ciphers" command
- * to list available ciphers, based upon protocol selected.
- *
- * Results:
- * A standard Tcl result list.
- *
- * Side effects:
- * constructs and destroys SSL context (CTX)
- *
- *-------------------------------------------------------------------
- */
-static const char *protocols[] = {
- "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL
-};
-enum protocol {
- 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 = NULL;
- 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?");
- 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;
- }
-
- ERR_clear_error();
-
- switch ((enum protocol)index) {
- 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
- 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
- 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
- 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
- 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
- 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
- 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;
- }
-
- ssl = SSL_new(ctx);
- if (ssl == NULL) {
- Tcl_AppendResult(interp, REASON(), NULL);
- SSL_CTX_free(ctx);
- return TCL_ERROR;
- }
-
- /* 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);
- }
-
- 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, (Tcl_Size) strlen(buf));
- } else {
- Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8);
- }
- }
- }
- if (use_supported) {
- sk_SSL_CIPHER_free(sk);
- }
- }
- SSL_free(ssl);
- SSL_CTX_free(ctx);
-
- Tcl_SetObjResult(interp, objPtr);
- return TCL_OK;
- clientData = clientData;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * ProtocolsObjCmd -- list available protocols
- *
- * This procedure is invoked to process the "tls::protocols" command
- * to list available protocols.
- *
- * Results:
- * A standard Tcl result list.
- *
- * Side effects:
- * none
- *
- *-------------------------------------------------------------------
- */
-static int
-ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
- Tcl_Obj *objPtr;
-
- dprintf("Called");
-
- if (objc != 1) {
- Tcl_WrongNumArgs(interp, 1, objv, "");
- return TCL_ERROR;
- }
-
- ERR_clear_error();
-
- objPtr = Tcl_NewListObj(0, NULL);
-
-#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) && !defined(OPENSSL_NO_SSL3_METHOD)
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1));
-#endif
-#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1));
-#endif
-#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1));
-#endif
-#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1));
-#endif
-#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1));
-#endif
-
- Tcl_SetObjResult(interp, objPtr);
- return TCL_OK;
- clientData = clientData;
-}
-
/*
*-------------------------------------------------------------------
*
* HandshakeObjCmd --
*
@@ -1171,11 +958,11 @@
return(TCL_ERROR);
}
ERR_clear_error();
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return(TCL_ERROR);
}
/* Make sure to operate on the topmost channel */
@@ -1249,20 +1036,19 @@
SSL_CTX *ctx = NULL;
Tcl_Obj *script = NULL;
Tcl_Obj *password = NULL;
Tcl_Obj *vcmd = NULL;
Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
- int idx;
- Tcl_Size len;
+ int idx, len;
int flags = TLS_TCL_INIT;
int server = 0; /* is connection incoming or outgoing? */
char *keyfile = NULL;
char *certfile = NULL;
unsigned char *key = NULL;
- Tcl_Size key_len = 0;
+ int key_len = 0;
unsigned char *cert = NULL;
- Tcl_Size cert_len = 0;
+ int cert_len = 0;
char *ciphers = NULL;
char *ciphersuites = NULL;
char *CAfile = NULL;
char *CAdir = NULL;
char *DHparams = NULL;
@@ -1295,20 +1081,20 @@
return TCL_ERROR;
}
ERR_clear_error();
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
for (idx = 2; idx < objc; idx++) {
- char *opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL);
+ char *opt = Tcl_GetStringFromObj(objv[idx], NULL);
if (opt[0] != '-')
break;
OPTOBJ("-alpn", alpn);
@@ -1326,11 +1112,11 @@
OPTSTR("-model", model);
OPTOBJ("-password", password);
OPTBOOL("-post_handshake", post_handshake);
OPTBOOL("-request", request);
OPTBOOL("-require", require);
- OPTINT("-securitylevel", level);
+ OPTINT("-security_level", level);
OPTBOOL("-server", server);
OPTSTR("-servername", servername);
OPTSTR("-session_id", session_id);
OPTBOOL("-ssl2", ssl2);
OPTBOOL("-ssl3", ssl3);
@@ -1339,11 +1125,11 @@
OPTBOOL("-tls1.2", tls1_2);
OPTBOOL("-tls1.3", tls1_3);
OPTOBJ("-validatecommand", vcmd);
OPTOBJ("-vcmd", vcmd);
- OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -post_handshake, -request, -require, -securitylevel, -server, -servername, -session_id, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, -tls1.3, or -validatecommand");
+ OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -post_handshake, -request, -require, -security_level, -server, -servername, -session_id, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, -tls1.3, or -validatecommand");
return TCL_ERROR;
}
if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
@@ -1424,12 +1210,12 @@
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
} else {
- if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, (int) key_len,
- (int) cert_len, CAdir, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
+ if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, key_len,
+ cert_len, CAdir, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
}
@@ -1515,12 +1301,11 @@
http/1.1, h2, h3, ftp, imap, pop3, xmpp-client, xmpp-server, mqtt, irc, etc. */
if (alpn) {
/* Convert a TCL list into a protocol-list in wire-format */
unsigned char *protos, *p;
unsigned int protos_len = 0;
- Tcl_Size cnt, i;
- int j;
+ int i, len, cnt;
Tcl_Obj **list;
if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
Tls_Free((char *) statePtr);
return TCL_ERROR;
@@ -1533,20 +1318,20 @@
Tcl_AppendResult(interp, "ALPN protocol name too long", (char *) NULL);
Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
- protos_len += 1 + (int) len;
+ protos_len += 1 + len;
}
/* Build the complete protocol-list */
protos = ckalloc(protos_len);
/* protocol-lists consist of 8-bit length-prefixed, byte strings */
- for (j = 0, p = protos; j < cnt; j++) {
- char *str = Tcl_GetStringFromObj(list[j], &len);
- *p++ = (unsigned char) len;
- memcpy(p, str, (size_t) len);
+ for (i = 0, p = protos; i < cnt; i++) {
+ char *str = Tcl_GetStringFromObj(list[i], &len);
+ *p++ = len;
+ memcpy(p, str, len);
p += len;
}
/* SSL_set_alpn_protos makes a copy of the protocol-list */
/* Note: This functions reverses the return value convention */
@@ -1568,10 +1353,11 @@
/*
* SSL Callbacks
*/
SSL_set_app_data(statePtr->ssl, (void *)statePtr); /* point back to us */
+
SSL_set_verify(statePtr->ssl, verify, VerifyCallback);
SSL_set_info_callback(statePtr->ssl, InfoCallback);
/* Callback for observing protocol messages */
#ifndef OPENSSL_NO_SSL_TRACE
@@ -1720,48 +1506,48 @@
const SSL_METHOD *method;
dprintf("Called");
if (!proto) {
- Tcl_AppendResult(interp, "no valid protocol selected", (char *) NULL);
+ Tcl_AppendResult(interp, "no valid protocol selected", NULL);
return NULL;
}
/* create SSL context */
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
if (ENABLED(proto, TLS_PROTO_SSL2)) {
- Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *) NULL);
+ Tcl_AppendResult(interp, "SSL2 protocol not supported", NULL);
return NULL;
}
#endif
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
if (ENABLED(proto, TLS_PROTO_SSL3)) {
- Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *) NULL);
+ Tcl_AppendResult(interp, "SSL3 protocol not supported", NULL);
return NULL;
}
#endif
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
if (ENABLED(proto, TLS_PROTO_TLS1)) {
- Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *) NULL);
+ Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", NULL);
return NULL;
}
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
- Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *) NULL);
+ Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", NULL);
return NULL;
}
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
- Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *) NULL);
+ Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", NULL);
return NULL;
}
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
- Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *) NULL);
+ Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", NULL);
return NULL;
}
#endif
if (proto == 0) {
/* Use full range */
@@ -1845,10 +1631,14 @@
/* Force cipher selection order by server */
if (!isServer) {
SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
}
+
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+ OpenSSL_add_all_algorithms(); /* Load ciphers and digests */
+#endif
SSL_CTX_set_app_data(ctx, (void*)interp); /* remember the interpreter */
SSL_CTX_set_options(ctx, SSL_OP_ALL); /* all SSL bug workarounds */
SSL_CTX_set_options(ctx, SSL_OP_NO_COMPRESSION); /* disable compression even if supported */
SSL_CTX_set_options(ctx, off); /* disable protocol versions */
@@ -2062,11 +1852,11 @@
Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
return TCL_ERROR;
}
/* Get channel Id */
- channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], (Tcl_Size *) NULL);
+ channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], NULL);
chan = Tcl_GetChannel(interp, channelName, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
@@ -2084,10 +1874,11 @@
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);
@@ -2132,11 +1923,11 @@
/* Verify mode depth */
LAPPEND_INT(interp, objPtr, "verifyDepth", SSL_get_verify_depth(statePtr->ssl));
/* Report the selected protocol as a result of the negotiation */
SSL_get0_alpn_selected(statePtr->ssl, &proto, &len);
- LAPPEND_STR(interp, objPtr, "alpn", (char *)proto, (Tcl_Size) len);
+ LAPPEND_STR(interp, objPtr, "alpn", (char *)proto, (int) len);
LAPPEND_STR(interp, objPtr, "protocol", SSL_get_version(statePtr->ssl), -1);
/* Valid for non-RSA signature and TLS 1.3 */
if (objc == 2) {
res = SSL_get_peer_signature_nid(statePtr->ssl, &nid);
@@ -2182,11 +1973,11 @@
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
return(TCL_ERROR);
}
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return(TCL_ERROR);
}
/* Make sure to operate on the topmost channel */
@@ -2215,11 +2006,11 @@
/* Renegotiation allowed */
LAPPEND_BOOL(interp, objPtr, "renegotiation_allowed", SSL_get_secure_renegotiation_support(ssl));
/* Get security level */
- LAPPEND_INT(interp, objPtr, "securitylevel", SSL_get_security_level(ssl));
+ LAPPEND_INT(interp, objPtr, "security_level", SSL_get_security_level(ssl));
/* Session info */
LAPPEND_BOOL(interp, objPtr, "session_reused", SSL_session_reused(ssl));
/* Is server info */
@@ -2262,14 +2053,10 @@
/* message authentication code - Cipher is AEAD (e.g. GCM or ChaCha20/Poly1305) or not */
/* Authenticated Encryption with associated data (AEAD) check */
LAPPEND_BOOL(interp, objPtr, "cipher_is_aead", SSL_CIPHER_is_aead(cipher));
- /* Digest used during the SSL/TLS handshake when using the cipher. */
- md = SSL_CIPHER_get_handshake_digest(cipher);
- LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1);
-
/* Get OpenSSL-specific ID, not IANA ID */
LAPPEND_INT(interp, objPtr, "cipher_id", (int) SSL_CIPHER_get_id(cipher));
/* Two-byte ID used in the TLS protocol of the given cipher */
LAPPEND_INT(interp, objPtr, "protocol_id", (int) SSL_CIPHER_get_protocol_id(cipher));
@@ -2276,10 +2063,14 @@
/* Textual description of the cipher */
if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) {
LAPPEND_STR(interp, objPtr, "description", buf, -1);
}
+
+ /* Digest used during the SSL/TLS handshake when using the cipher. */
+ md = SSL_CIPHER_get_handshake_digest(cipher);
+ LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1);
}
/* Session info */
session = SSL_get_session(ssl);
if (session != NULL) {
@@ -2289,16 +2080,16 @@
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);
- LAPPEND_STR(interp, objPtr, "alpn", (char *) proto, (Tcl_Size) len2);
+ LAPPEND_STR(interp, objPtr, "alpn", (char *) proto, (int) len2);
/* Report the selected protocol as a result of the NPN negotiation */
#ifdef USE_NPN
SSL_get0_next_proto_negotiated(ssl, &proto, &ulen);
- LAPPEND_STR(interp, objPtr, "npn", (char *) proto, (Tcl_Size) ulen);
+ LAPPEND_STR(interp, objPtr, "npn", (char *) proto, (int) ulen);
#endif
/* Resumable session */
LAPPEND_BOOL(interp, objPtr, "resumable", SSL_SESSION_is_resumable(session));
@@ -2308,30 +2099,30 @@
/* Timeout value - SSL_CTX_get_timeout (in seconds) */
LAPPEND_LONG(interp, objPtr, "timeout", SSL_SESSION_get_timeout(session));
/* Session id - TLSv1.2 and below only */
session_id = SSL_SESSION_get_id(session, &ulen);
- LAPPEND_BARRAY(interp, objPtr, "session_id", session_id, (Tcl_Size) ulen);
+ LAPPEND_BARRAY(interp, objPtr, "session_id", session_id, (int) ulen);
/* Session context */
session_id = SSL_SESSION_get0_id_context(session, &ulen);
- LAPPEND_BARRAY(interp, objPtr, "session_context", session_id, (Tcl_Size) ulen);
+ LAPPEND_BARRAY(interp, objPtr, "session_context", session_id, (int) ulen);
/* Session ticket - client only */
SSL_SESSION_get0_ticket(session, &ticket, &len2);
- LAPPEND_BARRAY(interp, objPtr, "session_ticket", ticket, (Tcl_Size) len2);
+ LAPPEND_BARRAY(interp, objPtr, "session_ticket", ticket, (int) len2);
/* Session ticket lifetime hint (in seconds) */
LAPPEND_LONG(interp, objPtr, "lifetime", SSL_SESSION_get_ticket_lifetime_hint(session));
/* Ticket app data */
SSL_SESSION_get0_ticket_appdata(session, &ticket, &len2);
- LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (Tcl_Size) len2);
+ LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (int) len2);
/* Get master key */
len2 = SSL_SESSION_get_master_key(session, buffer, SSL_MAX_MASTER_KEY_LENGTH);
- LAPPEND_BARRAY(interp, objPtr, "master_key", buffer, (Tcl_Size) len2);
+ LAPPEND_BARRAY(interp, objPtr, "master_key", buffer, (int) len2);
/* Compression id */
unsigned int id = SSL_SESSION_get_compress_id(session);
LAPPEND_STR(interp, objPtr, "compression_id", id == 1 ? "zlib" : "none", -1);
}
@@ -2374,10 +2165,11 @@
/* 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));
@@ -2385,41 +2177,14 @@
}
}
LAPPEND_OBJ(interp, objPtr, "caList", listPtr);
LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list));
- Tcl_SetObjResult(interp, objPtr);
- return TCL_OK;
- clientData = clientData;
-}
-
-/*
- *-------------------------------------------------------------------
- *
- * VersionObjCmd -- return version string from OpenSSL.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *-------------------------------------------------------------------
- */
-static int
-VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
- Tcl_Obj *objPtr;
-
- dprintf("Called");
-
- objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
- Tcl_SetObjResult(interp, objPtr);
-
- return TCL_OK;
- clientData = clientData;
- objc = objc;
- objv = objv;
+
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ clientData = clientData;
}
/*
*-------------------------------------------------------------------
*
@@ -2435,12 +2200,11 @@
*/
static int
MiscObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
static const char *commands [] = { "req", "strreq", NULL };
enum command { C_REQ, C_STRREQ, C_DUMMY };
- Tcl_Size cmd;
- int isStr;
+ int cmd, isStr;
char buffer[16384];
dprintf("Called");
if (objc < 2) {
@@ -2459,12 +2223,11 @@
case C_STRREQ: {
EVP_PKEY *pkey=NULL;
X509 *cert=NULL;
X509_NAME *name=NULL;
Tcl_Obj **listv;
- Tcl_Size listc;
- int i;
+ int listc,i;
BIO *out=NULL;
char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
char *keyout,*pemout,*str;
@@ -2491,11 +2254,12 @@
Tcl_SetVar(interp,keyout,"",0);
Tcl_SetVar(interp,pemout,"",0);
}
if (objc>=6) {
- if (Tcl_ListObjGetElements(interp, objv[5], &listc, &listv) != TCL_OK) {
+ 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);
@@ -2771,23 +2535,24 @@
return TCL_ERROR;
}
#endif
if (TlsLibInit(0) != TCL_OK) {
- Tcl_AppendResult(interp, "could not initialize SSL library", (char *) NULL);
+ Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
return TCL_ERROR;
}
- Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
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);
- Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+
+ Tls_DigestCommands(interp);
+ Tls_EncryptCommands(interp);
+ Tls_InfoCommands(interp);
if (interp) {
Tcl_Eval(interp, tlsTclInitScript);
}
Index: generic/tlsBIO.c
==================================================================
--- generic/tlsBIO.c
+++ generic/tlsBIO.c
@@ -6,24 +6,23 @@
#include "tlsInt.h"
static int BioWrite(BIO *bio, const char *buf, int bufLen) {
Tcl_Channel chan;
- Tcl_Size ret;
+ int ret;
int tclEofChan, tclErrno;
chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
dprintf("[chan=%p] BioWrite(%p, , %d)", (void *)chan, (void *) bio, bufLen);
- ret = Tcl_WriteRaw(chan, buf, (Tcl_Size) bufLen);
+ ret = (int) Tcl_WriteRaw(chan, buf, bufLen);
tclEofChan = Tcl_Eof(chan);
tclErrno = Tcl_GetErrno();
- dprintf("[chan=%p] BioWrite(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
- (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());
+ dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());
BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);
if (tclEofChan && ret <= 0) {
dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
@@ -53,11 +52,11 @@
dprintf("Setting should retry read flag");
BIO_set_retry_read(bio);
}
}
- return((int) ret);
+ return(ret);
}
static int BioRead(BIO *bio, char *buf, int bufLen) {
Tcl_Channel chan;
Tcl_Size ret = 0;
@@ -69,17 +68,16 @@
if (buf == NULL) {
return 0;
}
- ret = Tcl_ReadRaw(chan, buf, (Tcl_Size) bufLen);
+ ret = Tcl_ReadRaw(chan, buf, bufLen);
tclEofChan = Tcl_Eof(chan);
tclErrno = Tcl_GetErrno();
- dprintf("[chan=%p] BioRead(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
- (void *) chan, bufLen, ret, tclEofChan, tclErrno);
+ dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno);
BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);
if (tclEofChan && ret <= 0) {
dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
@@ -110,14 +108,13 @@
BIO_set_retry_write(bio);
}
}
- dprintf("BioRead(%p, , %d) [%p] returning %" TCL_SIZE_MODIFIER "d", (void *) bio,
- bufLen, (void *) chan, ret);
+ dprintf("BioRead(%p, , %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);
- return((int) ret);
+ return(ret);
}
static int BioPuts(BIO *bio, const char *str) {
dprintf("BioPuts(%p, ) called", bio, str);
ADDED generic/tlsDigest.c
Index: generic/tlsDigest.c
==================================================================
--- /dev/null
+++ generic/tlsDigest.c
@@ -0,0 +1,1485 @@
+/*
+ * Message Digest (MD) and Message Authentication Code (MAC) Module
+ *
+ * Provides commands to calculate a message digest (MD) or message
+ * authentication code (MAC) using a specified hash function and/or cipher.
+ *
+ * Copyright (C) 2023 Brian O'Hagan
+ *
+ */
+
+#include "tlsInt.h"
+#include "tclOpts.h"
+#include
+#include
+#include
+#include
+#include
+#include
+
+/* Constants */
+const char *hex = "0123456789abcdef";
+
+/* Macros */
+#define BUFFER_SIZE 65536
+#define CHAN_EOF 0x10
+#define READ_DELAY 5
+
+/* Digest format and operation */
+#define BIN_FORMAT 0x01
+#define HEX_FORMAT 0x02
+#define IS_XOF 0x08
+#define TYPE_MD 0x10
+#define TYPE_HMAC 0x20
+#define TYPE_CMAC 0x40
+#define TYPE_MAC 0x80
+
+#if OPENSSL_VERSION_NUMBER <= 0x30000000L
+#define EVP_MAC void
+#endif
+
+/*******************************************************************/
+
+/*
+ * This structure defines the per-instance state of a digest operation.
+ */
+typedef struct DigestState {
+ Tcl_Channel self; /* This socket channel */
+ Tcl_TimerToken timer; /* Timer for read events */
+
+ int flags; /* Chan config flags */
+ int watchMask; /* Current WatchProc mask */
+ int mode; /* Current mode of parent channel */
+ int format; /* Digest format and operation */
+
+ Tcl_Interp *interp; /* Current interpreter */
+ EVP_MD_CTX *ctx; /* MD Context */
+ HMAC_CTX *hctx; /* HMAC context */
+ CMAC_CTX *cctx; /* CMAC context */
+ Tcl_Command token; /* Command token */
+} DigestState;
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestStateNew --
+ *
+ * This function creates a per-instance state data structure
+ *
+ * Returns:
+ * Digest structure pointer
+ *
+ * Side effects:
+ * Creates structure
+ *
+ *-------------------------------------------------------------------
+ */
+DigestState *DigestStateNew(Tcl_Interp *interp, int format) {
+ DigestState *statePtr;
+
+ statePtr = (DigestState *) ckalloc((unsigned) sizeof(DigestState));
+ if (statePtr != NULL) {
+ memset(statePtr, 0, sizeof(DigestState));
+ statePtr->self = NULL; /* This socket channel */
+ statePtr->timer = NULL; /* Timer to flush data */
+ statePtr->flags = 0; /* Chan config flags */
+ statePtr->watchMask = 0; /* Current WatchProc mask */
+ statePtr->mode = 0; /* Current mode of parent channel */
+ statePtr->format = format; /* Digest format and operation */
+ statePtr->interp = interp; /* Current interpreter */
+ statePtr->ctx = NULL; /* MD Context */
+ statePtr->hctx = NULL; /* HMAC Context */
+ statePtr->cctx = NULL; /* CMAC Context */
+ statePtr->token = NULL; /* Command token */
+ }
+ return statePtr;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestStateFree --
+ *
+ * This function deletes a digest state structure
+ *
+ * Returns:
+ * Nothing
+ *
+ * Side effects:
+ * Removes structure
+ *
+ *-------------------------------------------------------------------
+ */
+void DigestStateFree(DigestState *statePtr) {
+ if (statePtr == (DigestState *) NULL) {
+ return;
+ }
+
+ /* Remove pending timer */
+ if (statePtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler(statePtr->timer);
+ }
+
+ /* Free context structures */
+ if (statePtr->ctx != (EVP_MD_CTX *) NULL) {
+ EVP_MD_CTX_free(statePtr->ctx);
+ }
+ if (statePtr->hctx != (HMAC_CTX *) NULL) {
+ HMAC_CTX_free(statePtr->hctx);
+ }
+ if (statePtr->cctx != (CMAC_CTX *) NULL) {
+ CMAC_CTX_free(statePtr->cctx);
+ }
+ ckfree(statePtr);
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestInitialize --
+ *
+ * Initialize a hash function
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR for failure with result set
+ * to error message.
+ *
+ * Side effects:
+ * No result or error message
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestInitialize(Tcl_Interp *interp, DigestState *statePtr, const EVP_MD *md,
+ const EVP_CIPHER *cipher, Tcl_Obj *keyObj, EVP_MAC *mac) {
+ int key_len = 0, res = 0;
+ const unsigned char *key = NULL;
+
+ dprintf("Called");
+
+ /* Create contexts */
+ switch(statePtr->format & 0xFF0) {
+ case TYPE_MD:
+ statePtr->ctx = EVP_MD_CTX_new();
+ res = (statePtr->ctx != NULL);
+ break;
+ case TYPE_HMAC:
+ statePtr->hctx = HMAC_CTX_new();
+ res = (statePtr->hctx != NULL);
+ break;
+ case TYPE_CMAC:
+ statePtr->cctx = CMAC_CTX_new();
+ res = (statePtr->cctx != NULL);
+ break;
+ }
+
+ if (!res) {
+ Tcl_AppendResult(interp, "Create context failed: ", REASON(), NULL);
+ return TCL_ERROR;
+ }
+
+ /* Get key */
+ if (keyObj != NULL) {
+ key = Tcl_GetByteArrayFromObj(keyObj, &key_len);
+ }
+
+ /* Initialize cryptography function */
+ switch(statePtr->format & 0xFF0) {
+ case TYPE_MD:
+ res = EVP_DigestInit_ex(statePtr->ctx, md, NULL);
+ break;
+ case TYPE_HMAC:
+ res = HMAC_Init_ex(statePtr->hctx, (const void *) key, key_len, md, NULL);
+ break;
+ case TYPE_CMAC:
+ res = CMAC_Init(statePtr->cctx, (const void *) key, key_len, cipher, NULL);
+ break;
+ }
+
+ if (!res) {
+ Tcl_AppendResult(interp, "Initialize failed: ", REASON(), NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestUpdate --
+ *
+ * Update a hash function with data
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR for failure with result set
+ * to error message if do_result is true.
+ *
+ * Side effects:
+ * Adds buf data to hash function or sets result to error message
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestUpdate(DigestState *statePtr, char *buf, size_t read, int do_result) {
+ int res = 0;
+
+ dprintf("Called");
+
+ switch(statePtr->format & 0xFF0) {
+ case TYPE_MD:
+ res = EVP_DigestUpdate(statePtr->ctx, buf, read);
+ break;
+ case TYPE_HMAC:
+ res = HMAC_Update(statePtr->hctx, buf, read);
+ break;
+ case TYPE_CMAC:
+ res = CMAC_Update(statePtr->cctx, buf, read);
+ break;
+ }
+
+ if (!res && do_result) {
+ Tcl_AppendResult(statePtr->interp, "Update failed: ", REASON(), NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestFinalize --
+ *
+ * Finalize a hash function and return the message digest
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR for failure with result set
+ * to error message.
+ *
+ * Side effects:
+ * Sets result to message digest or an error message.
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestFinalize(Tcl_Interp *interp, DigestState *statePtr, Tcl_Obj **resultObj) {
+ unsigned char md_buf[EVP_MAX_MD_SIZE];
+ unsigned int ulen;
+ int res = 0, md_len = 0;
+
+ dprintf("Called");
+
+ /* Finalize cryptography function and get result */
+ switch(statePtr->format & 0xFF0) {
+ case TYPE_MD:
+ if (!(statePtr->format & IS_XOF)) {
+ res = EVP_DigestFinal_ex(statePtr->ctx, md_buf, &ulen);
+ md_len = (int) ulen;
+ } else {
+ res = EVP_DigestFinalXOF(statePtr->ctx, md_buf, (size_t) EVP_MAX_MD_SIZE);
+ md_len = EVP_MAX_MD_SIZE;
+ }
+ break;
+ case TYPE_HMAC:
+ res = HMAC_Final(statePtr->hctx, md_buf, &ulen);
+ md_len = (int) ulen;
+ break;
+ case TYPE_CMAC:
+ size_t size;
+ res = CMAC_Final(statePtr->cctx, md_buf, &size);
+ md_len = (int) size;
+ break;
+ }
+
+ if (!res) {
+ if (resultObj == NULL) {
+ Tcl_AppendResult(interp, "Finalize failed: ", REASON(), NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /* Return message digest as either a binary or hex string */
+ if (statePtr->format & BIN_FORMAT) {
+ if (resultObj == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(md_buf, md_len));
+ } else {
+ *resultObj = Tcl_NewByteArrayObj(md_buf, md_len);
+ Tcl_IncrRefCount(*resultObj);
+ }
+
+ } else {
+ Tcl_Obj *newObj = Tcl_NewObj();
+ unsigned char *ptr = Tcl_SetByteArrayLength(newObj, md_len*2);
+
+ for (int i = 0; i < md_len; i++) {
+ *ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
+ *ptr++ = hex[md_buf[i] & 0x0F];
+ }
+
+ if (resultObj == NULL) {
+ Tcl_SetObjResult(interp, newObj);
+ } else {
+ *resultObj = newObj;
+ Tcl_IncrRefCount(*resultObj);
+ }
+ }
+ return TCL_OK;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestBlockModeProc --
+ *
+ * This function is invoked by the generic IO level
+ * to set blocking and nonblocking modes.
+ *
+ * Returns:
+ * 0 if successful or POSIX error code if failed.
+ *
+ * Side effects:
+ * Sets the device into blocking or nonblocking mode.
+ * Can call Tcl_SetChannelError.
+ *
+ *-------------------------------------------------------------------
+ */
+static int DigestBlockModeProc(ClientData clientData, int mode) {
+ DigestState *statePtr = (DigestState *) clientData;
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ statePtr->flags |= TLS_TCL_ASYNC;
+ } else {
+ statePtr->flags &= ~(TLS_TCL_ASYNC);
+ }
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestCloseProc --
+ *
+ * This function is invoked by the generic IO level to perform
+ * channel-type specific cleanup when the channel is closed. All
+ * queued output is flushed prior to calling this function.
+ *
+ * Returns:
+ * 0 if successful or POSIX error code if failed.
+ *
+ * Side effects:
+ * Deletes stored state data.
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestCloseProc(ClientData clientData, Tcl_Interp *interp) {
+ DigestState *statePtr = (DigestState *) clientData;
+
+ /* Cancel active timer, if any */
+ if (statePtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler(statePtr->timer);
+ statePtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ /* Output message digest if not already done */
+ if (!(statePtr->flags & CHAN_EOF)) {
+ Tcl_Channel parent = Tcl_GetStackedChannel(statePtr->self);
+ Tcl_Obj *resultObj;
+ int written;
+
+ if (DigestFinalize(statePtr->interp, statePtr, &resultObj) == TCL_OK) {
+ unsigned char *data = Tcl_GetByteArrayFromObj(resultObj, &written);
+ Tcl_WriteRaw(parent, data, written);
+ Tcl_DecrRefCount(resultObj);
+ }
+ statePtr->flags |= CHAN_EOF;
+ }
+
+ /* Clean-up */
+ DigestStateFree(statePtr);
+ return 0;
+}
+
+/*
+ * Same as DigestCloseProc but with individual read and write close control
+ */
+static int DigestClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags) {
+
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) {
+ return DigestCloseProc(instanceData, interp);
+ }
+ return EINVAL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestInputProc --
+ *
+ * Called by the generic IO system to read data from transform and
+ * place in buf. Transform gets data from the underlying channel.
+ *
+ * Returns:
+ * Total bytes read or -1 for an error along with a POSIX error
+ * code in errorCodePtr. Use EAGAIN for nonblocking and no data.
+ *
+ * Side effects:
+ * Read data from transform and write to buf
+ *
+ *----------------------------------------------------------------------
+ */
+int DigestInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) {
+ DigestState *statePtr = (DigestState *) clientData;
+ Tcl_Channel parent;
+ int read;
+ *errorCodePtr = 0;
+
+ /* Abort if nothing to process */
+ if (toRead <= 0 || statePtr->self == (Tcl_Channel) NULL) {
+ return 0;
+ }
+
+ /* Get bytes from underlying channel */
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ read = Tcl_ReadRaw(parent, buf, toRead);
+
+ /* Update hash function */
+ if (read > 0) {
+ /* Have data */
+ if (DigestUpdate(statePtr, buf, (size_t) read, 0) != TCL_OK) {
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+ /* This is correct */
+ read = -1;
+ *errorCodePtr = EAGAIN;
+
+ } else if (read < 0) {
+ /* Error */
+ *errorCodePtr = Tcl_GetErrno();
+
+ } else if (!(statePtr->flags & CHAN_EOF)) {
+ /* EOF */
+ Tcl_Obj *resultObj;
+ if (DigestFinalize(statePtr->interp, statePtr, &resultObj) == TCL_OK) {
+ unsigned char *data = Tcl_GetByteArrayFromObj(resultObj, &read);
+ memcpy(buf, data, read);
+ Tcl_DecrRefCount(resultObj);
+
+ } else {
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", REASON()));
+ *errorCodePtr = EINVAL;
+ read = 0;
+ }
+ statePtr->flags |= CHAN_EOF;
+ }
+ return read;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestOutputProc --
+ *
+ * Called by the generic IO system to write data in buf to transform.
+ * The transform writes the result to the underlying channel.
+ *
+ * Returns:
+ * Total bytes written or -1 for an error along with a POSIX error
+ * code in errorCodePtr. Use EAGAIN for nonblocking and can't write data.
+ *
+ * Side effects:
+ * Get data from buf and update digest
+ *
+ *----------------------------------------------------------------------
+ */
+ int DigestOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) {
+ DigestState *statePtr = (DigestState *) clientData;
+ *errorCodePtr = 0;
+
+ /* Abort if nothing to process */
+ if (toWrite <= 0 || statePtr->self == (Tcl_Channel) NULL) {
+ return 0;
+ }
+
+ /* Update hash function */
+ if (DigestUpdate(statePtr, buf, (size_t) toWrite, 0) != TCL_OK) {
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
+ *errorCodePtr = EINVAL;
+ return 0;
+ }
+ return toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestSetOptionProc --
+ *
+ * Called by the generic IO system to set channel option name to value.
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR if failed along with an error
+ * message in interp and Tcl_SetErrno.
+ *
+ * Side effects:
+ * Updates channel option to new value.
+ *
+ *----------------------------------------------------------------------
+ */
+static int DigestSetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
+ const char *optionValue) {
+ DigestState *statePtr = (DigestState *) clientData;
+ Tcl_Channel parent;
+ Tcl_DriverSetOptionProc *setOptionProc;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Delegate options downstream */
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
+ if (setOptionProc != NULL) {
+ return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
+ } else {
+ Tcl_SetErrno(EINVAL);
+ return Tcl_BadChannelOption(interp, optionName, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestGetOptionProc --
+ *
+ * Called by the generic IO system to get channel option name's value.
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR if failed along with an error
+ * message in interp and Tcl_SetErrno.
+ *
+ * Side effects:
+ * Sets result to option's value
+ *
+ *----------------------------------------------------------------------
+ */
+static int DigestGetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
+ Tcl_DString *optionValue) {
+ DigestState *statePtr = (DigestState *) clientData;
+ Tcl_Channel parent;
+ Tcl_DriverGetOptionProc *getOptionProc;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Delegate options downstream */
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));
+ if (getOptionProc != NULL) {
+ return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
+ } else if (optionName == (char*) NULL) {
+ /* Request is query for all options, this is ok. */
+ return TCL_OK;
+ } else {
+ Tcl_SetErrno(EINVAL);
+ return Tcl_BadChannelOption(interp, optionName, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestTimerHandler --
+ *
+ * Called by the notifier via timer to flush out pending input data.
+ *
+ * Returns:
+ * Nothing
+ *
+ * Side effects:
+ * May call Tcl_NotifyChannel
+ *
+ *----------------------------------------------------------------------
+ */
+static void DigestTimerHandler(ClientData clientData) {
+ DigestState *statePtr = (DigestState *) clientData;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return;
+ }
+
+ /* Clear timer token */
+ statePtr->timer = (Tcl_TimerToken) NULL;
+
+ /* Fire event if there is pending data, skip otherwise */
+ if ((statePtr->watchMask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) {
+ Tcl_NotifyChannel(statePtr->self, TCL_READABLE);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestWatchProc --
+ *
+ * Initialize the notifier to watch for events from this channel.
+ *
+ * Returns:
+ * Nothing (can't return error messages)
+ *
+ * Side effects:
+ * Configure notifier so future events on the channel will be seen by Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+void DigestWatchProc(ClientData clientData, int mask) {
+ DigestState *statePtr = (DigestState *) clientData;
+ Tcl_Channel parent;
+ Tcl_DriverWatchProc *watchProc;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return;
+ }
+
+ /* Store OR-ed combination of TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION */
+ statePtr->watchMask = mask;
+
+ /* Propagate mask info to parent channel */
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent));
+ watchProc(Tcl_GetChannelInstanceData(parent), mask);
+
+ /* Remove pending timer */
+ if (statePtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler(statePtr->timer);
+ statePtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ /* If there is data pending, set new timer to call Tcl_NotifyChannel */
+ if ((mask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) {
+ statePtr->timer = Tcl_CreateTimerHandler(READ_DELAY, DigestTimerHandler, (ClientData) statePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestGetHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve OS specific file handle
+ * from inside this channel. Not used for transformations?
+ *
+ * Returns:
+ * TCL_OK for success or TCL_ERROR for error or if not supported. If
+ * direction is TCL_READABLE, sets handlePtr to the handle used for
+ * input, or if TCL_WRITABLE sets to the handle used for output.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+int DigestGetHandleProc(ClientData clientData, int direction, ClientData *handlePtr) {
+ DigestState *statePtr = (DigestState *) clientData;
+ Tcl_Channel parent;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ return Tcl_GetChannelHandle(parent, direction, handlePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestNotifyProc --
+ *
+ * Called by Tcl to inform us of activity on the underlying channel.
+ *
+ * Returns:
+ * Unchanged interestMask which is an OR-ed combination of TCL_READABLE or TCL_WRITABLE
+ *
+ * Side effects:
+ * Cancels any pending timer.
+ *
+ *----------------------------------------------------------------------
+ */
+int DigestNotifyProc(ClientData clientData, int interestMask) {
+ DigestState *statePtr = (DigestState *) clientData;
+
+ /* Skip timer event as redundant */
+ if (statePtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler(statePtr->timer);
+ statePtr->timer = (Tcl_TimerToken) NULL;
+ }
+ return interestMask;
+}
+
+/*
+ *
+ * Channel type structure definition for digest transformations.
+ *
+ */
+static const Tcl_ChannelType digestChannelType = {
+ "digest", /* Type name */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
+ DigestCloseProc, /* Close proc */
+ DigestInputProc, /* Input proc */
+ DigestOutputProc, /* Output proc */
+ NULL, /* Seek proc */
+ DigestSetOptionProc, /* Set option proc */
+ DigestGetOptionProc, /* Get option proc */
+ DigestWatchProc, /* Initialize notifier */
+ DigestGetHandleProc, /* Get OS handles out of channel */
+ DigestClose2Proc, /* close2proc */
+ DigestBlockModeProc, /* Set blocking/nonblocking mode*/
+ NULL, /* Flush proc */
+ DigestNotifyProc, /* Handling of events bubbling up */
+ NULL, /* Wide seek proc */
+ NULL, /* Thread action */
+ NULL /* Truncate */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DigestChannelHandler --
+ *
+ * Create a stacked channel for a message digest transformation.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Adds transform to channel and sets result to channel id or error message.
+ *
+ *----------------------------------------------------------------------
+ */
+static int DigestChannelHandler(Tcl_Interp *interp, const char *channel, const EVP_MD *md,
+ const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj, EVP_MAC *mac) {
+ int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
+ Tcl_Channel chan;
+ DigestState *statePtr;
+
+ dprintf("Called");
+
+ /* Validate args */
+ if (channel == (const char *) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Get channel Id */
+ chan = Tcl_GetChannel(interp, channel, &mode);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Make sure to operate on the topmost channel */
+ chan = Tcl_GetTopChannel(chan);
+
+ /* Configure channel */
+ Tcl_SetChannelOption(interp, chan, "-translation", "binary");
+ if (Tcl_GetChannelBufferSize(chan) < EVP_MAX_MD_SIZE * 2) {
+ Tcl_SetChannelBufferSize(chan, EVP_MAX_MD_SIZE * 2);
+ }
+
+ /* Create state data structure */
+ if ((statePtr = DigestStateNew(interp, format)) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+ statePtr->self = chan;
+ statePtr->mode = mode;
+
+ /* Initialize hash function */
+ if (DigestInitialize(interp, statePtr, md, cipher, keyObj, mac) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Stack channel */
+ statePtr->self = Tcl_StackChannel(interp, &digestChannelType, (ClientData) statePtr, mode, chan);
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ DigestStateFree(statePtr);
+ return TCL_ERROR;
+ }
+
+ /* Set result to channel Id */
+ Tcl_SetResult(interp, (char *) Tcl_GetChannelName(chan), TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unstack Channel --
+ *
+ * This function removes the stacked channel from the top of the
+ * channel stack if it is a digest channel.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Removes transform from channel or sets result to error message.
+ *
+ *----------------------------------------------------------------------
+ */
+static int DigestUnstackObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ Tcl_Channel chan;
+ int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
+
+ dprintf("Called");
+
+ /* Validate arg count */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+ return TCL_ERROR;
+ }
+
+ /* Get channel */
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), &mode);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Make sure to operate on the topmost channel */
+ chan = Tcl_GetTopChannel(chan);
+
+ /* Check if digest channel */
+ if (Tcl_GetChannelType(chan) != &digestChannelType) {
+ Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
+ "\": not a digest channel", NULL);
+ Tcl_SetErrorCode(interp, "TLS", "UNSTACK", "CHANNEL", "INVALID", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Pop transform from channel */
+ return Tcl_UnstackChannel(interp, chan);
+ clientData = clientData;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestInstanceObjCmd --
+ *
+ * Handler for digest command instances. Used to add data to hash
+ * function or retrieve message digest.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Adds data to hash or returns message digest
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestInstanceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ DigestState *statePtr = (DigestState *) clientData;
+ int fn, data_len = 0;
+ char *data = NULL;
+ static const char *instance_fns [] = { "finalize", "update", NULL };
+
+ dprintf("Called");
+
+ /* Validate arg count */
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "function ?data?");
+ return TCL_ERROR;
+ }
+
+ /* Get function */
+ if (Tcl_GetIndexFromObj(interp, objv[1], instance_fns, "function", 0, &fn) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Do function */
+ if (fn) {
+ /* Get data or return error if none */
+ if (objc == 3) {
+ data = Tcl_GetByteArrayFromObj(objv[2], &data_len);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "update data");
+ return TCL_ERROR;
+ }
+
+ /* Update hash function */
+ if (DigestUpdate(statePtr, data, (size_t) data_len, 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ } else {
+ /* Finalize hash function and calculate message digest */
+ if (DigestFinalize(interp, statePtr, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_DeleteCommandFromToken(interp, statePtr->token);
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestCommandDeleteHandler --
+ *
+ * Callback to clean-up when digest instance command is deleted.
+ *
+ * Returns:
+ * Nothing
+ *
+ * Side effects:
+ * Destroys state info structure
+ *
+ *-------------------------------------------------------------------
+ */
+void DigestCommandDeleteHandler(ClientData clientData) {
+ DigestState *statePtr = (DigestState *) clientData;
+
+ /* Clean-up */
+ DigestStateFree(statePtr);
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestCommandHandler --
+ *
+ * Create command to allow user to add data to hash function.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Creates command or error message
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestCommandHandler(Tcl_Interp *interp, Tcl_Obj *cmdObj, const EVP_MD *md,
+ const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj, EVP_MAC *mac) {
+ DigestState *statePtr;
+ char *cmdName = Tcl_GetStringFromObj(cmdObj, NULL);
+
+ dprintf("Called");
+
+ /* Create state data structure */
+ if ((statePtr = DigestStateNew(interp, format)) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Initialize hash function */
+ if (DigestInitialize(interp, statePtr, md, cipher, keyObj, mac) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Create instance command */
+ statePtr->token = Tcl_CreateObjCommand(interp, cmdName, DigestInstanceObjCmd,
+ (ClientData) statePtr, DigestCommandDeleteHandler);
+
+ /* Return command name */
+ Tcl_SetObjResult(interp, cmdObj);
+ return TCL_OK;
+}
+
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestDataHandler --
+ *
+ * Return message digest for data using user specified hash function.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Sets result to message digest or error message
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestDataHandler(Tcl_Interp *interp, Tcl_Obj *dataObj, const EVP_MD *md,
+ const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj, EVP_MAC *mac) {
+ char *data;
+ int data_len;
+ DigestState *statePtr;
+
+ dprintf("Called");
+
+ /* Get data */
+ data = Tcl_GetByteArrayFromObj(dataObj, &data_len);
+ if (data == NULL) {
+ Tcl_SetResult(interp, "No data", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Create state data structure */
+ if ((statePtr = DigestStateNew(interp, format)) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Calc Digest */
+ if (DigestInitialize(interp, statePtr, md, cipher, keyObj, mac) != TCL_OK ||
+ DigestUpdate(statePtr, data, (size_t) data_len, 1) != TCL_OK ||
+ DigestFinalize(interp, statePtr, NULL) != TCL_OK) {
+ DigestStateFree(statePtr);
+ return TCL_ERROR;
+ }
+
+ /* Clean-up */
+ DigestStateFree(statePtr);
+ return TCL_OK;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestFileHandler --
+ *
+ * Return message digest for file using user specified hash function.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Result is message digest or error message
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestFileHandler(Tcl_Interp *interp, Tcl_Obj *inFileObj, const EVP_MD *md,
+ const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj, EVP_MAC *mac) {
+ DigestState *statePtr;
+ Tcl_Channel chan = NULL;
+ unsigned char buf[BUFFER_SIZE];
+ int res = TCL_OK, len;
+
+ dprintf("Called");
+
+ /* Create state data structure */
+ if ((statePtr = DigestStateNew(interp, format)) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Open file channel */
+ chan = Tcl_FSOpenFileChannel(interp, inFileObj, "rb", 0444);
+ if (chan == (Tcl_Channel) NULL) {
+ DigestStateFree(statePtr);
+ return TCL_ERROR;
+ }
+
+ /* Configure channel */
+ if ((res = Tcl_SetChannelOption(interp, chan, "-translation", "binary")) != TCL_OK) {
+ goto done;
+ }
+ Tcl_SetChannelBufferSize(chan, BUFFER_SIZE);
+
+ /* Initialize hash function */
+ if ((res = DigestInitialize(interp, statePtr, md, cipher, keyObj, mac)) != TCL_OK) {
+ goto done;
+ }
+
+ /* Read file data and update hash function */
+ while (!Tcl_Eof(chan)) {
+ len = Tcl_ReadRaw(chan, (char *) buf, BUFFER_SIZE);
+ if (len > 0) {
+ if (DigestUpdate(statePtr, &buf[0], (size_t) len, 1) != TCL_OK) {
+ res = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ /* Finalize hash function and calculate message digest */
+ res = DigestFinalize(interp, statePtr, NULL);
+
+done:
+ /* Close channel */
+ if (Tcl_Close(interp, chan) == TCL_ERROR) {
+ res = TCL_ERROR;
+ }
+
+ /* Clean-up */
+ DigestStateFree(statePtr);
+ return res;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * GetDigest -- Get message digest
+ *
+ * Returns:
+ * EVP_MD * or NULL
+ *
+ *-------------------------------------------------------------------
+ */
+EVP_MD *GetDigest(Tcl_Interp *interp, Tcl_Obj *objPtr, int *format) {
+ const EVP_MD *md = NULL;
+ char *digestName = Tcl_GetStringFromObj(objPtr, NULL);
+
+ if (digestName != NULL) {
+ md = EVP_get_digestbyname(digestName);
+ if (md == NULL) {
+ Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
+ return NULL;
+ } else if (md == EVP_shake128() || md == EVP_shake256()) {
+ *format |= IS_XOF;
+ }
+ } else {
+ Tcl_AppendResult(interp, "No digest specified", NULL);
+ return NULL;
+ }
+ return md;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * GetCipher -- Get cipher
+ *
+ * Returns:
+ * EVP_CIPHER * or NULL
+ *
+ *-------------------------------------------------------------------
+ */
+EVP_CIPHER *GetCipher(Tcl_Interp *interp, Tcl_Obj *objPtr, int *type) {
+ const EVP_CIPHER *cipher = NULL;
+ char *cipherName = Tcl_GetStringFromObj(objPtr, NULL);
+
+ if (cipherName != NULL) {
+ cipher = EVP_get_cipherbyname(cipherName);
+ *type = TYPE_CMAC;
+ if (cipher == NULL) {
+ Tcl_AppendResult(interp, "Invalid cipher \"", cipherName, "\"", NULL);
+ return NULL;
+ }
+ } else {
+ Tcl_AppendResult(interp, "No cipher specified", NULL);
+ return NULL;
+ }
+ return cipher;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * GetKey -- Get key
+ *
+ * Returns:
+ * unsigned char * or NULL
+ *
+ *-------------------------------------------------------------------
+ */
+unsigned char *GetKey(Tcl_Interp *interp, Tcl_Obj *objPtr, int *type) {
+ unsigned char *key = Tcl_GetByteArrayFromObj(objPtr, NULL);
+
+ if (key == NULL) {
+ Tcl_AppendResult(interp, "No key specified", NULL);
+ return NULL;
+ }
+ if (*type == TYPE_MD) {
+ *type = TYPE_HMAC;
+ }
+ return key;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * GetMAC -- Get MAC
+ *
+ * Returns:
+ * EVP_MAC * or NULL
+ *
+ *-------------------------------------------------------------------
+ */
+EVP_MAC *GetMAC(Tcl_Interp *interp, Tcl_Obj *objPtr, int *type) {
+ EVP_MAC *mac = NULL;
+ char *macName = Tcl_GetStringFromObj(objPtr, NULL);
+
+ if (macName != NULL) {
+ if (strcmp(macName, "cmac") == 0) {
+ *type = TYPE_CMAC;
+ } else if (strcmp(macName, "hmac") == 0) {
+ *type = TYPE_HMAC;
+ } else {
+ Tcl_AppendResult(interp, "Invalid MAC \"", macName, "\"", NULL);
+ return NULL;
+ }
+ mac = (void *) macName;
+ } else {
+ Tcl_AppendResult(interp, "No MAC specified", NULL);
+ return NULL;
+ }
+ return mac;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestMain --
+ *
+ * Return message digest or Message Authentication Code (MAC) of
+ * data using user specified hash function.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Sets result to message digest or error message
+ *
+ *-------------------------------------------------------------------
+ */
+static int DigestMain(int type, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ int idx, start = 1, format = HEX_FORMAT, res = TCL_OK;
+ Tcl_Obj *cipherObj = NULL, *cmdObj = NULL, *dataObj = NULL, *digestObj = NULL;
+ Tcl_Obj *fileObj = NULL, *keyObj = NULL, *macObj = NULL;
+ const char *channel = NULL, *opt;
+ const EVP_MD *md = NULL;
+ const EVP_CIPHER *cipher = NULL;
+ EVP_MAC *mac = NULL;
+
+ dprintf("Called");
+
+ /* Clear interp result */
+ Tcl_ResetResult(interp);
+
+ /* Validate arg count */
+ if (objc < 3 || objc > 12) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]");
+ return TCL_ERROR;
+ }
+
+ /* Special case of first arg is digest, cipher, or mac */
+ opt = Tcl_GetStringFromObj(objv[start], NULL);
+ if (opt[0] != '-') {
+ if (type == TYPE_MD || type == TYPE_HMAC) {
+ digestObj = objv[start];
+ start++;
+ } else if (type == TYPE_CMAC) {
+ cipherObj = objv[start];
+ start++;
+ } else if (type == TYPE_MAC) {
+ macObj = objv[start];
+ start++;
+ }
+ }
+
+ /* Get options */
+ for (idx = start; idx < objc; idx++) {
+ opt = Tcl_GetStringFromObj(objv[idx], NULL);
+
+ if (opt[0] != '-') {
+ break;
+ }
+
+ OPTFLAG("-bin", format, BIN_FORMAT);
+ OPTFLAG("-binary", format, BIN_FORMAT);
+ OPTFLAG("-hex", format, HEX_FORMAT);
+ OPTFLAG("-hexadecimal", format, HEX_FORMAT);
+ OPTSTR("-chan", channel);
+ OPTSTR("-channel", channel);
+ OPTOBJ("-cipher", cipherObj);
+ OPTOBJ("-command", cmdObj);
+ OPTOBJ("-data", dataObj);
+ OPTOBJ("-digest", digestObj);
+ OPTOBJ("-file", fileObj);
+ OPTOBJ("-filename", fileObj);
+ OPTOBJ("-key", keyObj);
+ OPTOBJ("-mac", macObj);
+
+ OPTBAD("option", "-bin, -channel, -cipher, -command, -data, -digest, -file, -filename, -hex, -key, or -mac");
+ return TCL_ERROR;
+ }
+
+ /* If only 1 arg left, it's the data */
+ if (idx < objc && dataObj == NULL) {
+ dataObj = objv[idx];
+ }
+
+ /* Get cipher */
+ if (cipherObj != NULL) {
+ if ((cipher = GetCipher(interp, cipherObj, &type)) == NULL) {
+ return TCL_ERROR;
+ }
+ } else if (type == TYPE_CMAC) {
+ Tcl_AppendResult(interp, "No cipher specified", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Get message digest */
+ if (digestObj != NULL) {
+ if ((md = GetDigest(interp, digestObj, &format)) == NULL) {
+ return TCL_ERROR;
+ }
+ } else if (type == TYPE_MD || type == TYPE_HMAC) {
+ Tcl_AppendResult(interp, "No digest specified", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Get key */
+ if (keyObj != NULL) {
+ if (GetKey(interp, keyObj, &type) == NULL) {
+ return TCL_ERROR;
+ }
+ } else if (type != TYPE_MD) {
+ Tcl_AppendResult(interp, "No key specified", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Get MAC */
+ if (macObj != NULL) {
+ if ((mac = GetMAC(interp, macObj, &type)) == NULL) {
+ return TCL_ERROR;
+ }
+ } else if (type == TYPE_MAC) {
+ Tcl_AppendResult(interp, "No MAC specified", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Calc digest on file, stacked channel, using instance command, or data blob */
+ if (fileObj != NULL) {
+ res = DigestFileHandler(interp, fileObj, md, cipher, format | type, keyObj, mac);
+ } else if (channel != NULL) {
+ res = DigestChannelHandler(interp, channel, md, cipher, format | type, keyObj, mac);
+ } else if (cmdObj != NULL) {
+ res = DigestCommandHandler(interp, cmdObj, md, cipher, format | type, keyObj, mac);
+ } else if (dataObj != NULL) {
+ res = DigestDataHandler(interp, dataObj, md, cipher, format | type, keyObj, mac);
+ } else {
+ Tcl_AppendResult(interp, "No operation specified: Use -channel, -command, -data, or -file option", NULL);
+ res = TCL_ERROR;
+ }
+ return res;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * Message Digest and Message Authentication Code Commands --
+ *
+ * Return Message Digest (MD) or Message Authentication Code (MAC).
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Sets result to message digest or error message
+ *
+ *-------------------------------------------------------------------
+ */
+static int MdObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ return DigestMain(TYPE_MD, interp, objc, objv);
+}
+
+static int CMACObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ return DigestMain(TYPE_CMAC, interp, objc, objv);
+}
+
+static int HMACObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ return DigestMain(TYPE_HMAC, interp, objc, objv);
+}
+
+static int MACObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ return DigestMain(TYPE_MAC, interp, objc, objv);
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * Message Digest Convenience Commands --
+ *
+ * Convenience commands for select message digests.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Sets result to message digest or error message
+ *
+ *-------------------------------------------------------------------
+ */
+ #define validate_argc(objc, objv) { \
+ if (objc != 2) { \
+ Tcl_WrongNumArgs(interp, 1, objv, "data"); \
+ return TCL_ERROR; \
+ } \
+}
+
+int MD4ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ validate_argc(objc, objv);
+ return DigestDataHandler(interp, objv[1], EVP_md4(), NULL, HEX_FORMAT | TYPE_MD, NULL, NULL);
+}
+
+int MD5ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ validate_argc(objc, objv);
+ return DigestDataHandler(interp, objv[1], EVP_md5(), NULL, HEX_FORMAT | TYPE_MD, NULL, NULL);
+}
+
+int SHA1ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ validate_argc(objc, objv);
+ return DigestDataHandler(interp, objv[1], EVP_sha1(), NULL, HEX_FORMAT | TYPE_MD, NULL, NULL);
+}
+
+int SHA256ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ validate_argc(objc, objv);
+ return DigestDataHandler(interp, objv[1], EVP_sha256(), NULL, HEX_FORMAT | TYPE_MD, NULL, NULL);
+}
+
+int SHA512ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ validate_argc(objc, objv);
+ return DigestDataHandler(interp, objv[1], EVP_sha512(), NULL, HEX_FORMAT | TYPE_MD, NULL, NULL);
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * Tls_DigestCommands --
+ *
+ * Create digest commands
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Creates commands
+ *
+ *-------------------------------------------------------------------
+ */
+int Tls_DigestCommands(Tcl_Interp *interp) {
+ Tcl_CreateObjCommand(interp, "tls::digest", MdObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::md", MdObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::cmac", CMACObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::hmac", HMACObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::mac", MACObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::md4", MD4ObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::md5", MD5ObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::sha1", SHA1ObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::sha256", SHA256ObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::sha512", SHA512ObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::unstack", DigestUnstackObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
+
ADDED generic/tlsEncrypt.c
Index: generic/tlsEncrypt.c
==================================================================
--- /dev/null
+++ generic/tlsEncrypt.c
@@ -0,0 +1,1287 @@
+/*
+ * Encryption Functions Module
+ *
+ * This module provides commands that can be used to encrypt or decrypt data.
+ *
+ * Copyright (C) 2023 Brian O'Hagan
+ *
+ */
+
+#include "tlsInt.h"
+#include "tclOpts.h"
+#include
+#include
+#include
+#include
+#if OPENSSL_VERSION_NUMBER >= 0x30000000L
+#include
+#endif
+
+/* Macros */
+#define BUFFER_SIZE 32768
+#define CHAN_EOF 0x10
+#define READ_DELAY 5
+
+/* Encryption functions */
+#define TYPE_MD 0x010
+#define TYPE_HMAC 0x020
+#define TYPE_CMAC 0x040
+#define TYPE_MAC 0x080
+#define TYPE_ENCRYPT 0x100
+#define TYPE_DECRYPT 0x200
+#define TYPE_SIGN 0x400
+#define TYPE_VERIFY 0x800
+
+/*******************************************************************/
+
+/*
+ * This structure defines the per-instance state of a encrypt operation.
+ */
+typedef struct EncryptState {
+ Tcl_Channel self; /* This socket channel */
+ Tcl_TimerToken timer; /* Timer for read events */
+
+ int flags; /* Chan config flags */
+ int watchMask; /* Current WatchProc mask */
+ int mode; /* Current mode of parent channel */
+ int type; /* Operation type */
+
+ Tcl_Interp *interp; /* Current interpreter */
+ EVP_CIPHER_CTX *ctx; /* Cipher Context */
+ Tcl_Command token; /* Command token */
+} EncryptState;
+
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptStateNew --
+ *
+ * This function creates a per-instance state data structure
+ *
+ * Returns:
+ * State structure pointer
+ *
+ * Side effects:
+ * Creates structure
+ *
+ *-------------------------------------------------------------------
+ */
+EncryptState *EncryptStateNew(Tcl_Interp *interp, int type) {
+ EncryptState *statePtr = (EncryptState *) ckalloc((unsigned) sizeof(EncryptState));
+
+ if (statePtr != NULL) {
+ memset(statePtr, 0, sizeof(EncryptState));
+ statePtr->self = NULL; /* This socket channel */
+ statePtr->timer = NULL; /* Timer to flush data */
+ statePtr->flags = 0; /* Chan config flags */
+ statePtr->watchMask = 0; /* Current WatchProc mask */
+ statePtr->mode = 0; /* Current mode of parent channel */
+ statePtr->type = type; /* Operation type */
+ statePtr->interp = interp; /* Current interpreter */
+ statePtr->ctx = NULL; /* Cipher Context */
+ statePtr->token = NULL; /* Command token */
+ }
+ return statePtr;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptStateFree --
+ *
+ * This function deletes a state data structure
+ *
+ * Returns:
+ * Nothing
+ *
+ * Side effects:
+ * Removes structure
+ *
+ *-------------------------------------------------------------------
+ */
+void EncryptStateFree(EncryptState *statePtr) {
+ if (statePtr == (EncryptState *) NULL) {
+ return;
+ }
+
+ /* Remove pending timer */
+ if (statePtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler(statePtr->timer);
+ }
+
+ /* Free context structures */
+ if (statePtr->ctx != (EVP_CIPHER_CTX *) NULL) {
+ EVP_CIPHER_CTX_free(statePtr->ctx);
+ }
+ ckfree(statePtr);
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptInitialize --
+ *
+ * Initialize an encryption function
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR for failure with result set
+ * to error message.
+ *
+ * Side effects:
+ * No result or error message
+ *
+ *-------------------------------------------------------------------
+ */
+int EncryptInitialize(Tcl_Interp *interp, int type, EVP_CIPHER_CTX **ctx,
+ Tcl_Obj *cipherObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
+ const EVP_CIPHER *cipher;
+ char *cipherName = NULL, *key = NULL, *iv = NULL;
+ int cipher_len = 0, key_len = 0, iv_len = 0, res;
+
+ dprintf("Called");
+
+ /* Get encryption parameters */
+ if (cipherObj != NULL) {
+ cipherName = Tcl_GetStringFromObj(cipherObj, &cipher_len);
+ }
+ if (keyObj != NULL) {
+ key = Tcl_GetStringFromObj(keyObj, &key_len);
+ }
+ if (ivObj != NULL) {
+ iv = Tcl_GetStringFromObj(ivObj, &iv_len);
+ }
+
+ /* Get cipher name */
+#if OPENSSL_VERSION_NUMBER < 0x30000000L
+ cipher = EVP_get_cipherbyname(cipherName);
+#else
+ cipher = EVP_CIPHER_fetch(NULL, cipherName, NULL);
+#endif
+ if (cipher == NULL) {
+ Tcl_AppendResult(interp, "Invalid cipher: \"", cipherName, "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Create and initialize the context */
+ if((*ctx = EVP_CIPHER_CTX_new()) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Initialize the operation. Need appropriate key and iv size. */
+#if OPENSSL_VERSION_NUMBER < 0x30000000L
+ if (type == TYPE_ENCRYPT) {
+ res = EVP_EncryptInit_ex(*ctx, cipher, NULL, key, iv);
+ } else {
+ res = EVP_DecryptInit_ex(*ctx, cipher, NULL, key, iv);
+ }
+#else
+ OSSL_PARAM params[2];
+ int index = 0;
+
+ if (iv != NULL) {
+ params[index++] = OSSL_PARAM_construct_octet_string(OSSL_CIPHER_PARAM_IV, (void *) iv, (size_t) iv_len);
+ }
+ params[index] = OSSL_PARAM_construct_end();
+
+ if (type == TYPE_ENCRYPT) {
+ res = EVP_EncryptInit_ex2(ctx, cipher, key, iv, params);
+ } else {
+ res = EVP_DecryptInit_ex2(ctx, cipher, key, iv, params);
+ }
+#endif
+
+ if(!res) {
+ Tcl_AppendResult(interp, "Initialize failed: ", REASON(), NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptUpdate --
+ *
+ * Update an encryption function with data
+ *
+ * Returns:
+ * 1 if successful or 0 for failure
+ *
+ * Side effects:
+ * Adds encrypted data to buffer or sets result to error message
+ *
+ *-------------------------------------------------------------------
+ */
+int EncryptUpdate(Tcl_Interp *interp, int type, EVP_CIPHER_CTX *ctx, unsigned char *out_buf,
+ int *out_len, unsigned char *data, int data_len) {
+ int res;
+
+ dprintf("Called");
+
+ /* Encrypt/decrypt data */
+ if (type == TYPE_ENCRYPT) {
+ res = EVP_EncryptUpdate(ctx, out_buf, out_len, data, data_len);
+ } else {
+ res = EVP_DecryptUpdate(ctx, out_buf, out_len, data, data_len);
+ }
+
+ if (res) {
+ return TCL_OK;
+ } else {
+ Tcl_AppendResult(interp, "Update failed: ", REASON(), NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptFinalize --
+ *
+ * Finalize an encryption function
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR for failure with result set
+ * to error message.
+ *
+ * Side effects:
+ * Adds encrypted data to buffer or sets result to error message
+ *
+ *-------------------------------------------------------------------
+ */
+int EncryptFinalize(Tcl_Interp *interp, int type, EVP_CIPHER_CTX *ctx, unsigned char *out_buf,
+ int *out_len) {
+ int res;
+
+ dprintf("Called");
+
+ /* Finalize data */
+ if (type == TYPE_ENCRYPT) {
+ res = EVP_EncryptFinal_ex(ctx, out_buf, out_len);
+ } else {
+ res = EVP_DecryptFinal_ex(ctx, out_buf, out_len);
+ }
+
+ if (res) {
+ return TCL_OK;
+ } else {
+ Tcl_AppendResult(interp, "Finalize failed: ", REASON(), NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptBlockModeProc --
+ *
+ * This function is invoked by the generic IO level
+ * to set blocking and nonblocking modes.
+ *
+ * Returns:
+ * 0 if successful or POSIX error code if failed.
+ *
+ * Side effects:
+ * Sets the device into blocking or nonblocking mode.
+ * Can call Tcl_SetChannelError.
+ *
+ *-------------------------------------------------------------------
+ */
+static int EncryptBlockModeProc(ClientData clientData, int mode) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ statePtr->flags |= TLS_TCL_ASYNC;
+ } else {
+ statePtr->flags &= ~(TLS_TCL_ASYNC);
+ }
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptCloseProc --
+ *
+ * This function is invoked by the generic IO level to perform
+ * channel-type specific cleanup when the channel is closed. All
+ * queued output is flushed prior to calling this function.
+ *
+ * Returns:
+ * 0 if successful or POSIX error code if failed.
+ *
+ * Side effects:
+ * Deletes stored state data.
+ *
+ *-------------------------------------------------------------------
+ */
+int EncryptCloseProc(ClientData clientData, Tcl_Interp *interp) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+
+ /* Cancel active timer, if any */
+ if (statePtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler(statePtr->timer);
+ statePtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ /* Output remaining data, if any */
+ if (!(statePtr->flags & CHAN_EOF)) {
+ Tcl_Channel parent = Tcl_GetStackedChannel(statePtr->self);
+ int out_len;
+ unsigned char out_buf[EVP_MAX_BLOCK_LENGTH];
+
+ /* Finalize function */
+ if (EncryptFinalize(interp, statePtr->type, statePtr->ctx, out_buf, &out_len) == TCL_OK) {
+ if (out_len > 0) {
+ int len = Tcl_WriteRaw(parent, (const char *) out_buf, out_len);
+ if (len < 0) {
+ return Tcl_GetErrno();
+ }
+ }
+ } else {
+ /* Error */
+ }
+
+ statePtr->flags |= CHAN_EOF;
+ }
+
+ /* Clean-up */
+ EncryptStateFree(statePtr);
+ return 0;
+}
+
+/*
+ * Same as EncryptCloseProc but with individual read and write close control
+ */
+static int EncryptClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags) {
+ if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) {
+ return EncryptCloseProc(instanceData, interp);
+ }
+ return EINVAL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptInputProc --
+ *
+ * Called by the generic IO system to read data from transform and
+ * place in buf. Transform gets data from the underlying channel.
+ *
+ * Returns:
+ * Total bytes read or -1 for an error along with a POSIX error
+ * code in errorCodePtr. Use EAGAIN for nonblocking and no data.
+ *
+ * Side effects:
+ * Read data from transform and write to buf
+ *
+ *----------------------------------------------------------------------
+ */
+int EncryptInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+ Tcl_Channel parent;
+ int read, out_len;
+ *errorCodePtr = 0;
+ char *in_buf;
+
+ /* Abort if nothing to process */
+ if (toRead <= 0 || statePtr->self == (Tcl_Channel) NULL) {
+ return 0;
+ }
+
+ /* Get bytes from underlying channel */
+ in_buf = Tcl_Alloc(toRead);
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ read = Tcl_ReadRaw(parent, in_buf, toRead);
+
+ /* Update function */
+ if (read > 0) {
+ /* Have data - Update function */
+ if (EncryptUpdate(statePtr->interp, statePtr->type, statePtr->ctx, buf, &out_len, in_buf, read) == TCL_OK) {
+ /* If have data, put in buf, otherwise tell TCL to try again */
+ if (out_len > 0) {
+ read = out_len;
+ } else {
+ *errorCodePtr = EAGAIN;
+ read = -1;
+ }
+ } else {
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
+ *errorCodePtr = EINVAL;
+ read = 0;
+ }
+
+ } else if (read < 0) {
+ /* Error */
+ *errorCodePtr = Tcl_GetErrno();
+
+ } else if (!(statePtr->flags & CHAN_EOF)) {
+ /* EOF - Finalize function and put any remaining data in buf */
+ if (EncryptFinalize(statePtr->interp, statePtr->type, statePtr->ctx, buf, &out_len) == TCL_OK) {
+ read = out_len;
+ } else {
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", REASON()));
+ *errorCodePtr = EINVAL;
+ read = 0;
+ }
+
+ statePtr->flags |= CHAN_EOF;
+ }
+ Tcl_Free(in_buf);
+ return read;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptOutputProc --
+ *
+ * Called by the generic IO system to write data in buf to transform.
+ * The transform writes the result to the underlying channel.
+ *
+ * Returns:
+ * Total bytes written or -1 for an error along with a POSIX error
+ * code in errorCodePtr. Use EAGAIN for nonblocking and can't write data.
+ *
+ * Side effects:
+ * Get data from buf and update encryption
+ *
+ *----------------------------------------------------------------------
+ */
+ int EncryptOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+ int write = 0, out_len;
+ *errorCodePtr = 0;
+ char *out_buf;
+
+ /* Abort if nothing to process */
+ if (toWrite <= 0 || statePtr->self == (Tcl_Channel) NULL) {
+ return 0;
+ }
+
+ out_buf = Tcl_Alloc(toWrite+EVP_MAX_BLOCK_LENGTH);
+
+ /* Update function */
+ if (EncryptUpdate(statePtr->interp, statePtr->type, statePtr->ctx, out_buf, &out_len, buf, toWrite) == TCL_OK) {
+ /* If have data, output it, otherwise tell TCL to try again */
+ if (out_len > 0) {
+ Tcl_Channel parent = Tcl_GetStackedChannel(statePtr->self);
+ write = Tcl_WriteRaw(parent, (const char *) out_buf, out_len);
+ write = toWrite;
+ } else {
+ *errorCodePtr = EAGAIN;
+ write = -1;
+ }
+
+ } else {
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON()));
+ *errorCodePtr = EINVAL;
+ write = 0;
+ }
+ Tcl_Free(out_buf);
+ return write;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptSetOptionProc --
+ *
+ * Called by the generic IO system to set channel option name to value.
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR if failed along with an error
+ * message in interp and Tcl_SetErrno.
+ *
+ * Side effects:
+ * Updates channel option to new value.
+ *
+ *----------------------------------------------------------------------
+ */
+static int EncryptSetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
+ const char *optionValue) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+ Tcl_Channel parent;
+ Tcl_DriverSetOptionProc *setOptionProc;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Delegate options downstream */
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
+ if (setOptionProc != NULL) {
+ return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
+ } else {
+ Tcl_SetErrno(EINVAL);
+ return Tcl_BadChannelOption(interp, optionName, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptGetOptionProc --
+ *
+ * Called by the generic IO system to get channel option name's value.
+ *
+ * Returns:
+ * TCL_OK if successful or TCL_ERROR if failed along with an error
+ * message in interp and Tcl_SetErrno.
+ *
+ * Side effects:
+ * Sets result to option's value
+ *
+ *----------------------------------------------------------------------
+ */
+static int EncryptGetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
+ Tcl_DString *optionValue) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+ Tcl_Channel parent;
+ Tcl_DriverGetOptionProc *getOptionProc;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Delegate options downstream */
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));
+ if (getOptionProc != NULL) {
+ return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
+ } else if (optionName == (char*) NULL) {
+ /* Request is query for all options, this is ok. */
+ return TCL_OK;
+ } else {
+ Tcl_SetErrno(EINVAL);
+ return Tcl_BadChannelOption(interp, optionName, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptTimerHandler --
+ *
+ * Called by the notifier via timer to flush out pending input data.
+ *
+ * Returns:
+ * Nothing
+ *
+ * Side effects:
+ * May call Tcl_NotifyChannel
+ *
+ *----------------------------------------------------------------------
+ */
+static void EncryptTimerHandler(ClientData clientData) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return;
+ }
+
+ /* Clear timer token */
+ statePtr->timer = (Tcl_TimerToken) NULL;
+
+ /* Fire event if there is pending data, skip otherwise */
+ if ((statePtr->watchMask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) {
+ Tcl_NotifyChannel(statePtr->self, TCL_READABLE);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptWatchProc --
+ *
+ * Initialize the notifier to watch for events from this channel.
+ *
+ * Returns:
+ * Nothing (can't return error messages)
+ *
+ * Side effects:
+ * Configure notifier so future events on the channel will be seen by Tcl.
+ *
+ *----------------------------------------------------------------------
+ */
+void EncryptWatchProc(ClientData clientData, int mask) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+ Tcl_Channel parent;
+ Tcl_DriverWatchProc *watchProc;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return;
+ }
+
+ /* Store OR-ed combination of TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION */
+ statePtr->watchMask = mask;
+
+ /* Propagate mask info to parent channel */
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent));
+ watchProc(Tcl_GetChannelInstanceData(parent), mask);
+
+ /* Remove pending timer */
+ if (statePtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler(statePtr->timer);
+ statePtr->timer = (Tcl_TimerToken) NULL;
+ }
+
+ /* If there is data pending, set new timer to call Tcl_NotifyChannel */
+ if ((mask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) {
+ statePtr->timer = Tcl_CreateTimerHandler(READ_DELAY, EncryptTimerHandler, (ClientData) statePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptGetHandleProc --
+ *
+ * Called from Tcl_GetChannelHandle to retrieve OS specific file handle
+ * from inside this channel. Not used for transformations?
+ *
+ * Returns:
+ * TCL_OK for success or TCL_ERROR for error or if not supported. If
+ * direction is TCL_READABLE, sets handlePtr to the handle used for
+ * input, or if TCL_WRITABLE sets to the handle used for output.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+int EncryptGetHandleProc(ClientData clientData, int direction, ClientData *handlePtr) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+ Tcl_Channel parent;
+
+ /* Abort if no channel */
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ parent = Tcl_GetStackedChannel(statePtr->self);
+ return Tcl_GetChannelHandle(parent, direction, handlePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptNotifyProc --
+ *
+ * Called by Tcl to inform us of activity on the underlying channel.
+ *
+ * Returns:
+ * Unchanged interestMask which is an OR-ed combination of TCL_READABLE or TCL_WRITABLE
+ *
+ * Side effects:
+ * Cancels any pending timer.
+ *
+ *----------------------------------------------------------------------
+ */
+int EncryptNotifyProc(ClientData clientData, int interestMask) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+
+ /* Skip timer event as redundant */
+ if (statePtr->timer != (Tcl_TimerToken) NULL) {
+ Tcl_DeleteTimerHandler(statePtr->timer);
+ statePtr->timer = (Tcl_TimerToken) NULL;
+ }
+ return interestMask;
+}
+
+/*
+ *
+ * Channel type structure definition for encryption transformations.
+ *
+ */
+static const Tcl_ChannelType encryptChannelType = {
+ "encryption", /* Type name */
+ TCL_CHANNEL_VERSION_5, /* v5 channel */
+ EncryptCloseProc, /* Close proc */
+ EncryptInputProc, /* Input proc */
+ EncryptOutputProc, /* Output proc */
+ NULL, /* Seek proc */
+ EncryptSetOptionProc, /* Set option proc */
+ EncryptGetOptionProc, /* Get option proc */
+ EncryptWatchProc, /* Initialize notifier */
+ EncryptGetHandleProc, /* Get OS handles out of channel */
+ EncryptClose2Proc, /* close2proc */
+ EncryptBlockModeProc, /* Set blocking/nonblocking mode*/
+ NULL, /* Flush proc */
+ EncryptNotifyProc, /* Handling of events bubbling up */
+ NULL, /* Wide seek proc */
+ NULL, /* Thread action */
+ NULL /* Truncate */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EncryptChannelHandler --
+ *
+ * Create a stacked channel for a message encryption transformation.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Adds transform to channel and sets result to channel id or error message.
+ *
+ *----------------------------------------------------------------------
+ */
+static int EncryptChannelHandler(Tcl_Interp *interp, int type, const char *channel,
+ Tcl_Obj *cipherObj, Tcl_Obj *digestObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
+ int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
+ Tcl_Channel chan;
+ EncryptState *statePtr;
+
+ dprintf("Called");
+
+ /* Validate args */
+ if (channel == (const char *) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Get channel Id */
+ chan = Tcl_GetChannel(interp, channel, &mode);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Make sure to operate on the topmost channel */
+ chan = Tcl_GetTopChannel(chan);
+
+ /* Configure channel */
+ Tcl_SetChannelOption(interp, chan, "-translation", "binary");
+
+ /* Create state data structure */
+ if ((statePtr = EncryptStateNew(interp, type)) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+ statePtr->self = chan;
+ statePtr->mode = mode;
+
+ /* Initialize function */
+ if (EncryptInitialize(interp, type, &statePtr->ctx, cipherObj, keyObj, ivObj) != TCL_OK) {
+ EncryptStateFree(statePtr);
+ return TCL_ERROR;
+ }
+
+ /* Stack channel */
+ statePtr->self = Tcl_StackChannel(interp, &encryptChannelType, (ClientData) statePtr, mode, chan);
+ if (statePtr->self == (Tcl_Channel) NULL) {
+ EncryptStateFree(statePtr);
+ return TCL_ERROR;
+ }
+
+ /* Set result to channel Id */
+ Tcl_SetResult(interp, (char *) Tcl_GetChannelName(chan), TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unstack Channel --
+ *
+ * This function removes the stacked channel from the top of the
+ * channel stack if it is a encryption channel.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Removes transform from channel or sets result to error message.
+ *
+ *----------------------------------------------------------------------
+ */
+static int EncryptUnstackObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ Tcl_Channel chan;
+ int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
+
+ dprintf("Called");
+
+ /* Validate arg count */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+ return TCL_ERROR;
+ }
+
+ /* Get channel */
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), &mode);
+ if (chan == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Make sure to operate on the topmost channel */
+ chan = Tcl_GetTopChannel(chan);
+
+ /* Check if encryption channel */
+ if (Tcl_GetChannelType(chan) != &encryptChannelType) {
+ Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
+ "\": not a encryption channel", NULL);
+ Tcl_SetErrorCode(interp, "TLS", "UNSTACK", "CHANNEL", "INVALID", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Pop transform from channel */
+ return Tcl_UnstackChannel(interp, chan);
+ clientData = clientData;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptInstanceObjCmd --
+ *
+ * Handler for encrypt/decrypt command instances. Used to update
+ * and finalize data for encrypt/decrypt function.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Adds data to encrypt/decrypt function
+ *
+ *-------------------------------------------------------------------
+ */
+int EncryptInstanceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+ int fn, data_len = 0, out_len;
+ char *data = NULL;
+ Tcl_Obj *resultObj;
+ unsigned char *out_buf;
+ static const char *instance_fns [] = { "finalize", "update", NULL };
+
+ dprintf("Called");
+
+ /* Validate arg count */
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "function ?data?");
+ return TCL_ERROR;
+ }
+
+ /* Get function */
+ if (Tcl_GetIndexFromObj(interp, objv[1], instance_fns, "function", 0, &fn) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Allocate storage for result. Size should be data size + block size. */
+ resultObj = Tcl_NewObj();
+ out_buf = Tcl_SetByteArrayLength(resultObj, data_len+EVP_MAX_BLOCK_LENGTH);
+ if (resultObj == NULL || out_buf == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ Tcl_DecrRefCount(resultObj);
+ return TCL_ERROR;
+ }
+
+ /* Do function */
+ if (fn) {
+ /* Get data or return error if none */
+ if (objc == 3) {
+ data = Tcl_GetByteArrayFromObj(objv[2], &data_len);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "update data");
+ Tcl_DecrRefCount(resultObj);
+ return TCL_ERROR;
+ }
+
+ /* Update function */
+ if (EncryptUpdate(interp, statePtr->type, statePtr->ctx, out_buf, &out_len, data, data_len) == TCL_OK) {
+ out_buf = Tcl_SetByteArrayLength(resultObj, out_len);
+ Tcl_SetObjResult(interp, resultObj);
+ } else {
+ Tcl_DecrRefCount(resultObj);
+ return TCL_ERROR;
+ }
+
+ } else {
+ /* Finalize function */
+ if (EncryptFinalize(interp, statePtr->type, statePtr->ctx, out_buf, &out_len) == TCL_OK) {
+ out_buf = Tcl_SetByteArrayLength(resultObj, out_len);
+ Tcl_SetObjResult(interp, resultObj);
+ } else {
+ Tcl_DecrRefCount(resultObj);
+ return TCL_ERROR;
+ }
+
+ /* Clean-up */
+ Tcl_DeleteCommandFromToken(interp, statePtr->token);
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptCommandDeleteHandler --
+ *
+ * Callback to clean-up when encrypt/decrypt command is deleted.
+ *
+ * Returns:
+ * Nothing
+ *
+ * Side effects:
+ * Destroys state info structure
+ *
+ *-------------------------------------------------------------------
+ */
+void EncryptCommandDeleteHandler(ClientData clientData) {
+ EncryptState *statePtr = (EncryptState *) clientData;
+
+ /* Clean-up */
+ EncryptStateFree(statePtr);
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptCommandHandler --
+ *
+ * Create command to add data to encrypt/decrypt function.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Creates command or error message
+ *
+ *-------------------------------------------------------------------
+ */
+int EncryptCommandHandler(Tcl_Interp *interp, int type, Tcl_Obj *cmdObj,
+ Tcl_Obj *cipherObj, Tcl_Obj *digestObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
+ EncryptState *statePtr;
+ char *cmdName = Tcl_GetStringFromObj(cmdObj, NULL);
+
+ dprintf("Called");
+
+ if ((statePtr = EncryptStateNew(interp, type)) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Initialize function */
+ if (EncryptInitialize(interp, type, &statePtr->ctx, cipherObj, keyObj, ivObj) != TCL_OK) {
+ EncryptStateFree(statePtr);
+ return TCL_ERROR;
+ }
+
+ /* Create instance command */
+ statePtr->token = Tcl_CreateObjCommand(interp, cmdName, EncryptInstanceObjCmd,
+ (ClientData) statePtr, EncryptCommandDeleteHandler);
+
+ /* Return command name */
+ Tcl_SetObjResult(interp, cmdObj);
+ return TCL_OK;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptDataHandler --
+ *
+ * Perform encryption function on a block of data and return result.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Sets result or error message
+ *
+ *-------------------------------------------------------------------
+ */
+int EncryptDataHandler(Tcl_Interp *interp, int type, Tcl_Obj *dataObj, Tcl_Obj *cipherObj,
+ Tcl_Obj *digestObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
+ EVP_CIPHER_CTX *ctx = NULL;
+ int data_len = 0, out_len = 0, len = 0, res = TCL_OK;
+ unsigned char *data, *out_buf;
+ Tcl_Obj *resultObj;
+
+ dprintf("Called");
+
+ /* Get data */
+ if (dataObj != NULL) {
+ data = Tcl_GetByteArrayFromObj(dataObj, &data_len);
+ } else {
+ Tcl_AppendResult(interp, "No data", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Allocate storage for result. Size should be data size + block size. */
+ resultObj = Tcl_NewObj();
+ out_buf = Tcl_SetByteArrayLength(resultObj, data_len+EVP_MAX_BLOCK_LENGTH);
+ if (resultObj == NULL || out_buf == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Perform operation */
+ if (EncryptInitialize(interp, type, &ctx, cipherObj, keyObj, ivObj) != TCL_OK ||
+ EncryptUpdate(interp, type, ctx, out_buf, &out_len, data, data_len) != TCL_OK ||
+ EncryptFinalize(interp, type, ctx, out_buf+out_len, &len) != TCL_OK) {
+ res = TCL_ERROR;
+ goto done;
+ }
+ out_len += len;
+
+done:
+ /* Set output result */
+ if (res == TCL_OK) {
+ out_buf = Tcl_SetByteArrayLength(resultObj, out_len);
+ Tcl_SetObjResult(interp, resultObj);
+ } else {
+ Tcl_DecrRefCount(resultObj);
+ /* Result is error message */
+ }
+
+ /* Clean up */
+ if (ctx != NULL) {
+ EVP_CIPHER_CTX_free(ctx);
+ }
+ return res;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptFileHandler --
+ *
+ * Perform encryption function on a block of data and return result.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Encrypts or decrypts inFile data to outFile and sets result to
+ * size of outFile, or an error message.
+ *
+ *-------------------------------------------------------------------
+ */
+int EncryptFileHandler(Tcl_Interp *interp, int type, Tcl_Obj *inFileObj, Tcl_Obj *outFileObj,
+ Tcl_Obj *cipherObj, Tcl_Obj *digestObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
+ EVP_CIPHER_CTX *ctx = NULL;
+ int total = 0, res, out_len = 0, len;
+ Tcl_Channel in = NULL, out = NULL;
+ unsigned char in_buf[BUFFER_SIZE];
+ unsigned char out_buf[BUFFER_SIZE+EVP_MAX_BLOCK_LENGTH];
+
+ dprintf("Called");
+
+ /* Open input file */
+ if ((in = Tcl_FSOpenFileChannel(interp, inFileObj, "rb", 0444)) == (Tcl_Channel) NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Open output file */
+ if ((out = Tcl_FSOpenFileChannel(interp, outFileObj, "wb", 0644)) == (Tcl_Channel) NULL) {
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+
+ /* Initialize operation */
+ if ((res = EncryptInitialize(interp, type, &ctx, cipherObj, keyObj, ivObj)) != TCL_OK) {
+ goto done;
+ }
+
+ /* Read file data from inFile, encrypt/decrypt it, then output to outFile */
+ while (!Tcl_Eof(in)) {
+ int read = Tcl_ReadRaw(in, (char *) in_buf, BUFFER_SIZE);
+ if (read > 0) {
+ if ((res = EncryptUpdate(interp, type, ctx, out_buf, &out_len, in_buf, read)) == TCL_OK) {
+ if (out_len > 0) {
+ len = Tcl_WriteRaw(out, (const char *) out_buf, out_len);
+ if (len >= 0) {
+ total += len;
+ } else {
+ Tcl_AppendResult(interp, "Write error: ", Tcl_ErrnoMsg(Tcl_GetErrno()), (char *) NULL);
+ res = TCL_ERROR;
+ goto done;
+ }
+ }
+ } else {
+ goto done;
+ }
+ } else if (read < 0) {
+ Tcl_AppendResult(interp, "Read error: ", Tcl_ErrnoMsg(Tcl_GetErrno()), (char *) NULL);
+ res = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ /* Finalize data and write any remaining data in block */
+ if ((res = EncryptFinalize(interp, type, ctx, out_buf, &out_len)) == TCL_OK) {
+ if (out_len > 0) {
+ len = Tcl_WriteRaw(out, (const char *) out_buf, out_len);
+ if (len >= 0) {
+ total += len;
+ } else {
+ Tcl_AppendResult(interp, "Write error: ", Tcl_ErrnoMsg(Tcl_GetErrno()), (char *) NULL);
+ res = TCL_ERROR;
+ goto done;
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
+ } else {
+ goto done;
+ }
+
+done:
+ /* Clean up */
+ if (in != NULL) {
+ Tcl_Close(interp, in);
+ }
+ if (out != NULL) {
+ Tcl_Close(interp, out);
+ }
+ if (ctx != NULL) {
+ EVP_CIPHER_CTX_free(ctx);
+ }
+ return res;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * EncryptMain --
+ *
+ * Perform encryption function and return result.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Sets result or error message
+ *
+ *-------------------------------------------------------------------
+ */
+static int EncryptMain(int type, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ Tcl_Obj *cipherObj = NULL, *cmdObj = NULL, *dataObj = NULL, *digestObj = NULL;
+ Tcl_Obj *inFileObj = NULL, *outFileObj = NULL, *keyObj = NULL, *ivObj = NULL, *macObj = NULL;
+ const char *channel = NULL, *opt;
+ int res;
+
+ dprintf("Called");
+
+ /* Clear interp result */
+ Tcl_ResetResult(interp);
+
+ /* Validate arg count */
+ if (objc < 3 || objc > 12) {
+ Tcl_WrongNumArgs(interp, 1, objv, "-cipher name ?-digest name? -key key ?-iv string? ?-mac name? [-channel chan | -command cmdName | -infile filename -outfile filename | -data data]");
+ return TCL_ERROR;
+ }
+
+ /* Get options */
+ for (int idx = 1; idx < objc; idx++) {
+ opt = Tcl_GetStringFromObj(objv[idx], NULL);
+
+ if (opt[0] != '-') {
+ break;
+ }
+
+ OPTSTR("-chan", channel);
+ OPTSTR("-channel", channel);
+ OPTOBJ("-cipher", cipherObj);
+ OPTOBJ("-command", cmdObj);
+ OPTOBJ("-data", dataObj);
+ OPTOBJ("-digest", digestObj);
+ OPTOBJ("-infile", inFileObj);
+ OPTOBJ("-outfile", outFileObj);
+ OPTOBJ("-key", keyObj);
+ OPTOBJ("-iv", ivObj);
+ OPTOBJ("-mac", macObj);
+
+ OPTBAD("option", "-chan, -channel, -cipher, -command, -data, -digest, -infile, -key, -iv, -mac, -outfile");
+ return TCL_ERROR;
+ }
+
+ /* Check for required options */
+ if (cipherObj == NULL) {
+ Tcl_AppendResult(interp, "No cipher", NULL);
+ } else if (keyObj == NULL) {
+ Tcl_AppendResult(interp, "No key", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Perform encryption function on file, stacked channel, using instance command, or data blob */
+ if (inFileObj != NULL && outFileObj != NULL) {
+ res = EncryptFileHandler(interp, type, inFileObj, outFileObj, cipherObj, digestObj, keyObj, ivObj);
+ } else if (channel != NULL) {
+ res = EncryptChannelHandler(interp, type, channel, cipherObj, digestObj, keyObj, ivObj);
+ } else if (cmdObj != NULL) {
+ res = EncryptCommandHandler(interp, type, cmdObj, cipherObj, digestObj, keyObj, ivObj);
+ } else if (dataObj != NULL) {
+ res = EncryptDataHandler(interp, type, dataObj, cipherObj, digestObj, keyObj, ivObj);
+ } else {
+ Tcl_AppendResult(interp, "No operation specified: Use -channel, -command, -data, -infile, or -outfile option", NULL);
+ res = TCL_ERROR;
+ }
+ return res;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * Encryption Commands --
+ *
+ * Perform encryption function and return results
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Command dependent
+ *
+ *-------------------------------------------------------------------
+ */
+static int EncryptObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ return EncryptMain(TYPE_ENCRYPT, interp, objc, objv);
+}
+
+static int DecryptObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ return EncryptMain(TYPE_DECRYPT, interp, objc, objv);
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * Encrypt_Initialize --
+ *
+ * Create namespace, commands, and register package version
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Creates commands
+ *
+ *-------------------------------------------------------------------
+ */
+int Tls_EncryptCommands(Tcl_Interp *interp) {
+ Tcl_CreateObjCommand(interp, "tls::encrypt", EncryptObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::decrypt", DecryptObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::unstack2", EncryptUnstackObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
+
Index: generic/tlsIO.c
==================================================================
--- generic/tlsIO.c
+++ generic/tlsIO.c
@@ -161,11 +161,11 @@
}
rc = SSL_get_error(statePtr->ssl, err);
dprintf("Got error: %i (rc = %i)", err, rc);
- dprintf("Got error: %s", ERR_reason_error_string(ERR_get_error()));
+ dprintf("Got error: %s", REASON());
bioShouldRetry = 0;
if (err <= 0) {
if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
bioShouldRetry = 1;
@@ -232,11 +232,11 @@
statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
return(-1);
case SSL_ERROR_SSL:
dprintf("Got permanent fatal SSL error, aborting immediately");
- Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
+ Tls_Error(statePtr, (char *)REASON());
statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
*errorCodePtr = ECONNABORTED;
return(-1);
case SSL_ERROR_WANT_CONNECT:
ADDED generic/tlsInfo.c
Index: generic/tlsInfo.c
==================================================================
--- /dev/null
+++ generic/tlsInfo.c
@@ -0,0 +1,597 @@
+/*
+ * Information Commands Module
+ *
+ * Provides commands that return info related to the OpenSSL config and data.
+ *
+ * Copyright (C) 2023 Brian O'Hagan
+ *
+ */
+
+#include "tlsInt.h"
+#include "tclOpts.h"
+#include
+#include
+#include
+
+/*
+ * Valid SSL and TLS Protocol Versions
+ */
+static const char *protocols[] = {
+ "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL
+};
+enum protocol {
+ TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE
+};
+
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * NamesCallback --
+ *
+ * Callback to add algorithm or method names to a TCL list object.
+ *
+ * Results:
+ * Append name to TCL list object.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------
+ */
+void NamesCallback(const OBJ_NAME *obj, void *arg) {
+ Tcl_Obj *objPtr = (Tcl_Obj *) arg;
+
+ /* Fields: (int) type and alias, (const char*) name (alias from) and data (alias to) */
+ if (strstr(obj->name, "rsa") == NULL && strstr(obj->name, "RSA") == NULL) {
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(obj->name,-1));
+ }
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * CipherInfo --
+ *
+ * Return a list of properties and values for cipherName.
+ *
+ * Results:
+ * A standard Tcl list.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------
+ */
+static int CipherObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ Tcl_Obj *objPtr, *listPtr;
+ unsigned char *cipherName = NULL, *modeName = NULL;
+ const EVP_CIPHER *cipher;
+ unsigned long flags, mode;
+
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+ OpenSSL_add_all_ciphers(); /* Make sure they're loaded */
+#endif
+
+ /* Clear errors */
+ Tcl_ResetResult(interp);
+ ERR_clear_error();
+
+ /* Validate arg count */
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+
+ /* Get cipher */
+ cipherName = Tcl_GetStringFromObj(objv[1], NULL);
+ cipher = EVP_get_cipherbyname(cipherName);
+
+ if (cipher == NULL) {
+ Tcl_AppendResult(interp, "Invalid cipher \"", cipherName, "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Get properties */
+ objPtr = Tcl_NewListObj(0, NULL);
+ LAPPEND_STR(interp, objPtr, "nid", OBJ_nid2ln(EVP_CIPHER_nid(cipher)), -1);
+ LAPPEND_STR(interp, objPtr, "name", EVP_CIPHER_name(cipher), -1);
+ LAPPEND_STR(interp, objPtr, "description", "", -1);
+ LAPPEND_INT(interp, objPtr, "block_size", EVP_CIPHER_block_size(cipher));
+ LAPPEND_INT(interp, objPtr, "key_length", EVP_CIPHER_key_length(cipher));
+ LAPPEND_INT(interp, objPtr, "iv_length", EVP_CIPHER_iv_length(cipher));
+ LAPPEND_STR(interp, objPtr, "type", OBJ_nid2ln(EVP_CIPHER_type(cipher)), -1);
+ LAPPEND_STR(interp, objPtr, "provider", "", -1);
+ flags = EVP_CIPHER_flags(cipher);
+ mode = EVP_CIPHER_mode(cipher);
+
+ /* EVP_CIPHER_get_mode */
+ switch(mode) {
+ case EVP_CIPH_STREAM_CIPHER:
+ modeName = "STREAM";
+ break;
+ case EVP_CIPH_ECB_MODE:
+ modeName = "ECB";
+ break;
+ case EVP_CIPH_CBC_MODE:
+ modeName = "CBC";
+ break;
+ case EVP_CIPH_CFB_MODE:
+ modeName = "CFB";
+ break;
+ case EVP_CIPH_OFB_MODE:
+ modeName = "OFB";
+ break;
+ case EVP_CIPH_CTR_MODE:
+ modeName = "CTR";
+ break;
+ case EVP_CIPH_GCM_MODE:
+ modeName = "GCM";
+ break;
+ case EVP_CIPH_XTS_MODE:
+ modeName = "XTS";
+ break;
+ case EVP_CIPH_CCM_MODE:
+ modeName = "CCM";
+ break;
+ case EVP_CIPH_OCB_MODE:
+ modeName = "OCB";
+ break;
+ case EVP_CIPH_WRAP_MODE :
+ modeName = "WRAP";
+ break;
+ default:
+ modeName = "unknown";
+ break;
+ }
+ LAPPEND_STR(interp, objPtr, "mode", modeName, -1);
+
+ /* Flags */
+ listPtr = Tcl_NewListObj(0, NULL);
+ LAPPEND_BOOL(interp, listPtr, "Variable Length", flags & EVP_CIPH_VARIABLE_LENGTH);
+ LAPPEND_BOOL(interp, listPtr, "Always Call Init", flags & EVP_CIPH_ALWAYS_CALL_INIT);
+ LAPPEND_BOOL(interp, listPtr, "Custom IV", flags & EVP_CIPH_CUSTOM_IV);
+ LAPPEND_BOOL(interp, listPtr, "Control Init", flags & EVP_CIPH_CTRL_INIT);
+ LAPPEND_BOOL(interp, listPtr, "Custom Cipher", flags & EVP_CIPH_FLAG_CUSTOM_CIPHER);
+ LAPPEND_BOOL(interp, listPtr, "AEAD Cipher", flags & EVP_CIPH_FLAG_AEAD_CIPHER);
+ LAPPEND_BOOL(interp, listPtr, "Custom Copy", flags & EVP_CIPH_CUSTOM_COPY);
+ LAPPEND_BOOL(interp, listPtr, "Non FIPS Allow", flags & EVP_CIPH_FLAG_NON_FIPS_ALLOW);
+ LAPPEND_OBJ(interp, objPtr, "flags", listPtr);
+
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * CiphersObjCmd --
+ *
+ * This procedure is invoked to process the "tls::ciphers" command
+ * to list available ciphers, based upon protocol selected.
+ *
+ * Results:
+ * A standard Tcl result list.
+ *
+ * Side effects:
+ * constructs and destroys SSL context (CTX)
+ *
+ *-------------------------------------------------------------------
+ */
+static int CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ SSL_CTX *ctx = NULL;
+ SSL *ssl = NULL;
+ STACK_OF(SSL_CIPHER) *sk = NULL;
+ int index, verbose = 0, use_supported = 0;
+ int min_version, max_version;
+
+ dprintf("Called");
+
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+ OpenSSL_add_all_ciphers(); /* Make sure they're loaded */
+#endif
+
+ /* Clear errors */
+ Tcl_ResetResult(interp);
+ ERR_clear_error();
+
+ /* Validate arg count */
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?protocol? ?verbose? ?supported?");
+ return TCL_ERROR;
+ }
+
+ /* List all ciphers */
+ if (objc == 1) {
+ Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
+
+ OBJ_NAME_do_all(OBJ_NAME_TYPE_CIPHER_METH, NamesCallback, (void *) objPtr);
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+
+ }
+
+ /* Get options */
+ if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK ||
+ (objc > 2 && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) ||
+ (objc > 3 && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum protocol)index) {
+ case TLS_SSL2:
+ Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
+ return TCL_ERROR;
+ 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
+ min_version = SSL3_VERSION;
+ max_version = SSL3_VERSION;
+ 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
+ min_version = TLS1_VERSION;
+ max_version = TLS1_VERSION;
+ 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
+ min_version = TLS1_1_VERSION;
+ max_version = TLS1_1_VERSION;
+ 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
+ min_version = TLS1_2_VERSION;
+ max_version = TLS1_2_VERSION;
+ 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
+ min_version = TLS1_3_VERSION;
+ max_version = TLS1_3_VERSION;
+ break;
+#endif
+ default:
+ min_version = SSL3_VERSION;
+ max_version = TLS1_3_VERSION;
+ break;
+ }
+
+ /* Create context */
+ if ((ctx = SSL_CTX_new(TLS_server_method())) == NULL) {
+ Tcl_AppendResult(interp, REASON(), NULL);
+ return TCL_ERROR;
+ }
+
+ /* Set protocol versions */
+ if (SSL_CTX_set_min_proto_version(ctx, min_version) == 0 ||
+ SSL_CTX_set_max_proto_version(ctx, max_version) == 0) {
+ SSL_CTX_free(ctx);
+ return TCL_ERROR;
+ }
+
+ /* Create SSL context */
+ if ((ssl = SSL_new(ctx)) == NULL) {
+ Tcl_AppendResult(interp, REASON(), NULL);
+ SSL_CTX_free(ctx);
+ return TCL_ERROR;
+ }
+
+ /* 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);
+ /*sk = SSL_CTX_get_ciphers(ctx);*/
+ }
+
+ if (sk != NULL) {
+ Tcl_Obj *objPtr = NULL;
+
+ if (!verbose) {
+ char *cp;
+ 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 {
+ char buf[BUFSIZ];
+ 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, (Tcl_Size) strlen(buf));
+ } else {
+ Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8);
+ }
+ }
+ }
+
+ /* Clean up */
+ if (use_supported) {
+ sk_SSL_CIPHER_free(sk);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ }
+
+ SSL_free(ssl);
+ SSL_CTX_free(ctx);
+ return TCL_OK;
+ clientData = clientData;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestInfo --
+ *
+ * Return a list of properties and values for digestName.
+ *
+ * Results:
+ * A standard Tcl list.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestInfo(Tcl_Interp *interp, char *digestName) {
+ Tcl_Obj *objPtr, *listPtr;
+ EVP_MD *md = EVP_get_digestbyname(digestName);
+ unsigned long flags;
+
+ if (md == NULL) {
+ Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Get properties */
+ objPtr = Tcl_NewListObj(0, NULL);
+ LAPPEND_STR(interp, objPtr, "name", EVP_MD_name(md), -1);
+ LAPPEND_STR(interp, objPtr, "description", "", -1);
+ LAPPEND_INT(interp, objPtr, "size", EVP_MD_size(md));
+ LAPPEND_INT(interp, objPtr, "block_size", EVP_MD_block_size(md));
+ LAPPEND_STR(interp, objPtr, "provider", "", -1);
+ LAPPEND_STR(interp, objPtr, "type", OBJ_nid2ln(EVP_MD_type(md)), -1);
+ LAPPEND_STR(interp, objPtr, "pkey_type", OBJ_nid2ln(EVP_MD_pkey_type(md)), -1);
+ flags = EVP_MD_flags(md);
+
+ /* Flags */
+ listPtr = Tcl_NewListObj(0, NULL);
+ LAPPEND_BOOL(interp, listPtr, "One-shot", flags & EVP_MD_FLAG_ONESHOT);
+ LAPPEND_BOOL(interp, listPtr, "XOF", flags & EVP_MD_FLAG_XOF);
+ LAPPEND_BOOL(interp, listPtr, "DigestAlgorithmId_NULL", flags & EVP_MD_FLAG_DIGALGID_NULL);
+ LAPPEND_BOOL(interp, listPtr, "DigestAlgorithmId_Abscent", flags & EVP_MD_FLAG_DIGALGID_ABSENT);
+ LAPPEND_BOOL(interp, listPtr, "DigestAlgorithmId_Custom", flags & EVP_MD_FLAG_DIGALGID_CUSTOM);
+ LAPPEND_BOOL(interp, listPtr, "FIPS", flags & EVP_MD_FLAG_FIPS);
+ LAPPEND_OBJ(interp, objPtr, "flags", listPtr);
+
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestsObjCmd --
+ *
+ * Return a list of all valid hash algorithms or message digests.
+ *
+ * Results:
+ * A standard Tcl list.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------
+ */
+int DigestsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ Tcl_Obj *objPtr;
+
+ dprintf("Called");
+
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+ OpenSSL_add_all_digests(); /* Make sure they're loaded */
+#endif
+
+ /* Validate arg count */
+ if (objc == 2) {
+ char *digestName = Tcl_GetStringFromObj(objv[1],NULL);
+ return DigestInfo(interp, digestName);
+ } else if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?name?");
+ return TCL_ERROR;
+ }
+
+ /* List all digests */
+ objPtr = Tcl_NewListObj(0, NULL);
+ OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) objPtr);
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ clientData = clientData;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * 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;
+
+ dprintf("Called");
+
+ /* Validate arg count */
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ /* List all MACs */
+ 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;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * ProtocolsObjCmd --
+ *
+ * Return a list of the available or supported SSL/TLS protocols.
+ *
+ * Results:
+ * A standard Tcl list.
+ *
+ * Side effects:
+ * none
+ *
+ *-------------------------------------------------------------------
+ */
+static int
+ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ Tcl_Obj *objPtr;
+
+ dprintf("Called");
+
+ /* Validate arg count */
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ /* List all MACs */
+ objPtr = Tcl_NewListObj(0, NULL);
+#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) && !defined(OPENSSL_NO_SSL3_METHOD)
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1));
+#endif
+#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1));
+#endif
+#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1));
+#endif
+#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1));
+#endif
+#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1));
+#endif
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ clientData = clientData;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * VersionObjCmd --
+ *
+ * Return a string with the OpenSSL version info.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------
+ */
+static int
+VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ Tcl_Obj *objPtr;
+
+ dprintf("Called");
+
+ /* Validate arg count */
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+ clientData = clientData;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * Tls_InfoCommands --
+ *
+ * Create info commands
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Creates commands
+ *
+ *-------------------------------------------------------------------
+ */
+int Tls_InfoCommands(Tcl_Interp *interp) {
+ Tcl_CreateObjCommand(interp, "tls::cipher", CipherObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ 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::macs", MacsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ return TCL_OK;
+}
Index: generic/tlsInt.h
==================================================================
--- generic/tlsInt.h
+++ generic/tlsInt.h
@@ -40,15 +40,11 @@
/*
* Backwards compatibility for size type change
*/
#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7
- #ifndef Tcl_Size
- typedef int Tcl_Size;
- #endif
-
- #define TCL_SIZE_MODIFIER ""
+# define Tcl_Size int
#endif
#include
#include
#include
@@ -102,10 +98,11 @@
#define dprintBuffer(bufferName, bufferLength) /**/
#define dprintFlags(statePtr) /**/
#endif
#define TCLTLS_SSL_ERROR(ssl,err) ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err))))
+#define REASON() ERR_reason_error_string(ERR_get_error())
/* Common list append macros */
#define LAPPEND_BARRAY(interp, obj, text, value, size) {\
if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
Tcl_ListObjAppendElement(interp, obj, Tcl_NewByteArrayObj(value, size)); \
@@ -196,11 +193,14 @@
Tcl_Obj *Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer);
void Tls_Error(State *statePtr, char *msg);
void Tls_Free(char *blockPtr);
void Tls_Clean(State *statePtr);
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);
+int Tls_DigestCommands(Tcl_Interp *interp);
+int Tls_EncryptCommands(Tcl_Interp *interp);
+int Tls_InfoCommands(Tcl_Interp *interp);
BIO *BIO_new_tcl(State* statePtr, int flags);
#define PTR2INT(x) ((int) ((intptr_t) (x)))
#endif /* _TLSINT_H */
Index: generic/tlsX509.c
==================================================================
--- generic/tlsX509.c
+++ generic/tlsX509.c
@@ -18,17 +18,21 @@
/*
* Binary string to hex string
*/
-int String_to_Hex(char* input, int ilen, char *output, int olen) {
+int String_to_Hex(unsigned char* input, int ilen, unsigned char *output, int olen) {
int count = 0;
+ unsigned char *iptr = input;
+ unsigned char *optr = &output[0];
+ const char *hex = "0123456789abcdef";
for (int i = 0; i < ilen && count < olen - 1; i++, count += 2) {
- sprintf(output + count, "%02X", input[i] & 0xff);
+ *optr++ = hex[(*iptr>>4)&0xF];
+ *optr++ = hex[(*iptr++)&0xF];
}
- output[count] = 0;
+ *optr = 0;
return count;
}
/*
* BIO to Buffer
@@ -77,14 +81,14 @@
Tcl_Obj *resultPtr = NULL;
int len = 0;
char buffer[1024];
if (astring != NULL) {
- len = String_to_Hex((char *)ASN1_STRING_get0_data(astring),
+ len = String_to_Hex(ASN1_STRING_get0_data(astring),
ASN1_STRING_length(astring), buffer, 1024);
}
- resultPtr = Tcl_NewStringObj(buffer, (Tcl_Size) len);
+ resultPtr = Tcl_NewStringObj(buffer, len);
return resultPtr;
}
/*
* Get Key Usage
@@ -202,11 +206,11 @@
if (names = X509_get_ext_d2i(cert, nid, 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, 1024);
- LAPPEND_STR(interp, listPtr, NULL, buffer, (Tcl_Size) len);
+ LAPPEND_STR(interp, listPtr, NULL, buffer, len);
}
sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);
}
return listPtr;
}
@@ -279,20 +283,20 @@
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) {
- LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_get0_data(uri), (Tcl_Size) ASN1_STRING_length(uri));
+ LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_get0_data(uri), ASN1_STRING_length(uri));
}
}
} else if (distpoint->type == 1) {
/* relative-name 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);
- LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_data(d), (Tcl_Size) ASN1_STRING_length(d));
+ LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_data(d), ASN1_STRING_length(d));
}
}
}
CRL_DIST_POINTS_free(crl);
}
@@ -333,11 +337,11 @@
for (int i = 0; i < sk_ACCESS_DESCRIPTION_num(ads); i++) {
ad = sk_ACCESS_DESCRIPTION_value(ads, i);
if (OBJ_obj2nid(ad->method) == NID_ad_ca_issuers && ad->location) {
if (ad->location->type == GEN_URI) {
len = ASN1_STRING_to_UTF8(&buf, ad->location->d.uniformResourceIdentifier);
- Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buf, (Tcl_Size) len));
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buf, len));
OPENSSL_free(buf);
break;
}
}
}
@@ -393,53 +397,53 @@
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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ LAPPEND_STR(interp, certPtr, "subject", buffer, len);
/* SHA1 Digest (Fingerprint) of cert - DER representation */
if (X509_digest(cert, EVP_sha1(), md, &len)) {
- len = String_to_Hex(md, len, buffer, BUFSIZ);
- LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, (Tcl_Size) len);
+ len = String_to_Hex(md, len, buffer, BUFSIZ);
+ LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, len);
}
/* SHA256 Digest (Fingerprint) of cert - DER representation */
if (X509_digest(cert, EVP_sha256(), md, &len)) {
- len = String_to_Hex(md, len, buffer, BUFSIZ);
- LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, (Tcl_Size) 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)) {
@@ -450,24 +454,24 @@
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);
- LAPPEND_STR(interp, certPtr, "publicKey", buffer, (Tcl_Size) 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, (Tcl_Size) len);
+ LAPPEND_STR(interp, certPtr, "publicKeyHash", buffer, len);
/* digest of the DER representation of the certificate */
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, (Tcl_Size) len);
+ LAPPEND_STR(interp, certPtr, "signatureHash", buffer, len);
}
/* Certificate Purpose. Call before checking for extensions. */
LAPPEND_STR(interp, certPtr, "purpose", Tls_x509Purpose(cert), -1);
LAPPEND_OBJ(interp, certPtr, "certificatePurpose", Tls_x509Purposes(interp, cert));
@@ -474,11 +478,11 @@
/* 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 */
+ /* Check if cert was issued by CA cert issuer or self signed */
LAPPEND_BOOL(interp, certPtr, "selfIssued", xflags & EXFLAG_SI);
LAPPEND_BOOL(interp, certPtr, "selfSigned", xflags & EXFLAG_SS);
LAPPEND_BOOL(interp, certPtr, "isProxyCert", xflags & EXFLAG_PROXY);
LAPPEND_BOOL(interp, certPtr, "extInvalid", xflags & EXFLAG_INVALID);
LAPPEND_BOOL(interp, certPtr, "isCACert", X509_check_ca(cert));
@@ -485,22 +489,22 @@
/* 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);
+ 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, (Tcl_Size) iuid->length));
+ Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, iuid->length));
} else {
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
}
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("subjectUniqueId", -1));
if (suid != NULL) {
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)suid->data, (Tcl_Size) suid->length));
+ Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)suid->data, suid->length));
} else {
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
}
}
@@ -510,11 +514,11 @@
/* 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 */
LAPPEND_OBJ(interp, certPtr, "authorityKeyIdentifier",
Tls_x509Identifier(X509_get0_authority_key_id(cert)));
-
+
/* Subject Key Identifier (SKI) is used to identify certificates that contain
a particular public key. RFC 5280 section 4.2.1.2, NID_subject_key_identifier */
LAPPEND_OBJ(interp, certPtr, "subjectKeyIdentifier",
Tls_x509Identifier(X509_get0_subject_key_id(cert)));
@@ -583,24 +587,24 @@
/* Certificate Alias. If uses a PKCS#12 structure, alias will reflect the
friendlyName attribute (RFC 2985). */
{
len = 0;
char *string = X509_alias_get0(cert, &len);
- LAPPEND_STR(interp, certPtr, "alias", string, (Tcl_Size) len);
+ LAPPEND_STR(interp, certPtr, "alias", string, 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ LAPPEND_STR(interp, certPtr, "all", certStr, len);
}
BIO_free(bio);
return certPtr;
}
Index: tests/badssl.csv
==================================================================
--- tests/badssl.csv
+++ tests/badssl.csv
@@ -1,19 +1,17 @@
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
-command,,,,,,,,,,
+,,,,,,,,,,
command,# Find default CA certificates directory,,,,,,,,,
command,if {[info exists ::env(SSL_CERT_FILE)]} {set ::cafile $::env(SSL_CERT_FILE)} else {set ::cafile [file normalize {C:\Users\Brian\Documents\Source\Build\SSL-1.1\certs\cacert.pem}]},,,,,,,,,
-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,,,,,,,,,,
+command,source common.tcl,,,,,,,,,
+,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc badssl {url} {set port 443;lassign [split $url "":""] url port;if {$port eq """"} {set port 443};set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}",,,,,,,,,
-command,,,,,,,,,,
+,,,,,,,,,,
command,# BadSSL.com Tests,,,,,,,,,
BadSSL,1000-sans,,,badssl 1000-sans.badssl.com,,,handshake failed: certificate verify failed due to: certificate has expired,,,1
BadSSL,10000-sans,,,badssl 10000-sans.badssl.com,,,handshake failed: excessive message size,,,1
BadSSL,3des,,,badssl 3des.badssl.com,,,handshake failed: sslv3 alert handshake failure,,,1
BadSSL,captive-portal,,,badssl captive-portal.badssl.com,,,handshake failed: certificate verify failed due to: Hostname mismatch,,,1
Index: tests/badssl.test
==================================================================
--- tests/badssl.test
+++ tests/badssl.test
@@ -12,16 +12,19 @@
# Find default CA certificates directory
if {[info exists ::env(SSL_CERT_FILE)]} {set ::cafile $::env(SSL_CERT_FILE)} else {set ::cafile [file normalize {C:\Users\Brian\Documents\Source\Build\SSL-1.1\certs\cacert.pem}]}
# 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}
+source common.tcl
# Helper functions
-proc badssl {url} {set port 443;lassign [split $url ":"] url port;if {$port eq ""} {set port 443};set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}
+proc badssl {url} {set port 443
+ lassign [split $url ":"] url port
+ if {$port eq ""} {set port 443}
+ set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port]
+ if {[catch {tls::handshake $ch} err]} {close $ch
+ return -code error $err} else {close $ch}}
# BadSSL.com Tests
test BadSSL-1.1 {1000-sans} -body {
DELETED tests/ciphers.csv
Index: tests/ciphers.csv
==================================================================
--- tests/ciphers.csv
+++ /dev/null
@@ -1,46 +0,0 @@
-# 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*,,,
DELETED tests/ciphers.test
Index: tests/ciphers.test
==================================================================
--- tests/ciphers.test
+++ /dev/null
@@ -1,121 +0,0 @@
-# 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
-
-# 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/common.tcl
Index: tests/common.tcl
==================================================================
--- /dev/null
+++ tests/common.tcl
@@ -0,0 +1,22 @@
+
+# Common Constraints
+package require tls
+
+# Supported protocols
+set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3]
+foreach protocol $protocols {
+ ::tcltest::testConstraint $protocol 0
+ ::tcltest::testConstraint !$protocol 1
+}
+
+foreach protocol [::tls::protocols] {
+ ::tcltest::testConstraint $protocol 1
+ ::tcltest::testConstraint !$protocol 0
+}
+
+# OpenSSL version
+::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]]
+
+# Legacy OpenSSL v1.1.1 vs new v3.x
+scan [lindex [split [::tls::version]] 1] %f version
+::tcltest::testConstraint new_api [expr {$version >= 3.0}]
ADDED tests/digest.csv
Index: tests/digest.csv
==================================================================
--- /dev/null
+++ tests/digest.csv
@@ -0,0 +1,277 @@
+# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
+command,package require tls,,,,,,,,,
+,,,,,,,,,,
+command,# Constraints,,,,,,,,,
+command,source common.tcl,,,,,,,,,
+,,,,,,,,,,
+command,# Helper functions - See common.tcl,,,,,,,,,
+command,proc digest_read_chan {cmd filename args} {;set ch [open $filename rb];set bsize [fconfigure $ch -buffersize];set new [$cmd {*}$args -chan $ch];while {![eof $new]} {set md [read $new $bsize]};close $new;return $md},,,,,,,,,
+command,proc digest_write_chan {cmd filename data args} {;set ch [open $filename wb];set new [$cmd {*}$args -chan $ch];puts -nonewline $new $data;flush $new;close $new;set ch [open $filename rb];set md [read $ch];close $ch;return $md},,,,,,,,,
+command,proc digest_accumulate {string args} {;set cmd [{*}$args -command dcmd]; $cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},,,,,,,,
+,,,,,,,,,,
+command,"set test_data ""Example string for message digest tests.\n""",,,,,,,,,
+command,"set test_file ""md_data.dat""",,,,,,,,,
+command,"set test_alt_file ""md_alt_data.dat""",,,,,,,,,
+command,"set test_key ""Example key""",,,,,,,,,
+command,::tcltest::makeFile $test_data $test_file,,,,,,,,,
+,,,,,,,,,,
+command,# Test short-cut commands,,,,,,,,,
+Shortcut Cmds,md4 cmd,,,::tls::md4 $test_data,,,793399f792eca2752c6af3234ba70858,,,
+Shortcut Cmds,md5 cmd,,,::tls::md5 $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
+Shortcut Cmds,sha1 cmd,,,::tls::sha1 $test_data,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+Shortcut Cmds,sha256 cmd,,,::tls::sha256 $test_data,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+Shortcut Cmds,sha512 cmd,,,::tls::sha512 $test_data,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+,,,,,,,,,,
+,,,,,,,,,,
+command,# Test MD command for read channel,,,,,,,,,
+MD Chan Read,md4,,,digest_read_chan ::tls::md $test_file -digest md4,,,793399f792eca2752c6af3234ba70858,,,
+MD Chan Read,md5,,,digest_read_chan ::tls::md $test_file -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Chan Read,sha1,,,digest_read_chan ::tls::md $test_file -digest sha1,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+MD Chan Read,sha256,,,digest_read_chan ::tls::md $test_file -digest sha256,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+MD Chan Read,sha512,,,digest_read_chan ::tls::md $test_file -digest sha512,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+MD Chan Read,md5 bin,,,binary encode hex [digest_read_chan ::tls::md $test_file -bin -digest md5],,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Chan Read,md5 hex,,,digest_read_chan ::tls::md $test_file -hex -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# Test MD command for write channel,,,,,,,,,
+MD Chan Write,md4,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest md4,,,793399f792eca2752c6af3234ba70858,,,
+MD Chan Write,md5,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Chan Write,sha1,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest sha1,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+MD Chan Write,sha256,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest sha256,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+MD Chan Write,sha512,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest sha512,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+MD Chan Write,md5 bin,,,binary encode hex [digest_write_chan ::tls::md $test_alt_file $test_data -bin -digest md5],,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Chan Write,md5 hex,,,digest_write_chan ::tls::md $test_alt_file $test_data -hex -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# Test MD command for object command,,,,,,,,,
+MD Command,md4,,,digest_accumulate $test_data ::tls::md -digest md4,,,793399f792eca2752c6af3234ba70858,,,
+MD Command,md5,,,digest_accumulate $test_data ::tls::md -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Command,sha1,,,digest_accumulate $test_data ::tls::md -digest sha1,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+MD Command,sha256,,,digest_accumulate $test_data ::tls::md -digest sha256,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+MD Command,sha512,,,digest_accumulate $test_data ::tls::md -digest sha512,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+MD Command,md5 bin,,,binary encode hex [digest_accumulate $test_data ::tls::md -digest md5 -bin],,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Command,md5 hex,,,digest_accumulate $test_data ::tls::md -digest md5 -hex,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# Test MD command for data shortcut,,,,,,,,,
+MD Shortcut,md4,,,::tls::md md4 $test_data,,,793399f792eca2752c6af3234ba70858,,,
+MD Shortcut,md5,,,::tls::md md5 $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Shortcut,sha1,,,::tls::md sha1 $test_data,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+MD Shortcut,sha256,,,::tls::md sha256 $test_data,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+MD Shortcut,sha512,,,::tls::md sha512 $test_data,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+,,,,,,,,,,
+command,# Test MD command for data,,,,,,,,,
+MD Data,md4,,,::tls::md -digest md4 -data $test_data,,,793399f792eca2752c6af3234ba70858,,,
+MD Data,md5,,,::tls::md -digest md5 -data $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Data,sha1,,,::tls::md -digest sha1 -data $test_data,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+MD Data,sha256,,,::tls::md -digest sha256 -data $test_data,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+MD Data,sha512,,,::tls::md -digest sha512 -data $test_data,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+MD Data,md5 bin,,,binary encode hex [::tls::md -digest md5 -data $test_data -bin],,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD Data,md5 hex,,,::tls::md -digest md5 -data $test_data -hex,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# Test MD command for file,,,,,,,,,
+MD File,md4,,,::tls::md -digest md4 -file $test_file,,,793399f792eca2752c6af3234ba70858,,,
+MD File,md5,,,::tls::md -digest md5 -file $test_file,,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD File,sha1,,,::tls::md -digest sha1 -file $test_file,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+MD File,sha256,,,::tls::md -digest sha256 -file $test_file,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+MD File,sha512,,,::tls::md -digest sha512 -file $test_file,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+MD File,md5 bin,,,binary encode hex [::tls::md -digest md5 -file $test_file -bin],,,962bf0803b4232ec23bd8427bb94ea09,,,
+MD File,md5 hex,,,::tls::md -digest md5 -file $test_file -hex,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# MD Error Cases,,,,,,,,,
+MD Errors,Too few args,,,::tls::md,,,"wrong # args: should be ""::tls::md ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+MD Errors,Too many args,,,::tls::md too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::md ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+MD Errors,Invalid digest,,,::tls::md bogus data,,,"Invalid digest ""bogus""",,,1
+MD Errors,Invalid digest Arg,,,::tls::md -digest bogus -data data,,,"Invalid digest ""bogus""",,,1
+MD Errors,No digest,,,::tls::md -hex -data value,,,No digest specified,,,1
+MD Errors,Invalid option,,,::tls::md -digest sha256 -bogus value,,,"bad option ""-bogus"": must be -bin, -channel, -cipher, -command, -data, -digest, -file, -filename, -hex, -key, or -mac",,,1
+MD Errors,Invalid file,,,::tls::md -digest sha256 -file bogus,,,"couldn't open ""bogus"": no such file or directory",,,1
+MD Errors,Invalid channel,,,::tls::md -digest sha256 -channel bogus,,,"can not find channel named ""bogus""",,,1
+MD Errors,No operation,,,::tls::md -digest sha256 -bin,,,"No operation specified: Use -channel, -command, -data, or -file option",,,1
+,,,,,,,,,,
+,,,,,,,,,,
+command,# Test CMAC command,,,,,,,,,
+command,"set test_cipher ""aes-128-cbc""",,,,,,,,,
+command,"set test_key ""Example key 1234""",,,,,,,,,
+CMAC,data,,,::tls::cmac -cipher $test_cipher -key $test_key -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+CMAC,file,,,::tls::cmac -cipher $test_cipher -key $test_key -file $test_file,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+CMAC,channel,,,digest_read_chan ::tls::cmac $test_file -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+CMAC,command,,,digest_accumulate $test_data ::tls::cmac -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+CMAC,data bin,,,binary encode hex [::tls::cmac -bin -cipher $test_cipher -key $test_key -data $test_data],,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+,,,,,,,,,,
+command,# Test MD CMAC,,,,,,,,,
+MD CMAC,data,,,::tls::md -cipher $test_cipher -key $test_key -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+MD CMAC,file,,,::tls::md -cipher $test_cipher -key $test_key -file $test_file,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+MD CMAC,channel,,,digest_read_chan ::tls::md $test_file -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+MD CMAC,command,,,digest_accumulate $test_data ::tls::md -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+MD CMAC,data bin,,,binary encode hex [::tls::md -bin -cipher $test_cipher -key $test_key -data $test_data],,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+,,,,,,,,,,
+command,# Test CMAC Shortcut,,,,,,,,,
+CMAC Shortcut,data,,,::tls::cmac $test_cipher -key $test_key $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+,,,,,,,,,,
+command,# CMAC Error Cases,,,,,,,,,
+CMAC Errors,Too few args,,,::tls::cmac,,,"wrong # args: should be ""::tls::cmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+CMAC Errors,Too many args,,,::tls::cmac too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::cmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+CMAC Errors,No cipher,,,::tls::cmac -hex -data $test_data,,,No cipher specified,,,1
+CMAC Errors,No key,,,::tls::cmac -cipher $test_cipher -data $test_data,,,No key specified,,,1
+CMAC Errors,Invalid cipher,,,::tls::cmac -cipher bogus -data $test_data,,,"Invalid cipher ""bogus""",,,1
+,,,,,,,,,,
+,,,,,,,,,,
+command,# Test HMAC command,,,,,,,,,
+command,set test_digest md5,,,,,,,,,
+command,"set test_key ""Example key""",,,,,,,,,
+HMAC,data,,,::tls::hmac -digest $test_digest -key $test_key -data $test_data,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+HMAC,file,,,::tls::hmac -digest $test_digest -key $test_key -file $test_file,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+HMAC,channel,,,digest_read_chan ::tls::hmac $test_file -digest $test_digest -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+HMAC,command,,,digest_accumulate $test_data ::tls::hmac -digest $test_digest -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+HMAC,data bin,,,binary encode hex [::tls::hmac -digest $test_digest -bin -key $test_key -data $test_data],,,f98327ef3e20ab6d388f676c6a79d93d,,,
+,,,,,,,,,,
+command,# Test MD HMAC,,,,,,,,,
+MD HMAC,data,,,::tls::md -digest $test_digest -key $test_key -data $test_data,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+MD HMAC,file,,,::tls::md -digest $test_digest -key $test_key -file $test_file,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+MD HMAC,channel,,,digest_read_chan ::tls::md $test_file -digest $test_digest -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+MD HMAC,command,,,digest_accumulate $test_data ::tls::md -digest $test_digest -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+MD HMAC,data bin,,,binary encode hex [::tls::md -digest $test_digest -bin -key $test_key -data $test_data],,,f98327ef3e20ab6d388f676c6a79d93d,,,
+,,,,,,,,,,
+command,# Test HMAC Shortcut,,,,,,,,,
+HMAC Shortcut,data,,,::tls::hmac $test_digest -key $test_key $test_data,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+,,,,,,,,,,
+command,# HMAC Error Cases,,,,,,,,,
+HMAC Errors,Too few args,,,::tls::hmac,,,"wrong # args: should be ""::tls::hmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+HMAC Errors,Too many args,,,::tls::hmac too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::hmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+HMAC Errors,No digest,,,::tls::hmac -hex -data $test_data,,,No digest specified,,,1
+HMAC Errors,No key,,,::tls::hmac -digest sha256 -data $test_data,,,No key specified,,,1
+HMAC Errors,Invalid digest,,,::tls::md -digest bogus -key $test_key -data $test_data,,,"Invalid digest ""bogus""",,,1
+,,,,,,,,,,
+,,,,,,,,,,
+command,# Test MAC command,,,,,,,,,
+command,"set test_cipher ""aes-128-cbc""",,,,,,,,,
+command,set test_digest sha256,,,,,,,,,
+command,"set test_key ""Example key 1234""",,,,,,,,,
+MAC,CMAC,,,::tls::mac -cipher $test_cipher -key $test_key -mac cmac -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+MAC,HMAC,,,::tls::mac -digest $test_digest -key $test_key -mac hmac -data $test_data,,,676daf96370d0e3c5598557da38a9a810a4fbacbb2d10c67f6dfa83f10f48e96,,,
+MAC,MD-CMAC,,,::tls::md -cipher $test_cipher -key $test_key -mac cmac -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+MAC,MD-HMAC,,,::tls::md -digest $test_digest -key $test_key -mac hmac -data $test_data,,,676daf96370d0e3c5598557da38a9a810a4fbacbb2d10c67f6dfa83f10f48e96,,,
+,,,,,,,,,,
+command,# MAC Error Cases,,,,,,,,,
+MAC Errors,Too few args,,,::tls::mac,,,"wrong # args: should be ""::tls::mac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+MAC Errors,No mac,,,::tls::mac -key $test_key -data $test_data,,,No MAC specified,,,1
+MAC Errors,No key,,,::tls::mac -mac hmac -data $test_data,,,No key specified,,,1
+MAC Errors,Invalid MAC,,,::tls::mac -mac scrypt -key $test_key -data $test_data,,,"Invalid MAC ""scrypt""",,,1
+MAC Errors,Too many args,,,::tls::mac too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::mac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+,,,,,,,,,,
+,,,,,,,,,,
+command,# RFC 1321 Message Digest 5,,,,,,,,,
+RFC1321-MD5,TC1,,,"::tls::md -digest md5 -data """"",,,d41d8cd98f00b204e9800998ecf8427e,,,
+RFC1321-MD5,TC2,,,"::tls::md -digest md5 -data ""a""",,,0cc175b9c0f1b6a831c399e269772661,,,
+RFC1321-MD5,TC3,,,"::tls::md -digest md5 -data ""abc""",,,900150983cd24fb0d6963f7d28e17f72,,,
+RFC1321-MD5,TC4,,,"::tls::md -digest md5 -data ""message digest""",,,f96b697d7cb7938d525a2f31aaf161d0,,,
+RFC1321-MD5,TC5,,,"::tls::md -digest md5 -data ""abcdefghijklmnopqrstuvwxyz""",,,c3fcd3d76192e4007dfb496cca67e13b,,,
+RFC1321-MD5,TC6,,,"::tls::md -digest md5 -data ""ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789""",,,d174ab98d277d9f5a5611c2c9f419d9f,,,
+RFC1321-MD5,TC7,,,"::tls::md -digest md5 -data [string repeat ""1234567890"" 8]",,,57edf4a22be3c955ac49da2e2107b67a,,,
+,,,,,,,,,,
+command,# RFC 6234 SHA1,,,,,,,,,
+RFC6234-MD-SHA1,TC1,,,"::tls::md -digest sha1 -data ""abc""",,,a9993e364706816aba3e25717850c26c9cd0d89d,,,
+RFC6234-MD-SHA1,TC2_1,,,"::tls::md -digest sha1 -data ""abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq""",,,84983e441c3bd26ebaae4aa1f95129e5e54670f1,,,
+RFC6234-MD-SHA1,TC3,,,"::tls::md -digest sha1 -data [string repeat ""a"" 1000000]",,,34aa973cd4c4daa4f61eeb2bdbad27316534016f,,,
+RFC6234-MD-SHA1,TC4,,,"::tls::md -digest sha1 -data [string repeat ""01234567"" 80]",,,dea356a2cddd90c7a7ecedc5ebb563934f460452,,,
+RFC6234-MD-SHA1,TC6,,,"::tls::md -digest sha1 -data ""\x5e""",,,5e6f80a34a9798cafc6a5db96cc57ba4c4db59c2,,,
+RFC6234-MD-SHA1,TC8_1,,,"::tls::md -digest sha1 -data ""\x9a\x7d\xfd\xf1\xec\xea\xd0\x6e\xd6\x46\xaa\x55\xfe\x75\x71\x46""",,,82abff6605dbe1c17def12a394fa22a82b544a35,,,
+RFC6234-MD-SHA1,TC10_1,,,"::tls::md -digest sha1 -data ""\xf7\x8f\x92\x14\x1b\xcd\x17\x0a\xe8\x9b\x4f\xba\x15\xa1\xd5\x9f\x3f\xd8\x4d\x22\x3c\x92\x51\xbd\xac\xbb\xae\x61\xd0\x5e\xd1\x15\xa0\x6a\x7c\xe1\x17\xb7\xbe\xea\xd2\x44\x21\xde\xd9\xc3\x25\x92\xbd\x57\xed\xea\xe3\x9c\x39\xfa\x1f\xe8\x94\x6a\x84\xd0\xcf\x1f\x7b\xee\xad\x17\x13\xe2\xe0\x95\x98\x97\x34\x7f\x67\xc8\x0b\x04\x00\xc2\x09\x81\x5d\x6b\x10\xa6\x83\x83\x6f\xd5\x56\x2a\x56\xca\xb1\xa2\x8e\x81\xb6\x57\x66\x54\x63\x1c\xf1\x65\x66\xb8\x6e\x3b\x33\xa1\x08\xb0\x53\x07\xc0\x0a\xff\x14\xa7\x68\xed\x73\x50\x60\x6a\x0f\x85\xe6\xa9\x1d\x39\x6f\x5b\x5c\xbe\x57\x7f\x9b\x38\x80\x7c\x7d\x52\x3d\x6d\x79\x2f\x6e\xbc\x24\xa4\xec\xf2\xb3\xa4\x27\xcd\xbb\xfb""",,,cb0082c8f197d260991ba6a460e76e202bad27b3,,,
+,,,,,,,,,,
+command,# RFC 6234 SHA256,,,,,,,,,
+RFC6234-MD-SHA256,TC1,,,"::tls::md -digest sha256 -data ""abc""",,,ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad,,,
+RFC6234-MD-SHA256,TC2_1,,,"::tls::md -digest sha256 -data ""abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq""",,,248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1,,,
+RFC6234-MD-SHA256,TC3,,,"::tls::md -digest sha256 -data [string repeat ""a"" 1000000]",,,cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0,,,
+RFC6234-MD-SHA256,TC4,,,"::tls::md -digest sha256 -data [string repeat ""01234567"" 80]",,,594847328451bdfa85056225462cc1d867d877fb388df0ce35f25ab5562bfbb5,,,
+RFC6234-MD-SHA256,TC6,,,"::tls::md -digest sha256 -data ""\x19""",,,68aa2e2ee5dff96e3355e6c7ee373e3d6a4e17f75f9518d843709c0c9bc3e3d4,,,
+RFC6234-MD-SHA256,TC8_256,,,"::tls::md -digest sha256 -data ""\xe3\xd7\x25\x70\xdc\xdd\x78\x7c\xe3\x88\x7a\xb2\xcd\x68\x46\x52""",,,175ee69b02ba9b58e2b0a5fd13819cea573f3940a94f825128cf4209beabb4e8,,,
+RFC6234-MD-SHA256,TC10_256,,,"::tls::md -digest sha256 -data ""\x83\x26\x75\x4e\x22\x77\x37\x2f\x4f\xc1\x2b\x20\x52\x7a\xfe\xf0\x4d\x8a\x05\x69\x71\xb1\x1a\xd5\x71\x23\xa7\xc1\x37\x76\x00\x00\xd7\xbe\xf6\xf3\xc1\xf7\xa9\x08\x3a\xa3\x9d\x81\x0d\xb3\x10\x77\x7d\xab\x8b\x1e\x7f\x02\xb8\x4a\x26\xc7\x73\x32\x5f\x8b\x23\x74\xde\x7a\x4b\x5a\x58\xcb\x5c\x5c\xf3\x5b\xce\xe6\xfb\x94\x6e\x5b\xd6\x94\xfa\x59\x3a\x8b\xeb\x3f\x9d\x65\x92\xec\xed\xaa\x66\xca\x82\xa2\x9d\x0c\x51\xbc\xf9\x33\x62\x30\xe5\xd7\x84\xe4\xc0\xa4\x3f\x8d\x79\xa3\x0a\x16\x5c\xba\xbe\x45\x2b\x77\x4b\x9c\x71\x09\xa9\x7d\x13\x8f\x12\x92\x28\x96\x6f\x6c\x0a\xdc\x10\x6a\xad\x5a\x9f\xdd\x30\x82\x57\x69\xb2\xc6\x71\xaf\x67\x59\xdf\x28\xeb\x39\x3d\x54\xd6""",,,97dbca7df46d62c8a422c941dd7e835b8ad3361763f7e9b2d95f4f0da6e1ccbc,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #1,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""0b"" 20]]",,,,,,,,,
+command,"set data ""Hi There""",,,,,,,,,
+RFC4231 HMAC TC1,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,896fb1128abbdf196832107cd49df33f47b4b1169912ba4f53684b22,,,
+RFC4231 HMAC TC1,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7,,,
+RFC4231 HMAC TC1,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6,,,
+RFC4231 HMAC TC1,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #2 - Test with a key shorter than the length of the HMAC output.,,,,,,,,,
+command,"set key ""Jefe""",,,,,,,,,
+command,"set data ""what do ya want for nothing?""",,,,,,,,,
+RFC4231 HMAC TC2,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44,,,
+RFC4231 HMAC TC2,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843,,,
+RFC4231 HMAC TC2,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649,,,
+RFC4231 HMAC TC2,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #3 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""aa"" 20]]",,,,,,,,,
+command,"set data [binary decode hex [string repeat ""dd"" 50]]",,,,,,,,,
+RFC4231 HMAC TC3,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,7fb3cb3588c6c1f6ffa9694d7d6ad2649365b0c1f65d69d1ec8333ea,,,
+RFC4231 HMAC TC3,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe,,,
+RFC4231 HMAC TC3,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27,,,
+RFC4231 HMAC TC3,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #4 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).,,,,,,,,,
+command,"set key [binary decode hex ""0102030405060708090a0b0c0d0e0f10111213141516171819""]",,,,,,,,,
+command,"set data [binary decode hex [string repeat ""cd"" 50]]",,,,,,,,,
+RFC4231 HMAC TC4,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,6c11506874013cac6a2abc1bb382627cec6a90d86efc012de7afec5a,,,
+RFC4231 HMAC TC4,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b,,,
+RFC4231 HMAC TC4,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb,,,
+RFC4231 HMAC TC4,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #5 - Test with a truncation of output to 128 bits.,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""0c"" 20]]",,,,,,,,,
+command,"set data ""Test With Truncation""",,,,,,,,,
+RFC4231 HMAC TC5,sha224,,,string range [::tls::hmac -digest sha224 -key $key -data $data] 0 31,,,0e2aea68a90c8d37c988bcdb9fca6fa8,,,
+RFC4231 HMAC TC5,sha256,,,string range [::tls::hmac -digest sha256 -key $key -data $data] 0 31,,,a3b6167473100ee06e0c796c2955552b,,,
+RFC4231 HMAC TC5,sha384,,,string range [::tls::hmac -digest sha384 -key $key -data $data] 0 31,,,3abf34c3503b2a23a46efc619baef897,,,
+RFC4231 HMAC TC5,sha512,,,string range [::tls::hmac -digest sha512 -key $key -data $data] 0 31,,,415fad6271580a531d4179bc891d87a6,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #6 - Test with a key larger than 128 bytes (= block-size of SHA-384 and SHA-512).,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""aa"" 131]]",,,,,,,,,
+command,"set data ""Test Using Larger Than Block-Size Key - Hash Key First""",,,,,,,,,
+RFC4231 HMAC TC6,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,95e9a0db962095adaebe9b2d6f0dbce2d499f112f2d2b7273fa6870e,,,
+RFC4231 HMAC TC6,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54,,,
+RFC4231 HMAC TC6,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952,,,
+RFC4231 HMAC TC6,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #7 - Test with a key and data that is larger than 128 bytes (= block-size of SHA-384 and SHA-512).,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""aa"" 131]]",,,,,,,,,
+command,"set data ""This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm.""",,,,,,,,,
+RFC4231 HMAC TC7,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,3a854166ac5d9f023f54d517d0b39dbd946770db9c2b95c9f6f565d1,,,
+RFC4231 HMAC TC7,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2,,,
+RFC4231 HMAC TC7,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e,,,
+RFC4231 HMAC TC7,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58,,,
+,,,,,,,,,,
+command,# NIST 800-38b Recommendation for Block Cipher Modes of Operation: The CMAC Mode for Authentication,,,,,,,,,
+command,# AES-128,,,,,,,,,
+command,"set key [binary decode hex ""2b7e151628aed2a6abf7158809cf4f3c""]",,,,,,,,,
+NIST800-38b-AES128,len=0,,,"::tls::cmac -cipher aes-128-cbc -key $key -data """"",,,bb1d6929e95937287fa37d129b756746,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172a""]",,,,,,,,,
+NIST800-38b-AES128,len=128,,,::tls::cmac -cipher aes-128-cbc -key $key -data $data,,,070a16b46b4d4144f79bdd9dd04a287c,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411""]",,,,,,,,,
+NIST800-38b-AES128,len=320,,,::tls::cmac -cipher aes-128-cbc -key $key -data $data,,,dfa66747de9ae63030ca32611497c827,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710""]",,,,,,,,,
+NIST800-38b-AES128,len=512,,,::tls::cmac -cipher aes-128-cbc -key $key -data $data,,,51f0bebf7e3b9d92fc49741779363cfe,,,
+,,,,,,,,,,
+command,# AES-192,,,,,,,,,
+command,"set key [binary decode hex ""8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b""]",,,,,,,,,
+NIST800-38b-AES-192,len=0,,,"::tls::cmac -cipher aes-192-cbc -key $key -data """"",,,d17ddf46adaacde531cac483de7a9367,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172a""]",,,,,,,,,
+NIST800-38b-AES-192,len=128,,,::tls::cmac -cipher aes-192-cbc -key $key -data $data,,,9e99a7bf31e710900662f65e617c5184,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411""]",,,,,,,,,
+NIST800-38b-AES-192,len=320,,,::tls::cmac -cipher aes-192-cbc -key $key -data $data,,,8a1de5be2eb31aad089a82e6ee908b0e,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710""]",,,,,,,,,
+NIST800-38b-AES-192,len=512,,,::tls::cmac -cipher aes-192-cbc -key $key -data $data,,,a1d5df0eed790f794d77589659f39a11,,,
+,,,,,,,,,,
+command,# AES-256,,,,,,,,,
+command,"set key [binary decode hex ""603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4""]",,,,,,,,,
+NIST800-38b-AES-256,len=0,,,"::tls::cmac -cipher aes-256-cbc -key $key -data """"",,,028962f61b7bf89efc6b551f4667d983,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172a""]",,,,,,,,,
+NIST800-38b-AES-256,len=128,,,::tls::cmac -cipher aes-256-cbc -key $key -data $data,,,28a7023f452e8f82bd4bf28d8c37c35c,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411""]",,,,,,,,,
+NIST800-38b-AES-256,len=320,,,::tls::cmac -cipher aes-256-cbc -key $key -data $data,,,aaf3d8f1de5640c232f5b169b9c911e6,,,
+command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710""]",,,,,,,,,
+NIST800-38b-AES-256,len=512,,,::tls::cmac -cipher aes-256-cbc -key $key -data $data,,,e1992190549f6ed5696a2c056c315410,,,
+,,,,,,,,,,
+command,# Cleanup,,,,,,,,,
+command,::tcltest::removeFile $test_file,,,,,,,,,
+command,::tcltest::removeFile $test_alt_file,,,,,,,,,
ADDED tests/digest.test
Index: tests/digest.test
==================================================================
--- /dev/null
+++ tests/digest.test
@@ -0,0 +1,789 @@
+# Auto generated test cases for digest.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
+
+# Constraints
+source common.tcl
+
+# Helper functions - See common.tcl
+proc digest_read_chan {cmd filename args} {;set ch [open $filename rb];set bsize [fconfigure $ch -buffersize];set new [$cmd {*}$args -chan $ch];while {![eof $new]} {set md [read $new $bsize]};close $new;return $md}
+proc digest_write_chan {cmd filename data args} {;set ch [open $filename wb];set new [$cmd {*}$args -chan $ch];puts -nonewline $new $data;flush $new;close $new;set ch [open $filename rb];set md [read $ch];close $ch;return $md}
+proc digest_accumulate {string args} {;set cmd [{*}$args -command dcmd]; $cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]}
+
+set test_data "Example string for message digest tests.\n"
+set test_file "md_data.dat"
+set test_alt_file "md_alt_data.dat"
+set test_key "Example key"
+::tcltest::makeFile $test_data $test_file
+
+# Test short-cut commands
+
+
+test Shortcut_Cmds-1.1 {md4 cmd} -body {
+ ::tls::md4 $test_data
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test Shortcut_Cmds-1.2 {md5 cmd} -body {
+ ::tls::md5 $test_data
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Shortcut_Cmds-1.3 {sha1 cmd} -body {
+ ::tls::sha1 $test_data
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test Shortcut_Cmds-1.4 {sha256 cmd} -body {
+ ::tls::sha256 $test_data
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test Shortcut_Cmds-1.5 {sha512 cmd} -body {
+ ::tls::sha512 $test_data
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+
+# Test MD command for read channel
+
+
+test MD_Chan_Read-2.1 {md4} -body {
+ digest_read_chan ::tls::md $test_file -digest md4
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test MD_Chan_Read-2.2 {md5} -body {
+ digest_read_chan ::tls::md $test_file -digest md5
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Chan_Read-2.3 {sha1} -body {
+ digest_read_chan ::tls::md $test_file -digest sha1
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test MD_Chan_Read-2.4 {sha256} -body {
+ digest_read_chan ::tls::md $test_file -digest sha256
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test MD_Chan_Read-2.5 {sha512} -body {
+ digest_read_chan ::tls::md $test_file -digest sha512
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test MD_Chan_Read-2.6 {md5 bin} -body {
+ binary encode hex [digest_read_chan ::tls::md $test_file -bin -digest md5]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Chan_Read-2.7 {md5 hex} -body {
+ digest_read_chan ::tls::md $test_file -hex -digest md5
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# Test MD command for write channel
+
+
+test MD_Chan_Write-3.1 {md4} -body {
+ digest_write_chan ::tls::md $test_alt_file $test_data -digest md4
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test MD_Chan_Write-3.2 {md5} -body {
+ digest_write_chan ::tls::md $test_alt_file $test_data -digest md5
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Chan_Write-3.3 {sha1} -body {
+ digest_write_chan ::tls::md $test_alt_file $test_data -digest sha1
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test MD_Chan_Write-3.4 {sha256} -body {
+ digest_write_chan ::tls::md $test_alt_file $test_data -digest sha256
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test MD_Chan_Write-3.5 {sha512} -body {
+ digest_write_chan ::tls::md $test_alt_file $test_data -digest sha512
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test MD_Chan_Write-3.6 {md5 bin} -body {
+ binary encode hex [digest_write_chan ::tls::md $test_alt_file $test_data -bin -digest md5]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Chan_Write-3.7 {md5 hex} -body {
+ digest_write_chan ::tls::md $test_alt_file $test_data -hex -digest md5
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# Test MD command for object command
+
+
+test MD_Command-4.1 {md4} -body {
+ digest_accumulate $test_data ::tls::md -digest md4
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test MD_Command-4.2 {md5} -body {
+ digest_accumulate $test_data ::tls::md -digest md5
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Command-4.3 {sha1} -body {
+ digest_accumulate $test_data ::tls::md -digest sha1
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test MD_Command-4.4 {sha256} -body {
+ digest_accumulate $test_data ::tls::md -digest sha256
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test MD_Command-4.5 {sha512} -body {
+ digest_accumulate $test_data ::tls::md -digest sha512
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test MD_Command-4.6 {md5 bin} -body {
+ binary encode hex [digest_accumulate $test_data ::tls::md -digest md5 -bin]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Command-4.7 {md5 hex} -body {
+ digest_accumulate $test_data ::tls::md -digest md5 -hex
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# Test MD command for data shortcut
+
+
+test MD_Shortcut-5.1 {md4} -body {
+ ::tls::md md4 $test_data
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test MD_Shortcut-5.2 {md5} -body {
+ ::tls::md md5 $test_data
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Shortcut-5.3 {sha1} -body {
+ ::tls::md sha1 $test_data
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test MD_Shortcut-5.4 {sha256} -body {
+ ::tls::md sha256 $test_data
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test MD_Shortcut-5.5 {sha512} -body {
+ ::tls::md sha512 $test_data
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+# Test MD command for data
+
+
+test MD_Data-6.1 {md4} -body {
+ ::tls::md -digest md4 -data $test_data
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test MD_Data-6.2 {md5} -body {
+ ::tls::md -digest md5 -data $test_data
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Data-6.3 {sha1} -body {
+ ::tls::md -digest sha1 -data $test_data
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test MD_Data-6.4 {sha256} -body {
+ ::tls::md -digest sha256 -data $test_data
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test MD_Data-6.5 {sha512} -body {
+ ::tls::md -digest sha512 -data $test_data
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test MD_Data-6.6 {md5 bin} -body {
+ binary encode hex [::tls::md -digest md5 -data $test_data -bin]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_Data-6.7 {md5 hex} -body {
+ ::tls::md -digest md5 -data $test_data -hex
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# Test MD command for file
+
+
+test MD_File-7.1 {md4} -body {
+ ::tls::md -digest md4 -file $test_file
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test MD_File-7.2 {md5} -body {
+ ::tls::md -digest md5 -file $test_file
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_File-7.3 {sha1} -body {
+ ::tls::md -digest sha1 -file $test_file
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test MD_File-7.4 {sha256} -body {
+ ::tls::md -digest sha256 -file $test_file
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test MD_File-7.5 {sha512} -body {
+ ::tls::md -digest sha512 -file $test_file
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test MD_File-7.6 {md5 bin} -body {
+ binary encode hex [::tls::md -digest md5 -file $test_file -bin]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test MD_File-7.7 {md5 hex} -body {
+ ::tls::md -digest md5 -file $test_file -hex
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# MD Error Cases
+
+
+test MD_Errors-8.1 {Too few args} -body {
+ ::tls::md
+ } -result {wrong # args: should be "::tls::md ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test MD_Errors-8.2 {Too many args} -body {
+ ::tls::md too many command line args to pass the test without an error or failing
+ } -result {wrong # args: should be "::tls::md ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test MD_Errors-8.3 {Invalid digest} -body {
+ ::tls::md bogus data
+ } -result {Invalid digest "bogus"} -returnCodes {1}
+
+test MD_Errors-8.4 {Invalid digest Arg} -body {
+ ::tls::md -digest bogus -data data
+ } -result {Invalid digest "bogus"} -returnCodes {1}
+
+test MD_Errors-8.5 {No digest} -body {
+ ::tls::md -hex -data value
+ } -result {No digest specified} -returnCodes {1}
+
+test MD_Errors-8.6 {Invalid option} -body {
+ ::tls::md -digest sha256 -bogus value
+ } -result {bad option "-bogus": must be -bin, -channel, -cipher, -command, -data, -digest, -file, -filename, -hex, -key, or -mac} -returnCodes {1}
+
+test MD_Errors-8.7 {Invalid file} -body {
+ ::tls::md -digest sha256 -file bogus
+ } -result {couldn't open "bogus": no such file or directory} -returnCodes {1}
+
+test MD_Errors-8.8 {Invalid channel} -body {
+ ::tls::md -digest sha256 -channel bogus
+ } -result {can not find channel named "bogus"} -returnCodes {1}
+
+test MD_Errors-8.9 {No operation} -body {
+ ::tls::md -digest sha256 -bin
+ } -result {No operation specified: Use -channel, -command, -data, or -file option} -returnCodes {1}
+
+
+# Test CMAC command
+set test_cipher "aes-128-cbc"
+set test_key "Example key 1234"
+
+
+test CMAC-9.1 {data} -body {
+ ::tls::cmac -cipher $test_cipher -key $test_key -data $test_data
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test CMAC-9.2 {file} -body {
+ ::tls::cmac -cipher $test_cipher -key $test_key -file $test_file
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test CMAC-9.3 {channel} -body {
+ digest_read_chan ::tls::cmac $test_file -cipher $test_cipher -key $test_key
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test CMAC-9.4 {command} -body {
+ digest_accumulate $test_data ::tls::cmac -cipher $test_cipher -key $test_key
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test CMAC-9.5 {data bin} -body {
+ binary encode hex [::tls::cmac -bin -cipher $test_cipher -key $test_key -data $test_data]
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+# Test MD CMAC
+
+
+test MD_CMAC-10.1 {data} -body {
+ ::tls::md -cipher $test_cipher -key $test_key -data $test_data
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test MD_CMAC-10.2 {file} -body {
+ ::tls::md -cipher $test_cipher -key $test_key -file $test_file
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test MD_CMAC-10.3 {channel} -body {
+ digest_read_chan ::tls::md $test_file -cipher $test_cipher -key $test_key
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test MD_CMAC-10.4 {command} -body {
+ digest_accumulate $test_data ::tls::md -cipher $test_cipher -key $test_key
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test MD_CMAC-10.5 {data bin} -body {
+ binary encode hex [::tls::md -bin -cipher $test_cipher -key $test_key -data $test_data]
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+# Test CMAC Shortcut
+
+
+test CMAC_Shortcut-11.1 {data} -body {
+ ::tls::cmac $test_cipher -key $test_key $test_data
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+# CMAC Error Cases
+
+
+test CMAC_Errors-12.1 {Too few args} -body {
+ ::tls::cmac
+ } -result {wrong # args: should be "::tls::cmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test CMAC_Errors-12.2 {Too many args} -body {
+ ::tls::cmac too many command line args to pass the test without an error or failing
+ } -result {wrong # args: should be "::tls::cmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test CMAC_Errors-12.3 {No cipher} -body {
+ ::tls::cmac -hex -data $test_data
+ } -result {No cipher specified} -returnCodes {1}
+
+test CMAC_Errors-12.4 {No key} -body {
+ ::tls::cmac -cipher $test_cipher -data $test_data
+ } -result {No key specified} -returnCodes {1}
+
+test CMAC_Errors-12.5 {Invalid cipher} -body {
+ ::tls::cmac -cipher bogus -data $test_data
+ } -result {Invalid cipher "bogus"} -returnCodes {1}
+
+
+# Test HMAC command
+set test_digest md5
+set test_key "Example key"
+
+
+test HMAC-13.1 {data} -body {
+ ::tls::hmac -digest $test_digest -key $test_key -data $test_data
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test HMAC-13.2 {file} -body {
+ ::tls::hmac -digest $test_digest -key $test_key -file $test_file
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test HMAC-13.3 {channel} -body {
+ digest_read_chan ::tls::hmac $test_file -digest $test_digest -key $test_key
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test HMAC-13.4 {command} -body {
+ digest_accumulate $test_data ::tls::hmac -digest $test_digest -key $test_key
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test HMAC-13.5 {data bin} -body {
+ binary encode hex [::tls::hmac -digest $test_digest -bin -key $test_key -data $test_data]
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+# Test MD HMAC
+
+
+test MD_HMAC-14.1 {data} -body {
+ ::tls::md -digest $test_digest -key $test_key -data $test_data
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test MD_HMAC-14.2 {file} -body {
+ ::tls::md -digest $test_digest -key $test_key -file $test_file
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test MD_HMAC-14.3 {channel} -body {
+ digest_read_chan ::tls::md $test_file -digest $test_digest -key $test_key
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test MD_HMAC-14.4 {command} -body {
+ digest_accumulate $test_data ::tls::md -digest $test_digest -key $test_key
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test MD_HMAC-14.5 {data bin} -body {
+ binary encode hex [::tls::md -digest $test_digest -bin -key $test_key -data $test_data]
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+# Test HMAC Shortcut
+
+
+test HMAC_Shortcut-15.1 {data} -body {
+ ::tls::hmac $test_digest -key $test_key $test_data
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+# HMAC Error Cases
+
+
+test HMAC_Errors-16.1 {Too few args} -body {
+ ::tls::hmac
+ } -result {wrong # args: should be "::tls::hmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test HMAC_Errors-16.2 {Too many args} -body {
+ ::tls::hmac too many command line args to pass the test without an error or failing
+ } -result {wrong # args: should be "::tls::hmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test HMAC_Errors-16.3 {No digest} -body {
+ ::tls::hmac -hex -data $test_data
+ } -result {No digest specified} -returnCodes {1}
+
+test HMAC_Errors-16.4 {No key} -body {
+ ::tls::hmac -digest sha256 -data $test_data
+ } -result {No key specified} -returnCodes {1}
+
+test HMAC_Errors-16.5 {Invalid digest} -body {
+ ::tls::md -digest bogus -key $test_key -data $test_data
+ } -result {Invalid digest "bogus"} -returnCodes {1}
+
+
+# Test MAC command
+set test_cipher "aes-128-cbc"
+set test_digest sha256
+set test_key "Example key 1234"
+
+
+test MAC-17.1 {CMAC} -body {
+ ::tls::mac -cipher $test_cipher -key $test_key -mac cmac -data $test_data
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test MAC-17.2 {HMAC} -body {
+ ::tls::mac -digest $test_digest -key $test_key -mac hmac -data $test_data
+ } -result {676daf96370d0e3c5598557da38a9a810a4fbacbb2d10c67f6dfa83f10f48e96}
+
+test MAC-17.3 {MD-CMAC} -body {
+ ::tls::md -cipher $test_cipher -key $test_key -mac cmac -data $test_data
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test MAC-17.4 {MD-HMAC} -body {
+ ::tls::md -digest $test_digest -key $test_key -mac hmac -data $test_data
+ } -result {676daf96370d0e3c5598557da38a9a810a4fbacbb2d10c67f6dfa83f10f48e96}
+
+# MAC Error Cases
+
+
+test MAC_Errors-18.1 {Too few args} -body {
+ ::tls::mac
+ } -result {wrong # args: should be "::tls::mac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test MAC_Errors-18.2 {No mac} -body {
+ ::tls::mac -key $test_key -data $test_data
+ } -result {No MAC specified} -returnCodes {1}
+
+test MAC_Errors-18.3 {No key} -body {
+ ::tls::mac -mac hmac -data $test_data
+ } -result {No key specified} -returnCodes {1}
+
+test MAC_Errors-18.4 {Invalid MAC} -body {
+ ::tls::mac -mac scrypt -key $test_key -data $test_data
+ } -result {Invalid MAC "scrypt"} -returnCodes {1}
+
+test MAC_Errors-18.5 {Too many args} -body {
+ ::tls::mac too many command line args to pass the test without an error or failing
+ } -result {wrong # args: should be "::tls::mac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+
+# RFC 1321 Message Digest 5
+
+
+test RFC1321-MD5-19.1 {TC1} -body {
+ ::tls::md -digest md5 -data ""
+ } -result {d41d8cd98f00b204e9800998ecf8427e}
+
+test RFC1321-MD5-19.2 {TC2} -body {
+ ::tls::md -digest md5 -data "a"
+ } -result {0cc175b9c0f1b6a831c399e269772661}
+
+test RFC1321-MD5-19.3 {TC3} -body {
+ ::tls::md -digest md5 -data "abc"
+ } -result {900150983cd24fb0d6963f7d28e17f72}
+
+test RFC1321-MD5-19.4 {TC4} -body {
+ ::tls::md -digest md5 -data "message digest"
+ } -result {f96b697d7cb7938d525a2f31aaf161d0}
+
+test RFC1321-MD5-19.5 {TC5} -body {
+ ::tls::md -digest md5 -data "abcdefghijklmnopqrstuvwxyz"
+ } -result {c3fcd3d76192e4007dfb496cca67e13b}
+
+test RFC1321-MD5-19.6 {TC6} -body {
+ ::tls::md -digest md5 -data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
+ } -result {d174ab98d277d9f5a5611c2c9f419d9f}
+
+test RFC1321-MD5-19.7 {TC7} -body {
+ ::tls::md -digest md5 -data [string repeat "1234567890" 8]
+ } -result {57edf4a22be3c955ac49da2e2107b67a}
+
+# RFC 6234 SHA1
+
+
+test RFC6234-MD-SHA1-20.1 {TC1} -body {
+ ::tls::md -digest sha1 -data "abc"
+ } -result {a9993e364706816aba3e25717850c26c9cd0d89d}
+
+test RFC6234-MD-SHA1-20.2 {TC2_1} -body {
+ ::tls::md -digest sha1 -data "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
+ } -result {84983e441c3bd26ebaae4aa1f95129e5e54670f1}
+
+test RFC6234-MD-SHA1-20.3 {TC3} -body {
+ ::tls::md -digest sha1 -data [string repeat "a" 1000000]
+ } -result {34aa973cd4c4daa4f61eeb2bdbad27316534016f}
+
+test RFC6234-MD-SHA1-20.4 {TC4} -body {
+ ::tls::md -digest sha1 -data [string repeat "01234567" 80]
+ } -result {dea356a2cddd90c7a7ecedc5ebb563934f460452}
+
+test RFC6234-MD-SHA1-20.5 {TC6} -body {
+ ::tls::md -digest sha1 -data "\x5e"
+ } -result {5e6f80a34a9798cafc6a5db96cc57ba4c4db59c2}
+
+test RFC6234-MD-SHA1-20.6 {TC8_1} -body {
+ ::tls::md -digest sha1 -data "\x9a\x7d\xfd\xf1\xec\xea\xd0\x6e\xd6\x46\xaa\x55\xfe\x75\x71\x46"
+ } -result {82abff6605dbe1c17def12a394fa22a82b544a35}
+
+test RFC6234-MD-SHA1-20.7 {TC10_1} -body {
+ ::tls::md -digest sha1 -data "\xf7\x8f\x92\x14\x1b\xcd\x17\x0a\xe8\x9b\x4f\xba\x15\xa1\xd5\x9f\x3f\xd8\x4d\x22\x3c\x92\x51\xbd\xac\xbb\xae\x61\xd0\x5e\xd1\x15\xa0\x6a\x7c\xe1\x17\xb7\xbe\xea\xd2\x44\x21\xde\xd9\xc3\x25\x92\xbd\x57\xed\xea\xe3\x9c\x39\xfa\x1f\xe8\x94\x6a\x84\xd0\xcf\x1f\x7b\xee\xad\x17\x13\xe2\xe0\x95\x98\x97\x34\x7f\x67\xc8\x0b\x04\x00\xc2\x09\x81\x5d\x6b\x10\xa6\x83\x83\x6f\xd5\x56\x2a\x56\xca\xb1\xa2\x8e\x81\xb6\x57\x66\x54\x63\x1c\xf1\x65\x66\xb8\x6e\x3b\x33\xa1\x08\xb0\x53\x07\xc0\x0a\xff\x14\xa7\x68\xed\x73\x50\x60\x6a\x0f\x85\xe6\xa9\x1d\x39\x6f\x5b\x5c\xbe\x57\x7f\x9b\x38\x80\x7c\x7d\x52\x3d\x6d\x79\x2f\x6e\xbc\x24\xa4\xec\xf2\xb3\xa4\x27\xcd\xbb\xfb"
+ } -result {cb0082c8f197d260991ba6a460e76e202bad27b3}
+
+# RFC 6234 SHA256
+
+
+test RFC6234-MD-SHA256-21.1 {TC1} -body {
+ ::tls::md -digest sha256 -data "abc"
+ } -result {ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad}
+
+test RFC6234-MD-SHA256-21.2 {TC2_1} -body {
+ ::tls::md -digest sha256 -data "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
+ } -result {248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1}
+
+test RFC6234-MD-SHA256-21.3 {TC3} -body {
+ ::tls::md -digest sha256 -data [string repeat "a" 1000000]
+ } -result {cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0}
+
+test RFC6234-MD-SHA256-21.4 {TC4} -body {
+ ::tls::md -digest sha256 -data [string repeat "01234567" 80]
+ } -result {594847328451bdfa85056225462cc1d867d877fb388df0ce35f25ab5562bfbb5}
+
+test RFC6234-MD-SHA256-21.5 {TC6} -body {
+ ::tls::md -digest sha256 -data "\x19"
+ } -result {68aa2e2ee5dff96e3355e6c7ee373e3d6a4e17f75f9518d843709c0c9bc3e3d4}
+
+test RFC6234-MD-SHA256-21.6 {TC8_256} -body {
+ ::tls::md -digest sha256 -data "\xe3\xd7\x25\x70\xdc\xdd\x78\x7c\xe3\x88\x7a\xb2\xcd\x68\x46\x52"
+ } -result {175ee69b02ba9b58e2b0a5fd13819cea573f3940a94f825128cf4209beabb4e8}
+
+test RFC6234-MD-SHA256-21.7 {TC10_256} -body {
+ ::tls::md -digest sha256 -data "\x83\x26\x75\x4e\x22\x77\x37\x2f\x4f\xc1\x2b\x20\x52\x7a\xfe\xf0\x4d\x8a\x05\x69\x71\xb1\x1a\xd5\x71\x23\xa7\xc1\x37\x76\x00\x00\xd7\xbe\xf6\xf3\xc1\xf7\xa9\x08\x3a\xa3\x9d\x81\x0d\xb3\x10\x77\x7d\xab\x8b\x1e\x7f\x02\xb8\x4a\x26\xc7\x73\x32\x5f\x8b\x23\x74\xde\x7a\x4b\x5a\x58\xcb\x5c\x5c\xf3\x5b\xce\xe6\xfb\x94\x6e\x5b\xd6\x94\xfa\x59\x3a\x8b\xeb\x3f\x9d\x65\x92\xec\xed\xaa\x66\xca\x82\xa2\x9d\x0c\x51\xbc\xf9\x33\x62\x30\xe5\xd7\x84\xe4\xc0\xa4\x3f\x8d\x79\xa3\x0a\x16\x5c\xba\xbe\x45\x2b\x77\x4b\x9c\x71\x09\xa9\x7d\x13\x8f\x12\x92\x28\x96\x6f\x6c\x0a\xdc\x10\x6a\xad\x5a\x9f\xdd\x30\x82\x57\x69\xb2\xc6\x71\xaf\x67\x59\xdf\x28\xeb\x39\x3d\x54\xd6"
+ } -result {97dbca7df46d62c8a422c941dd7e835b8ad3361763f7e9b2d95f4f0da6e1ccbc}
+
+# RFC 4231 HMAC Examples Test Case #1
+set key [binary decode hex [string repeat "0b" 20]]
+set data "Hi There"
+
+
+test RFC4231_HMAC_TC1-22.1 {sha224} -body {
+ ::tls::hmac -digest sha224 -key $key -data $data
+ } -result {896fb1128abbdf196832107cd49df33f47b4b1169912ba4f53684b22}
+
+test RFC4231_HMAC_TC1-22.2 {sha256} -body {
+ ::tls::hmac -digest sha256 -key $key -data $data
+ } -result {b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7}
+
+test RFC4231_HMAC_TC1-22.3 {sha384} -body {
+ ::tls::hmac -digest sha384 -key $key -data $data
+ } -result {afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6}
+
+test RFC4231_HMAC_TC1-22.4 {sha512} -body {
+ ::tls::hmac -digest sha512 -key $key -data $data
+ } -result {87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854}
+
+# RFC 4231 HMAC Examples Test Case #2 - Test with a key shorter than the length of the HMAC output.
+set key "Jefe"
+set data "what do ya want for nothing?"
+
+
+test RFC4231_HMAC_TC2-23.1 {sha224} -body {
+ ::tls::hmac -digest sha224 -key $key -data $data
+ } -result {a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44}
+
+test RFC4231_HMAC_TC2-23.2 {sha256} -body {
+ ::tls::hmac -digest sha256 -key $key -data $data
+ } -result {5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843}
+
+test RFC4231_HMAC_TC2-23.3 {sha384} -body {
+ ::tls::hmac -digest sha384 -key $key -data $data
+ } -result {af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649}
+
+test RFC4231_HMAC_TC2-23.4 {sha512} -body {
+ ::tls::hmac -digest sha512 -key $key -data $data
+ } -result {164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737}
+
+# RFC 4231 HMAC Examples Test Case #3 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).
+set key [binary decode hex [string repeat "aa" 20]]
+set data [binary decode hex [string repeat "dd" 50]]
+
+
+test RFC4231_HMAC_TC3-24.1 {sha224} -body {
+ ::tls::hmac -digest sha224 -key $key -data $data
+ } -result {7fb3cb3588c6c1f6ffa9694d7d6ad2649365b0c1f65d69d1ec8333ea}
+
+test RFC4231_HMAC_TC3-24.2 {sha256} -body {
+ ::tls::hmac -digest sha256 -key $key -data $data
+ } -result {773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe}
+
+test RFC4231_HMAC_TC3-24.3 {sha384} -body {
+ ::tls::hmac -digest sha384 -key $key -data $data
+ } -result {88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27}
+
+test RFC4231_HMAC_TC3-24.4 {sha512} -body {
+ ::tls::hmac -digest sha512 -key $key -data $data
+ } -result {fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb}
+
+# RFC 4231 HMAC Examples Test Case #4 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).
+set key [binary decode hex "0102030405060708090a0b0c0d0e0f10111213141516171819"]
+set data [binary decode hex [string repeat "cd" 50]]
+
+
+test RFC4231_HMAC_TC4-25.1 {sha224} -body {
+ ::tls::hmac -digest sha224 -key $key -data $data
+ } -result {6c11506874013cac6a2abc1bb382627cec6a90d86efc012de7afec5a}
+
+test RFC4231_HMAC_TC4-25.2 {sha256} -body {
+ ::tls::hmac -digest sha256 -key $key -data $data
+ } -result {82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b}
+
+test RFC4231_HMAC_TC4-25.3 {sha384} -body {
+ ::tls::hmac -digest sha384 -key $key -data $data
+ } -result {3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb}
+
+test RFC4231_HMAC_TC4-25.4 {sha512} -body {
+ ::tls::hmac -digest sha512 -key $key -data $data
+ } -result {b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd}
+
+# RFC 4231 HMAC Examples Test Case #5 - Test with a truncation of output to 128 bits.
+set key [binary decode hex [string repeat "0c" 20]]
+set data "Test With Truncation"
+
+
+test RFC4231_HMAC_TC5-26.1 {sha224} -body {
+ string range [::tls::hmac -digest sha224 -key $key -data $data] 0 31
+ } -result {0e2aea68a90c8d37c988bcdb9fca6fa8}
+
+test RFC4231_HMAC_TC5-26.2 {sha256} -body {
+ string range [::tls::hmac -digest sha256 -key $key -data $data] 0 31
+ } -result {a3b6167473100ee06e0c796c2955552b}
+
+test RFC4231_HMAC_TC5-26.3 {sha384} -body {
+ string range [::tls::hmac -digest sha384 -key $key -data $data] 0 31
+ } -result {3abf34c3503b2a23a46efc619baef897}
+
+test RFC4231_HMAC_TC5-26.4 {sha512} -body {
+ string range [::tls::hmac -digest sha512 -key $key -data $data] 0 31
+ } -result {415fad6271580a531d4179bc891d87a6}
+
+# RFC 4231 HMAC Examples Test Case #6 - Test with a key larger than 128 bytes (= block-size of SHA-384 and SHA-512).
+set key [binary decode hex [string repeat "aa" 131]]
+set data "Test Using Larger Than Block-Size Key - Hash Key First"
+
+
+test RFC4231_HMAC_TC6-27.1 {sha224} -body {
+ ::tls::hmac -digest sha224 -key $key -data $data
+ } -result {95e9a0db962095adaebe9b2d6f0dbce2d499f112f2d2b7273fa6870e}
+
+test RFC4231_HMAC_TC6-27.2 {sha256} -body {
+ ::tls::hmac -digest sha256 -key $key -data $data
+ } -result {60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54}
+
+test RFC4231_HMAC_TC6-27.3 {sha384} -body {
+ ::tls::hmac -digest sha384 -key $key -data $data
+ } -result {4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952}
+
+test RFC4231_HMAC_TC6-27.4 {sha512} -body {
+ ::tls::hmac -digest sha512 -key $key -data $data
+ } -result {80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598}
+
+# RFC 4231 HMAC Examples Test Case #7 - Test with a key and data that is larger than 128 bytes (= block-size of SHA-384 and SHA-512).
+set key [binary decode hex [string repeat "aa" 131]]
+set data "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm."
+
+
+test RFC4231_HMAC_TC7-28.1 {sha224} -body {
+ ::tls::hmac -digest sha224 -key $key -data $data
+ } -result {3a854166ac5d9f023f54d517d0b39dbd946770db9c2b95c9f6f565d1}
+
+test RFC4231_HMAC_TC7-28.2 {sha256} -body {
+ ::tls::hmac -digest sha256 -key $key -data $data
+ } -result {9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2}
+
+test RFC4231_HMAC_TC7-28.3 {sha384} -body {
+ ::tls::hmac -digest sha384 -key $key -data $data
+ } -result {6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e}
+
+test RFC4231_HMAC_TC7-28.4 {sha512} -body {
+ ::tls::hmac -digest sha512 -key $key -data $data
+ } -result {e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58}
+
+# NIST 800-38b Recommendation for Block Cipher Modes of Operation: The CMAC Mode for Authentication
+# AES-128
+set key [binary decode hex "2b7e151628aed2a6abf7158809cf4f3c"]
+
+
+test NIST800-38b-AES128-29.1 {len=0} -body {
+ ::tls::cmac -cipher aes-128-cbc -key $key -data ""
+ } -result {bb1d6929e95937287fa37d129b756746}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172a"]
+
+test NIST800-38b-AES128-29.2 {len=128} -body {
+ ::tls::cmac -cipher aes-128-cbc -key $key -data $data
+ } -result {070a16b46b4d4144f79bdd9dd04a287c}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411"]
+
+test NIST800-38b-AES128-29.3 {len=320} -body {
+ ::tls::cmac -cipher aes-128-cbc -key $key -data $data
+ } -result {dfa66747de9ae63030ca32611497c827}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710"]
+
+test NIST800-38b-AES128-29.4 {len=512} -body {
+ ::tls::cmac -cipher aes-128-cbc -key $key -data $data
+ } -result {51f0bebf7e3b9d92fc49741779363cfe}
+
+# AES-192
+set key [binary decode hex "8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"]
+
+
+test NIST800-38b-AES-192-30.1 {len=0} -body {
+ ::tls::cmac -cipher aes-192-cbc -key $key -data ""
+ } -result {d17ddf46adaacde531cac483de7a9367}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172a"]
+
+test NIST800-38b-AES-192-30.2 {len=128} -body {
+ ::tls::cmac -cipher aes-192-cbc -key $key -data $data
+ } -result {9e99a7bf31e710900662f65e617c5184}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411"]
+
+test NIST800-38b-AES-192-30.3 {len=320} -body {
+ ::tls::cmac -cipher aes-192-cbc -key $key -data $data
+ } -result {8a1de5be2eb31aad089a82e6ee908b0e}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710"]
+
+test NIST800-38b-AES-192-30.4 {len=512} -body {
+ ::tls::cmac -cipher aes-192-cbc -key $key -data $data
+ } -result {a1d5df0eed790f794d77589659f39a11}
+
+# AES-256
+set key [binary decode hex "603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"]
+
+
+test NIST800-38b-AES-256-31.1 {len=0} -body {
+ ::tls::cmac -cipher aes-256-cbc -key $key -data ""
+ } -result {028962f61b7bf89efc6b551f4667d983}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172a"]
+
+test NIST800-38b-AES-256-31.2 {len=128} -body {
+ ::tls::cmac -cipher aes-256-cbc -key $key -data $data
+ } -result {28a7023f452e8f82bd4bf28d8c37c35c}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411"]
+
+test NIST800-38b-AES-256-31.3 {len=320} -body {
+ ::tls::cmac -cipher aes-256-cbc -key $key -data $data
+ } -result {aaf3d8f1de5640c232f5b169b9c911e6}
+set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710"]
+
+test NIST800-38b-AES-256-31.4 {len=512} -body {
+ ::tls::cmac -cipher aes-256-cbc -key $key -data $data
+ } -result {e1992190549f6ed5696a2c056c315410}
+
+# Cleanup
+::tcltest::removeFile $test_file
+::tcltest::removeFile $test_alt_file
+
+# Cleanup
+::tcltest::cleanupTests
+return
ADDED tests/encrypt.csv
Index: tests/encrypt.csv
==================================================================
--- /dev/null
+++ tests/encrypt.csv
@@ -0,0 +1,47 @@
+# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
+command,package require tls,,,,,,,,,
+,,,,,,,,,,
+command,# Constraints,,,,,,,,,
+command,source common.tcl,,,,,,,,,
+,,,,,,,,,,
+command,# Helper functions - See common.tcl,,,,,,,,,
+command,"proc read_chan {filename args} {set ch [open $filename rb];set bsize [fconfigure $ch -buffersize];set new [{*}$args -chan $ch];set dat """";while {![eof $new]} {append dat [read $new $bsize]};close $new;return $dat}",,,,,,,,,
+command,proc write_chan {filename data args} {set ch [open $filename wb];set new [{*}$args -chan $ch];puts -nonewline $new $data;flush $new;close $new;set ch [open $filename rb];set dat [read $ch];close $ch;return $dat},,,,,,,,,
+command,"proc accumulate {string args} {set cmd [{*}$args -command dcmd];set ::dat """";append ::dat [$cmd update [string range $string 0 20]];append ::dat [$cmd update [string range $string 21 end]];append ::dat [$cmd finalize]}",$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},,,,,,,,
+command,proc get_file_hex {filename} {set ch [open $filename rb];set data [read $ch];close $ch;return [binary encode hex $data]},,,,,,,,,
+command,proc get_file_text {filename} {set ch [open $filename r];set data [read $ch];close $ch;return $data},,,,,,,,,
+,,,,,,,,,,
+command,"set test_data ""Example string for message digest tests.\n""",,,,,,,,,
+command,"set unencrypted_file ""unencrypted_data.dat""",,,,,,,,,
+command,"set encrypted_file ""encrypted_data.dat""",,,,,,,,,
+command,"set alt_file ""result_data.dat""",,,,,,,,,
+command,"set test_key ""Example key""",,,,,,,,,
+command,"set test_iv ""Example iv""",,,,,,,,,
+command,::tcltest::makeFile $test_data $unencrypted_file,,,,,,,,,
+ ,,,,,,,,,,
+command,# Test encrypt data,,,,,,,,,
+command,set cipher aes-128-cbc,,,,,,,,,
+command,"set hex_string ""3cea034398de64507abbc7bcf6acba55c7011100c9015c22b3c9c331d18479fed5e542ce02a3b89a0f750daf8e2a494e""",,,,,,,,,
+Encrypt Decrypt Data,Encrypt aes-138-cbc,,,binary encode hex [set data [tls::encrypt -cipher $cipher -key $test_key -iv $test_iv -data $test_data]],,,$hex_string,,,
+Encrypt Decrypt Data,Decrypt aes-128-cbc,,,tls::decrypt -cipher $cipher -key $test_key -iv $test_iv -data $data,,,$test_data,,,
+ ,,,,,,,,,,
+command,# Test encrypt file,,,,,,,,,
+Encrypt Decrypt File,Encrypt aes-138-cbc,,,tls::encrypt -cipher $cipher -key $test_key -iv $test_iv -infile $unencrypted_file -outfile $encrypted_file;get_file_hex $encrypted_file,,,$hex_string,,,
+Encrypt Decrypt File,Decrypt aes-128-cbc,,,tls::decrypt -cipher $cipher -key $test_key -iv $test_iv -infile $encrypted_file -outfile $alt_file;get_file_text $alt_file,,,$test_data,,,
+ ,,,,,,,,,,
+command,# Test encrypt using object command,,,,,,,,,
+Encrypt Decrypt Command,Encrypt aes-138-cbc,,,accumulate $test_data tls::encrypt -cipher $cipher -key $test_key -iv $test_iv;binary encode hex $::dat,,,$hex_string,,,
+Encrypt Decrypt Command,Decrypt aes-128-cbc,,,accumulate $::dat tls::decrypt -cipher $cipher -key $test_key -iv $test_iv;set ::dat,,,$test_data,,,
+ ,,,,,,,,,,
+command,# Test encrypt using read channel,,,,,,,,,
+Encrypt Decrypt Channel Read,Encrypt aes-138-cbc,,,binary encode hex [read_chan $unencrypted_file tls::encrypt -cipher $cipher -key $test_key -iv $test_iv],,,$hex_string,,,
+Encrypt Decrypt Channel Read,Decrypt aes-138-cbc,,,read_chan $encrypted_file tls::decrypt -cipher $cipher -key $test_key -iv $test_iv,,,$test_data,,,
+ ,,,,,,,,,,
+command,# Test encrypt using write channel,,,,,,,,,
+Encrypt Decrypt Channel Write,Encrypt aes-138-cbc,,,binary encode hex [set data [write_chan $encrypted_file $test_data tls::encrypt -cipher $cipher -key $test_key -iv $test_iv]],,,$hex_string,,,
+Encrypt Decrypt Channel Write,Decrypt aes-138-cbc,,,write_chan $alt_file $data tls::decrypt -cipher $cipher -key $test_key -iv $test_iv,,,$test_data,,,
+,,,,,,,,,,
+command,# Cleanup,,,,,,,,,
+command,::tcltest::removeFile $unencrypted_file,,,,,,,,,
+command,::tcltest::removeFile $encrypted_file,,,,,,,,,
+command,::tcltest::removeFile $alt_file,,,,,,,,,
ADDED tests/encrypt.test
Index: tests/encrypt.test
==================================================================
--- /dev/null
+++ tests/encrypt.test
@@ -0,0 +1,99 @@
+# Auto generated test cases for encrypt.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
+
+# Constraints
+source common.tcl
+
+# Helper functions - See common.tcl
+proc read_chan {filename args} {set ch [open $filename rb];set bsize [fconfigure $ch -buffersize];set new [{*}$args -chan $ch];set dat "";while {![eof $new]} {append dat [read $new $bsize]};close $new;return $dat}
+proc write_chan {filename data args} {set ch [open $filename wb];set new [{*}$args -chan $ch];puts -nonewline $new $data;flush $new;close $new;set ch [open $filename rb];set dat [read $ch];close $ch;return $dat}
+proc accumulate {string args} {set cmd [{*}$args -command dcmd];set ::dat "";append ::dat [$cmd update [string range $string 0 20]];append ::dat [$cmd update [string range $string 21 end]];append ::dat [$cmd finalize]}
+proc get_file_hex {filename} {set ch [open $filename rb];set data [read $ch];close $ch;return [binary encode hex $data]}
+proc get_file_text {filename} {set ch [open $filename r];set data [read $ch];close $ch;return $data}
+
+set test_data "Example string for message digest tests.\n"
+set unencrypted_file "unencrypted_data.dat"
+set encrypted_file "encrypted_data.dat"
+set alt_file "result_data.dat"
+set test_key "Example key"
+set test_iv "Example iv"
+::tcltest::makeFile $test_data $unencrypted_file
+
+# Test encrypt data
+set cipher aes-128-cbc
+set hex_string "3cea034398de64507abbc7bcf6acba55c7011100c9015c22b3c9c331d18479fed5e542ce02a3b89a0f750daf8e2a494e"
+
+
+test Encrypt_Decrypt_Data-1.1 {Encrypt aes-138-cbc} -body {
+ binary encode hex [set data [tls::encrypt -cipher $cipher -key $test_key -iv $test_iv -data $test_data]]
+ } -result $hex_string
+
+test Encrypt_Decrypt_Data-1.2 {Decrypt aes-128-cbc} -body {
+ tls::decrypt -cipher $cipher -key $test_key -iv $test_iv -data $data
+ } -result $test_data
+
+# Test encrypt file
+
+
+test Encrypt_Decrypt_File-2.1 {Encrypt aes-138-cbc} -body {
+ tls::encrypt -cipher $cipher -key $test_key -iv $test_iv -infile $unencrypted_file -outfile $encrypted_file
+ get_file_hex $encrypted_file
+ } -result $hex_string
+
+test Encrypt_Decrypt_File-2.2 {Decrypt aes-128-cbc} -body {
+ tls::decrypt -cipher $cipher -key $test_key -iv $test_iv -infile $encrypted_file -outfile $alt_file
+ get_file_text $alt_file
+ } -result $test_data
+
+# Test encrypt using object command
+
+
+test Encrypt_Decrypt_Command-3.1 {Encrypt aes-138-cbc} -body {
+ accumulate $test_data tls::encrypt -cipher $cipher -key $test_key -iv $test_iv
+ binary encode hex $::dat
+ } -result $hex_string
+
+test Encrypt_Decrypt_Command-3.2 {Decrypt aes-128-cbc} -body {
+ accumulate $::dat tls::decrypt -cipher $cipher -key $test_key -iv $test_iv
+ set ::dat
+ } -result $test_data
+
+# Test encrypt using read channel
+
+
+test Encrypt_Decrypt_Channel_Read-4.1 {Encrypt aes-138-cbc} -body {
+ binary encode hex [read_chan $unencrypted_file tls::encrypt -cipher $cipher -key $test_key -iv $test_iv]
+ } -result $hex_string
+
+test Encrypt_Decrypt_Channel_Read-4.2 {Decrypt aes-138-cbc} -body {
+ read_chan $encrypted_file tls::decrypt -cipher $cipher -key $test_key -iv $test_iv
+ } -result $test_data
+
+# Test encrypt using write channel
+
+
+test Encrypt_Decrypt_Channel_Write-5.1 {Encrypt aes-138-cbc} -body {
+ binary encode hex [set data [write_chan $encrypted_file $test_data tls::encrypt -cipher $cipher -key $test_key -iv $test_iv]]
+ } -result $hex_string
+
+test Encrypt_Decrypt_Channel_Write-5.2 {Decrypt aes-138-cbc} -body {
+ write_chan $alt_file $data tls::decrypt -cipher $cipher -key $test_key -iv $test_iv
+ } -result $test_data
+
+# Cleanup
+::tcltest::removeFile $unencrypted_file
+::tcltest::removeFile $encrypted_file
+::tcltest::removeFile $alt_file
+
+# Cleanup
+::tcltest::cleanupTests
+return
ADDED tests/info.csv
Index: tests/info.csv
==================================================================
--- /dev/null
+++ tests/info.csv
@@ -0,0 +1,82 @@
+# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
+command,package require tls,,,,,,,,,
+,,,,,,,,,,
+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,# Constraints,,,,,,,,,
+command,source common.tcl,,,,,,,,,
+,,,,,,,,,,
+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,# 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},,,
+,,,,,,,,,,
+command,# Test list ciphers for protocols,,,,,,,,,
+Ciphers By Protocol,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2] [::tls::ciphers ssl2]",,,missing {} unexpected {},,,
+Ciphers By Protocol,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3] [::tls::ciphers ssl3]",,,missing {} unexpected {},,,
+Ciphers By Protocol,TLS1.0,tls1,,"lcompare [exec_get "":"" ciphers -tls1] [::tls::ciphers tls1]",,,missing {} unexpected {},,,
+Ciphers By Protocol,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1] [::tls::ciphers tls1.1]",,,missing {} unexpected {},,,
+Ciphers By Protocol,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2] [::tls::ciphers tls1.2]",,,missing {} unexpected {},,,
+Ciphers By Protocol,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3] [::tls::ciphers tls1.3]",,,missing {} unexpected {},,,
+,,,,,,,,,,
+command,# Test cipher descriptions,,,,,,,,,
+Ciphers With Descriptions,SSL2,ssl2,,"lcompare [exec_get ""\r\n"" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,SSL3,ssl3,,"lcompare [exec_get ""\r\n"" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,TLS1.0,tls1,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,TLS1.1,tls1.1,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,TLS1.2,tls1.2,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,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,,,,,,,,,
+Ciphers Protocol Specific,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,TLS1.0,tls1,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,,
+,,,,,,,,,,
+command,# Ciphers Error Cases,,,,,,,,,
+Ciphers Errors,Too many args,,,::tls::ciphers too many args to pass,,,"wrong # args: should be ""::tls::ciphers ?protocol? ?verbose? ?supported?""",,,1
+Ciphers Errors,Invalid protocol,,,::tls::ciphers bogus,,,"bad protocol ""bogus"": must be ssl2, ssl3, tls1, tls1.1, tls1.2, or tls1.3",,,1
+Ciphers Errors,Invalid verbose,,,::tls::ciphers tls1.3 bogus,,,"expected boolean value but got ""bogus""",,,1
+Ciphers Errors,Invalid supported,,,::tls::ciphers tls1.3 1 bogus,,,"expected boolean value but got ""bogus""",,,1
+Ciphers Errors,SSL2,!ssl2,,::tls::ciphers ssl2,,,ssl2: protocol not supported,,,1
+Ciphers Errors,SSL3,!ssl3,,::tls::ciphers ssl3,,,ssl3: protocol not supported,,,1
+Ciphers Errors,TLS1.0,!tls1,,::tls::ciphers tls1,,,tls1: protocol not supported,,,1
+Ciphers Errors,TLS1.1,!tls1.1,,::tls::ciphers tls1.1,,,tls1.0: protocol not supported,,,1
+Ciphers Errors,TLS1.2,!tls1.2,,::tls::ciphers tls1.2,,,tls1.1: protocol not supported,,,1
+Ciphers Errors,TLS1.3,!tls1.3,,::tls::ciphers tls1.3,,,tls1.3: protocol not supported,,,1
+,,,,,,,,,,
+command,# Test Cipher Info,,,,,,,,,
+Cipher Info,AES-256-CCM,,,tls::cipher aes-256-ccm,,,nid aes-256-ccm name id-aes256-CCM description {} block_size 1 key_length 32 iv_length 12 type aes-256-ccm provider {} mode CCM flags {{Variable Length} 0 {Always Call Init} 1 {Custom IV} 1 {Control Init} 1 {Custom Cipher} 1 {AEAD Cipher} 1 {Custom Copy} 1 {Non FIPS Allow} 0},,,
+,,,,,,,,,,
+command,# Test list digests,,,,,,,,,
+Digests List,All,,,lcompare [lsort [exec_get_digests]] [lsort [tls::digests]],,,missing {} unexpected {},,,
+,,,,,,,,,,
+command,# Test Digest Info,,,,,,,,,
+Digest Info,md5,,,tls::digests md5,,,name MD5 description {} size 16 block_size 64 provider {} type md5 pkey_type md5WithRSAEncryption flags {One-shot 0 XOF 0 DigestAlgorithmId_NULL 0 DigestAlgorithmId_Abscent 0 DigestAlgorithmId_Custom 0 FIPS 0},,,
+,,,,,,,,,,
+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*,,,
+,,,,,,,,,,
+command,# Error Cases,,,,,,,,,
+Error Cases,Cipher Too few args,,,::tls::cipher,,,"wrong # args: should be ""::tls::cipher name""",,,1
+Error Cases,Cipher Too many args,,,::tls::cipher too many args,,,"wrong # args: should be ""::tls::cipher name""",,,1
+Error Cases,Digests Too many args,,,::tls::digests too many args,,,"wrong # args: should be ""::tls::digests ?name?""",,,1
+Error Cases,MACs Too many args,,,::tls::macs too many args,,,"wrong # args: should be ""::tls::macs""",,,1
+Error Cases,Protocols Too many args,,,::tls::protocols too many args,,,"wrong # args: should be ""::tls::protocols""",,,1
+Error Cases,Version Too many args,,,::tls::version too many args,,,"wrong # args: should be ""::tls::version""",,,1
ADDED tests/info.test
Index: tests/info.test
==================================================================
--- /dev/null
+++ tests/info.test
@@ -0,0 +1,234 @@
+# Auto generated test cases for info.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
+
+# 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
+source common.tcl
+
+# 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 exec_get_pks {} {set list [list];set data [exec openssl list -public-key-methods];foreach line [split $data "\n"] {if {![string match "*Type:*" $line]} {lappend list [string trim $line]}};return $list}
+proc exec_get_macs {} {return [list cmac hmac]}
+proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result}
+
+# Test list ciphers
+
+
+test Ciphers_List-1.1 {All} -body {
+ lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]]
+ } -result {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}}
+
+# Test list ciphers for protocols
+
+
+test Ciphers_By_Protocol-2.1 {SSL2} -constraints {ssl2} -body {
+ lcompare [exec_get ":" ciphers -ssl2] [::tls::ciphers ssl2]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.2 {SSL3} -constraints {ssl3} -body {
+ lcompare [exec_get ":" ciphers -ssl3] [::tls::ciphers ssl3]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.3 {TLS1.0} -constraints {tls1} -body {
+ lcompare [exec_get ":" ciphers -tls1] [::tls::ciphers tls1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.4 {TLS1.1} -constraints {tls1.1} -body {
+ lcompare [exec_get ":" ciphers -tls1_1] [::tls::ciphers tls1.1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.5 {TLS1.2} -constraints {tls1.2} -body {
+ lcompare [exec_get ":" ciphers -tls1_2] [::tls::ciphers tls1.2]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-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 Ciphers_With_Descriptions-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 Ciphers_With_Descriptions-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 Ciphers_With_Descriptions-3.3 {TLS1.0} -constraints {tls1} -body {
+ lcompare [exec_get "\r\n" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_With_Descriptions-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 Ciphers_With_Descriptions-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 Ciphers_With_Descriptions-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 Ciphers_Protocol_Specific-4.1 {SSL2} -constraints {ssl2} -body {
+ lcompare [exec_get ":" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_Protocol_Specific-4.2 {SSL3} -constraints {ssl3} -body {
+ lcompare [exec_get ":" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_Protocol_Specific-4.3 {TLS1.0} -constraints {tls1} -body {
+ lcompare [exec_get ":" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_Protocol_Specific-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 Ciphers_Protocol_Specific-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 Ciphers_Protocol_Specific-4.6 {TLS1.3} -constraints {tls1.3} -body {
+ lcompare [exec_get ":" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]
+ } -result {missing {} unexpected {}}
+
+# Ciphers Error Cases
+
+
+test Ciphers_Errors-5.1 {Too many args} -body {
+ ::tls::ciphers too many args to pass
+ } -result {wrong # args: should be "::tls::ciphers ?protocol? ?verbose? ?supported?"} -returnCodes {1}
+
+test Ciphers_Errors-5.2 {Invalid protocol} -body {
+ ::tls::ciphers bogus
+ } -result {bad protocol "bogus": must be ssl2, ssl3, tls1, tls1.1, tls1.2, or tls1.3} -returnCodes {1}
+
+test Ciphers_Errors-5.3 {Invalid verbose} -body {
+ ::tls::ciphers tls1.3 bogus
+ } -result {expected boolean value but got "bogus"} -returnCodes {1}
+
+test Ciphers_Errors-5.4 {Invalid supported} -body {
+ ::tls::ciphers tls1.3 1 bogus
+ } -result {expected boolean value but got "bogus"} -returnCodes {1}
+
+test Ciphers_Errors-5.5 {SSL2} -constraints {!ssl2} -body {
+ ::tls::ciphers ssl2
+ } -result {ssl2: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.6 {SSL3} -constraints {!ssl3} -body {
+ ::tls::ciphers ssl3
+ } -result {ssl3: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.7 {TLS1.0} -constraints {!tls1} -body {
+ ::tls::ciphers tls1
+ } -result {tls1: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.8 {TLS1.1} -constraints {!tls1.1} -body {
+ ::tls::ciphers tls1.1
+ } -result {tls1.0: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.9 {TLS1.2} -constraints {!tls1.2} -body {
+ ::tls::ciphers tls1.2
+ } -result {tls1.1: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.10 {TLS1.3} -constraints {!tls1.3} -body {
+ ::tls::ciphers tls1.3
+ } -result {tls1.3: protocol not supported} -returnCodes {1}
+
+# Test Cipher Info
+
+
+test Cipher_Info-6.1 {AES-256-CCM} -body {
+ tls::cipher aes-256-ccm
+ } -result {nid aes-256-ccm name id-aes256-CCM description {} block_size 1 key_length 32 iv_length 12 type aes-256-ccm provider {} mode CCM flags {{Variable Length} 0 {Always Call Init} 1 {Custom IV} 1 {Control Init} 1 {Custom Cipher} 1 {AEAD Cipher} 1 {Custom Copy} 1 {Non FIPS Allow} 0}}
+
+# Test list digests
+
+
+test Digests_List-7.1 {All} -body {
+ lcompare [lsort [exec_get_digests]] [lsort [tls::digests]]
+ } -result {missing {} unexpected {}}
+
+# Test Digest Info
+
+
+test Digest_Info-8.1 {md5} -body {
+ tls::digests md5
+ } -result {name MD5 description {} size 16 block_size 64 provider {} type md5 pkey_type md5WithRSAEncryption flags {One-shot 0 XOF 0 DigestAlgorithmId_NULL 0 DigestAlgorithmId_Abscent 0 DigestAlgorithmId_Custom 0 FIPS 0}}
+
+# Test list MACs
+
+
+test MAC_List-9.1 {All} -body {
+ lcompare [exec_get_macs] [tls::macs]
+ } -result {missing {} unexpected {}}
+
+# Test list protocols
+
+
+test Protocols-10.1 {All} -body {
+ lcompare $::protocols [::tls::protocols]
+ } -result {missing {ssl2 ssl3} unexpected {}}
+
+# Test show version
+
+
+test Version-11.1 {All} -body {
+ ::tls::version
+ } -match {glob} -result {*}
+
+test Version-11.2 {OpenSSL} -constraints {OpenSSL} -body {
+ ::tls::version
+ } -match {glob} -result {OpenSSL*}
+
+# Error Cases
+
+
+test Error_Cases-12.1 {Cipher Too few args} -body {
+ ::tls::cipher
+ } -result {wrong # args: should be "::tls::cipher name"} -returnCodes {1}
+
+test Error_Cases-12.2 {Cipher Too many args} -body {
+ ::tls::cipher too many args
+ } -result {wrong # args: should be "::tls::cipher name"} -returnCodes {1}
+
+test Error_Cases-12.3 {Digests Too many args} -body {
+ ::tls::digests too many args
+ } -result {wrong # args: should be "::tls::digests ?name?"} -returnCodes {1}
+
+test Error_Cases-12.4 {MACs Too many args} -body {
+ ::tls::macs too many args
+ } -result {wrong # args: should be "::tls::macs"} -returnCodes {1}
+
+test Error_Cases-12.5 {Protocols Too many args} -body {
+ ::tls::protocols too many args
+ } -result {wrong # args: should be "::tls::protocols"} -returnCodes {1}
+
+test Error_Cases-12.6 {Version Too many args} -body {
+ ::tls::version too many args
+ } -result {wrong # args: should be "::tls::version"} -returnCodes {1}
+
+# Cleanup
+::tcltest::cleanupTests
+return
Index: tests/make_test_files.tcl
==================================================================
--- tests/make_test_files.tcl
+++ tests/make_test_files.tcl
@@ -72,11 +72,15 @@
set prev $group
puts $out ""
}
# Test case
- set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name]
+ if {[string index $name 0] ne {$}} {
+ set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name]
+ } else {
+ 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"
@@ -85,11 +89,11 @@
}
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 \[ \" \{]} {
+ 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 "}"
@@ -101,10 +105,11 @@
}
puts $out $buffer
} else {
# Empty line
+ puts $out ""
}
break
}
}
Index: win/makefile.vc
==================================================================
--- win/makefile.vc
+++ win/makefile.vc
@@ -25,20 +25,24 @@
# Note the resource file does not makes sense if doing a static library build
# hence it is under that condition. TMP_DIR is the output directory
# defined by rules for object files.
PRJ_OBJS = $(TMP_DIR)\tls.obj \
$(TMP_DIR)\tlsBIO.obj \
+ $(TMP_DIR)\tlsDigest.obj \
+ $(TMP_DIR)\tlsEncrypt.obj \
+ $(TMP_DIR)\tlsInfo.obj \
$(TMP_DIR)\tlsIO.obj \
$(TMP_DIR)\tlsX509.obj
# Define any additional project include flags
# SSL_INSTALL_FOLDER = with the OpenSSL installation folder following.
PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -I"$(OPENSSL_INSTALL_DIR)\include"
# Define any additional compiler flags that might be required for the project
PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS
-
+
+#
# SSL Libs:
# 1. ${LIBCRYPTO}.dll
# 2. ${LIBSSL}.dll
# Where LIBCRYPTO (#1.) and LIBSSL (#2.) are defined as follows:
# v1.1: libcrypto-1.1-x64.dll and libssl-1.1-x64.dll
@@ -53,10 +57,14 @@
# Define the standard targets
!include "targets.vc"
# Project specific targets
+all:
+
+clean: default-clean
+
# We must define a pkgindex target that will create a pkgIndex.tcl
# file in the $(OUT_DIR) directory. We can just redirect to the
# default-pkgindex target for our sample extension.
pkgindex: default-pkgindex