TclTLS
Check-in [e650e24320]
Login
HomeTimelineBranchesTagsTicketsWiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

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 | crypto
Files: files | file ages | folders
SHA3-256: e650e24320cfd832f922067f8cf747748f4c07129a711b6d85c23c9399691c71
User & Date: bohagan 2024-03-10 04:27:18
Context
2024-03-10
04:44
Updated test comparisons to handle OpenSSL 3 format data check-in: ae4bd8026c user: bohagan tags: crypto
04:27
Updated make test scripts tool to better embed TCL procedures and handle quoted data check-in: e650e24320 user: bohagan tags: crypto
01:27
Windows makefile update to add realclean target and correct pkgIndex target check-in: ae7ba9d447 user: bohagan tags: crypto
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/info.csv. 

1
2
3
4
5
6
7
8
9
10
11















12
13











14











15










16



17




18
19
20
21
22
23
24

# 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 [file join [file dirname [info script]] 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_pkeys {} {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}",,,,,,,,,










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 {},,,











|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>

>
>
>
|
>
>
>
>








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

# 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 [file join [file dirname [info script]] 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""] {
        set line [string trim $line]
        foreach {cipher ptr 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_pkeys {} {
    set list [list]
    set data [exec openssl list -public-key-methods]
    foreach line [split $data ""\n""] {
        set line [string trim $line]
        if {[string match ""Type:*"" $line]} continue
        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
}
",,,,,,,,,
,,,,,,,,,,
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 {},,,
︙︙

Changes to tests/info.test.

︙︙
13
14
15
16
17
18
19
20















21











22











23


24








25
26







27
28
29
30
31
32
33

# 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 [file join [file dirname [info script]] 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_pkeys {} {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}}








|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
|
>
>
|
>
>
>
>
>
>
>
>

|
>
>
>
>
>
>
>








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

# 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 [file join [file dirname [info script]] 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"] {
        set line [string trim $line]
        foreach {cipher ptr 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_pkeys {} {
    set list [list]
    set data [exec openssl list -public-key-methods]
    foreach line [split $data "\n"] {
        set line [string trim $line]
        if {[string match "Type:*" $line]} continue
        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}}
︙︙

Changes to tests/make_test_files.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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

82
83
84
85
86
87
88

#
# Name:		Make Test Files From CSV Files
# Version:	0.2
# Date:		August 6, 2022
# 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.
#





















































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

    # 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]
	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]
		} 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



|
|







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







|






|



|





|





<

|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




<
















>








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

#
# Name:		Make Test Files From CSV Files
# 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
    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 [parse_csv $in $data]

















	# Get command or test case
	foreach {group name constraints setup body cleanup match result output errorOutput returnCodes} $list {
	    if {$group eq "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]
		} 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
︙︙
119
120
121
122
123
124
125

126
127
128

    close $in
}

#
# Call script
#
foreach file [glob *.csv] {

    process_config_file $file
}
exit








>




154
155
156
157
158
159
160
161
162
163
164

    close $in
}

#
# Call script
#
foreach file [glob *.csv] {
puts $file
    process_config_file $file
}
exit

Powered by Fossil · RSS