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: |
5b864605ad1cad604ebca8e8db8760f9 |
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
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 | # 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} | > > > | 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 | 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 {}} | > > > | 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 | 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 {}} | > | 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 | 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 {}} | > | 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 | 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 {*} | > | 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 | # # Name: Make Test Files From CSV Files | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | < | < < < < < < < < < < < < < < < < < > | > > > > | > > | 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.3 # Date: March 9, 2024 # Author: Brian O'Hagan # Email: [email protected] # 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 } 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 \[ \" \{ \$]} { 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 |