Mercurial > hg > egg-tcls
annotate urllog.tcl @ 102:5425dc418505
urllog: Entity data is now in UTF-8, but TCL source files are interpreted with current system locale, which may not be UTF-8. We must therefore "convert" the entity mapping string to UTF-8 to be certain of TCL's interpretation of its encoding.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Tue, 13 Sep 2011 15:51:15 +0300 |
parents | 372b63af72b5 |
children | 453f978f19e5 |
rev | line source |
---|---|
0 | 1 ########################################################################## |
2 # | |
99
8139169293f9
urllog: Bump version to 2.2.
Matti Hamalainen <ccr@tnsp.org>
parents:
98
diff
changeset
|
3 # URLLog v2.2 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" | |
99
8139169293f9
urllog: Bump version to 2.2.
Matti Hamalainen <ccr@tnsp.org>
parents:
98
diff
changeset
|
138 set urllog_version "2.2" |
0 | 139 |
140 set urllog_tlds [split $urllog_tlds ","] | |
141 set urllog_httprep [split "\@|%40|{|%7B|}|%7D|\[|%5B|\]|%5D" "|"] | |
142 | |
102
5425dc418505
urllog: Entity data is now in UTF-8, but TCL source files are interpreted with current system locale, which may not be UTF-8. We must therefore "convert" the entity mapping string to UTF-8 to be certain of TCL's interpretation of its encoding.
Matti Hamalainen <ccr@tnsp.org>
parents:
101
diff
changeset
|
143 |
5425dc418505
urllog: Entity data is now in UTF-8, but TCL source files are interpreted with current system locale, which may not be UTF-8. We must therefore "convert" the entity mapping string to UTF-8 to be certain of TCL's interpretation of its encoding.
Matti Hamalainen <ccr@tnsp.org>
parents:
101
diff
changeset
|
144 set urllog_ent_str "'|'|—|-|‏||—|-|‪||‬||‎||å|Ã¥|Å|Ã…|é|é|:|:| | |”|\"|“|\"|»|>>|"|\"|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>" |
5425dc418505
urllog: Entity data is now in UTF-8, but TCL source files are interpreted with current system locale, which may not be UTF-8. We must therefore "convert" the entity mapping string to UTF-8 to be certain of TCL's interpretation of its encoding.
Matti Hamalainen <ccr@tnsp.org>
parents:
101
diff
changeset
|
145 set urllog_html_ent [split [encoding convertfrom "utf-8" $urllog_ent_str] "|"] |
0 | 146 |
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
|
147 ### 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
|
148 package require sqlite3 |
0 | 149 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
|
150 |
0 | 151 ### Binding initializations |
152 if {$urllog_search != 0} { | |
28 | 153 bind pub - !urlfind urllog_pub_urlfind |
154 bind msg - urlfind urllog_msg_urlfind | |
0 | 155 } |
156 | |
157 bind pubm - *.* urllog_checkmsg | |
158 bind topc - *.* urllog_checkmsg | |
159 | |
160 | |
161 ### 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
|
162 set urllog_message "$urllog_name v$urllog_version (C) 2000-2011 ccr/TNSP" |
0 | 163 putlog "$urllog_message" |
164 | |
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
|
165 ### 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
|
166 ::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
|
167 if {$http_proxy != 0} { |
28 | 168 ::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
|
169 } |
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
|
170 |
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
|
171 if {$http_tls_support != 0} { |
28 | 172 package require tls |
89
77e05ce9e9b8
urllog: Add certdir option setting.
Matti Hamalainen <ccr@tnsp.org>
parents:
87
diff
changeset
|
173 ::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
|
174 } |
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 |
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
|
176 ### 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
|
177 if {[catch {sqlite3 urldb $urllog_db_file} uerrmsg]} { |
28 | 178 putlog " Could not open SQLite3 database '$urllog_db_file': $uerrmsg" |
179 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
|
180 } |
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
|
181 |
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
|
182 |
0 | 183 if {$http_proxy != 0} { |
28 | 184 putlog " (Using proxy $http_proxy_host:$http_proxy_port)" |
0 | 185 } |
186 | |
187 if {$urllog_check != 0} { | |
28 | 188 putlog " (Additional URL validity checks enabled)" |
0 | 189 } |
190 | |
191 if {$urllog_verbose != 0} { | |
28 | 192 putlog " (Verbose mode enabled)" |
0 | 193 } |
194 | |
195 if {$urllog_search != 0} { | |
28 | 196 putlog " (Search commands enabled)" |
0 | 197 } |
198 | |
199 #------------------------------------------------------------------------- | |
200 ### Utility functions | |
201 proc urllog_log {arg} { | |
28 | 202 global urllog_logmsg urllog_name |
0 | 203 |
28 | 204 if {$urllog_logmsg != 0} { |
205 putlog "$urllog_name: $arg" | |
206 } | |
0 | 207 } |
208 | |
209 | |
210 proc urllog_ctime { utime } { | |
211 | |
28 | 212 if {$utime == "" || $utime == "*"} { |
213 set utime 0 | |
214 } | |
0 | 215 |
28 | 216 return [clock format $utime -format "%d.%m.%Y %H:%M"] |
0 | 217 } |
218 | |
219 | |
220 proc urllog_isnumber {uarg} { | |
221 | |
28 | 222 foreach i [split $uarg {}] { |
65
31c8c4f50aa6
urllog: Improve urllog_isnumber function.
Matti Hamalainen <ccr@tnsp.org>
parents:
62
diff
changeset
|
223 if {![string match \[0-9\] $i]} { return 0 } |
28 | 224 } |
0 | 225 |
65
31c8c4f50aa6
urllog: Improve urllog_isnumber function.
Matti Hamalainen <ccr@tnsp.org>
parents:
62
diff
changeset
|
226 return 1 |
0 | 227 } |
228 | |
229 | |
230 proc urllog_msg {apublic anick achan amsg} { | |
28 | 231 global urllog_preferredmsg |
0 | 232 |
28 | 233 if {$apublic == 1} { |
234 putserv "$urllog_preferredmsg $achan :$amsg" | |
235 } else { | |
236 putserv "$urllog_preferredmsg $anick :$amsg" | |
237 } | |
0 | 238 } |
239 | |
240 | |
241 proc urllog_verb_msg {anick achan amsg} { | |
28 | 242 global urllog_verbose |
0 | 243 |
28 | 244 if {$urllog_verbose != 0} { |
245 urllog_msg 1 $anick $achan $amsg | |
246 } | |
0 | 247 } |
248 | |
249 | |
250 proc urllog_convert_ent {udata} { | |
28 | 251 global urllog_html_ent |
252 regsub -all " " $udata " " utmp | |
253 regsub -all "\r" $udata " " utmp | |
254 regsub -all "\n" $utmp " " utmp | |
255 regsub -all " *" $utmp " " utmp | |
256 regsub -all "\t" $utmp "" utmp | |
257 return [string map -nocase $urllog_html_ent $utmp] | |
0 | 258 } |
259 | |
260 | |
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 proc urllog_escape { str } { |
28 | 262 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
|
263 } |
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
|
264 |
0 | 265 #------------------------------------------------------------------------- |
266 proc urllog_get_short {utime} { | |
68 | 267 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
|
268 |
28 | 269 set ustr "ABCDEFGHIJKLNMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" |
270 set ulen [string length $ustr] | |
0 | 271 |
28 | 272 set u1 [expr $utime / ($ulen * $ulen)] |
273 set utmp [expr $utime % ($ulen * $ulen)] | |
274 set u2 [expr $utmp / $ulen] | |
275 set u3 [expr $utmp % $ulen] | |
0 | 276 |
28 | 277 return "\[ $urllog_shorturl_prefix[string index $ustr $u1][string index $ustr $u2][string index $ustr $u3] \]" |
0 | 278 } |
279 | |
280 | |
281 #------------------------------------------------------------------------- | |
282 proc urllog_chop_url {url} { | |
28 | 283 global urllog_shorturl_orig |
68 | 284 |
28 | 285 if {[string length $url] > $urllog_shorturl_orig} { |
286 return "[string range $url 0 $urllog_shorturl_orig]..." | |
287 } else { | |
288 return $url | |
289 } | |
0 | 290 } |
291 | |
292 #------------------------------------------------------------------------- | |
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
|
293 proc urllog_exists {urlStr urlNick urlHost urlChan} { |
28 | 294 global urldb urlmsg_alreadyknown urllog_shorturl |
0 | 295 |
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
|
296 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
|
297 urldb eval $usql { |
28 | 298 urllog_log "URL said by $urlNick ($urlStr) already known" |
299 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
|
300 set qstr "[urllog_get_short $uid] " |
28 | 301 } else { |
302 set qstr "" | |
303 } | |
304 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
|
305 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
|
306 set qstr "$urlmsg_alreadyknown - '$utitle' $qstr" |
28 | 307 } else { |
308 set qstr "$urlmsg_alreadyknown $qstr" | |
309 } | |
310 urllog_verb_msg $urlNick $urlChan $qstr | |
311 return 0 | |
312 } | |
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
|
313 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
|
314 } |
0 | 315 |
18
1e2232135354
More changes for SQLite support.
Matti Hamalainen <ccr@tnsp.org>
parents:
13
diff
changeset
|
316 |
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
|
317 #------------------------------------------------------------------------- |
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 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
|
319 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
|
320 |
93
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
321 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
|
322 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
|
323 } else { |
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 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
|
325 } |
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
326 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
|
327 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
|
328 urllog_log "$uerrmsg on SQL:\n$usql" |
28 | 329 return 0 |
330 } | |
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
331 set uid [urldb last_insert_rowid] |
28 | 332 urllog_log "Added URL ($urlNick@$urlChan): $urlStr" |
0 | 333 |
334 | |
28 | 335 ### Let's say something, to confirm that everything went well. |
336 if {$urllog_shorturl != 0} { | |
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
337 set qstr "[urllog_get_short $uid] " |
28 | 338 } else { |
339 set qstr "" | |
340 } | |
341 if {[string length $urlTitle] > 0} { | |
342 urllog_verb_msg $urlNick $urlChan "'$urlTitle' ([urllog_chop_url $urlStr]) $qstr" | |
343 } else { | |
344 urllog_verb_msg $urlNick $urlChan "[urllog_chop_url $urlStr] $qstr" | |
345 } | |
0 | 346 |
28 | 347 return 1 |
0 | 348 } |
349 | |
350 | |
351 #------------------------------------------------------------------------- | |
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
|
352 proc urllog_http_handler {utoken utotal ucurr} { |
28 | 353 upvar #0 $utoken state |
0 | 354 |
28 | 355 # Stop fetching data after 3000 bytes, this should be enough to |
356 # contain the head section of a HTML page. | |
357 if {$ucurr > 64000} { | |
358 set state(status) "ok" | |
359 } | |
0 | 360 } |
361 | |
84
fa1e95c2a0bc
urllog: Bump version to 2.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
83
diff
changeset
|
362 |
0 | 363 #------------------------------------------------------------------------- |
364 proc urllog_checkurl {urlStr urlNick urlHost urlChan} { | |
28 | 365 global urllog_tlds urllog_check urlmsg_nosuchhost urlmsg_ioerror |
366 global urlmsg_timeout urlmsg_errorgettingdoc urllog_httprep | |
367 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
|
368 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
|
369 |
96
e5a6c27be365
urllog: Comments and cosmetics.
Matti Hamalainen <ccr@tnsp.org>
parents:
95
diff
changeset
|
370 ### Try to guess the URL protocol component (if it is missing) |
28 | 371 set u_checktld 1 |
372 if {[string match "*www.*" $urlStr] && ![string match "http://*" $urlStr] && ![string match "https://*" $urlStr]} { | |
373 set urlStr "http://$urlStr" | |
374 } elseif {[string match "*ftp.*" $urlStr] && ![string match "ftp://*" $urlStr]} { | |
375 set urlStr "ftp://$urlStr" | |
376 } | |
0 | 377 |
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
|
378 ### 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
|
379 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 | 380 # Check if the IP is on local network |
92
f6f4595856ff
urllog: Cosmetics. Remove useless parenthesis.
Matti Hamalainen <ccr@tnsp.org>
parents:
91
diff
changeset
|
381 if {$ni1 == 127 || $ni1 == 10 || ($ni1 == 192 && $ni2 == 168) || $ni1 == 0} { |
28 | 382 urllog_log "URL pointing to local or invalid network, ignored ($urlStr)." |
383 return 0 | |
384 } | |
385 # Skip TLD check for URLs with IP address | |
386 set u_checktld 0 | |
387 } | |
0 | 388 |
96
e5a6c27be365
urllog: Comments and cosmetics.
Matti Hamalainen <ccr@tnsp.org>
parents:
95
diff
changeset
|
389 ### Check now if we have an ShortURL here ... |
28 | 390 if {$urllog_shorturl != 0 && [string match "*$urllog_shorturl_prefix*" $urlStr]} { |
98
fbbe7ee40e2f
urllog: Improve one informational / error message.
Matti Hamalainen <ccr@tnsp.org>
parents:
97
diff
changeset
|
391 urllog_log "Ignoring ShortURL from $urlNick: $urlStr" |
28 | 392 return 0 |
393 } | |
0 | 394 |
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
|
395 ### 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
|
396 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
|
397 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
|
398 } |
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
|
399 |
28 | 400 ### Check the PORT (if the ":" is there) |
401 set u_record [split $urlStr "/"] | |
402 set u_hostname [lindex $u_record 2] | |
403 set u_port [lindex [split $u_hostname ":"] end] | |
0 | 404 |
28 | 405 if {![urllog_isnumber $u_port] && $u_port != "" && $u_port != $u_hostname} { |
406 urllog_log "Broken URL from $urlNick: ($urlStr) illegal port $u_port" | |
407 return 0 | |
408 } | |
0 | 409 |
28 | 410 # Default to port 80 (HTTP) |
411 if {![urllog_isnumber $u_port]} { | |
412 set u_port 80 | |
413 } | |
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
|
414 |
28 | 415 ### Is it a http or ftp url? (FIX ME!) |
97
366e68ad94df
urllog: Use u_proto variable to check for if the protocol is supported instead of doing useless additional string checking.
Matti Hamalainen <ccr@tnsp.org>
parents:
96
diff
changeset
|
416 if {$u_proto != "http" && $u_proto != "https" && $u_proto != "ftp"} { |
366e68ad94df
urllog: Use u_proto variable to check for if the protocol is supported instead of doing useless additional string checking.
Matti Hamalainen <ccr@tnsp.org>
parents:
96
diff
changeset
|
417 urllog_log "Broken URL from $urlNick: ($urlStr) UNSUPPORTED protocol class ($u_proto)." |
28 | 418 return 0 |
419 } | |
0 | 420 |
28 | 421 ### Check the Top Level Domain (TLD) validity |
422 if {$u_checktld != 0} { | |
423 set u_sane [lindex [split $u_hostname "."] end] | |
424 set u_tld [lindex [split $u_sane ":"] 0] | |
425 set u_found 0 | |
0 | 426 |
28 | 427 if {[string length $u_tld] == 2} { |
428 # Assume all 2-letter domains to be valid :) | |
429 set u_found 1 | |
430 } else { | |
431 # Check our list of known TLDs | |
432 foreach itld $urllog_tlds { | |
433 if {[string match $itld $u_tld]} { | |
434 set u_found 1 | |
435 } | |
436 } | |
437 } | |
0 | 438 |
28 | 439 if {$u_found == 0} { |
440 urllog_log "Broken URL from $urlNick: ($urlStr) illegal TLD: $u_tld." | |
441 return 0 | |
442 } | |
443 } | |
0 | 444 |
28 | 445 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
|
446 |
91
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
447 ### 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
|
448 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
|
449 return 1 |
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
450 } |
0 | 451 |
28 | 452 ### 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
|
453 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
|
454 # 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
|
455 urllog_addurl $urlStr $urlNick $urlHost $urlChan "" |
28 | 456 return 1 |
457 } | |
7
50b52294e93e
urllog: Strip ‏ entities from titles; Some work on SSL/https support.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
458 |
28 | 459 ### Does the document pointed by the URL exist? |
460 if {[catch {set utoken [::http::geturl $urlStr -progress urllog_http_handler -blocksize 1024 -timeout 3000]} uerrmsg]} { | |
461 urllog_verb_msg $urlNick $urlChan "$urlmsg_ioerror ($uerrmsg)" | |
462 urllog_log "HTTP request failed: $uerrmsg" | |
463 return 0 | |
464 } | |
0 | 465 |
28 | 466 if {[::http::status $utoken] == "timeout"} { |
467 urllog_verb_msg $urlNick $urlChan "$urlmsg_timeout" | |
468 urllog_log "HTTP request timed out ($urlStr)" | |
469 return 0 | |
470 } | |
0 | 471 |
28 | 472 if {[::http::status $utoken] != "ok"} { |
473 urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::error $utoken])" | |
474 urllog_log "Error in HTTP transaction: [::http::error $utoken] ($urlStr)" | |
475 return 0 | |
476 } | |
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
|
477 |
28 | 478 # Fixme! Handle redirects! |
479 set ucode [::http::ncode $utoken] | |
480 if {$ucode >= 200 && $ucode <= 309} { | |
481 set udata [::http::data $utoken] | |
482 set uconvert 0 | |
101
372b63af72b5
urllog: Improve page character set encoding detection/guessing.
Matti Hamalainen <ccr@tnsp.org>
parents:
99
diff
changeset
|
483 if {[regexp -nocase -- "<meta.\*\?content=\"text/html.\*\?charset=(\[^\"\]*)\".\*\?/>" $udata umatches uencoding]} { |
28 | 484 if {[string length $uencoding] > 3} { |
101
372b63af72b5
urllog: Improve page character set encoding detection/guessing.
Matti Hamalainen <ccr@tnsp.org>
parents:
99
diff
changeset
|
485 set uencoding [string tolower $uencoding] |
372b63af72b5
urllog: Improve page character set encoding detection/guessing.
Matti Hamalainen <ccr@tnsp.org>
parents:
99
diff
changeset
|
486 regsub -- "iso-" $uencoding "iso" uencoding |
28 | 487 set uconvert 1 |
488 } | |
489 } | |
86
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
490 if {$uconvert == 0} { |
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
491 set uencoding "iso8859-1" |
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
492 } |
0 | 493 |
28 | 494 set umatches [regexp -nocase -inline -- "<title>(.\*\?)</title>" $udata] |
495 if {[llength $umatches] > 0} { | |
496 set urlTitle [lindex $umatches 1] | |
86
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
497 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
|
498 urllog_log "Error in charset conversion: $cerrmsg" |
28 | 499 } |
500 set urlTitle [urllog_convert_ent $urlTitle] | |
501 regsub -all "(^ *| *$)" $urlTitle "" urlTitle | |
502 } else { | |
503 set urlTitle "" | |
504 } | |
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
|
505 |
28 | 506 # Rasiatube hack |
507 if {[string match "*/rasiatube/view*" $urlStr]} { | |
508 set rasia 0 | |
509 set umatches [regexp -nocase -inline -- "<link rel=\"video_src\"\.\*\?file=(http://\[^&\]+)&" $udata] | |
510 if {[llength $umatches] > 0} { | |
511 set urlStr [lindex $umatches 1] | |
512 regsub -all "\/v\/" $urlStr "\/watch\?v=" urlStr | |
513 set rasia 1 | |
514 } else { | |
515 set umatches [regexp -nocase -inline -- "SWFObject.\"(\[^\"\]+)\", *\"flashvideo" $udata] | |
516 if {[llength $umatches] > 0} { | |
517 set urlStr [lindex $umatches 1] | |
518 regsub "http:\/\/www.dailymotion.com\/swf\/" $urlStr "http:\/\/www.dailymotion.com\/video\/" urlStr | |
519 set rasia 1 | |
520 } | |
521 } | |
522 | |
523 if {$rasia != 0} { | |
524 urllog_log "RasiaTube mangler: $urlStr" | |
525 urllog_verb_msg $urlNick $urlChan "Korjataan haiseva rasiatube-linkki: $urlStr" | |
526 } | |
527 } | |
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
|
528 |
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
|
529 # 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
|
530 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
|
531 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
|
532 } |
28 | 533 return 1 |
534 } else { | |
535 urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::code $utoken])" | |
536 urllog_log "[::http::code $utoken] - $urlStr" | |
537 } | |
0 | 538 |
28 | 539 ::http::cleanup $utoken |
0 | 540 } |
541 | |
542 | |
543 #------------------------------------------------------------------------- | |
87 | 544 proc urllog_checkmsg {unick uhost uhand uchan utext} { |
28 | 545 ### Check the nick |
87 | 546 if {$unick == "*"} { |
28 | 547 urllog_log "urllog_checkmsg: nick was wc, this should not happen." |
548 return 0 | |
549 } | |
0 | 550 |
28 | 551 ### Do the URL checking |
87 | 552 foreach str [split $utext " "] { |
553 if {[regexp "(ftp|http|https)://|www\..+|ftp\..*" $str]} { | |
554 urllog_checkurl $str $unick $uhost $uchan | |
28 | 555 } |
556 } | |
0 | 557 |
28 | 558 return 0 |
0 | 559 } |
560 | |
561 | |
562 #------------------------------------------------------------------------- | |
563 ### Parse arguments, find and show the results | |
564 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
|
565 global urllog_shorturl urldb |
28 | 566 global urllog_showmax_pub urllog_showmax_priv urlmsg_nomatch |
0 | 567 |
28 | 568 if {$upublic == 0} { |
569 set ulimit 5 | |
570 } else { | |
571 set ulimit 3 | |
572 } | |
19
9cf22053e5da
Repair !urlfind functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
18
diff
changeset
|
573 |
28 | 574 ### Parse the given command |
575 urllog_log "$unick/$uhand searched URL: $utext" | |
0 | 576 |
28 | 577 set ftokens [split $utext " "] |
578 set fpatlist "" | |
579 foreach ftoken $ftokens { | |
580 set fprefix [string range $ftoken 0 0] | |
581 set fpattern [string range $ftoken 1 end] | |
0 | 582 |
28 | 583 if {$fprefix == "-"} { |
584 lappend fpatlist "url NOT LIKE '%[urllog_escape $fpattern]%'" | |
585 } elseif {$fprefix == "%"} { | |
586 lappend fpatlist "user='[urllog_escape $fpattern]'" | |
587 } elseif {$fprefix == "@"} { | |
588 # foo | |
589 } else { | |
590 lappend fpatlist "url LIKE '%[urllog_escape $ftoken]%'" | |
591 } | |
592 } | |
19
9cf22053e5da
Repair !urlfind functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
18
diff
changeset
|
593 |
27
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
594 if {[llength $fpatlist] > 0} { |
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
595 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
|
596 } else { |
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
597 set fquery "" |
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
598 } |
68 | 599 |
28 | 600 set iresults 0 |
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
601 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 | 602 urldb eval $usql { |
28 | 603 incr iresults |
604 set shortURL $uurl | |
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
605 if {$urllog_shorturl != 0 && $uid != ""} { |
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
606 set shortURL "$shortURL [urllog_get_short $uid]" |
28 | 607 } |
608 urllog_msg $upublic $unick $uchan "#$iresults: $shortURL ($uuser@[urllog_ctime $utime])" | |
609 } | |
610 | |
611 if {$iresults == 0} { | |
612 # If no URLs were found | |
613 urllog_msg $upublic $unick $uchan $urlmsg_nomatch | |
614 } | |
0 | 615 |
28 | 616 return 0 |
0 | 617 } |
618 | |
619 | |
620 #------------------------------------------------------------------------- | |
621 ### Finding binded functions | |
622 proc urllog_pub_urlfind {unick uhost uhand uchan utext} { | |
28 | 623 urllog_find $unick $uhand $uchan $utext 1 |
624 return 0 | |
0 | 625 } |
626 | |
627 | |
628 proc urllog_msg_urlfind {unick uhost uhand utext} { | |
28 | 629 urllog_find $unick $uhand "" $utext 0 |
630 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
|
631 } |
0 | 632 |
633 # end of script |