Mercurial > hg > egg-tcls
changeset 7:50b52294e93e
urllog: Strip ‏ entities from titles; Some work on SSL/https support.
| author | Matti Hamalainen <ccr@tnsp.org> |
|---|---|
| date | Wed, 22 Jun 2011 19:58:14 +0300 |
| parents | 026257a62da4 |
| children | 7ceb3b5aeaa4 |
| files | urllog.tcl |
| diffstat | 1 files changed, 13 insertions(+), 8 deletions(-) [+] |
line wrap: on
line diff
--- a/urllog.tcl Wed Jun 22 19:57:02 2011 +0300 +++ b/urllog.tcl Wed Jun 22 19:58:14 2011 +0300 @@ -1,6 +1,6 @@ ########################################################################## # -# URLLog v1.99.12 by ccr/TNSP <ccr@tnsp.org> +# URLLog v1.99.13 by ccr/TNSP <ccr@tnsp.org> # (C) Copyright 2000-2011 Tecnic Software productions (TNSP) # ########################################################################## @@ -23,6 +23,7 @@ set http_proxy_host "" set http_proxy_port 8080 +set http_tls_support 0 ### ### General options @@ -121,21 +122,27 @@ ########################################################################## #------------------------------------------------------------------------- set urllog_name "URLLog" -set urllog_version "1.99.12" +set urllog_version "1.99.13" set urllog_tlds [split $urllog_tlds ","] set urllog_httprep [split "\@|%40|{|%7B|}|%7D|\[|%5B|\]|%5D" "|"] -set urllog_html_ent [split "‪||‬||‎||å|å|Å|Å|é|é|:|:|ä|ä|ö|ö|ä|ä|ö|ö| | |-|-|”|\"|“|\"|»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>|ä|ä|ö|ö|Ä|Ä" "|"] +set urllog_html_ent [split "‏||—|-|‪||‬||‎||å|å|Å|Å|é|é|:|:|ä|ä|ö|ö|ä|ä|ö|ö| | |-|-|”|\"|“|\"|»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>|ä|ä|ö|ö|Ä|Ä" "|"] ### HTTP module initialization package require http + + ::http::config -useragent "$urllog_name/$urllog_version" if {$http_proxy != 0} { ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port } +if {$http_tls_support != 0} { + package require tls + ::http::register https 443 [list ::tls::socket -request 1 -require 1 -cadir "/etc/certs/"] +} ### Binding initializations if {$urllog_search != 0} { @@ -411,12 +418,12 @@ ### Do we perform additional optional checks? - if {$urllog_check == 0 || [string range $urlStr 0 6] != "http://"} { + if {$urllog_check == 0 || [string range $urlStr 0 4] != "http:"} { # No optional checks, just add the URL urllog_addurl $urlStr $urlNick $urlHost $urlChan "" return 1 } - + ### Does the document pointed by the URL exist? if {[catch {set utoken [::http::geturl $urlStr -progress urllog_http_handler -blocksize 1024 -timeout 3000]} uerrmsg]} { urllog_verb_msg $urlNick $urlChan "$urlmsg_ioerror ($uerrmsg)" @@ -505,9 +512,7 @@ ### Do the URL checking foreach istr [split $text " "] { - if {[string match "*http://*" $istr] || [string match "*ftp://*" $istr] || - [string match "*www.*" $istr] || [string match "*ftp.*" $istr] || - [regexp "(ftp|http|https)://\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}\\.\[0-9\]\{1,3\}" $istr imatch]} { + if {[regexp "(ftp|http|https)://|www\..+|ftp\..*" $istr]} { urllog_checkurl $istr $nick $uhost $chan } }