Mercurial > hg > egg-tcls
annotate urllog.tcl @ 95:687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
| author | Matti Hamalainen <ccr@tnsp.org> |
|---|---|
| date | Mon, 12 Sep 2011 19:00:20 +0300 |
| parents | 4e02c0219afe |
| children | e5a6c27be365 |
| rev | line source |
|---|---|
| 0 | 1 ########################################################################## |
| 2 # | |
|
84
fa1e95c2a0bc
urllog: Bump version to 2.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
83
diff
changeset
|
3 # URLLog v2.1 by ccr/TNSP <ccr@tnsp.org> |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
4 # (C) Copyright 2000-2011 Tecnic Software productions (TNSP) |
| 0 | 5 # |
| 6 ########################################################################## | |
| 7 # | |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
8 # URL-logger script for EggDrop IRC robot, utilizing SQLite3 database |
|
81
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
9 # This script requires SQLite TCL extension. Under Debian, you need: |
|
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
10 # tcl8.5 libsqlite3-tcl (and eggdrop eggdrop-data, of course) |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
11 # |
|
81
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
12 # NOTICE! If you are upgrading to URLLog v2.0+ from any 1.x version, you |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
13 # may want to run a conversion script against your URL-database file, |
|
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
14 # if you wish to preserve the old data. |
| 0 | 15 # |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
16 # See convert_urllog_db.tcl for more information. |
|
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
17 # |
|
81
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
18 # If you are doing a fresh install, you will need to create the |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
19 # initial SQLite3 database with the required table schemas. You |
|
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
20 # can do that by running: create_urllog_db.tcl |
| 0 | 21 # |
| 22 ########################################################################## | |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
23 |
| 0 | 24 ### |
| 25 ### HTTP options | |
| 26 ### | |
|
81
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
27 # Set to 1 if you want to enable use of HTTP proxy. |
|
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
28 # If you do, you MUST set the proxy settings below too. |
| 0 | 29 set http_proxy 0 |
| 30 | |
| 31 # Proxy host and port number (only used if enabled above) | |
| 32 set http_proxy_host "" | |
| 33 set http_proxy_port 8080 | |
| 34 | |
|
81
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
35 # Enable _experimental_ TLS/SSL support. This may not work at all. |
|
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
36 # If unsure, leave this option disabled (0). |
|
7
50b52294e93e
urllog: Strip ‏ entities from titles; Some work on SSL/https support.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
37 set http_tls_support 0 |
| 0 | 38 |
|
89
77e05ce9e9b8
urllog: Add certdir option setting.
Matti Hamalainen <ccr@tnsp.org>
parents:
87
diff
changeset
|
39 set http_tls_cadir "/usr/share/ca-certificates/mozilla" |
|
77e05ce9e9b8
urllog: Add certdir option setting.
Matti Hamalainen <ccr@tnsp.org>
parents:
87
diff
changeset
|
40 |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
41 |
| 0 | 42 ### |
| 43 ### General options | |
| 44 ### | |
| 45 | |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
46 # Filename of the SQLite URL database file |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
47 set urllog_db_file "urllog.sqlite" |
| 0 | 48 |
| 49 | |
| 50 # 1 = Verbose: Say messages when URL is OK, bad, etc. | |
| 51 # 0 = Quiet : Be quiet (only speak if asked with !urlfind, etc) | |
| 52 set urllog_verbose 1 | |
| 53 | |
| 54 | |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
55 # 1 = Enable logging of various script actions into bot's log |
| 0 | 56 # 0 = Don't. |
| 57 set urllog_logmsg 1 | |
| 58 | |
| 59 | |
| 60 # 1 = Check URLs for validity and existence before adding. | |
| 61 # 0 = No checks. Add _anything_ that looks like an URL to the database. | |
| 62 set urllog_check 1 | |
| 63 | |
| 64 | |
| 65 ### | |
| 66 ### Search related settings | |
| 67 ### | |
| 68 | |
| 69 # 0 = No search-commands available | |
| 70 # 1 = Search enabled | |
| 71 set urllog_search 1 | |
| 72 | |
| 73 | |
|
81
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
74 # Limit how many URLs should the "!urlfind" command show at most. |
| 0 | 75 set urllog_showmax_pub 3 |
| 76 | |
|
81
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
77 # Same as above, but for private message search. |
| 0 | 78 set urllog_showmax_priv 6 |
| 79 | |
| 80 | |
| 81 ### | |
| 82 ### ShortURL-settings | |
| 83 ### | |
| 84 | |
|
73
646b2fd67312
urllog: Improve documentation of different settings.
Matti Hamalainen <ccr@tnsp.org>
parents:
70
diff
changeset
|
85 # 1 = Enable showing of ShortURLs |
|
646b2fd67312
urllog: Improve documentation of different settings.
Matti Hamalainen <ccr@tnsp.org>
parents:
70
diff
changeset
|
86 # 0 = ShortURLs not shown in any bot actions |
| 0 | 87 set urllog_shorturl 1 |
| 88 | |
|
73
646b2fd67312
urllog: Improve documentation of different settings.
Matti Hamalainen <ccr@tnsp.org>
parents:
70
diff
changeset
|
89 # Max length of original URL to be shown, rest is chopped |
|
646b2fd67312
urllog: Improve documentation of different settings.
Matti Hamalainen <ccr@tnsp.org>
parents:
70
diff
changeset
|
90 # off if the URL is longer than the specified amount. |
| 0 | 91 set urllog_shorturl_orig 30 |
| 92 | |
|
73
646b2fd67312
urllog: Improve documentation of different settings.
Matti Hamalainen <ccr@tnsp.org>
parents:
70
diff
changeset
|
93 # Web server URL that handles redirects of ShortURLs |
| 0 | 94 set urllog_shorturl_prefix "http://tnsp.org/u/" |
| 95 | |
| 96 | |
| 97 ### | |
|
81
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
98 ### Message texts (informal, errors, etc.) |
| 0 | 99 ### |
| 100 | |
| 101 # No such host was found | |
| 102 set urlmsg_nosuchhost "ei tommosta oo!" | |
| 103 | |
| 104 # Could not connect host (I/O errors etc) | |
| 105 set urlmsg_ioerror "kraak, virhe yhdynnässä." | |
| 106 | |
| 107 # HTTP timeout | |
| 108 set urlmsg_timeout "ei jaksa ootella" | |
| 109 | |
| 110 # No such document was found | |
| 111 set urlmsg_errorgettingdoc "siitosvirhe" | |
| 112 | |
| 113 # URL was already known (was in database) | |
| 114 set urlmsg_alreadyknown "wanha!" | |
| 115 #set urlmsg_alreadyknown "Empiiristen havaintojen perusteella ja tällä sovellutusalueella esiintyneisiin aikaisempiin kontekstuaalisiin ilmaisuihin viitaten uskallan todeta, että sovellukseen ilmoittamasi tietoverkko-osoite oli kronologisti ajatellen varsin postpresentuaalisesti sopimaton ja ennestään hyvin tunnettu." | |
| 116 | |
| 117 # No match was found when searched with !urlfind or other command | |
| 118 set urlmsg_nomatch "Ei osumia." | |
| 119 | |
| 120 | |
| 121 ### | |
| 122 ### Things that you usually don't need to touch ... | |
| 123 ### | |
| 124 | |
| 125 # What IRC "command" should we use to send messages: | |
| 126 # (Valid alternatives are "PRIVMSG" and "NOTICE") | |
| 127 set urllog_preferredmsg "PRIVMSG" | |
| 128 | |
| 129 # The valid known Top Level Domains (TLDs), but not the country code TLDs | |
| 130 # (Now includes the new IANA published TLDs) | |
|
90
a9a4456eb213
urllog: Add .xxx TLD to supported list.
Matti Hamalainen <ccr@tnsp.org>
parents:
89
diff
changeset
|
131 set urllog_tlds "org,com,net,mil,gov,biz,edu,coop,aero,info,museum,name,pro,int,xxx" |
| 0 | 132 |
| 133 | |
| 134 ########################################################################## | |
| 135 # No need to look below this line | |
| 136 ########################################################################## | |
| 137 set urllog_name "URLLog" | |
|
84
fa1e95c2a0bc
urllog: Bump version to 2.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
83
diff
changeset
|
138 set urllog_version "2.1" |
| 0 | 139 |
| 140 set urllog_tlds [split $urllog_tlds ","] | |
| 141 set urllog_httprep [split "\@|%40|{|%7B|}|%7D|\[|%5B|\]|%5D" "|"] | |
| 142 | |
|
86
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
143 set urllog_html_ent [split "—|-|‏||—|-|‪||‬||‎||å|Ã¥|Å|Ã…|é|é|:|:| | |”|\"|“|\"|»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>" "|"] |
| 0 | 144 |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
145 ### Require packages |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
146 package require sqlite3 |
| 0 | 147 package require http |
|
7
50b52294e93e
urllog: Strip ‏ entities from titles; Some work on SSL/https support.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
148 |
| 0 | 149 ### Binding initializations |
| 150 if {$urllog_search != 0} { | |
| 28 | 151 bind pub - !urlfind urllog_pub_urlfind |
| 152 bind msg - urlfind urllog_msg_urlfind | |
| 0 | 153 } |
| 154 | |
| 155 bind pubm - *.* urllog_checkmsg | |
| 156 bind topc - *.* urllog_checkmsg | |
| 157 | |
| 158 | |
| 159 ### Initialization messages | |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
160 set urllog_message "$urllog_name v$urllog_version (C) 2000-2011 ccr/TNSP" |
| 0 | 161 putlog "$urllog_message" |
| 162 | |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
163 ### HTTP module initialization |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
164 ::http::config -useragent "$urllog_name/$urllog_version" |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
165 if {$http_proxy != 0} { |
| 28 | 166 ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
167 } |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
168 |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
169 if {$http_tls_support != 0} { |
| 28 | 170 package require tls |
|
89
77e05ce9e9b8
urllog: Add certdir option setting.
Matti Hamalainen <ccr@tnsp.org>
parents:
87
diff
changeset
|
171 ::http::register https 443 [list ::tls::socket -request 1 -require 1 -cadir $http_tls_cadir] |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
172 } |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
173 |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
174 ### SQLite database initialization |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
175 if {[catch {sqlite3 urldb $urllog_db_file} uerrmsg]} { |
| 28 | 176 putlog " Could not open SQLite3 database '$urllog_db_file': $uerrmsg" |
| 177 exit 2 | |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
178 } |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
179 |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
180 |
| 0 | 181 if {$http_proxy != 0} { |
| 28 | 182 putlog " (Using proxy $http_proxy_host:$http_proxy_port)" |
| 0 | 183 } |
| 184 | |
| 185 if {$urllog_check != 0} { | |
| 28 | 186 putlog " (Additional URL validity checks enabled)" |
| 0 | 187 } |
| 188 | |
| 189 if {$urllog_verbose != 0} { | |
| 28 | 190 putlog " (Verbose mode enabled)" |
| 0 | 191 } |
| 192 | |
| 193 if {$urllog_search != 0} { | |
| 28 | 194 putlog " (Search commands enabled)" |
| 0 | 195 } |
| 196 | |
| 197 #------------------------------------------------------------------------- | |
| 198 ### Utility functions | |
| 199 proc urllog_log {arg} { | |
| 28 | 200 global urllog_logmsg urllog_name |
| 0 | 201 |
| 28 | 202 if {$urllog_logmsg != 0} { |
| 203 putlog "$urllog_name: $arg" | |
| 204 } | |
| 0 | 205 } |
| 206 | |
| 207 | |
| 208 proc urllog_ctime { utime } { | |
| 209 | |
| 28 | 210 if {$utime == "" || $utime == "*"} { |
| 211 set utime 0 | |
| 212 } | |
| 0 | 213 |
| 28 | 214 return [clock format $utime -format "%d.%m.%Y %H:%M"] |
| 0 | 215 } |
| 216 | |
| 217 | |
| 218 proc urllog_isnumber {uarg} { | |
| 219 | |
| 28 | 220 foreach i [split $uarg {}] { |
|
65
31c8c4f50aa6
urllog: Improve urllog_isnumber function.
Matti Hamalainen <ccr@tnsp.org>
parents:
62
diff
changeset
|
221 if {![string match \[0-9\] $i]} { return 0 } |
| 28 | 222 } |
| 0 | 223 |
|
65
31c8c4f50aa6
urllog: Improve urllog_isnumber function.
Matti Hamalainen <ccr@tnsp.org>
parents:
62
diff
changeset
|
224 return 1 |
| 0 | 225 } |
| 226 | |
| 227 | |
| 228 proc urllog_msg {apublic anick achan amsg} { | |
| 28 | 229 global urllog_preferredmsg |
| 0 | 230 |
| 28 | 231 if {$apublic == 1} { |
| 232 putserv "$urllog_preferredmsg $achan :$amsg" | |
| 233 } else { | |
| 234 putserv "$urllog_preferredmsg $anick :$amsg" | |
| 235 } | |
| 0 | 236 } |
| 237 | |
| 238 | |
| 239 proc urllog_verb_msg {anick achan amsg} { | |
| 28 | 240 global urllog_verbose |
| 0 | 241 |
| 28 | 242 if {$urllog_verbose != 0} { |
| 243 urllog_msg 1 $anick $achan $amsg | |
| 244 } | |
| 0 | 245 } |
| 246 | |
| 247 | |
| 248 proc urllog_convert_ent {udata} { | |
| 28 | 249 global urllog_html_ent |
| 250 regsub -all " " $udata " " utmp | |
| 251 regsub -all "\r" $udata " " utmp | |
| 252 regsub -all "\n" $utmp " " utmp | |
| 253 regsub -all " *" $utmp " " utmp | |
| 254 regsub -all "\t" $utmp "" utmp | |
| 255 return [string map -nocase $urllog_html_ent $utmp] | |
| 0 | 256 } |
| 257 | |
| 258 | |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
259 proc urllog_escape { str } { |
| 28 | 260 return [string map {' ''} $str] |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
261 } |
|
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
262 |
| 0 | 263 #------------------------------------------------------------------------- |
| 264 proc urllog_get_short {utime} { | |
| 68 | 265 global urllog_shorturl_prefix |
|
13
e06d41fb69d5
Begin work on converting urllog.tcl to use an SQLite3 database instead of flat file.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
266 |
| 28 | 267 set ustr "ABCDEFGHIJKLNMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" |
| 268 set ulen [string length $ustr] | |
| 0 | 269 |
| 28 | 270 set u1 [expr $utime / ($ulen * $ulen)] |
| 271 set utmp [expr $utime % ($ulen * $ulen)] | |
| 272 set u2 [expr $utmp / $ulen] | |
| 273 set u3 [expr $utmp % $ulen] | |
| 0 | 274 |
| 28 | 275 return "\[ $urllog_shorturl_prefix[string index $ustr $u1][string index $ustr $u2][string index $ustr $u3] \]" |
| 0 | 276 } |
| 277 | |
| 278 | |
| 279 #------------------------------------------------------------------------- | |
| 280 proc urllog_chop_url {url} { | |
| 28 | 281 global urllog_shorturl_orig |
| 68 | 282 |
| 28 | 283 if {[string length $url] > $urllog_shorturl_orig} { |
| 284 return "[string range $url 0 $urllog_shorturl_orig]..." | |
| 285 } else { | |
| 286 return $url | |
| 287 } | |
| 0 | 288 } |
| 289 | |
| 290 #------------------------------------------------------------------------- | |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
291 proc urllog_exists {urlStr urlNick urlHost urlChan} { |
| 28 | 292 global urldb urlmsg_alreadyknown urllog_shorturl |
| 0 | 293 |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
294 set usql "SELECT id AS uid, utime AS utime, url AS uurl, user AS uuser, host AS uhost, chan AS uchan, title AS utitle FROM urls WHERE url='[urllog_escape $urlStr]'" |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
295 urldb eval $usql { |
| 28 | 296 urllog_log "URL said by $urlNick ($urlStr) already known" |
| 297 if {$urllog_shorturl != 0} { | |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
298 set qstr "[urllog_get_short $uid] " |
| 28 | 299 } else { |
| 300 set qstr "" | |
| 301 } | |
| 302 append qstr "($uuser/$uchan@[urllog_ctime $utime])" | |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
303 if {[string length $utitle] > 0} { |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
304 set qstr "$urlmsg_alreadyknown - '$utitle' $qstr" |
| 28 | 305 } else { |
| 306 set qstr "$urlmsg_alreadyknown $qstr" | |
| 307 } | |
| 308 urllog_verb_msg $urlNick $urlChan $qstr | |
| 309 return 0 | |
| 310 } | |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
311 return 1 |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
312 } |
| 0 | 313 |
|
18
1e2232135354
More changes for SQLite support.
Matti Hamalainen <ccr@tnsp.org>
parents:
13
diff
changeset
|
314 |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
315 #------------------------------------------------------------------------- |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
316 proc urllog_addurl {urlStr urlNick urlHost urlChan urlTitle} { |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
317 global urldb urllog_shorturl |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
318 |
|
93
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
319 if {$urlTitle == ""} { |
|
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
320 set uins "NULL" |
|
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
321 } else { |
|
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
322 set uins "'[urllog_escape $urlTitle]'" |
|
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
323 } |
|
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
324 set usql "INSERT INTO urls (utime,url,user,host,chan,title) VALUES ([unixtime], '[urllog_escape $urlStr]', '[urllog_escape $urlNick]', '[urllog_escape $urlHost]', '[urllog_escape $urlChan]', $uins)" |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
325 if {[catch {urldb eval $usql} uerrmsg]} { |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
326 urllog_log "$uerrmsg on SQL:\n$usql" |
| 28 | 327 return 0 |
| 328 } | |
|
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
329 set uid [urldb last_insert_rowid] |
| 28 | 330 urllog_log "Added URL ($urlNick@$urlChan): $urlStr" |
| 0 | 331 |
| 332 | |
| 28 | 333 ### Let's say something, to confirm that everything went well. |
| 334 if {$urllog_shorturl != 0} { | |
|
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
335 set qstr "[urllog_get_short $uid] " |
| 28 | 336 } else { |
| 337 set qstr "" | |
| 338 } | |
| 339 if {[string length $urlTitle] > 0} { | |
| 340 urllog_verb_msg $urlNick $urlChan "'$urlTitle' ([urllog_chop_url $urlStr]) $qstr" | |
| 341 } else { | |
| 342 urllog_verb_msg $urlNick $urlChan "[urllog_chop_url $urlStr] $qstr" | |
| 343 } | |
| 0 | 344 |
| 28 | 345 return 1 |
| 0 | 346 } |
| 347 | |
| 348 | |
| 349 #------------------------------------------------------------------------- | |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
350 proc urllog_http_handler {utoken utotal ucurr} { |
| 28 | 351 upvar #0 $utoken state |
| 0 | 352 |
| 28 | 353 # Stop fetching data after 3000 bytes, this should be enough to |
| 354 # contain the head section of a HTML page. | |
| 355 if {$ucurr > 64000} { | |
| 356 set state(status) "ok" | |
| 357 } | |
| 0 | 358 } |
| 359 | |
|
84
fa1e95c2a0bc
urllog: Bump version to 2.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
83
diff
changeset
|
360 |
| 0 | 361 #------------------------------------------------------------------------- |
| 362 proc urllog_checkurl {urlStr urlNick urlHost urlChan} { | |
| 28 | 363 global urllog_tlds urllog_check urlmsg_nosuchhost urlmsg_ioerror |
| 364 global urlmsg_timeout urlmsg_errorgettingdoc urllog_httprep | |
| 365 global urllog_shorturl_prefix urllog_shorturl urllog_encoding | |
|
95
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
366 global http_tls_support |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
367 |
| 28 | 368 ### Try to determine the URL protocol component (if it is missing) |
| 369 set u_checktld 1 | |
| 370 if {[string match "*www.*" $urlStr] && ![string match "http://*" $urlStr] && ![string match "https://*" $urlStr]} { | |
| 371 set urlStr "http://$urlStr" | |
| 372 } elseif {[string match "*ftp.*" $urlStr] && ![string match "ftp://*" $urlStr]} { | |
| 373 set urlStr "ftp://$urlStr" | |
| 374 } | |
| 0 | 375 |
|
95
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
376 ### Handle URLs that have an IPv4-address |
|
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
377 if {[regexp "(\[a-z\]+)://(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})" $urlStr u_match u_proto ni1 ni2 ni3 ni4]} { |
| 28 | 378 # Check if the IP is on local network |
|
92
f6f4595856ff
urllog: Cosmetics. Remove useless parenthesis.
Matti Hamalainen <ccr@tnsp.org>
parents:
91
diff
changeset
|
379 if {$ni1 == 127 || $ni1 == 10 || ($ni1 == 192 && $ni2 == 168) || $ni1 == 0} { |
| 28 | 380 urllog_log "URL pointing to local or invalid network, ignored ($urlStr)." |
| 381 return 0 | |
| 382 } | |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
383 |
| 28 | 384 # Skip TLD check for URLs with IP address |
| 385 set u_checktld 0 | |
| 386 } | |
| 0 | 387 |
| 28 | 388 if {$urllog_shorturl != 0 && [string match "*$urllog_shorturl_prefix*" $urlStr]} { |
| 389 urllog_log "Ignoring ShortURL." | |
| 390 return 0 | |
| 391 } | |
| 0 | 392 |
|
95
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
393 ### Get URL protocol component |
|
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
394 set u_proto "" |
|
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
395 if {[regexp "(\[a-z\]+)://" $urlStr u_match u_proto]} { |
|
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
396 } |
|
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
397 |
| 28 | 398 ### Check the PORT (if the ":" is there) |
| 399 set u_record [split $urlStr "/"] | |
| 400 set u_hostname [lindex $u_record 2] | |
| 401 set u_port [lindex [split $u_hostname ":"] end] | |
| 0 | 402 |
| 28 | 403 if {![urllog_isnumber $u_port] && $u_port != "" && $u_port != $u_hostname} { |
| 404 urllog_log "Broken URL from $urlNick: ($urlStr) illegal port $u_port" | |
| 405 return 0 | |
| 406 } | |
| 0 | 407 |
| 28 | 408 # Default to port 80 (HTTP) |
| 409 if {![urllog_isnumber $u_port]} { | |
| 410 set u_port 80 | |
| 411 } | |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
412 |
| 28 | 413 ### Is it a http or ftp url? (FIX ME!) |
| 414 if {[string range $urlStr 0 3] != "http" && [string range $urlStr 0 2] != "ftp"} { | |
| 415 urllog_log "Broken URL from $urlNick: ($urlStr) UNSUPPORTED TYPE (not HTTP or FTP)" | |
| 416 return 0 | |
| 417 } | |
| 0 | 418 |
| 28 | 419 ### Check the Top Level Domain (TLD) validity |
| 420 if {$u_checktld != 0} { | |
| 421 set u_sane [lindex [split $u_hostname "."] end] | |
| 422 set u_tld [lindex [split $u_sane ":"] 0] | |
| 423 set u_found 0 | |
| 0 | 424 |
| 28 | 425 if {[string length $u_tld] == 2} { |
| 426 # Assume all 2-letter domains to be valid :) | |
| 427 set u_found 1 | |
| 428 } else { | |
| 429 # Check our list of known TLDs | |
| 430 foreach itld $urllog_tlds { | |
| 431 if {[string match $itld $u_tld]} { | |
| 432 set u_found 1 | |
| 433 } | |
| 434 } | |
| 435 } | |
| 0 | 436 |
| 28 | 437 if {$u_found == 0} { |
| 438 urllog_log "Broken URL from $urlNick: ($urlStr) illegal TLD: $u_tld." | |
| 439 return 0 | |
| 440 } | |
| 441 } | |
| 0 | 442 |
| 28 | 443 set urlStr [string map $urllog_httprep $urlStr] |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
444 |
|
91
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
445 ### Does the URL already exist? |
|
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
446 if {![urllog_exists $urlStr $urlNick $urlHost $urlChan]} { |
|
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
447 return 1 |
|
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
448 } |
| 0 | 449 |
| 28 | 450 ### Do we perform additional optional checks? |
|
95
687bdd74dfac
urllog: Check if TLS support is enabled when checking if we can fetch title information via HTTP or SSL/HTTP.
Matti Hamalainen <ccr@tnsp.org>
parents:
93
diff
changeset
|
451 if {$urllog_check == 0 || ($http_tls_support == 0 && $u_proto == "https") || $u_proto != "http"} { |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
452 # No optional checks, just add the URL, if it does not exist already |
|
91
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
453 urllog_addurl $urlStr $urlNick $urlHost $urlChan "" |
| 28 | 454 return 1 |
| 455 } | |
|
7
50b52294e93e
urllog: Strip ‏ entities from titles; Some work on SSL/https support.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
456 |
| 28 | 457 ### Does the document pointed by the URL exist? |
| 458 if {[catch {set utoken [::http::geturl $urlStr -progress urllog_http_handler -blocksize 1024 -timeout 3000]} uerrmsg]} { | |
| 459 urllog_verb_msg $urlNick $urlChan "$urlmsg_ioerror ($uerrmsg)" | |
| 460 urllog_log "HTTP request failed: $uerrmsg" | |
| 461 return 0 | |
| 462 } | |
| 0 | 463 |
| 28 | 464 if {[::http::status $utoken] == "timeout"} { |
| 465 urllog_verb_msg $urlNick $urlChan "$urlmsg_timeout" | |
| 466 urllog_log "HTTP request timed out ($urlStr)" | |
| 467 return 0 | |
| 468 } | |
| 0 | 469 |
| 28 | 470 if {[::http::status $utoken] != "ok"} { |
| 471 urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::error $utoken])" | |
| 472 urllog_log "Error in HTTP transaction: [::http::error $utoken] ($urlStr)" | |
| 473 return 0 | |
| 474 } | |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
475 |
| 28 | 476 # Fixme! Handle redirects! |
| 477 set ucode [::http::ncode $utoken] | |
| 478 if {$ucode >= 200 && $ucode <= 309} { | |
| 479 set udata [::http::data $utoken] | |
| 480 set umatches [regexp -nocase -inline -- "<meta.\*\?content=\".\*\?charset=(\[^\"\]*)\"/>" $udata] | |
| 481 set uconvert 0 | |
| 482 if {[llength $umatches] > 0} { | |
| 483 set uencoding [lindex $umatches 1] | |
| 484 if {[string length $uencoding] > 3} { | |
|
86
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
485 regsub -nocase "-" $uencoding "" uencoding |
| 28 | 486 set uconvert 1 |
| 487 } | |
| 488 } | |
|
86
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
489 if {$uconvert == 0} { |
|
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
490 set uencoding "iso8859-1" |
|
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
491 } |
| 0 | 492 |
| 28 | 493 set umatches [regexp -nocase -inline -- "<title>(.\*\?)</title>" $udata] |
| 494 if {[llength $umatches] > 0} { | |
| 495 set urlTitle [lindex $umatches 1] | |
|
86
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
496 if {[catch {set urlTitle [encoding convertfrom $uencoding $urlTitle]} cerrmsg]} { |
|
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
497 urllog_log "Error in charset conversion: $cerrmsg" |
| 28 | 498 } |
| 499 set urlTitle [urllog_convert_ent $urlTitle] | |
| 500 regsub -all "(^ *| *$)" $urlTitle "" urlTitle | |
| 501 } else { | |
| 502 set urlTitle "" | |
| 503 } | |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
504 |
| 28 | 505 # Rasiatube hack |
| 506 if {[string match "*/rasiatube/view*" $urlStr]} { | |
| 507 set rasia 0 | |
| 508 set umatches [regexp -nocase -inline -- "<link rel=\"video_src\"\.\*\?file=(http://\[^&\]+)&" $udata] | |
| 509 if {[llength $umatches] > 0} { | |
| 510 set urlStr [lindex $umatches 1] | |
| 511 regsub -all "\/v\/" $urlStr "\/watch\?v=" urlStr | |
| 512 set rasia 1 | |
| 513 } else { | |
| 514 set umatches [regexp -nocase -inline -- "SWFObject.\"(\[^\"\]+)\", *\"flashvideo" $udata] | |
| 515 if {[llength $umatches] > 0} { | |
| 516 set urlStr [lindex $umatches 1] | |
| 517 regsub "http:\/\/www.dailymotion.com\/swf\/" $urlStr "http:\/\/www.dailymotion.com\/video\/" urlStr | |
| 518 set rasia 1 | |
| 519 } | |
| 520 } | |
| 521 | |
| 522 if {$rasia != 0} { | |
| 523 urllog_log "RasiaTube mangler: $urlStr" | |
| 524 urllog_verb_msg $urlNick $urlChan "Korjataan haiseva rasiatube-linkki: $urlStr" | |
| 525 } | |
| 526 } | |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
527 |
|
83
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
528 # Check if the URL already exists, just in case we had some redirects |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
529 if {[urllog_exists $urlStr $urlNick $urlHost $urlChan]} { |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
530 urllog_addurl $urlStr $urlNick $urlHost $urlChan $urlTitle |
|
f171a9fb7b7b
urllog: Split urllog_add function to urllog_exists for checking whether given URL already exists in the database. Use urllog_exists where appropriate.
Matti Hamalainen <ccr@tnsp.org>
parents:
82
diff
changeset
|
531 } |
| 28 | 532 return 1 |
| 533 } else { | |
| 534 urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::code $utoken])" | |
| 535 urllog_log "[::http::code $utoken] - $urlStr" | |
| 536 } | |
| 0 | 537 |
| 28 | 538 ::http::cleanup $utoken |
| 0 | 539 } |
| 540 | |
| 541 | |
| 542 #------------------------------------------------------------------------- | |
| 87 | 543 proc urllog_checkmsg {unick uhost uhand uchan utext} { |
| 28 | 544 ### Check the nick |
| 87 | 545 if {$unick == "*"} { |
| 28 | 546 urllog_log "urllog_checkmsg: nick was wc, this should not happen." |
| 547 return 0 | |
| 548 } | |
| 0 | 549 |
| 28 | 550 ### Do the URL checking |
| 87 | 551 foreach str [split $utext " "] { |
| 552 if {[regexp "(ftp|http|https)://|www\..+|ftp\..*" $str]} { | |
| 553 urllog_checkurl $str $unick $uhost $uchan | |
| 28 | 554 } |
| 555 } | |
| 0 | 556 |
| 28 | 557 return 0 |
| 0 | 558 } |
| 559 | |
| 560 | |
| 561 #------------------------------------------------------------------------- | |
| 562 ### Parse arguments, find and show the results | |
| 563 proc urllog_find {unick uhand uchan utext upublic} { | |
|
62
6428b1bcb34b
urllog: Remove some global variable references where they are not used.
Matti Hamalainen <ccr@tnsp.org>
parents:
50
diff
changeset
|
564 global urllog_shorturl urldb |
| 28 | 565 global urllog_showmax_pub urllog_showmax_priv urlmsg_nomatch |
| 0 | 566 |
| 28 | 567 if {$upublic == 0} { |
| 568 set ulimit 5 | |
| 569 } else { | |
| 570 set ulimit 3 | |
| 571 } | |
|
19
9cf22053e5da
Repair !urlfind functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
18
diff
changeset
|
572 |
| 28 | 573 ### Parse the given command |
| 574 urllog_log "$unick/$uhand searched URL: $utext" | |
| 0 | 575 |
| 28 | 576 set ftokens [split $utext " "] |
| 577 set fpatlist "" | |
| 578 foreach ftoken $ftokens { | |
| 579 set fprefix [string range $ftoken 0 0] | |
| 580 set fpattern [string range $ftoken 1 end] | |
| 0 | 581 |
| 28 | 582 if {$fprefix == "-"} { |
| 583 lappend fpatlist "url NOT LIKE '%[urllog_escape $fpattern]%'" | |
| 584 } elseif {$fprefix == "%"} { | |
| 585 lappend fpatlist "user='[urllog_escape $fpattern]'" | |
| 586 } elseif {$fprefix == "@"} { | |
| 587 # foo | |
| 588 } else { | |
| 589 lappend fpatlist "url LIKE '%[urllog_escape $ftoken]%'" | |
| 590 } | |
| 591 } | |
|
19
9cf22053e5da
Repair !urlfind functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
18
diff
changeset
|
592 |
|
27
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
593 if {[llength $fpatlist] > 0} { |
|
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
594 set fquery "WHERE [join $fpatlist " AND "]" |
|
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
595 } else { |
|
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
596 set fquery "" |
|
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
597 } |
| 68 | 598 |
| 28 | 599 set iresults 0 |
|
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
600 set usql "SELECT id AS uid, utime AS utime, url AS uurl, user AS uuser, host AS uhost FROM urls $fquery ORDER BY utime DESC LIMIT $ulimit" |
| 68 | 601 urldb eval $usql { |
| 28 | 602 incr iresults |
| 603 set shortURL $uurl | |
|
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
604 if {$urllog_shorturl != 0 && $uid != ""} { |
|
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
605 set shortURL "$shortURL [urllog_get_short $uid]" |
| 28 | 606 } |
| 607 urllog_msg $upublic $unick $uchan "#$iresults: $shortURL ($uuser@[urllog_ctime $utime])" | |
| 608 } | |
| 609 | |
| 610 if {$iresults == 0} { | |
| 611 # If no URLs were found | |
| 612 urllog_msg $upublic $unick $uchan $urlmsg_nomatch | |
| 613 } | |
| 0 | 614 |
| 28 | 615 return 0 |
| 0 | 616 } |
| 617 | |
| 618 | |
| 619 #------------------------------------------------------------------------- | |
| 620 ### Finding binded functions | |
| 621 proc urllog_pub_urlfind {unick uhost uhand uchan utext} { | |
| 28 | 622 urllog_find $unick $uhand $uchan $utext 1 |
| 623 return 0 | |
| 0 | 624 } |
| 625 | |
| 626 | |
| 627 proc urllog_msg_urlfind {unick uhost uhand utext} { | |
| 28 | 628 urllog_find $unick $uhand "" $utext 0 |
| 629 return 0 | |
|
3
8003090caa35
Lots of code cleanups, add "fixer" for RasiaTube links (which suck) to point directly to Youtube.
Matti Hamalainen <ccr@tnsp.org>
parents:
0
diff
changeset
|
630 } |
| 0 | 631 |
| 632 # end of script |