more tests and some fixes

2 files changed, 27 insertions, 8 deletions

diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl
index 3df52f0..e1d5fe4 100644
--- a/library/http/cookiejar.tcl
+++ b/library/http/cookiejar.tcl
@@ -234,12 +234,15 @@ package provide cookiejar $::http::cookiejar_version
     method InitDomainList {} {
 	upvar 0 ::http::cookiejar_offline offline
 	if {!$offline} {
-	    set data [my GetDomainListOnline]
-	    if {[string length $data]} {
-		my InstallDomainData $data
-		return
+	    try {
+		set data [my GetDomainListOnline]
+		if {[string length $data]} {
+		    my InstallDomainData $data
+		    return
+		}
+	    } on error {} {
+		log warn "attempting to fall back to built in version"
 	    }
-	    log warn "attempting to fall back to built in version"
 	}
 	my InstallDomainData [my GetDomainListOffline]
     }
@@ -317,8 +320,13 @@ package provide cookiejar $::http::cookiejar_version
     }
 
     destructor {
-	after cancel $aid
-	db close
+	catch {
+	    after cancel $aid
+	}
+	catch {
+	    db close
+	}
+	return
     }
 
     method GetCookiesForHostAndPath {listVar secure host path fullhost} {
@@ -378,11 +386,22 @@ package provide cookiejar $::http::cookiejar_version
 
     method BadDomain options {
 	if {![dict exists $options domain]} {
+	    log error "no domain present in options"
 	    return 0
 	}
 	dict with options {}
 	if {$domain ne $origin} {
 	    log debug "cookie domain varies from origin ($domain, $origin)"
+	    if {[string match .* $domain]} {
+		set dotd $domain
+	    } else {
+		set dotd .$domain
+	    }
+	    if {![string equal -length [string length $dotd] \
+		    [string reverse $dotd] [string reverse $origin]]} {
+		log warn "bad cookie: domain not suffix of origin"
+		return 1
+	    }
 	}
 	if {![regexp {[^0-9.]} $domain]} {
 	    if {$domain eq $origin} {
diff --git a/library/http/idna.tcl b/library/http/idna.tcl
index 7dfb968..53e45ca 100644
--- a/library/http/idna.tcl
+++ b/library/http/idna.tcl
@@ -25,7 +25,7 @@ namespace eval ::tcl::idna {
 	# Split term from RFC 3490, Sec 3.1
 	foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
 	    if {[regexp {[^-A-Za-z0-9]} $part]} {
-		if {[regexp {[^-A-Za-z0-9\u0100-\uffff]} $part ch]} {
+		if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} {
 		    scan $ch %c c
 		    if {$ch < "!" || $ch > "~"} {
 			set ch [format "\\u%04x" $c]