104
105
106
107
108
109
110
111
112
113
|
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
+
+
+
+
+
+
+
+
+
+
|
if {$force || ![info exists forceSecureUri]} then {
set forceSecureUri true
}
#
# NOTE: Should the HTTP request processor fail if the "tls" package is
# not available?
#
variable mustHaveTls; # DEFAULT: true
if {$force || ![info exists mustHaveTls]} then {
set mustHaveTls true
}
#
# NOTE: Is this HTTP request processor allowed to use plain HTTP if/when
# the "tls" package is not available? This should only be changed
# if the "tls" package cannot be easily installed for use with the
# native Tcl interpreter in use. It should be noted here that the
|
225
226
227
228
229
230
231
232
233
234
|
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
+
+
+
+
+
+
|
# NOTE: This variable is used to determine if plain HTTP URIs should be
# converted to HTTPS, if the "tls" package is available.
#
variable forceSecureUri
#
# NOTE: This variable is used to determine if an error should be raised
# if the "tls" package is not available.
#
variable mustHaveTls
#
# NOTE: This variable is used to determine if plain HTTP is allowed if
# the "tls" package is not available.
#
variable allowInsecureUri
|
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
|
283
284
285
286
287
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
|
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
-
+
+
+
+
+
+
+
-
-
+
+
|
namespace eval ::tcl::unsupported {}
set ::tcl::unsupported::socketAF inet
}
#
# 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://
#
# NOTE: If the 'tls' package is available, always attempt to use HTTPS;
# 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}] == 0} then {
if {[catch {package require tls} error] == 0} then {
::http::register https 443 [list ::tls::socket -tls1 true]
if {$forceSecureUri} then {
if {[string range $uri 0 6] eq "http://"} then {
set uri [appendArgs https:// [string range $uri 7 end]]
if {[string tolower [string range $uri 0 6]] eq $http} then {
set uri [appendArgs $https [string range $uri 7 end]]
}
}
} else {
if {$mustHaveTls} then {
error [appendArgs \
"the \"tls\" package cannot be loaded: " $error]
}
if {$allowInsecureUri} then {
if {[string range $uri 0 7] eq "https://"} then {
set uri [appendArgs http:// [string range $uri 8 end]]
if {[string tolower [string range $uri 0 7]] eq $https} then {
set uri [appendArgs $http [string range $uri 8 end]]
}
}
}
#
|
414
415
416
417
418
419
420
421
422
423
424
425
|
445
446
447
448
449
450
451
452
453
454
455
456
|
-
-
+
+
|
# NOTE: For security, by default, do NOT follow an HTTP
# redirect if it attempts to redirect from HTTPS
# to HTTP.
#
if {!$allowInsecureRedirect && \
[string range $uri 0 7] eq "https://" && \
[string range $location 0 7] ne "https://"} then {
[string tolower [string range $uri 0 7]] eq $https && \
[string tolower [string range $location 0 7]] ne $https} then {
#
# NOTE: Just "give up" and raise a script error.
#
::http::cleanup $token; error [appendArgs \
"refused insecure redirect from \"" $uri "\" to \"" \
|