diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2014-02-16 09:04:44 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2014-02-16 09:04:44 (GMT) |
| commit | 9b6ba772240147bd21bb1c4c0173ed2f4e794f84 (patch) | |
| tree | 7837739526b73801c521413565277384583500a1 /library/http | |
| parent | 1c6910c2ec785c4ed4dbd27ed84206e43c7186c6 (diff) | |
| download | tcl-9b6ba772240147bd21bb1c4c0173ed2f4e794f84.zip tcl-9b6ba772240147bd21bb1c4c0173ed2f4e794f84.tar.gz tcl-9b6ba772240147bd21bb1c4c0173ed2f4e794f84.tar.bz2 | |
extending the IDNA tests
Diffstat (limited to 'library/http')
| -rw-r--r-- | library/http/idna.tcl | 12 |
1 files changed, 9 insertions, 3 deletions
diff --git a/library/http/idna.tcl b/library/http/idna.tcl index a73d113..7dfb968 100644 --- a/library/http/idna.tcl +++ b/library/http/idna.tcl @@ -30,10 +30,15 @@ namespace eval ::tcl::idna { if {$ch < "!" || $ch > "~"} { set ch [format "\\u%04x" $c] } - throw [list IDNA INVALID_NAME_CHARACTER $c] \ + throw [list IDNA INVALID_NAME_CHARACTER $ch] \ "bad character \"$ch\" in DNS name" } set part xn--[punyencode $part] + # Length restriction from RFC 5890, Sec 2.3.1 + if {[string length $part] > 63} { + throw [list IDNA OVERLONG_PART $part] \ + "hostname part too long" + } } lappend parts $part } @@ -226,7 +231,7 @@ namespace eval ::tcl::idna { for {set oldi $i; set w 1; set k $base} 1 {incr in} { if {[set ch [string index $post $in]] eq ""} { - throw {PUNYCODE BAD_INPUT} "exceeded input data" + throw {PUNYCODE BAD_INPUT LENGTH} "exceeded input data" } if {[string match -nocase {[a-z]} $ch]} { scan [string toupper $ch] %c digit @@ -234,7 +239,8 @@ namespace eval ::tcl::idna { } elseif {[string match {[0-9]} $ch]} { set digit [expr {$ch + 26}] } else { - throw {PUNYCODE BAD_INPUT} "bad decode character \"$ch\"" + throw {PUNYCODE BAD_INPUT CHAR} \ + "bad decode character \"$ch\"" } incr i [expr {$digit * $w}] set t [expr {min(max($tmin, $k-$bias), $tmax)}] |