| ︙ | | |
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
|
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
|
-
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
|
# procedure will always attempt to force HTTPS use when the "tls"
# package is available -AND- it disallows redirects from HTTPS to
# HTTP -AND- it disallows using HTTP when the "tls" package is
# unavailable.
#
set http http://; set https https://
set http http://
set httpLen [string length $http]
set httpEnd [expr {$httpLen - 1}]
set https https://
set httpsLen [string length $https]
set httpsEnd [expr {$httpsLen - 1}]
#
# NOTE: If the "tls" package is available, always attempt to use HTTPS;
# otherwise, only attempt to use HTTP if explicitly allowed.
#
if {[catch {package require tls} error] == 0} then {
::http::register https 443 [list ::tls::socket -tls1 true]
if {$forceSecureUri} then {
if {[string tolower [string range $uri 0 6]] eq $http} then {
set uri [appendArgs $https [string range $uri 7 end]]
if {[string tolower [string range $uri 0 $httpEnd]] eq $http} then {
set uri [appendArgs $https [string range $uri $httpLen end]]
}
}
} else {
if {$mustHaveTls} then {
error [appendArgs \
"the \"tls\" package cannot be loaded: " $error]
}
if {$allowInsecureUri} then {
if {[string tolower [string range $uri 0 7]] eq $https} then {
set uri [appendArgs $http [string range $uri 8 end]]
if {[string tolower [string range $uri 0 $httpsEnd]] eq $https} then {
set uri [appendArgs $http [string range $uri $httpsLen end]]
}
}
}
#
|
| ︙ | | |
363
364
365
366
367
368
369
370
371
372
373
|
369
370
371
372
373
374
375
376
377
378
379
|
-
+
|
#
if {[string length $code] == 0} then {
error [appendArgs \
"received empty HTTP response code for URL \"" $uri \
"\", the \"tls\" (and/or \"http\") package(s) may be " \
"broken for this platform"]
"broken for this Tcl installation (or platform)"]
}
#
# NOTE: Check the HTTP response code, in order to follow any HTTP
# redirect responses.
|
| ︙ | | |
414
415
416
417
418
419
420
421
422
423
424
425
426
|
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
|
-
+
+
+
+
-
+
|
# than X.
#
incr redirectCount
#
# TODO: Maybe make this limit more configurable?
# TODO: Maybe make this limit more configurable? The caller
# can pass any negative integer to disable it entirely
# -OR- zero to completely disallow any redirects.
#
if {$redirectLimit >= 0 && \
if {$redirectCount > $redirectLimit} then {
$redirectCount > $redirectLimit} then {
#
# NOTE: Just "give up" and raise a script error.
#
::http::cleanup $token; error [appendArgs \
"redirection limit of " $redirectLimit " exceeded"]
|
| ︙ | | |
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
|
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
|
-
-
+
+
+
+
-
-
+
+
+
|
# NOTE: For security, by default, do NOT follow an HTTP
# redirect if it attempts to redirect from HTTPS
# to HTTP.
#
if {!$allowInsecureRedirect && \
[string tolower [string range $uri 0 7]] eq $https && \
[string tolower [string range $location 0 7]] ne $https} then {
[string tolower [string range \
$uri 0 $httpsEnd]] eq $https && \
[string tolower [string range \
$location 0 $httpsEnd]] ne $https} then {
#
# NOTE: Just "give up" and raise a script error.
#
::http::cleanup $token; error [appendArgs \
"refused insecure redirect from \"" $uri "\" to \"" \
$location \"]
"refused (insecure) redirect from \"" $uri \
"\" to \"" $location \
"\" with HTTP response status code " $code]
}
#
# NOTE: Replace the original URI with the new one, for
# use in the next HTTP request.
|
| ︙ | | |
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
|
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
|
-
+
+
-
-
+
+
|
} else {
#
# NOTE: Just "give up" and raise a script error.
#
::http::cleanup $token; error [appendArgs \
"redirect from \"" $uri "\" missing location, code " \
"redirect from \"" $uri \
"\" missing location, HTTP response status code " \
$code ", data: " $data]
}
}
300 -
304 -
305 -
306 {
::http::cleanup $token; error [appendArgs \
"unsupported redirection HTTP response status code " $code \
", data: " $data]
"unsupported redirection HTTP response status code " \
$code ", data: " $data]
}
4?? {
::http::cleanup $token; error [appendArgs \
"client error HTTP response status code " $code ", data: " \
$data]
|
| ︙ | | |