288
289
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
|
288
289
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
329
330
|
-
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
|
# NOTE: Setup lowercase URI scheme prefixes used within this procedure
# to detect and/or change the URI scheme used. By default, this
# 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]]
}
}
}
#
# NOTE: Unless the caller forbids it, display progress messages during
# the download.
|
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
|
-
+
|
# this platform. So far, this issue has only been seen
# with the tls 1.6.1 package that shipped with macOS.
#
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.
#
switch -glob -- $code {
|
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
|
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
|
-
+
+
+
+
-
+
|
#
# NOTE: We hit another HTTP redirect. Stop if there are more
# 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"]
}
|
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
|
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
|
-
-
+
+
+
+
-
-
+
+
+
-
+
+
-
-
+
+
|
#
# 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.
#
set uri $location
#
# NOTE: Cleanup the current HTTP token now beause a new
# one will be created for the next request.
#
::http::cleanup $token
} 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]
}
5?? {
|