Package Downloads Server: Check-in [5790d1dd55]

Overview

Comment:	Address chicken-and-egg issues related to the 'http' and 'tls' packages. Add 'allowInsecureHttp' setting to permit insecure HTTP requests to be issued by the client. Prevent the package downloader from using the API keys associated with the package repository. Add and update comments.
Downloads:	Tarball \| ZIP archive \| SQL archive
Timelines:	family \| ancestors \| descendants \| both \| trunk
Files:	files \| file ages \| folders
SHA1:	5790d1dd55310833988f9b508b07c3ea4f9d60c9
User & Date:	mistachkin on 2016-09-15 08:19:42
Other Links:	manifest \| tags

Context

2016-09-17
00:02		Make sure that the TLS protocol is always enabled when downloading via HTTPS. check-in: fbe498f5f3 user: mistachkin tags: trunk
2016-09-15
08:19		Address chicken-and-egg issues related to the 'http' and 'tls' packages. Add 'allowInsecureHttp' setting to permit insecure HTTP requests to be issued by the client. Prevent the package downloader from using the API keys associated with the package repository. Add and update comments. check-in: 5790d1dd55 user: mistachkin tags: trunk
2016-09-14
21:41		Add 'apply' compatibility shim for native Tcl 8.4. Enhance and update comments. check-in: 2bfdcf67cf user: mistachkin tags: trunk

Changes

Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified client/1.0/pkgd.eagle from [cc28280428] to [64d1062216].

Modified client/1.0/pkgd.eagle.asc from [fe86dd5643] to [1ae1ea5c61].

Modified client/1.0/pkgd.eagle.harpy from [008374ed6e] to [893c5734c0].

Modified client/1.0/pkgd.eagle.harpy.asc from [386b489277] to [8fe81ed6c3].

Modified client/1.0/pkgr.eagle from [5031a13764] to [3124877c79].

Modified client/1.0/pkgr.eagle.asc from [6f0e9043c2] to [868ee097b3].

Modified client/1.0/pkgr.eagle.harpy from [b956793b69] to [b911adf9d7].

Modified client/1.0/pkgr.eagle.harpy.asc from [94cc581ee8] to [222750b24a].

