Mercurial > hg > egg-tcls
changeset 328:b3fded816ad8
Merged.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Wed, 03 Jun 2015 18:51:42 +0300 |
parents | a5282cdc56e6 (diff) fe12434d6cbd (current diff) |
children | 50d47bdd4425 |
files | |
diffstat | 2 files changed, 31 insertions(+), 17 deletions(-) [+] |
line wrap: on
line diff
--- a/urllog.tcl Thu May 21 10:00:59 2015 +0300 +++ b/urllog.tcl Wed Jun 03 18:51:42 2015 +0300 @@ -282,11 +282,12 @@ } #------------------------------------------------------------------------- -proc urllog_validate_url { urlNick urlChan urlMStr urlMProto } { +proc urllog_validate_url { urlNick urlChan urlMStr urlMProto urlMHostName } { global urllog_tld_list urlmsg_nosuchhost urllog_httprep urlmsg_unknown_tld global urllog_shorturl_prefix urllog_shorturl urllog_check_tld upvar 1 $urlMStr urlStr upvar 1 $urlMProto urlProto + upvar 1 $urlMHostName urlHostName ### Try to guess the URL protocol component (if it is missing) set u_checktld 1 @@ -297,7 +298,7 @@ } ### Handle URLs that have an IPv4-address - if {[regexp "(\[a-z\]+)://(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})" $urlStr u_match urlProto ni1 ni2 ni3 ni4]} { + if {[regexp "(\[a-z\]+)://(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})" $urlStr urlMatch urlProto ni1 ni2 ni3 ni4]} { # Check if the IP is on local network if {$ni1 == 127 || $ni1 == 10 || ($ni1 == 192 && $ni2 == 168) || $ni1 == 0} { urllog_log "URL pointing to local or invalid network, ignored ($urlStr)." @@ -321,15 +322,15 @@ ### Get URL protocol component set urlProto "" - regexp "(\[a-z\]+)://" $urlStr u_match urlProto + regexp "(\[a-z\]+)://" $urlStr urlMatch urlProto ### Check the PORT (if the ":" is there) - set u_record [split $urlStr "/"] - set u_hostname [lindex $u_record 2] - set u_port [lindex [split $u_hostname ":"] end] + set urlRecord [split $urlStr "/"] + set urlHostName [lindex $urlRecord 2] + set urlPort [lindex [split $urlHostName ":"] end] - if {![urllog_isnumber $u_port] && $u_port != "" && $u_port != $u_hostname} { - urllog_log "Broken URL from $urlNick: ($urlStr) illegal port $u_port" + if {![urllog_isnumber $urlPort] && $urlPort != "" && $urlPort != $urlHostName} { + urllog_log "Broken URL from $urlNick: ($urlStr) illegal port $urlPort" return 0 } @@ -341,7 +342,7 @@ ### Check the Top Level Domain (TLD) validity if {$urllog_check_tld != 0 && $u_checktld != 0} { - set u_sane [lindex [split $u_hostname "."] end] + set u_sane [lindex [split $urlHostName "."] end] set u_tld [lindex [split $u_sane ":"] 0] set u_found 0 @@ -380,22 +381,23 @@ } ### Validate URL compoments, etc. - set u_proto "" - if {![urllog_validate_url $urlNick $urlChan urlStr u_proto]} { + set urlProto "" + set urlHostName "" + if {![urllog_validate_url $urlNick $urlChan urlStr urlProto urlHostName]} { return 1 } ### Do we perform additional checks? - if {$urllog_extra_checks == 0 || !(($http_tls_support != 0 && $u_proto == "https") || $u_proto == "http")} { + if {$urllog_extra_checks == 0 || !(($http_tls_support != 0 && $urlProto == "https") || $urlProto == "http")} { # No optional checks, or it's not http/https. if {$urllog_extra_strict == 0} { # Strict checking disabled, so add the URL, if it does not exist already. urllog_addurl $urlStr $urlNick $urlHost $urlChan "" return 1 - } elseif {$http_tls_support == 0 && $u_proto == "https"} { + } elseif {$http_tls_support == 0 && $urlProto == "https"} { # Strict ENABLED: If TLS support is disabled and we have https, do nothing return 1 - } elseif {$u_proto != "http" && $u_prot != "https"} { + } elseif {$urlProto != "http" && $urlProto != "https"} { # Strict ENABLED: It's not http, or https return 1 } @@ -409,10 +411,16 @@ ### Handle redirects if {$ucode >= 301 && $ucode <= 302} { set nurlStr $umeta(Location) + if {![regexp "\[a-z\]+://" $nurlStr]} { + if {[string range $nurlStr 0 0] != "/"} { + append nurlStr "/" + } + set nurlStr "${urlProto}://${urlHostName}${nurlStr}" + } urllog_log "Redirection: $urlStr -> $nurlStr" set urlStr $nurlStr - if {![urllog_validate_url $urlNick $urlChan urlStr urlProto]} { + if {![urllog_validate_url $urlNick $urlChan urlStr urlProto urlHostName]} { return 1 } @@ -424,10 +432,16 @@ ### Handle 2nd level redirects if {$ucode >= 301 && $ucode <= 302} { set nurlStr $umeta(Location) + if {![regexp "\[a-z\]+://" $nurlStr]} { + if {[string range $nurlStr 0 0] != "/"} { + append nurlStr "/" + } + set nurlStr "${urlProto}://${urlHostName}${nurlStr}" + } urllog_log "Redirection #2: $urlStr -> $nurlStr" set urlStr $nurlStr - if {![urllog_validate_url $urlNick $urlChan urlStr urlProto]} { + if {![urllog_validate_url $urlNick $urlChan urlStr urlProto urlHostName]} { return 1 }
--- a/utillib.tcl Thu May 21 10:00:59 2015 +0300 +++ b/utillib.tcl Wed Jun 03 18:51:42 2015 +0300 @@ -14,7 +14,7 @@ append utl_html_ent_str "|ä|ä|å|ö|—|-|'|'|–|-|"|\"" append utl_html_ent_str "|||-|’|'|ü|ü|Ü|Ü|•|*|€|€" append utl_html_ent_str "|”|\"|‘|'|ä|ä|·|*|®|®|´|'" -append utl_html_ent_str "|ö|ö|ö|ö|#|#" +append utl_html_ent_str "|ö|ö|ö|ö|#|#|'|'" set utl_html_ent_list [split [encoding convertfrom "utf-8" $utl_html_ent_str] "|"]