Diff
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

Differences From Artifact [a0240c6935]:

To Artifact [79b8785f12]:


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
#
# Test Vectors
#















#
# Create test case and output to test file
#
proc do_test {group cipher test_num tc params fn} {
    array set config [list Key "" IV "" Msg "" Repeat 1 Length ""]
    array set config $params

    # Test info
    set line [format "tcltest::test %s-%d.%d {%s %s} \\\n\t" $group $test_num $tc [string totitle $fn] $cipher]

    # Test constraints
    append line [format "-constraints %s \\\n\t" [string map [list "-" "_"] $cipher]]

    # Test body
    set cmd [format "tls::%s -cipher %s -padding 0 \\\n\t\t" $fn $cipher]

    if {$fn eq "encrypt"} {
	set list1 [list Msg Data Plaintext PLAINTEXT]
	set list2 [list Output Ciphertext CIPHERTEXT]
    } else {
	set list1 [list Output Ciphertext CIPHERTEXT]
	set list2 [list Msg Data Plaintext PLAINTEXT]
    }

    # Add test parameters
    foreach {param names type} [list -key [list Key key KEY] s -iv [list IV iv] s -data $list1 s] {
	foreach name $names {
	    if {[info exists config($name)]} {
		set data $config($name)
		# Handle hex string
		if {$type eq "s" && [string length $data] > 0 && [string index $data 0] ne "\""} {
		    set data [format {[binary decode hex %s]} $data]
		}
		if {[string length $data] > 0} {
		    append cmd " " $param " " $data " \\\n\t\t"
		}

	    }
	}
    }
    append line [format {-body {binary encode hex [%s]}} [string trimright $cmd " \\\n\t"]]
    append line " \\\n\t"

    # Test cleanup

    # Test result
    set result ""
    foreach key $list2 {
	if {[info exists config($key)]} {
	    set result $config($key)
	    # Convert hex to lowercase
	    if {[string index $result 0] ne "\""} {
		set result [string tolower $result]
	    }
	}
    }
    
    append line [format {-match exact -result %s} $result]

    # Return codes
    #append line { -returnCodes 0}
    return $line
}

#




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




|












|
|

|
|



|


|
<
<
<
<
|


>









<


|
<
<
|
|
|
<
<
<







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
#
# Test Vectors
#

#
# Get string or hex string value
#
proc get_value {type data {count 1}} {
    # Handle hex string
    if {$type eq "s" && [string length $data] > 0 && [string index $data 0] ne "\""} {
	set data [format {[binary decode hex %s]} $data]
    }
    if {$type eq "s" && $count > 1} {
	set data [format {[string repeat %s %d]} $data $count]
    }
    return $data
}

#
# Create test case and output to test file
#
proc do_test {group cipher test_num tc params fn} {
    array set config [list repeat 1]
    array set config $params

    # Test info
    set line [format "tcltest::test %s-%d.%d {%s %s} \\\n\t" $group $test_num $tc [string totitle $fn] $cipher]

    # Test constraints
    append line [format "-constraints %s \\\n\t" [string map [list "-" "_"] $cipher]]

    # Test body
    set cmd [format "tls::%s -cipher %s -padding 0 \\\n\t\t" $fn $cipher]

    if {$fn eq "encrypt"} {
	set list1 [list plaintext msg data]
	set list2 [list ciphertext output result]
    } else {
	set list1 [list ciphertext output result]
	set list2 [list plaintext msg data]
    }

    # Add test parameters
    foreach {param names type} [list -key [list key] s -iv [list iv nonce] s -data $list1 s] {
	foreach name $names {
	    if {[info exists config($name)]} {
		set data [get_value $type $config($name)]




		if {$data ne ""} {
		    append cmd " " $param " " $data " \\\n\t\t"
		}
		break
	    }
	}
    }
    append line [format {-body {binary encode hex [%s]}} [string trimright $cmd " \\\n\t"]]
    append line " \\\n\t"

    # Test cleanup

    # Test result

    foreach key $list2 {
	if {[info exists config($key)]} {
	    append line [format {-match exact -result %s} [string tolower $config($key)]]


	    break
	}
    }




    # Return codes
    #append line { -returnCodes 0}
    return $line
}

#
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130


131
132
133
134
135
136
137

	} else {
	    # Append args to params
	    set index [string first "=" $line]
	    if {$index > -1} {
		set key [string trim [string range $line 0 [expr {$index - 1}]]]
		set value [string trim [string range $line [expr {$index + 1}] end]]
		lappend params $key $value
	    }
	}
    }

    # Handle last test case
    if {[llength $params] > 0} {
	puts $out [do_test $group $cipher $test_num [incr tc] $params]


	puts $out ""
    }
    
    # Cleanup
    puts $out "# Cleanup\n::tcltest::cleanupTests\nreturn"
    close $ch
    close $out







|






|
>
>







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

	} else {
	    # Append args to params
	    set index [string first "=" $line]
	    if {$index > -1} {
		set key [string trim [string range $line 0 [expr {$index - 1}]]]
		set value [string trim [string range $line [expr {$index + 1}] end]]
		lappend params [string tolower $key] $value
	    }
	}
    }

    # Handle last test case
    if {[llength $params] > 0} {
	puts $out [do_test $group $cipher $test_num [incr tc] $params encrypt]
	puts $out ""
	puts $out [do_test $group $cipher $test_num [incr tc] $params decrypt]
	puts $out ""
    }
    
    # Cleanup
    puts $out "# Cleanup\n::tcltest::cleanupTests\nreturn"
    close $ch
    close $out