TclTLS
Check-in [89706c884d]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
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: 89706c884d5d32f1da6a9ca9aca771975e0028bd19b4b7405cd2c4172b4e731d
User & Date: bohagan on 2024-03-10 05:06:00
Other Links: branch diff | manifest | tags
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
Side-by-Side Diff Ignore Whitespace Patch
Modified tests/badssl.csv from [f294744529] to [7b5b675a52]. 
1
2
3
4
5
6
7






8














9
10
11
12
13
14
15

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
    }
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}}",,,,,,,,,
    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
︙
Modified tests/badssl.test from [0bf5ddad0c] to [e09b8a9787].
︙
10
11
12
13
14
15
16






17














18
19
20
21
22
23
24

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
    }
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}}
    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}
︙
Modified tests/digest.csv from [3371cf815e] to [f8d5498d86]. 
1
2
3
4
5
6
7
8
9
10
11






























12
13
14
15
16
17
18

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]},$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},,,,,,,,
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,,,,,,,,,
,,,,,,,,,,
︙
Modified tests/digest.test from [cdebbb86d7] to [141e7b6f90].
︙
11
12
13
14
15
16
17
18
19
20






























21
22
23
24
25
26
27

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]}
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
︙
Modified tests/encrypt.csv from [a8fd540f67] to [d5071e261f]. 
1
2
3
4
5
6
7
8
9














































10
11
12
13
14
15
16

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]}",$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,"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""",,,,,,,,,
︙
Modified tests/encrypt.test from [30ef9b5ec2] to [0f4562d9a7]. 
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

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}
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"
︙
Modified tests/info.csv from [3df08db6b4] to [dacbd09ea3].
︙
20
21
22
23
24
25
26

27



28
29
30
31
32
33
34

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} {
command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,,
    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

66



67
68
69
70
71
72
73

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 {} {
command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,,
    return [list cmac hmac]
}
",,,,,,,,,
command,"proc list_tolower {list} {
    set result [list]
    foreach element $list {
        lappend result [string tolower $element]
    }
    return $result
}
︙
Modified tests/info.test from [855ee5e7e2] to [609f78c567].
︙
29
30
31
32
33
34
35
36




37
38
39
40
41
42
43

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 {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
75




76
77
78
79
80
81
82

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 exec_get_macs {} {
    return [list cmac hmac]
}

proc list_tolower {list} {
    set result [list]
    foreach element $list {
        lappend result [string tolower $element]
    }
    return $result
}
︙
Modified tests/make_test_files.tcl from [862f168c9a] to [17625961d8].
︙
70
71
72
73
74
75
76

77
78
79
80
81
82
83

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
︙
Powered by Fossil · RSS