File: stringprep.test

package info (click to toggle)
tcllib 1.20%2Bdfsg-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 68,064 kB
  • sloc: tcl: 216,842; ansic: 14,250; sh: 2,846; xml: 1,766; yacc: 1,145; pascal: 881; makefile: 107; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (164 lines) | stat: -rw-r--r-- 6,074 bytes parent folder | download | duplicates (7)
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
# stringprep.test                                               -*- tcl -*-
#
#	Tests for the stringprep package.
#
# Copyright (c) 2007 Sergei Golovan
# Copyright (c) 2007 Pat Thoyts
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: stringprep.test,v 1.3 2009/11/02 00:26:44 patthoyts Exp $

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.3
testsNeedTcltest 1.0

testing {
    useLocalFile unicode_data.tcl
    useLocalFile unicode.tcl
    useLocalFile stringprep_data.tcl
    useLocalFile stringprep.tcl
}

# -------------------------------------------------------------------------
# Define two stringprep profiles

# IDN Nameprep: http://www.ietf.org/rfc/rfc3491.txt
::stringprep::register nameprep \
    -mapping {B.1 B.2} \
    -normalization KC \
    -prohibited {A.1 C.1.2 C.2.2 C.3 C.4 C.5 C.6 C.7 C.8 C.9} \
    -prohibitedBidi 1

# XMPP Nodeprep: http://www.ietf.org/rfc/rfc3920.txt
::stringprep::register nodeprep \
    -mapping {B.1 B.2} \
    -normalization KC \
    -prohibited {A.1 C.1.1 C.1.2 C.2.1 C.2.2 C.3 C.4 C.5 C.6 C.7 C.8 C.9} \
    -prohibitedList {0x22 0x26 0x27 0x2f 0x3a 0x3c 0x3e 0x40} \
    -prohibitedBidi 1

# -------------------------------------------------------------------------

test stringprep-1.1 {register: bad -mapping table} {
    catch {::stringprep::register type -mapping {B.4}} result
    set result
} {::stringprep::register -mapping: Only B.1, B.2, B.3 tables are allowed}

test stringprep-1.2 {register: bad -normalization option} {
    catch {::stringprep::register type -normalization KK} result
    set result
} {::stringprep::register -normalization: Only D, C, KD, KC or empty normalization is allowed}

test stringprep-1.3 {register: bad -prohibited table} {
    catch {::stringprep::register type -prohibited {B.1}} result
    set result
} {::stringprep::register -prohibited: Only tables A.1, C.* are allowed to prohibit}

test stringprep-1.4 {register: bad -prohibited table 2} {
    catch {::stringprep::register type -prohibited {C.4}} result
    set result
} {::stringprep::register -prohibited: Must prohibit all C.3--C.9 tables or none of them}

test stringprep-1.5 {register: bad -prohibitedList list} {
    catch {::stringprep::register type -prohibitedList {1 2 3 a b c}} result
    set result
} {::stringprep::register -prohibitedList: List of integers expected}

test stringprep-1.6 {register: bad -prohibitedBidi value} {
    catch {::stringprep::register type -prohibitedBidi yesss} result
    set result
} {::stringprep::register -prohibitedBidi: Boolean value expected}

test stringprep-2.1 {stringprep: bad profile} {
    catch {::stringprep::stringprep unknown ""} result
    set result
} {invalid_profile}

test stringprep-2.2 {stringprep: prohibited character} {
    catch {::stringprep::stringprep nodeprep "user@host"} result
    set result
} {prohibited_character}

test stringprep-2.3 {stringprep: prohibited bidi} {
    catch {::stringprep::stringprep nameprep "\u0627\u0031"} result
    set result
} {prohibited_bidi}


# -------------------------------------------------------------------------
# nameprep test vectors
#  http://www.gnu.org/software/libidn/draft-josefsson-idn-test-vectors.html
#
# list of: comment, input, output

set vectors {
    { "Map to nothing"
        "foo\xC2\xAD\xCD\x8F\xE1\xA0\x86\xE1\xA0\x8B.bar\xE2\x80\x8B\xE2\x81\xA0.baz\xEF\xB8\x80\xEF\xB8\x88\xEF\xB8\x8F\xEF\xBB\xBF"
        "foo.bar.baz" }
    { "Case folding ASCII U+0043 U+0041 U+0046 U+0045" "CAFE" "cafe" }
    { "Case folding 8bit U+00DF (german sharp s)" "\xC3\x9F" "ss" }
    { "Case folding U+0130 (turkish capital I with dot)" "\xC4\xB0" "i\xcc\x87" }
    { "Case folding multibyte U+0143 U+037A" "\xC5\x83\xCD\xBA" "\xC5\x84 \xCE\xB9" }
    { "Case folding U+2121 U+33C6 U+1D7BB (Tcl cannot represent U+1D7BB)"
	"\xE2\x84\xA1\xE3\x8F\x86\xF0\x9D\x9E\xBB"
        "telc\xE2\x88\x95kg\xCF\x83" }
    { "Normalization of U+006a U+030c U+00A0 U+00AA" "\x6A\xCC\x8C\xC2\xA0\xC2\xAA"
        "\xC7\xB0 a" }
    { "Case folding U+1FB7 and normalization" "\xE1\xBE\xB7" "\xE1\xBE\xB6\xCE\xB9" }
    { "Case folding U+2121 U+33C6" "\xE2\x84\xA1\xE3\x8F\x86"
        "telc\xE2\x88\x95kg" }
}

set id 0
foreach vector $vectors {
    foreach {comment input output} $vector break

    if {$id == 5} {
	test nameprep-$id $comment knownBug {
	    list [catch {::stringprep::stringprep nameprep \
			     [encoding convertfrom utf-8 $input]} res] $res
	} [list 0 [encoding convertfrom utf-8 $output]]
    } else {
	test nameprep-$id $comment {
	    list [catch {::stringprep::stringprep nameprep \
			     [encoding convertfrom utf-8 $input]} res] $res
	} [list 0 [encoding convertfrom utf-8 $output]]
    }
    incr id
}

# -------------------------------------------------------------------------
# SASLPrep: http://www.ietf.org/rfc/rfc4013.txt

::stringprep::register saslprep \
    -mapping {B.1} \
    -normalization KC \
    -prohibited {A.1 C.1.2 C.2.1 C.2.2 C.3 C.4 C.5 C.6 C.7 C.8 C.9} \
    -prohibitedBidi 1

foreach {n input result title} {
    1  "I\u00ADX"     {0 IX}         "SOFT HYPHEN mapped to nothing"
    2  "user"         {0 user}       "no transformation"
    3  "USER"         {0 USER}       "case preserved, will not match #2"
    4  "\u00AA"       {0 a}          "output is NFKC, input in ISO 8859-1"
    5  "\u2168"       {0 IX}         "output is NFKC, will match #1"
    6  "\u0007"       {1 prohibited_character} "Error - prohibited character"
    7  "\u0627\u0031" {1 prohibited_bidi} "Error - bidirectional check"
} {
    test saslprep-1.$n $title {
	list [catch {::stringprep::stringprep saslprep $input} res] $res
    } $result
}

# -------------------------------------------------------------------------

::tcltest::cleanupTests

# -------------------------------------------------------------------------