Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Reformatted test case helper procedures | 
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive | 
| Timelines: | family | ancestors | descendants | both | crypto | 
| Files: | files | file ages | folders | 
| SHA3-256: | 89706c884d5d32f1da6a9ca9aca77197 | 
| User & Date: | bohagan 2024-03-10 05:06:00 | 
Context
| 2024-03-10 | ||
| 05:56 | Added global namespace qualifier to command names. Catch error for eval embedded tls.tcl script. check-in: c0bbfde5a4 user: bohagan tags: crypto | |
| 05:06 | Reformatted test case helper procedures check-in: 89706c884d user: bohagan tags: crypto | |
| 04:44 | Updated test comparisons to handle OpenSSL 3 format data check-in: ae4bd8026c user: bohagan tags: crypto | |
Changes
Changes to tests/badssl.csv.
| 1 2 3 4 5 6 7 | # Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes command,package require tls,,,,,,,,, ,,,,,,,,,, command,# Constraints,,,,,,,,, command,source [file join [file dirname [info script]] common.tcl],,,,,,,,, ,,,,,,,,,, command,# Helper functions,,,,,,,,, | > > > > > > | > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | 
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,source [file join [file dirname [info script]] common.tcl],,,,,,,,,
,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc badssl {url} {
    set port 443
    lassign [split $url "":""] url port
    if {$port eq """"} {
        set port 443
    }
    set cmd [list tls::socket -autoservername 1 -require 1]
    if {[info exists ::env(SSL_CERT_FILE)]} {
        lappend cmd -cafile $::env(SSL_CERT_FILE)
    }
    lappend cmd $url $port
    set ch [eval $cmd]
    if {[catch {tls::handshake $ch} err]} {
        close $ch
	return -code error $err
    } else {
        close $ch
    }
}
",,,,,,,,,
,,,,,,,,,,
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,,glob,handshake failed: * alert handshake failure,,,1
BadSSL,captive-portal,old_api,,badssl captive-portal.badssl.com,,,"handshake failed: certificate verify failed due to ""Hostname mismatch""",,,1
BadSSL,captive-portal,new_api,,badssl captive-portal.badssl.com,,,"handshake failed: certificate verify failed due to ""hostname mismatch""",,,1
 | 
| ︙ | ︙ | 
Changes to tests/badssl.test.
| ︙ | ︙ | |||
| 10 11 12 13 14 15 16 | package require tls # Constraints source [file join [file dirname [info script]] common.tcl] # Helper functions | > > > > > > | > > > > > > > > > > > > > | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | 
package require tls
# Constraints
source [file join [file dirname [info script]] common.tcl]
# Helper functions
proc badssl {url} {
    set port 443
    lassign [split $url ":"] url port
    if {$port eq ""} {
        set port 443
    }
    set cmd [list tls::socket -autoservername 1 -require 1]
    if {[info exists ::env(SSL_CERT_FILE)]} {
        lappend cmd -cafile $::env(SSL_CERT_FILE)
    }
    lappend cmd $url $port
    set ch [eval $cmd]
    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 {
	badssl 1000-sans.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}
 | 
| ︙ | ︙ | 
Changes to tests/digest.csv.
| 1 2 3 4 5 6 7 8 | 
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,"::tcltest::testConstraint md4 [expr {""md4"" in [::tls::digests]}]",,,,,,,,,
command,catch {tls::provider legacy},,,,,,,,,
,,,,,,,,,,
command,# Helper functions - See common.tcl,,,,,,,,,
 | | > > > > > > > > > > | > > > > > > > > > > > > > > | > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | 
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,"::tcltest::testConstraint md4 [expr {""md4"" in [::tls::digests]}]",,,,,,,,,
command,catch {tls::provider legacy},,,,,,,,,
,,,,,,,,,,
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]
}
",,,,,,,,
,,,,,,,,,,
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,,,,,,,,,
,,,,,,,,,,
 | 
| ︙ | ︙ | 
Changes to tests/digest.test.
| ︙ | ︙ | |||
| 11 12 13 14 15 16 17 | 
package require tls
# Constraints
::tcltest::testConstraint md4 [expr {"md4" in [::tls::digests]}]
catch {tls::provider legacy}
# Helper functions - See common.tcl
 | | > > > > > > > > > > | > > > > > > > > > > > | > > > > > > | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | 
package require tls
# Constraints
::tcltest::testConstraint md4 [expr {"md4" in [::tls::digests]}]
catch {tls::provider legacy}
# 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
 | 
| ︙ | ︙ | 
Changes to tests/encrypt.csv.
| 1 2 3 4 | # Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes command,package require tls,,,,,,,,, ,,,,,,,,,, command,# Helper functions - See common.tcl,,,,,,,,, | | > > > > > > > > > > > | > > > > > > > > > > > | > > > > > > > > > > > | > > | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | 
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
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]
}
",,,,,,,,
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""",,,,,,,,,
 | 
| ︙ | ︙ | 
Changes to tests/encrypt.test.
| 1 2 3 4 5 6 7 8 9 10 11 12 13 | 
# 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
# Helper functions - See common.tcl
 | | > > > > > > > > > > > | > > > > > > > > > > > > > > > | > > > | > > > > > > | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | 
# 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
# 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"
 | 
| ︙ | ︙ | 
Changes to tests/info.csv.
| ︙ | ︙ | |||
| 20 21 22 23 24 25 26 | 
        if {$i ni $list1} {
            lappend u $i
        }
    }
    return [list ""missing"" $m ""unexpected"" $u]
}
",,,,,,,,,
 | > | > > | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 | 
        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""] {
        set line [string trim $line]
        if {$line eq ""Legacy:""} continue
        if {$line eq ""Provided:""} break
 | 
| ︙ | ︙ | |||
| 59 60 61 62 63 64 65 | 
        if {$line eq ""Legacy:"" || [string match ""Type:*"" $line]} continue
        if {$line eq ""Provided:""} break
        lappend list [string trim $line]
    }
    return $list
}
",,,,,,,,,
 | > | > > | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | 
        if {$line eq ""Legacy:"" || [string match ""Type:*"" $line]} continue
        if {$line eq ""Provided:""} break
        lappend list [string trim $line]
    }
    return $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
}
 | 
| ︙ | ︙ | 
Changes to tests/info.test.
| ︙ | ︙ | |||
| 29 30 31 32 33 34 35 | 
        if {$i ni $list1} {
            lappend u $i
        }
    }
    return [list "missing" $m "unexpected" $u]
}
 | | > > > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | 
        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"] {
        set line [string trim $line]
        if {$line eq "Legacy:"} continue
        if {$line eq "Provided:"} break
 | 
| ︙ | ︙ | |||
| 68 69 70 71 72 73 74 | 
        if {$line eq "Legacy:" || [string match "Type:*" $line]} continue
        if {$line eq "Provided:"} break
        lappend list [string trim $line]
    }
    return $list
}
 | | > > > | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | 
        if {$line eq "Legacy:" || [string match "Type:*" $line]} continue
        if {$line eq "Provided:"} break
        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
}
 | 
| ︙ | ︙ | 
Changes to tests/make_test_files.tcl.
| ︙ | ︙ | |||
| 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | 
    # Open file with test case indo
    set in [open $filename r]
    array set cases [list]
    # Open output test file
    set out [open [format %s.test [file rootname $filename]] w]
    array set cases [list]
    # Add setup commands to test file
    puts $out [format "# Auto generated test cases for %s" [file tail $filename]]
    #puts $out [format "# Auto generated test cases for %s created on %s" [file tail $filename] [clock format [clock seconds]]]
    # Package requires
 | > | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | 
    # Open file with test case indo
    set in [open $filename r]
    array set cases [list]
    # Open output test file
    set out [open [format %s.test [file rootname $filename]] w]
    fconfigure $out -encoding utf-8 -translation {auto lf}
    array set cases [list]
    # Add setup commands to test file
    puts $out [format "# Auto generated test cases for %s" [file tail $filename]]
    #puts $out [format "# Auto generated test cases for %s created on %s" [file tail $filename] [clock format [clock seconds]]]
    # Package requires
 | 
| ︙ | ︙ |