Mercurial > hg > egg-tcls
comparison urllog.tcl @ 464:506977ea9d0c
urllog: Improve URL validation.
| author | Matti Hamalainen <ccr@tnsp.org> |
|---|---|
| date | Wed, 07 Feb 2018 19:01:36 +0200 |
| parents | cfbe6acc1d73 |
| children | cbad3fa706fe |
comparison
equal
deleted
inserted
replaced
| 463:fe478b7bd80e | 464:506977ea9d0c |
|---|---|
| 288 upvar 1 $urlMProto urlProto | 288 upvar 1 $urlMProto urlProto |
| 289 upvar 1 $urlMHostName urlHostName | 289 upvar 1 $urlMHostName urlHostName |
| 290 | 290 |
| 291 ### Try to guess the URL protocol component (if it is missing) | 291 ### Try to guess the URL protocol component (if it is missing) |
| 292 set u_checktld 1 | 292 set u_checktld 1 |
| 293 if {![string match "http://*" $urlStr] && ![string match "https://*" $urlStr] && ![string match "ftp://*" $urlStr]} { | 293 if {![string match "http://*" $urlStr] && ![string match "https://*" $urlStr] && ![string match "ftp://*" $urlStr] && ![string match "*://*" $urlStr]} { |
| 294 if {[string match "*www.*" $urlStr]} { | 294 if {[string match "*www.*" $urlStr]} { |
| 295 set urlStr "http://$urlStr" | 295 set urlStr "http://$urlStr" |
| 296 } elseif {[string match "*ftp.*" $urlStr]} { | 296 } elseif {[string match "*ftp.*" $urlStr]} { |
| 297 set urlStr "ftp://$urlStr" | 297 set urlStr "ftp://$urlStr" |
| 298 } | 298 } |
| 321 return 0 | 321 return 0 |
| 322 } | 322 } |
| 323 | 323 |
| 324 ### Get URL protocol component | 324 ### Get URL protocol component |
| 325 set urlProto "" | 325 set urlProto "" |
| 326 regexp "(\[a-z\]+)://" $urlStr urlMatch urlProto | 326 if {[regexp "(\[a-z\]+)://" $urlStr urlMatch urlProto]} { |
| 327 ### Is it a http or ftp url? | |
| 328 if {$urlProto != "http" && $urlProto != "https" && $urlProto != "ftp"} { | |
| 329 urllog_log "Broken URL from $urlNick: ($urlStr) UNSUPPORTED protocol class ($urlProto)." | |
| 330 return 0 | |
| 331 } | |
| 332 } else { | |
| 333 urllog_log "Broken URL from $urlNick: ($urlStr), no protocol specifier." | |
| 334 return 0 | |
| 335 } | |
| 327 | 336 |
| 328 ### Check the PORT (if the ":" is there) | 337 ### Check the PORT (if the ":" is there) |
| 329 set urlRecord [split $urlStr "/"] | 338 set urlRecord [split $urlStr "/"] |
| 330 set urlHostName [lindex $urlRecord 2] | 339 set urlHostName [lindex $urlRecord 2] |
| 331 set urlPort [lindex [split $urlHostName ":"] end] | 340 set urlPort [lindex [split $urlHostName ":"] end] |
| 553 | 562 |
| 554 ### Check the channel | 563 ### Check the channel |
| 555 if {[utl_match_delim_list $urllog_log_channels $uchan]} { | 564 if {[utl_match_delim_list $urllog_log_channels $uchan]} { |
| 556 ### Do the URL checking | 565 ### Do the URL checking |
| 557 foreach str [split $utext " "] { | 566 foreach str [split $utext " "] { |
| 558 if {[regexp "((ftp|http|https)://\[^\[:space:\]\]+|^(www|ftp)\.\[^\[:space:\]\]+)" $str ulink]} { | 567 if {[regexp "(\[a-z]+://\[^\[:space:\]\]+|^(www|ftp)\.\[^\[:space:\]\]+)" $str ulink]} { |
| 559 urllog_check_url $str $unick $uhost $uchan | 568 urllog_check_url $str $unick $uhost $uchan |
| 560 } | 569 } |
| 561 } | 570 } |
| 562 } | 571 } |
| 563 | 572 |