Mercurial > hg > egg-tcls

comparison urllog.tcl @ 659:eddf0ff17fbd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
urllog: Use new HTTP helpers from utillib.
author Matti Hamalainen <ccr@tnsp.org>
date Fri, 19 Feb 2021 21:03:26 +0200
parents 10ea2c1101b3
children afe4b1fe5e79
comparison
equal deleted inserted replaced
658:33580ee2579e 659:eddf0ff17fbd
209 return 1 209 return 1
210 } 210 }
211 211
212 212
213 #------------------------------------------------------------------------- 213 #-------------------------------------------------------------------------
214 proc urllog_clear_request { urlStatus urlSCode urlCode urlData urlMeta } { 214 proc urllog_do_request { urlNick urlChan urlStr urlStatus urlSCode urlCode urlData urlMeta } {
215 215
216 ### Clear the request data
217 upvar $urlStatus ustatus 216 upvar $urlStatus ustatus
218 upvar $urlSCode uscode 217 upvar $urlSCode uscode
219 upvar $urlCode ucode 218 upvar $urlCode ucode
220 upvar $urlData udata 219 upvar $urlData udata
221 upvar $urlMeta umeta 220 upvar $urlMeta umeta
222 221
223 unset ustatus
224 unset uscode
225 unset ucode
226 unset udata
227 array unset umeta
228 }
229
230
231 #-------------------------------------------------------------------------
232 proc urllog_do_request { urlNick urlChan urlStr urlStatus urlSCode urlCode urlData urlMeta } {
233
234 upvar $urlStatus ustatus
235 upvar $urlSCode uscode
236 upvar $urlCode ucode
237 upvar $urlData udata
238 upvar $urlMeta umeta
239
240 set urlHeaders {} 222 set urlHeaders {}
241 lappend urlHeaders "Accept-Encoding" "identity" 223 lappend urlHeaders "Accept-Encoding" "identity"
242 #lappend urlHeaders "Connection" "keep-alive" 224 #lappend urlHeaders "Connection" "keep-alive"
243 225
244 ### Perform request 226 set uresult [utl_http_do_request $urlHeaders $urlStr ustatus uscode ucode udata umeta]
245 if {[catch {set utoken [::http::geturl $urlStr -timeout 6000 -binary 1 -headers $urlHeaders]} uerrmsg]} { 227 if {$uresult == -1} {
246 urllog_verb_msg 1 $urlNick $urlChan "err_http_get" [list $urlStr $uerrmsg] 228 urllog_verb_msg 1 $urlNick $urlChan "err_http_get" [list $urlStr $uscode]
247 urllog_log "HTTP request failed: $uerrmsg" 229 urllog_log "HTTP request failed: $uscode"
248 return 0 230 return 0
249 } 231 } elseif {$uresult < 0} {
250
251 ### Check status
252 set ustatus [::http::status $utoken]
253 set uscode [::http::code $utoken]
254 set ucode [::http::ncode $utoken]
255
256 if {$ustatus != "ok"} {
257 urllog_verb_msg 1 $urlNick $urlChan "err_http_status" [list $urlStr $ustatus $uscode $ucode] 232 urllog_verb_msg 1 $urlNick $urlChan "err_http_status" [list $urlStr $ustatus $uscode $ucode]
258 urllog_log "Error in HTTP request: $ustatus / $uscode ($urlStr)" 233 urllog_log "Error in HTTP request: $ustatus / $uscode ($urlStr)"
259 return 0 234 return 0
260 }
261
262 ### Get data
263 set udata [::http::data $utoken]
264 array set umeta [::http::meta $utoken]
265 ::http::cleanup $utoken
266
267 ### Sanitize the metadata KEYS
268 foreach {ukey uvalue} [array get umeta] {
269 set ukey [string tolower $ukey]
270 set umeta($ukey) $uvalue
271 } 235 }
272 236
273 return 1 237 return 1
274 } 238 }
275 239
397 if {![urllog_validate_url $urlNick $urlChan ustr uproto uhostname]} { 361 if {![urllog_validate_url $urlNick $urlChan ustr uproto uhostname]} {
398 return 0 362 return 0
399 } 363 }
400 364
401 ### Attempt to fetch redirection target 365 ### Attempt to fetch redirection target
402 urllog_clear_request ustatus uscode ucode udata umeta 366 utl_http_clear_request ustatus uscode ucode udata umeta
367
403 if {![urllog_do_request $urlNick $urlChan $ustr ustatus uscode ucode udata umeta]} { 368 if {![urllog_do_request $urlNick $urlChan $ustr ustatus uscode ucode udata umeta]} {
404 urllog_verb_msg 1 $urlNick $urlChan "err_redirect_fail" [list $ustr $ustatus $uscode $ucode $urlRedirLevel] 369 urllog_verb_msg 1 $urlNick $urlChan "err_redirect_fail" [list $ustr $ustatus $uscode $ucode $urlRedirLevel]
405 urllog_log "Error fetching redirect: status=$ustatus, code=$ucode, scode=$uscode, url=$ustr, redirLevel=$urlRedirLevel" 370 urllog_log "Error fetching redirect: status=$ustatus, code=$ucode, scode=$uscode, url=$ustr, redirLevel=$urlRedirLevel"
406 return 0 371 return 0
407 } 372 }