Mercurial > hg > egg-tcls
annotate urllog.tcl @ 570:0e3ee1f51c80
urllog: Cosmetics.
| author | Matti Hamalainen <ccr@tnsp.org> |
|---|---|
| date | Sun, 20 Sep 2020 18:47:16 +0300 |
| parents | 537df683836c |
| children | d4d2fda12308 |
| rev | line source |
|---|---|
| 0 | 1 ########################################################################## |
| 2 # | |
| 563 | 3 # URLLog v2.5.0 by Matti 'ccr' Hamalainen <ccr@tnsp.org> |
|
493
ace795974e66
urllog: Bump copyright year.
Matti Hamalainen <ccr@tnsp.org>
parents:
479
diff
changeset
|
4 # (C) Copyright 2000-2020 Tecnic Software productions (TNSP) |
| 0 | 5 # |
|
113
077c7383f36f
urllog: Add line about the script's license.
Matti Hamalainen <ccr@tnsp.org>
parents:
112
diff
changeset
|
6 # This script is freely distributable under GNU GPL (version 2) license. |
|
077c7383f36f
urllog: Add line about the script's license.
Matti Hamalainen <ccr@tnsp.org>
parents:
112
diff
changeset
|
7 # |
| 0 | 8 ########################################################################## |
| 9 # | |
|
458
cfbe6acc1d73
urllog: tcl-tls 1.7.x (tested with 1.7.13) is now a requirement. It is
Matti Hamalainen <ccr@tnsp.org>
parents:
457
diff
changeset
|
10 # NOTICE! NOTICE! This script REQUIRES tcl-tls 1.7.13+ if you wish to |
|
cfbe6acc1d73
urllog: tcl-tls 1.7.x (tested with 1.7.13) is now a requirement. It is
Matti Hamalainen <ccr@tnsp.org>
parents:
457
diff
changeset
|
11 # support SSL/TLS https for URL checking. And you probably do. |
|
cfbe6acc1d73
urllog: tcl-tls 1.7.x (tested with 1.7.13) is now a requirement. It is
Matti Hamalainen <ccr@tnsp.org>
parents:
457
diff
changeset
|
12 # |
|
50
f69363fc1f61
Update some comments and add a bit of documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
49
diff
changeset
|
13 # 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
|
14 # This script requires SQLite TCL extension. Under Debian, you need: |
|
17e542b7985a
urllog, quotedb: Improve documentation.
Matti Hamalainen <ccr@tnsp.org>
parents:
73
diff
changeset
|
15 # 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
|
16 # |
|
479
fc3b6bc37927
urllog: Improve documentation slightly.
Matti Hamalainen <ccr@tnsp.org>
parents:
473
diff
changeset
|
17 # If you are doing a fresh install, you will need to create the initial |
|
fc3b6bc37927
urllog: Improve documentation slightly.
Matti Hamalainen <ccr@tnsp.org>
parents:
473
diff
changeset
|
18 # database with the required table schemas. You can do that by running |
|
503
fdd1f0b83685
urllog: Migration from old versions hasn't been supported in reality for a
Matti Hamalainen <ccr@tnsp.org>
parents:
493
diff
changeset
|
19 # "create_urllog_db.tcl". You also need to set up the configuration in |
|
fdd1f0b83685
urllog: Migration from old versions hasn't been supported in reality for a
Matti Hamalainen <ccr@tnsp.org>
parents:
493
diff
changeset
|
20 # "config.urllog" file. |
| 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 |
|
263
f01d60175c44
urllog: Move configuration to external file.
Matti Hamalainen <ccr@tnsp.org>
parents:
260
diff
changeset
|
24 ### The configuration should be in config.urllog in same directory |
|
f01d60175c44
urllog: Move configuration to external file.
Matti Hamalainen <ccr@tnsp.org>
parents:
260
diff
changeset
|
25 ### as this script. Or change the line below to point where ever |
|
f01d60175c44
urllog: Move configuration to external file.
Matti Hamalainen <ccr@tnsp.org>
parents:
260
diff
changeset
|
26 ### you wish. See "config.urllog.example" for an example config file. |
|
f01d60175c44
urllog: Move configuration to external file.
Matti Hamalainen <ccr@tnsp.org>
parents:
260
diff
changeset
|
27 source [file dirname [info script]]/config.urllog |
| 0 | 28 |
|
291
54d34d086b47
urllog: Use the utility lib for entity conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
289
diff
changeset
|
29 ### Required utillib.tcl |
|
54d34d086b47
urllog: Use the utility lib for entity conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
289
diff
changeset
|
30 source [file dirname [info script]]/utillib.tcl |
|
54d34d086b47
urllog: Use the utility lib for entity conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
289
diff
changeset
|
31 |
| 0 | 32 |
| 33 ########################################################################## | |
| 34 # No need to look below this line | |
| 35 ########################################################################## | |
| 560 | 36 package require sqlite3 |
| 37 package require http | |
| 38 | |
| 0 | 39 set urllog_name "URLLog" |
| 563 | 40 set urllog_version "2.5.0" |
| 560 | 41 set urllog_message "$urllog_name v$urllog_version (C) 2000-2020 ccr/TNSP" |
| 42 | |
| 0 | 43 |
|
300
2a9ee3f68225
urllog: Make TLD check configurable.
Matti Hamalainen <ccr@tnsp.org>
parents:
299
diff
changeset
|
44 set urllog_tld_list [split $urllog_tld_list ","] |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
422
diff
changeset
|
45 set urllog_httprep [split "\@|%40|{|%7B|}|%7D|\[|%5B|\]|%5D" "|"] |
| 561 | 46 set urllog_shorturl_str "ABCDEFGHIJKLNMOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" |
| 0 | 47 |
|
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
|
48 |
| 0 | 49 ### Binding initializations |
|
531
137d61a0b5b7
urllog: Rename two functions.
Matti Hamalainen <ccr@tnsp.org>
parents:
503
diff
changeset
|
50 bind pub - !urlfind urllog_pub_cmd_urlfind |
|
137d61a0b5b7
urllog: Rename two functions.
Matti Hamalainen <ccr@tnsp.org>
parents:
503
diff
changeset
|
51 bind msg - !urlfind urllog_msg_cmd_urlfind |
| 249 | 52 bind pubm - *.* urllog_check_line |
| 53 bind topc - *.* urllog_check_line | |
| 0 | 54 |
| 55 | |
| 56 #------------------------------------------------------------------------- | |
| 57 ### Utility functions | |
| 560 | 58 proc urllog_log {umsg} { |
|
267
da239a953e24
urllog: Change some setting names, etc.
Matti Hamalainen <ccr@tnsp.org>
parents:
264
diff
changeset
|
59 global urllog_log_enable urllog_name |
| 0 | 60 |
|
267
da239a953e24
urllog: Change some setting names, etc.
Matti Hamalainen <ccr@tnsp.org>
parents:
264
diff
changeset
|
61 if {$urllog_log_enable != 0} { |
| 560 | 62 putlog "$urllog_name: $umsg" |
| 28 | 63 } |
| 0 | 64 } |
| 65 | |
| 66 | |
| 67 proc urllog_isnumber {uarg} { | |
| 28 | 68 foreach i [split $uarg {}] { |
|
65
31c8c4f50aa6
urllog: Improve urllog_isnumber function.
Matti Hamalainen <ccr@tnsp.org>
parents:
62
diff
changeset
|
69 if {![string match \[0-9\] $i]} { return 0 } |
| 28 | 70 } |
|
65
31c8c4f50aa6
urllog: Improve urllog_isnumber function.
Matti Hamalainen <ccr@tnsp.org>
parents:
62
diff
changeset
|
71 return 1 |
| 0 | 72 } |
| 73 | |
| 74 | |
| 75 proc urllog_msg {apublic anick achan amsg} { | |
| 28 | 76 global urllog_preferredmsg |
| 0 | 77 |
| 28 | 78 if {$apublic == 1} { |
| 79 putserv "$urllog_preferredmsg $achan :$amsg" | |
| 80 } else { | |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
422
diff
changeset
|
81 putserv "$urllog_preferredmsg $anick :$amsg" |
| 28 | 82 } |
| 0 | 83 } |
| 84 | |
| 85 | |
| 86 proc urllog_verb_msg {anick achan amsg} { | |
| 28 | 87 global urllog_verbose |
| 0 | 88 |
| 28 | 89 if {$urllog_verbose != 0} { |
| 90 urllog_msg 1 $anick $achan $amsg | |
| 91 } | |
| 0 | 92 } |
| 93 | |
| 94 | |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
95 proc urllog_sanitize_encoding {uencoding} { |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
96 regsub -- "^\[a-z\]\[a-z\]_\[A-Z\]\[A-Z\]\." $uencoding "" uencoding |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
97 set uencoding [string tolower $uencoding] |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
98 regsub -- "^iso-" $uencoding "iso" uencoding |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
99 return $uencoding |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
100 } |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
101 |
| 294 | 102 |
| 0 | 103 #------------------------------------------------------------------------- |
|
150
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
104 proc urllog_get_short {utime} { |
|
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
105 global urllog_shorturl_prefix urllog_shorturl_str |
|
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
106 |
|
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
107 set ulen [string length $urllog_shorturl_str] |
| 0 | 108 |
| 28 | 109 set u1 [expr $utime / ($ulen * $ulen)] |
| 110 set utmp [expr $utime % ($ulen * $ulen)] | |
| 111 set u2 [expr $utmp / $ulen] | |
| 112 set u3 [expr $utmp % $ulen] | |
| 0 | 113 |
|
150
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
114 return "\[ $urllog_shorturl_prefix[string index $urllog_shorturl_str $u1][string index $urllog_shorturl_str $u2][string index $urllog_shorturl_str $u3] \]" |
|
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
115 } |
| 0 | 116 |
| 117 | |
| 118 #------------------------------------------------------------------------- | |
| 119 proc urllog_chop_url {url} { | |
| 28 | 120 global urllog_shorturl_orig |
| 68 | 121 |
| 28 | 122 if {[string length $url] > $urllog_shorturl_orig} { |
| 123 return "[string range $url 0 $urllog_shorturl_orig]..." | |
| 124 } else { | |
| 125 return $url | |
| 126 } | |
| 0 | 127 } |
| 128 | |
| 241 | 129 |
| 0 | 130 #------------------------------------------------------------------------- |
|
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
|
131 proc urllog_exists {urlStr urlNick urlHost urlChan} { |
| 28 | 132 global urldb urlmsg_alreadyknown urllog_shorturl |
|
315
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
133 global urllog_msg_channels |
| 0 | 134 |
|
295
141bb4a2b76f
utillib: utl_escape (which will be deprecated soon).
Matti Hamalainen <ccr@tnsp.org>
parents:
294
diff
changeset
|
135 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='[utl_escape $urlStr]'" |
| 297 | 136 urldb eval $usql { |
| 28 | 137 urllog_log "URL said by $urlNick ($urlStr) already known" |
| 138 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
|
139 set qstr "[urllog_get_short $uid] " |
| 28 | 140 } else { |
| 141 set qstr "" | |
| 142 } | |
|
422
880a07485275
Add utl_ctime() to utillib and use it elsewhere.
Matti Hamalainen <ccr@tnsp.org>
parents:
372
diff
changeset
|
143 append qstr "($uuser/$uchan@[utl_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
|
144 if {[string length $utitle] > 0} { |
| 311 | 145 set qstr "$urlmsg_alreadyknown - '$utitle' $qstr" |
| 28 | 146 } else { |
| 147 set qstr "$urlmsg_alreadyknown $qstr" | |
| 148 } | |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
422
diff
changeset
|
149 |
|
315
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
150 if {[utl_match_delim_list $urllog_msg_channels $uchan]} { |
|
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
151 urllog_verb_msg $urlNick $urlChan $qstr |
|
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
152 } |
| 28 | 153 return 0 |
| 154 } | |
|
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
|
155 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
|
156 } |
| 0 | 157 |
|
18
1e2232135354
More changes for SQLite support.
Matti Hamalainen <ccr@tnsp.org>
parents:
13
diff
changeset
|
158 |
|
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
|
159 #------------------------------------------------------------------------- |
|
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
|
160 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
|
161 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
|
162 |
|
93
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
163 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
|
164 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
|
165 } else { |
|
295
141bb4a2b76f
utillib: utl_escape (which will be deprecated soon).
Matti Hamalainen <ccr@tnsp.org>
parents:
294
diff
changeset
|
166 set uins "'[utl_escape $urlTitle]'" |
|
93
4e02c0219afe
urllog: Insert NULL into title column when we didn't get a title.
Matti Hamalainen <ccr@tnsp.org>
parents:
92
diff
changeset
|
167 } |
|
295
141bb4a2b76f
utillib: utl_escape (which will be deprecated soon).
Matti Hamalainen <ccr@tnsp.org>
parents:
294
diff
changeset
|
168 set usql "INSERT INTO urls (utime,url,user,host,chan,title) VALUES ([unixtime], '[utl_escape $urlStr]', '[utl_escape $urlNick]', '[utl_escape $urlHost]', '[utl_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
|
169 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
|
170 urllog_log "$uerrmsg on SQL:\n$usql" |
| 28 | 171 return 0 |
| 172 } | |
|
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
173 set uid [urldb last_insert_rowid] |
| 28 | 174 urllog_log "Added URL ($urlNick@$urlChan): $urlStr" |
| 0 | 175 |
| 176 | |
| 28 | 177 ### Let's say something, to confirm that everything went well. |
| 178 if {$urllog_shorturl != 0} { | |
|
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
179 set qstr "[urllog_get_short $uid] " |
| 28 | 180 } else { |
| 181 set qstr "" | |
| 182 } | |
| 183 if {[string length $urlTitle] > 0} { | |
| 311 | 184 urllog_verb_msg $urlNick $urlChan "'$urlTitle' ([urllog_chop_url $urlStr]) $qstr" |
| 28 | 185 } else { |
| 186 urllog_verb_msg $urlNick $urlChan "[urllog_chop_url $urlStr] $qstr" | |
| 187 } | |
| 0 | 188 |
| 28 | 189 return 1 |
| 0 | 190 } |
| 191 | |
| 192 | |
| 193 #------------------------------------------------------------------------- | |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
194 proc urllog_dorequest { urlNick urlChan urlStr urlStatus urlSCode urlCode urlData urlMeta } { |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
195 global urlmsg_ioerror urlmsg_timeout urlmsg_errorgettingdoc |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
196 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
197 upvar 1 $urlStatus ustatus |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
198 upvar 1 $urlSCode uscode |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
199 upvar 1 $urlCode ucode |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
200 upvar 1 $urlData udata |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
201 upvar 1 $urlMeta umeta |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
202 |
|
456
102dc89488af
urllog: Improve how http headers are formed.
Matti Hamalainen <ccr@tnsp.org>
parents:
425
diff
changeset
|
203 set urlHeaders {} |
|
102dc89488af
urllog: Improve how http headers are formed.
Matti Hamalainen <ccr@tnsp.org>
parents:
425
diff
changeset
|
204 lappend urlHeaders "Accept-Encoding" "identity" |
|
457
a7029d65796b
urllog: Do not use Connection: keep-alive for production.
Matti Hamalainen <ccr@tnsp.org>
parents:
456
diff
changeset
|
205 # lappend urlHeaders "Connection" "keep-alive" |
|
456
102dc89488af
urllog: Improve how http headers are formed.
Matti Hamalainen <ccr@tnsp.org>
parents:
425
diff
changeset
|
206 |
|
102dc89488af
urllog: Improve how http headers are formed.
Matti Hamalainen <ccr@tnsp.org>
parents:
425
diff
changeset
|
207 if {[catch {set utoken [::http::geturl $urlStr -timeout 6000 -binary 1 -headers $urlHeaders]} uerrmsg]} { |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
208 urllog_verb_msg $urlNick $urlChan "$urlmsg_ioerror ($uerrmsg)" |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
209 urllog_log "HTTP request failed: $uerrmsg" |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
210 return 0 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
211 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
212 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
213 set ustatus [::http::status $utoken] |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
214 if {$ustatus == "timeout"} { |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
215 urllog_verb_msg $urlNick $urlChan "$urlmsg_timeout" |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
216 urllog_log "HTTP request timed out ($urlStr)" |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
217 return 0 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
218 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
219 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
220 if {$ustatus != "ok"} { |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
221 urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ([::http::error $utoken])" |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
222 urllog_log "Error in HTTP transaction: [::http::error $utoken] ($urlStr)" |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
223 return 0 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
224 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
225 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
226 set ustatus [::http::status $utoken] |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
227 set uscode [::http::code $utoken] |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
228 set ucode [::http::ncode $utoken] |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
229 set udata [::http::data $utoken] |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
230 array set umeta [::http::meta $utoken] |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
231 ::http::cleanup $utoken |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
232 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
233 return 1 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
234 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
235 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
236 #------------------------------------------------------------------------- |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
237 proc urllog_validate_url { urlNick urlChan urlMStr urlMProto urlMHostName } { |
|
302
f487cc166714
urllog: Add message for unknown TLDs.
Matti Hamalainen <ccr@tnsp.org>
parents:
300
diff
changeset
|
238 global urllog_tld_list urlmsg_nosuchhost urllog_httprep urlmsg_unknown_tld |
|
300
2a9ee3f68225
urllog: Make TLD check configurable.
Matti Hamalainen <ccr@tnsp.org>
parents:
299
diff
changeset
|
239 global urllog_shorturl_prefix urllog_shorturl urllog_check_tld |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
240 upvar 1 $urlMStr urlStr |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
241 upvar 1 $urlMProto urlProto |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
242 upvar 1 $urlMHostName urlHostName |
|
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
|
243 |
|
96
e5a6c27be365
urllog: Comments and cosmetics.
Matti Hamalainen <ccr@tnsp.org>
parents:
95
diff
changeset
|
244 ### Try to guess the URL protocol component (if it is missing) |
| 28 | 245 set u_checktld 1 |
|
464
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
246 if {![string match "http://*" $urlStr] && ![string match "https://*" $urlStr] && ![string match "ftp://*" $urlStr] && ![string match "*://*" $urlStr]} { |
|
372
9dd4d2e3a4ac
urllog: Fix missing http(s)/ftp:// protocol prefix guessing.
Matti Hamalainen <ccr@tnsp.org>
parents:
329
diff
changeset
|
247 if {[string match "*www.*" $urlStr]} { |
|
9dd4d2e3a4ac
urllog: Fix missing http(s)/ftp:// protocol prefix guessing.
Matti Hamalainen <ccr@tnsp.org>
parents:
329
diff
changeset
|
248 set urlStr "http://$urlStr" |
|
9dd4d2e3a4ac
urllog: Fix missing http(s)/ftp:// protocol prefix guessing.
Matti Hamalainen <ccr@tnsp.org>
parents:
329
diff
changeset
|
249 } elseif {[string match "*ftp.*" $urlStr]} { |
|
9dd4d2e3a4ac
urllog: Fix missing http(s)/ftp:// protocol prefix guessing.
Matti Hamalainen <ccr@tnsp.org>
parents:
329
diff
changeset
|
250 set urlStr "ftp://$urlStr" |
|
9dd4d2e3a4ac
urllog: Fix missing http(s)/ftp:// protocol prefix guessing.
Matti Hamalainen <ccr@tnsp.org>
parents:
329
diff
changeset
|
251 } |
| 28 | 252 } |
| 0 | 253 |
|
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
|
254 ### Handle URLs that have an IPv4-address |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
255 if {[regexp "(\[a-z\]+)://(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})\\.(\[0-9\]{1,3})" $urlStr urlMatch urlProto ni1 ni2 ni3 ni4]} { |
| 28 | 256 # Check if the IP is on local network |
|
92
f6f4595856ff
urllog: Cosmetics. Remove useless parenthesis.
Matti Hamalainen <ccr@tnsp.org>
parents:
91
diff
changeset
|
257 if {$ni1 == 127 || $ni1 == 10 || ($ni1 == 192 && $ni2 == 168) || $ni1 == 0} { |
| 28 | 258 urllog_log "URL pointing to local or invalid network, ignored ($urlStr)." |
| 259 return 0 | |
| 260 } | |
| 261 # Skip TLD check for URLs with IP address | |
| 262 set u_checktld 0 | |
| 263 } | |
| 0 | 264 |
|
96
e5a6c27be365
urllog: Comments and cosmetics.
Matti Hamalainen <ccr@tnsp.org>
parents:
95
diff
changeset
|
265 ### Check now if we have an ShortURL here ... |
|
150
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
266 if {[string match "$urllog_shorturl_prefix*" $urlStr]} { |
|
98
fbbe7ee40e2f
urllog: Improve one informational / error message.
Matti Hamalainen <ccr@tnsp.org>
parents:
97
diff
changeset
|
267 urllog_log "Ignoring ShortURL from $urlNick: $urlStr" |
|
252
eb2fce89b8ab
urllog: Comment out some currently unused code.
Matti Hamalainen <ccr@tnsp.org>
parents:
251
diff
changeset
|
268 # set uud "" |
|
eb2fce89b8ab
urllog: Comment out some currently unused code.
Matti Hamalainen <ccr@tnsp.org>
parents:
251
diff
changeset
|
269 # set usql "SELECT id AS uid, url AS uurl, user AS uuser, host AS uhost, chan AS uchan, title AS utitle FROM urls WHERE utime=$uud" |
|
eb2fce89b8ab
urllog: Comment out some currently unused code.
Matti Hamalainen <ccr@tnsp.org>
parents:
251
diff
changeset
|
270 # urldb eval $usql { |
|
eb2fce89b8ab
urllog: Comment out some currently unused code.
Matti Hamalainen <ccr@tnsp.org>
parents:
251
diff
changeset
|
271 # urllog_verb_msg $urlNick $urlChan "'$utitle' - $uurl" |
|
eb2fce89b8ab
urllog: Comment out some currently unused code.
Matti Hamalainen <ccr@tnsp.org>
parents:
251
diff
changeset
|
272 # return 1 |
|
eb2fce89b8ab
urllog: Comment out some currently unused code.
Matti Hamalainen <ccr@tnsp.org>
parents:
251
diff
changeset
|
273 # } |
| 28 | 274 return 0 |
| 275 } | |
| 0 | 276 |
|
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
|
277 ### Get URL protocol component |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
278 set urlProto "" |
|
464
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
279 if {[regexp "(\[a-z\]+)://" $urlStr urlMatch urlProto]} { |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
280 ### Is it a http or ftp url? |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
281 if {$urlProto != "http" && $urlProto != "https" && $urlProto != "ftp"} { |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
282 urllog_log "Broken URL from $urlNick: ($urlStr) UNSUPPORTED protocol class ($urlProto)." |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
283 return 0 |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
284 } |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
285 } else { |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
286 urllog_log "Broken URL from $urlNick: ($urlStr), no protocol specifier." |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
287 return 0 |
|
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
288 } |
|
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
|
289 |
| 28 | 290 ### Check the PORT (if the ":" is there) |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
291 set urlRecord [split $urlStr "/"] |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
292 set urlHostName [lindex $urlRecord 2] |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
293 set urlPort [lindex [split $urlHostName ":"] end] |
| 0 | 294 |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
295 if {![urllog_isnumber $urlPort] && $urlPort != "" && $urlPort != $urlHostName} { |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
296 urllog_log "Broken URL from $urlNick: ($urlStr) illegal port $urlPort" |
| 28 | 297 return 0 |
| 298 } | |
| 0 | 299 |
| 28 | 300 ### Check the Top Level Domain (TLD) validity |
|
300
2a9ee3f68225
urllog: Make TLD check configurable.
Matti Hamalainen <ccr@tnsp.org>
parents:
299
diff
changeset
|
301 if {$urllog_check_tld != 0 && $u_checktld != 0} { |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
302 set u_sane [lindex [split $urlHostName "."] end] |
| 28 | 303 set u_tld [lindex [split $u_sane ":"] 0] |
| 304 set u_found 0 | |
| 0 | 305 |
| 28 | 306 if {[string length $u_tld] == 2} { |
| 307 # Assume all 2-letter domains to be valid :) | |
| 308 set u_found 1 | |
| 309 } else { | |
| 310 # Check our list of known TLDs | |
|
300
2a9ee3f68225
urllog: Make TLD check configurable.
Matti Hamalainen <ccr@tnsp.org>
parents:
299
diff
changeset
|
311 foreach itld $urllog_tld_list { |
| 28 | 312 if {[string match $itld $u_tld]} { |
| 313 set u_found 1 | |
| 314 } | |
| 315 } | |
| 316 } | |
| 0 | 317 |
| 28 | 318 if {$u_found == 0} { |
|
302
f487cc166714
urllog: Add message for unknown TLDs.
Matti Hamalainen <ccr@tnsp.org>
parents:
300
diff
changeset
|
319 urllog_log "Broken URL from $urlNick: ($urlStr) unknown TLD: ${u_tld}." |
|
f487cc166714
urllog: Add message for unknown TLDs.
Matti Hamalainen <ccr@tnsp.org>
parents:
300
diff
changeset
|
320 urllog_verb_msg $urlNick $urlChan $urlmsg_unknown_tld |
| 28 | 321 return 0 |
| 322 } | |
| 323 } | |
| 0 | 324 |
| 28 | 325 set urlStr [string map $urllog_httprep $urlStr] |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
326 return 1 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
327 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
328 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
329 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
330 #------------------------------------------------------------------------- |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
331 proc urllog_check_url {urlStr urlNick urlHost urlChan} { |
|
299
1ff281e821a3
urllog: Make rasiatube hack configurable.
Matti Hamalainen <ccr@tnsp.org>
parents:
298
diff
changeset
|
332 global urllog_encoding http_tls_support urlmsg_errorgettingdoc |
|
304
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
333 global urllog_extra_checks urllog_extra_strict urllog_rasiatube_hack |
|
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
|
334 |
|
91
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
335 ### 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
|
336 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
|
337 return 1 |
|
6f4bfd8e9447
urllog: Reorder code and make it simpler by removing duplicate checks.
Matti Hamalainen <ccr@tnsp.org>
parents:
90
diff
changeset
|
338 } |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
422
diff
changeset
|
339 |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
340 ### Validate URL compoments, etc. |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
341 set urlProto "" |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
342 set urlHostName "" |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
343 if {![urllog_validate_url $urlNick $urlChan urlStr urlProto urlHostName]} { |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
344 return 1 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
345 } |
| 0 | 346 |
|
267
da239a953e24
urllog: Change some setting names, etc.
Matti Hamalainen <ccr@tnsp.org>
parents:
264
diff
changeset
|
347 ### Do we perform additional checks? |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
348 if {$urllog_extra_checks == 0 || !(($http_tls_support != 0 && $urlProto == "https") || $urlProto == "http")} { |
| 230 | 349 # No optional checks, or it's not http/https. |
| 306 | 350 if {$urllog_extra_strict == 0} { |
|
304
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
351 # Strict checking disabled, so add the URL, if it does not exist already. |
|
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
352 urllog_addurl $urlStr $urlNick $urlHost $urlChan "" |
|
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
353 return 1 |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
354 } elseif {$http_tls_support == 0 && $urlProto == "https"} { |
|
304
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
355 # Strict ENABLED: If TLS support is disabled and we have https, do nothing |
|
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
356 return 1 |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
357 } elseif {$urlProto != "http" && $urlProto != "https"} { |
|
304
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
358 # Strict ENABLED: It's not http, or https |
|
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
359 return 1 |
|
f1589fe20732
urllog: Added urllog_extra_strict option.
Matti Hamalainen <ccr@tnsp.org>
parents:
302
diff
changeset
|
360 } |
| 28 | 361 } |
|
7
50b52294e93e
urllog: Strip ‏ entities from titles; Some work on SSL/https support.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
362 |
| 28 | 363 ### Does the document pointed by the URL exist? |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
364 if {![urllog_dorequest $urlNick $urlChan $urlStr ustatus uscode ucode udata umeta]} { |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
365 return 1 |
| 28 | 366 } |
| 0 | 367 |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
368 ### Handle redirects |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
369 if {$ucode >= 301 && $ucode <= 302} { |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
370 set nurlStr $umeta(Location) |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
371 if {![regexp "\[a-z\]+://" $nurlStr]} { |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
372 if {[string range $nurlStr 0 0] != "/"} { |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
373 append nurlStr "/" |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
374 } |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
375 set nurlStr "${urlProto}://${urlHostName}${nurlStr}" |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
376 } |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
377 urllog_log "Redirection: $urlStr -> $nurlStr" |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
378 set urlStr $nurlStr |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
379 |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
380 if {![urllog_validate_url $urlNick $urlChan urlStr urlProto urlHostName]} { |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
381 return 1 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
382 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
383 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
384 if {![urllog_dorequest $urlNick $urlChan $urlStr ustatus uscode ucode udata umeta]} { |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
385 return 1 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
386 } |
| 28 | 387 } |
|
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
|
388 |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
389 ### Handle 2nd level redirects |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
390 if {$ucode >= 301 && $ucode <= 302} { |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
391 set nurlStr $umeta(Location) |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
392 if {![regexp "\[a-z\]+://" $nurlStr]} { |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
393 if {[string range $nurlStr 0 0] != "/"} { |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
394 append nurlStr "/" |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
395 } |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
396 set nurlStr "${urlProto}://${urlHostName}${nurlStr}" |
|
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
397 } |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
398 urllog_log "Redirection #2: $urlStr -> $nurlStr" |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
399 set urlStr $nurlStr |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
400 |
|
327
a5282cdc56e6
urllog: Fix redirection handling for HTTP 1.1.
Matti Hamalainen <ccr@tnsp.org>
parents:
319
diff
changeset
|
401 if {![urllog_validate_url $urlNick $urlChan urlStr urlProto urlHostName]} { |
|
251
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
402 return 1 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
403 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
404 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
405 if {![urllog_dorequest $urlNick $urlChan $urlStr ustatus uscode ucode udata umeta]} { |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
406 return 1 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
407 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
408 } |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
409 |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
410 # Final document |
|
e59f0c3ea0f4
urllog: Handle first and second level redirects.
Matti Hamalainen <ccr@tnsp.org>
parents:
250
diff
changeset
|
411 if {$ucode >= 200 && $ucode <= 205} { |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
412 set uenc_doc "" |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
413 set uenc_http "" |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
414 set uencoding "" |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
415 |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
416 # Get information about specified character encodings |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
417 if {[info exists umeta(Content-Type)] && [regexp -nocase {charset\s*=\s*([a-z0-9._-]+)} $umeta(Content-Type) umatches uenc_http]} { |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
418 # Found character set encoding information in HTTP headers |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
419 } |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
420 |
|
150
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
421 if {[regexp -nocase -- "<meta.\*\?content=\"text/html.\*\?charset=(\[^\"\]*)\".\*\?/\?>" $udata umatches uenc_doc]} { |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
422 # Found old style HTML meta tag with character set information |
|
150
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
423 } elseif {[regexp -nocase -- "<meta.\*\?charset=\"(\[^\"\]*)\".\*\?/\?>" $udata umatches uenc_doc]} { |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
424 # Found HTML5 style meta tag with character set information |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
425 } |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
426 |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
427 # Make sanitized versions of the encoding strings |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
428 set uenc_http2 [urllog_sanitize_encoding $uenc_http] |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
429 set uenc_doc2 [urllog_sanitize_encoding $uenc_doc] |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
430 |
| 311 | 431 # Check if the document has specified encoding |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
432 # KLUDGE! |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
433 set uencoding $uenc_http2 |
|
318
5d886e2137d5
urllog: Fix character set conversion a bit.
Matti Hamalainen <ccr@tnsp.org>
parents:
315
diff
changeset
|
434 if {$uencoding == "" && $uenc_doc2 != ""} { |
|
5d886e2137d5
urllog: Fix character set conversion a bit.
Matti Hamalainen <ccr@tnsp.org>
parents:
315
diff
changeset
|
435 set uencoding $uenc_doc2 |
|
5d886e2137d5
urllog: Fix character set conversion a bit.
Matti Hamalainen <ccr@tnsp.org>
parents:
315
diff
changeset
|
436 } elseif {$uencoding == ""} { |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
422
diff
changeset
|
437 # If _NO_ known encoding of any kind, assume the default of iso8859-1 |
|
86
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
438 set uencoding "iso8859-1" |
|
4c2b6482c08c
urllog: Different strategy for charset encoding conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
84
diff
changeset
|
439 } |
| 0 | 440 |
| 311 | 441 urllog_log "Charsets: http='$uenc_http', doc='$uenc_doc' / sanitized http='$uenc_http2', doc='$uenc_doc2' -> '$uencoding'" |
| 442 | |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
443 # Get the document title, if any |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
444 set urlTitle "" |
|
470
2faf2eb18f26
urllog: Add support for Twitter meta titles.
Matti Hamalainen <ccr@tnsp.org>
parents:
469
diff
changeset
|
445 |
|
473
d155cec91375
urllog: Fixes to Twitter title matching.
Matti Hamalainen <ccr@tnsp.org>
parents:
472
diff
changeset
|
446 if {[regexp -nocase -- "<meta name=\"twitter:title\" content=\"(.\*\?)\"\\s\*\/\?>" $udata umatches urlTitle]} { |
|
470
2faf2eb18f26
urllog: Add support for Twitter meta titles.
Matti Hamalainen <ccr@tnsp.org>
parents:
469
diff
changeset
|
447 # ... |
|
2faf2eb18f26
urllog: Add support for Twitter meta titles.
Matti Hamalainen <ccr@tnsp.org>
parents:
469
diff
changeset
|
448 } elseif {[regexp -nocase -- "<title.\*\?>(.\*\?)</title>" $udata umatches urlTitle]} { |
|
2faf2eb18f26
urllog: Add support for Twitter meta titles.
Matti Hamalainen <ccr@tnsp.org>
parents:
469
diff
changeset
|
449 # ... |
|
2faf2eb18f26
urllog: Add support for Twitter meta titles.
Matti Hamalainen <ccr@tnsp.org>
parents:
469
diff
changeset
|
450 } |
|
313
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
451 |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
452 # If facebook, get meta info |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
453 if {[regexp -nocase -- "(http|https):\/\/www.facebook.com" $urlStr]} { |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
454 if {[regexp -nocase -- "<meta name=\"description\" content=\"(.\*\?)\"" $udata umatches urlTmp]} { |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
455 if {$urlTitle != ""} { append urlTitle " :: " } |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
456 append urlTitle $urlTmp |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
457 } |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
458 } |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
459 |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
460 # If character set conversion is required, do it now |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
461 if {$urlTitle != "" && $uencoding != ""} { |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
462 if {[catch {set urlTitle [encoding convertfrom $uencoding $urlTitle]} cerrmsg]} { |
|
8175ef52889b
urllog: Improve URL title functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
312
diff
changeset
|
463 urllog_log "Error in charset conversion: $cerrmsg" |
| 28 | 464 } |
|
150
52350ed97775
urllog: Cleanups, rename/move some global variables.
Matti Hamalainen <ccr@tnsp.org>
parents:
136
diff
changeset
|
465 |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
466 # Convert some HTML entities to plaintext and do some cleanup |
|
291
54d34d086b47
urllog: Use the utility lib for entity conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
289
diff
changeset
|
467 set utmp [utl_convert_html_ent $urlTitle] |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
468 regsub -all "\r|\n|\t" $utmp " " utmp |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
469 regsub -all " *" $utmp " " utmp |
|
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
470 set urlTitle [string trim $utmp] |
| 28 | 471 } |
|
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
|
472 |
|
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
|
473 # 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
|
474 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
|
475 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
|
476 } |
| 28 | 477 return 1 |
| 478 } else { | |
|
116
4f3edcf72987
urllog: Improvements in document / HTTP encoding handling and conversion.
Matti Hamalainen <ccr@tnsp.org>
parents:
115
diff
changeset
|
479 urllog_verb_msg $urlNick $urlChan "$urlmsg_errorgettingdoc ($ucode)" |
|
224
aaf433ab696a
urllog: Improve error messages a bit.
Matti Hamalainen <ccr@tnsp.org>
parents:
223
diff
changeset
|
480 urllog_log "Error fetching document: status=$ustatus, code=$ucode, scode=$uscode, url=$urlStr" |
| 28 | 481 } |
| 0 | 482 } |
| 483 | |
| 484 | |
| 485 #------------------------------------------------------------------------- | |
|
219
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
486 |
|
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
487 |
| 249 | 488 proc urllog_check_line {unick uhost uhand uchan utext} { |
|
219
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
489 global urllog_log_channels |
|
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
490 |
| 28 | 491 ### Check the nick |
| 87 | 492 if {$unick == "*"} { |
| 249 | 493 urllog_log "urllog_check_line: Nick was wc, this should not happen." |
| 28 | 494 return 0 |
| 495 } | |
| 0 | 496 |
|
219
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
497 ### Check the channel |
|
315
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
498 if {[utl_match_delim_list $urllog_log_channels $uchan]} { |
|
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
499 ### Do the URL checking |
|
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
500 foreach str [split $utext " "] { |
|
464
506977ea9d0c
urllog: Improve URL validation.
Matti Hamalainen <ccr@tnsp.org>
parents:
458
diff
changeset
|
501 if {[regexp "(\[a-z]+://\[^\[:space:\]\]+|^(www|ftp)\.\[^\[:space:\]\]+)" $str ulink]} { |
|
315
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
502 urllog_check_url $str $unick $uhost $uchan |
|
219
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
503 } |
| 28 | 504 } |
| 505 } | |
| 0 | 506 |
| 28 | 507 return 0 |
| 0 | 508 } |
| 509 | |
| 510 | |
| 511 #------------------------------------------------------------------------- | |
| 512 ### Parse arguments, find and show the results | |
| 513 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
|
514 global urllog_shorturl urldb |
| 28 | 515 global urllog_showmax_pub urllog_showmax_priv urlmsg_nomatch |
| 0 | 516 |
| 28 | 517 if {$upublic == 0} { |
| 518 set ulimit 5 | |
| 519 } else { | |
| 520 set ulimit 3 | |
| 521 } | |
|
19
9cf22053e5da
Repair !urlfind functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
18
diff
changeset
|
522 |
| 28 | 523 ### Parse the given command |
| 524 urllog_log "$unick/$uhand searched URL: $utext" | |
| 0 | 525 |
| 28 | 526 set ftokens [split $utext " "] |
| 527 set fpatlist "" | |
| 528 foreach ftoken $ftokens { | |
| 529 set fprefix [string range $ftoken 0 0] | |
| 530 set fpattern [string range $ftoken 1 end] | |
|
295
141bb4a2b76f
utillib: utl_escape (which will be deprecated soon).
Matti Hamalainen <ccr@tnsp.org>
parents:
294
diff
changeset
|
531 set qpattern "'%[utl_escape $fpattern]%'" |
| 0 | 532 |
| 28 | 533 if {$fprefix == "-"} { |
|
128
0d21b9d1d2b9
urllog: Improve search functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
127
diff
changeset
|
534 lappend fpatlist "(url NOT LIKE $qpattern OR title NOT LIKE $qpattern)" |
| 28 | 535 } elseif {$fprefix == "%"} { |
|
128
0d21b9d1d2b9
urllog: Improve search functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
127
diff
changeset
|
536 lappend fpatlist "user LIKE $qpattern" |
| 28 | 537 } elseif {$fprefix == "@"} { |
| 538 # foo | |
|
112
fae3dd7a8b20
urllog: Oops, a typo in variable name. Fixed.
Matti Hamalainen <ccr@tnsp.org>
parents:
111
diff
changeset
|
539 } elseif {$fprefix == "+"} { |
|
128
0d21b9d1d2b9
urllog: Improve search functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
127
diff
changeset
|
540 lappend fpatlist "(url LIKE $qpattern OR title LIKE $qpattern)" |
| 28 | 541 } else { |
|
295
141bb4a2b76f
utillib: utl_escape (which will be deprecated soon).
Matti Hamalainen <ccr@tnsp.org>
parents:
294
diff
changeset
|
542 set qpattern "'%[utl_escape $ftoken]%'" |
|
128
0d21b9d1d2b9
urllog: Improve search functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
127
diff
changeset
|
543 lappend fpatlist "(url LIKE $qpattern OR title LIKE $qpattern)" |
| 28 | 544 } |
| 545 } | |
|
19
9cf22053e5da
Repair !urlfind functionality.
Matti Hamalainen <ccr@tnsp.org>
parents:
18
diff
changeset
|
546 |
|
27
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
547 if {[llength $fpatlist] > 0} { |
|
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
548 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
|
549 } else { |
|
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
550 set fquery "" |
|
6e381916b016
Some fixes in the query mechanisms of QuoteDB and URLLog.
Matti Hamalainen <ccr@tnsp.org>
parents:
20
diff
changeset
|
551 } |
| 68 | 552 |
| 28 | 553 set iresults 0 |
|
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
554 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 | 555 urldb eval $usql { |
| 28 | 556 incr iresults |
| 557 set shortURL $uurl | |
|
82
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
558 if {$urllog_shorturl != 0 && $uid != ""} { |
|
1bbc79f41a1c
urllog: Rename few variables for clarity.
Matti Hamalainen <ccr@tnsp.org>
parents:
81
diff
changeset
|
559 set shortURL "$shortURL [urllog_get_short $uid]" |
| 28 | 560 } |
|
422
880a07485275
Add utl_ctime() to utillib and use it elsewhere.
Matti Hamalainen <ccr@tnsp.org>
parents:
372
diff
changeset
|
561 urllog_msg $upublic $unick $uchan "#$iresults: $shortURL ($uuser@[utl_ctime $utime])" |
| 28 | 562 } |
|
424
825cac46b1cb
Cosmetic / stray trailing whitespace cleanup.
Matti Hamalainen <ccr@tnsp.org>
parents:
422
diff
changeset
|
563 |
| 28 | 564 if {$iresults == 0} { |
| 565 # If no URLs were found | |
| 566 urllog_msg $upublic $unick $uchan $urlmsg_nomatch | |
| 567 } | |
| 0 | 568 |
| 28 | 569 return 0 |
| 0 | 570 } |
| 571 | |
| 572 | |
| 573 #------------------------------------------------------------------------- | |
| 574 ### Finding binded functions | |
|
531
137d61a0b5b7
urllog: Rename two functions.
Matti Hamalainen <ccr@tnsp.org>
parents:
503
diff
changeset
|
575 proc urllog_pub_cmd_urlfind {unick uhost uhand uchan utext} { |
|
219
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
576 global urllog_search_channels |
|
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
577 |
|
315
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
578 if {[utl_match_delim_list $urllog_search_channels $uchan]} { |
|
7a987b22a817
urllog: Add new configuration option urllog_msg_channels.
Matti Hamalainen <ccr@tnsp.org>
parents:
313
diff
changeset
|
579 return [urllog_find $unick $uhand $uchan $utext 1] |
|
219
4e09bcc48851
urllog: Add settings for specifying channels where URL logging is active, and where !urlfind functionality works (separately, if so desired.)
Matti Hamalainen <ccr@tnsp.org>
parents:
218
diff
changeset
|
580 } |
| 28 | 581 return 0 |
| 0 | 582 } |
| 583 | |
| 584 | |
|
531
137d61a0b5b7
urllog: Rename two functions.
Matti Hamalainen <ccr@tnsp.org>
parents:
503
diff
changeset
|
585 proc urllog_msg_cmd_urlfind {unick uhost uhand utext} { |
| 28 | 586 urllog_find $unick $uhand "" $utext 0 |
| 587 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
|
588 } |
| 0 | 589 |
| 560 | 590 |
| 591 #------------------------------------------------------------------------- | |
| 592 # Script initialization | |
| 593 #------------------------------------------------------------------------- | |
| 570 | 594 ### Initialization messages |
| 560 | 595 putlog "$urllog_message" |
| 596 | |
| 570 | 597 |
| 598 ### Miscellaneous init messages | |
| 560 | 599 if {$urllog_extra_checks != 0} { |
| 600 putlog " - Additional URL validity checks enabled." | |
| 601 } | |
| 602 | |
| 603 if {$urllog_check_tld != 0} { | |
| 604 putlog " - Check TLD enabled." | |
| 605 } | |
| 606 | |
| 607 if {$urllog_verbose != 0} { | |
| 608 putlog " - Verbose mode enabled." | |
| 609 } | |
| 610 | |
| 570 | 611 |
| 560 | 612 ### HTTP module initialization |
| 613 if {[info exists http_user_agent] && $http_user_agent != ""} { | |
| 614 ::http::config -useragent $http_user_agent | |
| 615 } else { | |
| 616 ::http::config -useragent "$urllog_name/$urllog_version" | |
| 617 } | |
| 618 | |
| 619 if {[info exists http_use_proxy] && $http_use_proxy != 0} { | |
| 620 ::http::config -proxyhost $http_proxy_host -proxyport $http_proxy_port | |
| 621 putlog " - Using proxy $http_proxy_host:$http_proxy_port" | |
| 622 } | |
| 623 | |
| 624 if {[info exists http_tls_support] && $http_tls_support != 0} { | |
| 625 package require tls | |
| 626 ::http::register https 443 [list ::tls::socket -request true -require true -ssl2 false -ssl3 false -tls1 true -tls1.1 true -tls1.2 true -cadir $http_tls_cadir -autoservername true] | |
| 627 putlog " - TLS/SSL support enabled." | |
| 628 } | |
| 629 | |
| 630 | |
| 631 ### SQLite database initialization | |
| 632 if {[catch {sqlite3 urldb $urllog_db_file} uerrmsg]} { | |
| 561 | 633 putlog "Could not open SQLite3 database '${urllog_db_file}': ${uerrmsg}" |
| 560 | 634 exit 2 |
| 635 } | |
| 636 | |
| 637 | |
| 0 | 638 # end of script |