︙			︙
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90	unset -nocomplain pkgr_path } # # NOTE: This procedure is used to provide a TIP #194 compatible [apply] # command to the native Tcl 8.4 interpreter. Eagle and native Tcl ~~# 8.5 (or higher) have this command built-in.~~ # if {[llength [info commands ::apply]] == 0} then { proc ::apply { lambdaExpr args } { set length [llength $lambdaExpr] if {$length < 2 \|\| $length > 3} { error [appendArgs \	\| > > > > > >	76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96	unset -nocomplain pkgr_path } # # NOTE: This procedure is used to provide a TIP #194 compatible [apply] # command to the native Tcl 8.4 interpreter. Eagle and native Tcl # 8.5 (or higher) have this command built-in. The lambdaExpr # argument must be a list with two or three elements. The first # element is the list of arguments to the procedure. The second # element is the body of the procedure. The third element is the # target namespace for the procedure. If the third element is not # specified, the global namespace is used. Any remaining arguments # are passed to the procedure verbatim. # if {[llength [info commands ::apply]] == 0} then { proc ::apply { lambdaExpr args } { set length [llength $lambdaExpr] if {$length < 2 \|\| $length > 3} { error [appendArgs \
︙			︙
101 102 103 104 105 106 107 ~~108~~ 109 110 111 112 113 114 115	return [uplevel 1 [list $procName] $args] } } # # NOTE: This procedure returns a formatted, possibly version-specific, ~~# package name, for use in logging.~~ # proc formatPackageName { package version } { return [string trim [appendArgs $package " " $version]] } # # NOTE: This procedure returns a formatted script result. If the string	\| > >	107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123	return [uplevel 1 [list $procName] $args] } } # # NOTE: This procedure returns a formatted, possibly version-specific, # package name, for use in logging. The package argument is the # name of the package. The version argument is the version of the # package. # proc formatPackageName { package version } { return [string trim [appendArgs $package " " $version]] } # # NOTE: This procedure returns a formatted script result. If the string
︙			︙
313 314 315 316 317 318 319 ~~320~~ 321 322 ~~323~~ 324 325 326 327 328 329 330 331 332 333 334 335 336 337 ~~338~~ 339 ~~340~~ 341 342 343 344 345 346 347	} # # NOTE: This procedure returns the list of API keys to use when looking # up packages via the package repository server. An empty list # is returned if no API keys are currently configured. The prefix # argument is an extra variable name prefix to check prior to any ~~# that are already configured.~~ # # <internal> ~~proc getApiKeys { {prefix ""} } {~~ global env variable autoApiKeys # # NOTE: If the caller specified a variable name prefix, try to use it # first. # set prefixes [list] if {[string length $prefix] > 0} then { lappend prefixes $prefix } # ~~# NOTE: Next, fallback to the variable name prefix for this package.~~ # ~~lappend prefixes [getLookupVarNamePrefix]~~ # # NOTE: Try each variable name prefix, in order, until a set of API # keys is found. # foreach prefix $prefixes { #	\| > > \| \| > > \| >	321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360	} # # NOTE: This procedure returns the list of API keys to use when looking # up packages via the package repository server. An empty list # is returned if no API keys are currently configured. The prefix # argument is an extra variable name prefix to check prior to any # that are already configured. The prefixOnly argument should be # non-zero to exclude any API keys other than those based on the # prefix specified by the caller. # # <internal> proc getApiKeys { {prefix ""} {prefixOnly false} } { global env variable autoApiKeys # # NOTE: If the caller specified a variable name prefix, try to use it # first. # set prefixes [list] if {[string length $prefix] > 0} then { lappend prefixes $prefix } # # NOTE: Next, fallback to the variable name prefix for this package, # unless the caller has forbidden us to do so. # if {!$prefixOnly} then { lappend prefixes [getLookupVarNamePrefix] } # # NOTE: Try each variable name prefix, in order, until a set of API # keys is found. # foreach prefix $prefixes { #
︙			︙
370 371 372 373 374 375 376 ~~377~~ 378 ~~379~~ 380 381 382 383 384 385 386	if {[info exists env($varName)]} then { return $env($varName) } } # ~~# NOTE: If there is a default list of API keys, just return it.~~ # ~~~~if {~~[info exists autoApiKeys] && [llength $autoApiKeys] > 0} then {~~ return $autoApiKeys } # # NOTE: Otherwise, return the system default, which is "anonymous" # packages only (i.e. those without any owners). #	\| > > \|	383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401	if {[info exists env($varName)]} then { return $env($varName) } } # # NOTE: If there is a default list of API keys, just return it, # unless the caller has forbidden us to do so. # if {!$prefixOnly && \ [info exists autoApiKeys] && [llength $autoApiKeys] > 0} then { return $autoApiKeys } # # NOTE: Otherwise, return the system default, which is "anonymous" # packages only (i.e. those without any owners). #
︙			︙
727 728 729 730 731 732 733 ~~734~~ 735 736 737 738 739 740 741	set metadata(certificate) $certificate } } # # NOTE: This procedure, which may only be used from an Eagle script, checks # if a native Tcl library is loaded and ready. If not, a script error ~~# is raised.~~ # proc tclMustBeReady {} { # # NOTE: This procedure is useless when running in native Tcl; therefore, # forbid its use there. # if {![isEagle]} then {	\|	742 743 744 745 746 747 748 749 750 751 752 753 754 755 756	set metadata(certificate) $certificate } } # # NOTE: This procedure, which may only be used from an Eagle script, checks # if a native Tcl library is loaded and ready. If not, a script error # is raised. There are no arguments. # proc tclMustBeReady {} { # # NOTE: This procedure is useless when running in native Tcl; therefore, # forbid its use there. # if {![isEagle]} then {
︙			︙
750 751 752 753 754 755 756 ~~757~~ 758 759 760 761 762 763 764	error "cannot use Tcl language, supporting library is not loaded" } } # # NOTE: This procedure is designed for Eagle. It attempts to load the # "best" native Tcl library. It may raise any number of script ~~# errors.~~ # proc makeTclReady {} { # # NOTE: This procedure is useless when running in native Tcl; therefore, # forbid its use there. # if {![isEagle]} then {	\|	765 766 767 768 769 770 771 772 773 774 775 776 777 778 779	error "cannot use Tcl language, supporting library is not loaded" } } # # NOTE: This procedure is designed for Eagle. It attempts to load the # "best" native Tcl library. It may raise any number of script # errors. There are no arguments. # proc makeTclReady {} { # # NOTE: This procedure is useless when running in native Tcl; therefore, # forbid its use there. # if {![isEagle]} then {
︙			︙
777 778 779 780 781 782 783 ~~784~~ 785 786 787 788 789 790 791	# tclMustBeReady } # # NOTE: This procedure, which may only be used from a native Tcl script, # checks if Garuda and Eagle are loaded and ready. If not, a script ~~# error is raised.~~ # proc eagleMustBeReady {} { # # NOTE: This procedure is useless when running in Eagle; therefore, # forbid its use there. # if {[isEagle]} then {	\|	792 793 794 795 796 797 798 799 800 801 802 803 804 805 806	# tclMustBeReady } # # NOTE: This procedure, which may only be used from a native Tcl script, # checks if Garuda and Eagle are loaded and ready. If not, a script # error is raised. There are no arguments. # proc eagleMustBeReady {} { # # NOTE: This procedure is useless when running in Eagle; therefore, # forbid its use there. # if {[isEagle]} then {
︙			︙
800 801 802 803 804 805 806 ~~807~~ 808 809 810 811 812 813 814	error "cannot use Eagle language, supporting package is not loaded" } } # # NOTE: This procedure is designed for native Tcl. It attempts to load # the Garuda package and gain access to Eagle. It may raise any ~~# number of script errors.~~ # proc makeEagleReady {} { # # NOTE: This procedure is useless when running in Eagle; therefore, # forbid its use there. # if {[isEagle]} then {	\|	815 816 817 818 819 820 821 822 823 824 825 826 827 828 829	error "cannot use Eagle language, supporting package is not loaded" } } # # NOTE: This procedure is designed for native Tcl. It attempts to load # the Garuda package and gain access to Eagle. It may raise any # number of script errors. There are no arguments. # proc makeEagleReady {} { # # NOTE: This procedure is useless when running in Eagle; therefore, # forbid its use there. # if {[isEagle]} then {
︙			︙
1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206	} } } else { error "unsupported script certificate" } } # # NOTE: This procedure performs initial setup of the package repository # client, using the current configuration parameters. There are # no arguments. It may load the Garuda package when evaluated in # native Tcl. It may load a native Tcl library when evaluated in # Eagle. It may install the [package unknown] hook. #	> > > > > > > > > > > > > > > > > > > > > > > >	1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245	} } } else { error "unsupported script certificate" } } # # NOTE: This procedure returns non-zero if the specified package can be # downloaded, i.e. because it is not required for the downloading # process itself to be functional, etc. The package argument is # the name of the package to check. # proc canDownloadPackage { package } { # # NOTE: Since the "http" and "tls" packages are required from within # the custom [package unknown] itself, in order to locate and # download the requested package, we must return false here to # prevent needless recursion. # if {[lsearch -exact [list http tls] $package] != -1} then { return false } # # NOTE: Currently, all other packages, including Garuda, are legal to # handle from the custom [package unknown] handler. # return true } # # NOTE: This procedure performs initial setup of the package repository # client, using the current configuration parameters. There are # no arguments. It may load the Garuda package when evaluated in # native Tcl. It may load a native Tcl library when evaluated in # Eagle. It may install the [package unknown] hook. #
︙			︙
1314 1315 1316 1317 1318 1319 1320 ~~1321 1322 1323~~ 1324 ~~1325 1326 1327 1328~~ 1329 1330 1331 1332 1333 1334 1335	# proc packageUnknownHandler { package {version ""} } { variable verboseUnknownResult # # NOTE: First, run our special [package unknown] handler. # ~~set code(1) [catch { getPackageFromRepository $package $version handler } result(1)]~~ if {$verboseUnknownResult} then { pkgLog [appendArgs \ "repository handler results for package \"" [formatPackageName \ $package $version] "\" are " [formatResult $code(1) $result(1)]] } # # NOTE: Next, run the saved [package unknown] handler. # set code(2) [catch { runSavedPackageUnknownHandler $package $version	> \| \| \| \| \| \| \| >	1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376	# proc packageUnknownHandler { package {version ""} } { variable verboseUnknownResult # # NOTE: First, run our special [package unknown] handler. # if {[canDownloadPackage $package]} then { set code(1) [catch { getPackageFromRepository $package $version handler } result(1)] if {$verboseUnknownResult} then { pkgLog [appendArgs \ "repository handler results for package \"" [formatPackageName \ $package $version] "\" are " [formatResult $code(1) $result(1)]] } } # # NOTE: Next, run the saved [package unknown] handler. # set code(2) [catch { runSavedPackageUnknownHandler $package $version
︙			︙
1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428	# # NOTE: This procedure sets up the default values for all configuration # parameters used by the package repository client. There are no # arguments. # proc setupPackageUnknownVars {} { # # NOTE: What is the default set of API keys if none were set explicitly? # This list is subject to change at any time -AND- may be empty or # may contain non-working API keys, please do not rely on it. # variable autoApiKeys; # DEFAULT: 0000000000000000000000000000000000000000	> > > > > > > > > > > > > > >	1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484	# # NOTE: This procedure sets up the default values for all configuration # parameters used by the package repository client. There are no # arguments. # proc setupPackageUnknownVars {} { # # 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 # official package repository server reserves the right to refuse # plain HTTP connections, which means that changing this setting # may be totally pointless. # variable allowInsecureHttp; # DEFAULT: false if {![info exists allowInsecureHttp]} then { set allowInsecureHttp false } # # NOTE: What is the default set of API keys if none were set explicitly? # This list is subject to change at any time -AND- may be empty or # may contain non-working API keys, please do not rely on it. # variable autoApiKeys; # DEFAULT: 0000000000000000000000000000000000000000
︙			︙
1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 ~~1657~~ 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671	# designed to process a single HTTP request, including any HTTP # 3XX redirects (up to the specified limit), and return the raw # HTTP response data. It does not contain special code to handle # HTTP status codes other than 3XX (e.g. 4XX, 5XX, etc). # # <public> proc getFileViaHttp { uri redirectLimit channel quiet args } { # # NOTE: This variable is used to keep track of the currently scheduled # (i.e. pending) [after] event. # variable afterForPageProgress # # NOTE: This procedure requires the modern version of the HTTP package, # which is typically included with the Tcl core distribution. # package require http 2.0 # ~~# NOTE: If the 'tls' package is available, always attempt to use HTTPS.~~ # if {[catch {package require tls}] == 0} then { ::http::register https 443 ::tls::socket if {[string range $uri 0 6] eq "http://"} then { set uri [appendArgs https:// [string range $uri 7 end]] } } # # NOTE: Unless the caller forbids it, display progress messages during # the download. # if {!$quiet} then {	> > > > > > \| > > > > >	1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738	# designed to process a single HTTP request, including any HTTP # 3XX redirects (up to the specified limit), and return the raw # HTTP response data. It does not contain special code to handle # HTTP status codes other than 3XX (e.g. 4XX, 5XX, etc). # # <public> proc getFileViaHttp { uri redirectLimit channel quiet args } { # # NOTE: This variable is used to determine if plain HTTP is allowed if # the "tls" package is not available. # variable allowInsecureHttp # # NOTE: This variable is used to keep track of the currently scheduled # (i.e. pending) [after] event. # variable afterForPageProgress # # NOTE: This procedure requires the modern version of the HTTP package, # which is typically included with the Tcl core distribution. # package require http 2.0 # # 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 { ::http::register https 443 ::tls::socket if {[string range $uri 0 6] eq "http://"} then { set uri [appendArgs https:// [string range $uri 7 end]] } } elseif {$allowInsecureHttp} then { if {[string range $uri 0 7] eq "https://"} then { set uri [appendArgs http:// [string range $uri 8 end]] } } # # NOTE: Unless the caller forbids it, display progress messages during # the download. # if {!$quiet} then {
︙			︙