TclTLS
Check-in [5b864605ad]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:Updated make test scripts tool to better embed TCL procedures and handle quoted data
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 5b864605ad1cad604ebca8e8db8760f9d372bb4a22538f35aec26886371241df
User & Date: bohagan on 2024-03-10 03:09:54
Other Links: manifest | tags
Context
2024-03-10
03:32
Reformatted test cases check-in: f9d486f0f0 user: bohagan tags: trunk
03:09
Updated make test scripts tool to better embed TCL procedures and handle quoted data check-in: 5b864605ad user: bohagan tags: trunk
02:15
Back port doc and all test updates from crypto branch check-in: ceb434bb23 user: bohagan tags: trunk
Changes
Side-by-Side Diff Ignore Whitespace Patch
Modified tests/badssl.test from [952cadb5d3] to [0bf5ddad0c]. 
1
2
3
4
5
6
7
8
9
10
11

12
13

14
15

16
17
18
19
20
21
22

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












+


+


+








# Auto generated test cases for badssl.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 [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}
︙
Modified tests/ciphers.test from [3c7cdcefd5] to [dc4d964ab4].
︙
14
15
16
17
18
19
20

21
22
23

24
25
26
27
28
29

30
31
32
33
34
35
36

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








+



+






+








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 {}}
︙
49
50
51
52
53
54
55

56
57
58
59
60
61
62

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66








+








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 {}}
︙
75
76
77
78
79
80
81

82
83
84
85
86
87
88

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93








+








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 {}}
︙
101
102
103
104
105
106
107

108
109
110
111
112
113
114

106
107
108
109
110
111
112
113
114
115
116
117
118
119
120








+








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 {*}
︙
Modified tests/make_test_files.tcl from [c31b96320d] to [862f168c9a]. 
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
67
68
69
70
71
72
73
74
75
76

77





78
79
80
81
82
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105

106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

121
122
123

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
67
68
69
70

71
72
73
74
75
76
77

78
79
80
81

82
83
84
85
86
87

88
89
90
91
92
93

94

95
















96
97
98
99

100
101
102
103
104
105
106
107
108
109
110
111

112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164



-
-
+
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+






-
+



-
+





-
+





-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-











+
-
+
+
+
+
+












-
+















+















+




#
# Name:		Make Test Files From CSV Files
# Version:	0.2
# Date:		August 6, 2022
# Version:	0.3
# Date:		March 9, 2024
# Author:	Brian O'Hagan
# Email:	brian199@comcast.net
# Legal Notice:	(c) Copyright 2020 by Brian O'Hagan
#		Released under the Apache v2.0 license. I would appreciate a copy of any modifications
#		made to this package for possible incorporation in a future release.
#

#
# Parse CSV line
#
proc parse_csv {ch data} {
    set buffer ""
    set result [list]
    set start 0
    set end [string length $data]

    while {$start < $end} {
	if {[string index $data $start] eq "\""} {
	    # Quoted
	    if {[set index [string first "\"" $data [incr start]]] > -1} {
		set next [string index $data [expr {$index + 1}]]
		if {$next eq "\""} {
		    # Quote
		    append buffer [string range $data $start $index]
		    set start [incr index]

		} else {
		    # End of quoted data
		    append buffer [string range $data $start [incr index -1]]
		    set start [incr index 3]
		    lappend result $buffer
		    set buffer ""
		}

	    } else {
		# Multi-line
		append buffer [string range $data $start end] "\n"
		gets $ch new
		set data "\""
		append data $new
		set start 0
		set end [string length $data]
	    }

	} else {
	    # Not quoted, so no embedded NL, quotes, or commas
	    set index [string first "," $data $start]
	    if {$index > -1} {
		lappend result [string range $data $start [incr index -1]]
		set start [incr index 2]
	    } else {
		lappend result [string range $data $start end]
		set start [string length $data]
	    }
	}
    }
    return $result
}

#
# Convert test case file into test files
#
proc process_config_file {filename} {
    set prev ""
    set test 0

    # Open file with test case indo    
    # Open file with test case indo
    set in [open $filename r]
    array set cases [list]

    # Open output test file
    set out [open [format %s.test [file rootname $filename]] w]
    array set cases [list]
    

    # Add setup commands to test file
    puts $out [format "# Auto generated test cases for %s" [file tail $filename]]
    #puts $out [format "# Auto generated test cases for %s created on %s" [file tail $filename] [clock format [clock seconds]]]
    

    # Package requires
    puts $out "\n# Load Tcl Test package"
    puts $out [subst -nocommands {if {[lsearch [namespace children] ::tcltest] == -1} {\n\tpackage require tcltest\n\tnamespace import ::tcltest::*\n}\n}]
    puts $out {set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]}
    puts $out ""
    

    # Generate test cases and add to test file
    while {[gets $in data] > -1} {
	# Skip comments
	set data [string trim $data]
	if {[string match "#*" $data]} continue

	# Split comma separated fields with quotes
	set list [list]
	set list [parse_csv $in $data]
	while {[string length $data] > 0} {
	    if {[string index $data 0] eq "\""} {
		# Quoted
		set end [string first "\"," $data]
		if {$end == -1} {set end [expr {[string length $data]+1}]}
		lappend list [string map [list {""} \"] [string range $data 1 [incr end -1]]]
		set data [string range $data [incr end 3] end]
		
	    } else {
		# Not quoted, so no embedded NL, quotes, or commas
		set index [string first "," $data]
		if {$index == -1} {set index [expr {[string length $data]+1}]}
		lappend list [string range $data 0 [incr index -1]]
		set data [string range $data [incr index 2] end]
	    }
	}

	# Get command or test case
	foreach {group name constraints setup body cleanup match result output errorOutput returnCodes} $list {
	    if {$group eq "command"} {
		# Pass-through command
		puts $out $name

	    } elseif {$group ne "" && $body ne ""} {
		set group [string map [list " " "_"] $group]
		if {$group ne $prev} {
		    incr test
		    set prev $group
		    puts $out ""
		}

		# Test case
		if {[string index $name 0] ne {$}} {
		set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name]
		    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"
			    foreach line [split $cmd ";"] {
				append buffer \t [string trim $line] \n
			    }
			    append buffer "    \}"
			} elseif {$opt in [list -output -errorOutput]} {
			    append buffer " " $opt " {" $cmd \n "}"
			} elseif {$opt in [list -result]} {
			    if {[string index $cmd 0] in [list \[ \" \{]} {
			    if {[string index $cmd 0] in [list \[ \" \{ \$]} {
				append buffer " " $opt " " $cmd
			    } elseif {[string match {*[\\$]*} $cmd]} {
				append buffer " " $opt " \"" [string map [list \\\\\" \\\"] [string map [list \" \\\" ] $cmd]] "\""
			    } else {
				append buffer " " $opt " {" $cmd "}"
			    }
			} else {
			    append buffer " " $opt " {" $cmd "}"
			}
		    }
		}
		puts $out $buffer

	    } else {
		# Empty line
		puts $out ""
	    }
	    break
	}
    }

    # Output clean-up commands
    puts $out "\n# Cleanup\n::tcltest::cleanupTests\nreturn"
    close $out
    close $in
}

#
# Call script
#
foreach file [glob *.csv] {
puts $file
    process_config_file $file
}
exit
Powered by Fossil · RSS