# 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

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