1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
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
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
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
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
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
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
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
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
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
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
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
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
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
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
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
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
| ###############################################################################
#
# pkgd.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Downloader Client
#
# Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################
#
# NOTE: Use our own namespace here because even though we do not directly
# support namespaces ourselves, we do not want to pollute the global
# namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::PackageDownloader {
#
# NOTE: This procedure emits a message to the package downloader client
# log. The string argument is the content of the message to emit.
#
proc pkgLog { string } {
catch {
tclLog [appendArgs [pid] " : " [clock seconds] " : pkgd : " $string]
}
}
#
# NOTE: This procedure sets up the default values for all URN configuration
# parameters used by the package downloader client. If the force
# argument is non-zero, any existing values will be overwritten and
# set back to their default values.
#
proc setupDownloadServerVars { force } {
#
# NOTE: The URN, relative to the base URI, where the Package Signing Keys
# may be downloaded.
#
variable openPgpKeyUrn; # DEFAULT: pkg_keys
if {$force || ![info exists openPgpKeyUrn]} then {
set openPgpKeyUrn pkg_keys
}
#
# NOTE: The fallback URN, relative to the base URI, where the Package
# Signing Keys may be downloaded. This should only be used when
# the primary URN did not produce valid data.
#
variable openPgpKeyUrnFallback1; # DEFAULT: pkg_keys_mirror_1
if {$force || ![info exists openPgpKeyUrnFallback1]} then {
set openPgpKeyUrnFallback1 pkg_keys_mirror_1
}
#
# NOTE: The URN, relative to the base URI, where a login request may
# be sent.
#
variable loginUrn; # DEFAULT: pkgd_login
if {$force || ![info exists loginUrn]} then {
set loginUrn pkgd_login
}
#
# NOTE: The URN, relative to the base URI, where the list of supported
# platforms for a single package may be found.
#
variable platformsUrn; # DEFAULT: pkgd_platforms
if {$force || ![info exists platformsUrn]} then {
set platformsUrn pkgd_platforms
}
#
# NOTE: The URN, relative to the base URI, where a single package file
# may be found.
#
variable downloadUrn; # DEFAULT: pkgd_file
if {$force || ![info exists downloadUrn]} then {
set downloadUrn pkgd_file
}
#
# NOTE: The URN, relative to the base URI, where a logout request may
# be sent.
#
variable logoutUrn; # DEFAULT: pkgd_logout
if {$force || ![info exists logoutUrn]} then {
set logoutUrn pkgd_logout
}
}
#
# NOTE: This procedure sets up the default values for all version
# configuration parameters used by the package downloader client.
# If the force argument is non-zero, any existing values will be
# overwritten and set back to their default values.
#
proc setupDownloadVersionVars { force } {
#
# NOTE: The name of the branch where the package files should be fetched
# from.
#
variable branchName; # DEFAULT: trunk
if {$force || ![info exists branchName]} then {
set branchName trunk
}
}
#
# NOTE: This procedure sets up the default values for all URI configuration
# parameters used by the package downloader client. If the force
# argument is non-zero, any existing values will be overwritten and
# set back to their default values.
#
proc setupDownloadUriVars { force } {
#
# NOTE: The base URI used to build the URIs for the package file server.
#
variable baseUri; # DEFAULT: https://tcl.to/r
if {$force || ![info exists baseUri]} then {
set baseUri https://tcl.to/r
}
#
# NOTE: The URI where the Package Signing Keys may be downloaded. This
# should return a payload containing the OpenPGP key data.
#
variable openPgpKeyUri; # DEFAULT: ${baseUri}/${openPgpKeyUrn}
if {$force || ![info exists openPgpKeyUri]} then {
set openPgpKeyUri {${baseUri}/${openPgpKeyUrn}}
}
#
# NOTE: The fallback URI where the Package Signing Keys may be
# downloaded. This should return a payload containing the OpenPGP
# key data. This should only be used when the primary URN did not
# produce valid OpenPGP key data.
#
variable openPgpKeyUriFallback; # DEFAULT: .../${openPgpKeyUrnFallback1}
if {$force || ![info exists openPgpKeyUriFallback]} then {
set openPgpKeyUriFallback {${baseUri}/${openPgpKeyUrnFallback1}}
}
#
# NOTE: The URI where a login request may be sent. This should return a
# payload containing the necessary HTTP(S) cookie information.
#
variable loginUri; # DEFAULT: ${baseUri}/${loginUrn}?...
if {$force || ![info exists loginUri]} then {
set loginUri [appendArgs \
{${baseUri}/${loginUrn}?} {[uriEscape name $userName]} & \
{[uriEscape password $password]}]
}
#
# NOTE: The URI where the list of supported platforms for a single
# package may be found.
#
variable platformsUri; # DEFAULT: ${baseUri}/${platformsUrn}?...
if {$force || ![info exists platformsUri]} then {
set platformsUri {${baseUri}/${platformsUrn}?download&name=${branchName}}
}
#
# NOTE: The URI where a single package file may be found. This file will
# belong to a specific version of one package.
#
variable downloadUri; # DEFAULT: ${baseUri}/${downloadUrn}?...
if {$force || ![info exists downloadUri]} then {
set downloadUri [appendArgs \
{${baseUri}/${downloadUrn}?download&ci=${branchName}&} \
{[uriEscape filename $fileName]}]
}
#
# NOTE: The URI where a logout request should be sent. This should
# return a payload indicating that the logout was successful.
#
variable logoutUri; # DEFAULT: ${baseUri}/${logoutUrn}?...
if {$force || ![info exists logoutUri]} then {
set logoutUri [appendArgs \
{${baseUri}/${logoutUrn}?} {[uriEscape authToken $authToken]}]
}
}
#
# NOTE: This procedure sets up the default values for all configuration
# parameters used by the package downloader client. The script
# argument is the fully qualified path and file name for the script
# being evaluated.
#
proc setupDownloadVars { script force } {
#
# NOTE: What is the fully qualified path to the directory containing the
# package downloader client?
#
variable clientDirectory
if {$force || ![info exists clientDirectory]} then {
set clientDirectory [file normalize [file dirname $script]]
}
#
# NOTE: This is the HTTP(S) login cookie to use when downloading files
# from the package file server.
#
variable loginCookie; # DEFAULT: NONE
if {$force || ![info exists loginCookie]} then {
set loginCookie [list]
}
#
# NOTE: Prevent progress messages from being displayed while downloading
# from the repository, etc? By default, this is enabled.
#
variable quiet; # DEFAULT: true
if {$force || ![info exists quiet]} then {
set quiet true
}
#
# NOTE: Emit diagnostic messages when a new temporary directory name is
# created.
#
variable verboseTemporaryDirectory; # DEFAULT: false
if {$force || ![info exists verboseTemporaryDirectory]} then {
set verboseTemporaryDirectory false
}
#
# NOTE: The user name for the public account on the package file server.
# If this is an empty string, there is no public account.
#
variable publicUserName; # DEFAULT: public
if {$force || ![info exists publicUserName]} then {
set publicUserName public
}
#
# NOTE: The password associated with the public account on the package
# file server. If this is an empty string, the public account is
# disabled. This is not considered to be a secret; however, it
# should not be shared with any person or organization that does
# not have access to the package downloader client.
#
variable publicPassword; # DEFAULT: X+NlF2obS5tQFKIsf/q345/naqVSGD67Cg
if {$force || ![info exists publicPassword]} then {
set publicPassword X+NlF2obS5tQFKIsf/q345/naqVSGD67Cg
}
#
# NOTE: The root directory where any persistent packages will be saved.
#
variable persistentRootDirectory; # DEFAULT: [getPersistentRootDirectory]
if {$force || ![info exists persistentRootDirectory]} then {
set persistentRootDirectory [getPersistentRootDirectory]
}
#
# NOTE: The root directory where any temporary packages will be written.
#
variable temporaryRootDirectory; # DEFAULT: [getFileTempDirectory PKGD_TEMP]
if {$force || ![info exists temporaryRootDirectory]} then {
set temporaryRootDirectory \
[::PackageRepository::getFileTempDirectory PKGD_TEMP]
}
#
# NOTE: Is this package being run by the package installer tool? If so,
# all downloaded packages should be automatically persisted to the
# library path.
#
variable viaInstall; # DEFAULT: false
if {$force || ![info exists viaInstall]} then {
set viaInstall false
}
#
# NOTE: This is the name of the executable file used to invoke the
# Mono implementation, possibly without a file extension.
#
variable monoFileNameOnly; # DEFAULT: <unset>
if {$force || ![info exists monoFileNameOnly]} then {
if {[isWindows]} then {
set monoFileNameOnly mono.exe
} else {
set monoFileNameOnly mono
}
}
#
# NOTE: The command to use when attempting to verify that Mono and its
# associated runtimes are installed locally. Generally, this is
# not needed on Windows machines.
#
variable monoInstalledCommand; # DEFAULT: mono --version
if {$force || ![info exists monoInstalledCommand]} then {
set monoInstalledCommand {{${monoFileNameOnly}} --version}
}
#
# NOTE: The regular expression pattern used when attempting to verify
# that Mono and its associated runtimes are installed locally.
# Generally, this is not needed on Windows machines.
#
variable monoInstalledPattern; # DEFAULT: ^Mono JIT compiler version \d+\.
if {$force || ![info exists monoInstalledPattern]} then {
set monoInstalledPattern {^Mono JIT compiler version \d+\.}
}
#
# NOTE: This is the name of the executable file used to invoke the
# .NET Core implementation, possibly without a file extension.
#
variable dotnetFileNameOnly; # DEFAULT: <unset>
if {$force || ![info exists dotnetFileNameOnly]} then {
if {[isWindows]} then {
set dotnetFileNameOnly dotnet.exe
} else {
set dotnetFileNameOnly dotnet
}
}
#
# NOTE: The command to use when attempting to verify that .NET Core and
# its associated runtimes are installed locally. Generally, this
# is not needed on Windows machines.
#
variable dotnetInstalledCommand; # DEFAULT: dotnet --version
if {$force || ![info exists dotnetInstalledCommand]} then {
set dotnetInstalledCommand {{${dotnetFileNameOnly}} --version}
}
#
# NOTE: The regular expression pattern used when attempting to verify
# that .NET Core and its associated runtimes are installed locally.
# Generally, this is not needed on Windows machines.
#
variable dotnetInstalledPattern; # DEFAULT: ^\d+\.\d+(?:\.\d+)*$
if {$force || ![info exists dotnetInstalledPattern]} then {
set dotnetInstalledPattern {^\d+\.\d+(?:\.\d+)*$}
}
}
#
# NOTE: This procedure modifies the URN variables used by the package
# downloader client so that one or more alternative (private?)
# backend file servers may be used. The serverId argument must
# consist only of alphanumeric characters and it must begin with
# a letter.
#
# <public>
proc useServerId { {serverId ""} } {
variable downloadUrn
variable loginUrn
variable logoutUrn
variable openPgpKeyUrn
variable openPgpKeyUrnFallback1
variable platformsUrn
::PackageRepository::verifyServerId $serverId
if {[string length $serverId] > 0} then {
#
# NOTE: Reset the URN variables to values that should cause
# the specified server Id to be used (assume the server
# Id itself is valid and active).
#
# HACK: These prefixes are hard-coded and must be manually kept
# synchronized with those in the setupDownloadServerVars
# procedure.
#
set downloadUrn [appendArgs pkgd_file_ $serverId]
set loginUrn [appendArgs pkgd_login_ $serverId]
set logoutUrn [appendArgs pkgd_logout_ $serverId]
set openPgpKeyUrn [appendArgs pkg_keys_ $serverId]
set openPgpKeyUrnFallback1 [appendArgs pkg_keys_mirror_1_ $serverId]
set platformsUrn [appendArgs pkgd_platforms_ $serverId]
} else {
#
# NOTE: Forcibly reset URN variables to their default values.
#
setupDownloadServerVars true
}
}
#
# NOTE: This procedure modifies the version variables used by the package
# downloader client so that a specific version will be used. The
# versionId argument must consist only of hexadecimal characters.
#
# <public>
proc useVersionId { {versionId ""} } {
variable branchName
verifyVersionId $versionId
if {[string length $versionId] > 0} then {
#
# NOTE: Set the variables to values that should cause the specified
# version Id to be used (assume the version Id itself is valid
# and active).
#
set branchName $versionId; # TODO: Translations here?
} else {
#
# NOTE: Forcibly reset the variables to their default values.
#
setupDownloadVersionVars true
}
}
#
# NOTE: This procedure escapes a single name/value pair for use in a URI
# query string. The name argument is the name of the parameter.
# The value argument is the value of the parameter.
#
proc uriEscape { name value } {
if {[isEagle]} then {
return [appendArgs \
[uri escape data $name] = [uri escape data $value]]
} else {
package require http 2.0
return [::http::formatQuery $name $value]
}
}
#
# NOTE: This procedure returns the root directory where any packages that
# are downloaded should be saved to permanent storage for subsequent
# use. There are no arguments.
#
proc getPersistentRootDirectory {} {
global env
#
# NOTE: Allow the persistent root directory to be overridden via the
# environment. Typically, this customization will only be needed
# if multiple instances of Tcl need to share packages.
#
if {[info exists env(PKGD_ROOT)]} then {
return $env(PKGD_ROOT)
}
#
# NOTE: Fallback to returning a directory parallel to the one containing
# the library directory.
#
return [file join [file dirname [info library]] pkgd]
}
#
# NOTE: This procedure checks the configured persistent root directory for
# downloaded packages. If any checks fail, a script error is raised.
# There are no arguments. The return value is undefined.
#
proc verifyPersistentRootDirectory {} {
variable persistentRootDirectory
if {![info exists persistentRootDirectory]} then {
error "persistent root directory not set"
}
if {[string length $persistentRootDirectory] == 0} then {
error "persistent root directory is invalid"
}
#
# NOTE: Either the persistent root directory must already exist -OR- we
# must be able to create it.
#
if {![file isdirectory $persistentRootDirectory] && \
[catch {file mkdir $persistentRootDirectory}]} then {
error [appendArgs \
"persistent root directory \"" $persistentRootDirectory \
"\" does not exist and could not be created"]
}
}
#
# NOTE: This procedure returns the name of the package index file for the
# language specified by the language argument. An empty string will
# be returned if the language is unsupported or unrecognized.
#
proc getPackageIndexFileName { language } {
if {[string length $language] == 0 || $language eq "eagle"} then {
return pkgIndex.eagle
} elseif {$language eq "tcl"} then {
return pkgIndex.tcl
} else {
return ""
}
}
#
# NOTE: This procedure, which is only used for native Tcl, generates a
# "root" package index file (i.e. "pkgIndex.tcl") suitable for
# use with native Tcl 8.4 (or higher). It will recursively scan
# for all other native Tcl package index files that are within the
# configured persistent root directory and [source] them, thereby
# causing all packages located within them to become available.
# Since Eagle (by default) already performs recursive searches for
# its package index files, this procedure is not needed for Eagle.
# The return value is undefined.
#
proc maybeCreateRootTclPackageIndex {} {
variable persistentRootDirectory
verifyPersistentRootDirectory
set persistentDirectory $persistentRootDirectory
set fileName [file join $persistentDirectory pkgIndex.tcl]
if {[file exists $fileName]} then {return ""}
writeFile $fileName [string trim [string map [list \r\n \n] {
###############################################################################
#
# pkgIndex.tcl --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Generated Recursive Package Index File -- PLEASE DO NOT EDIT
#
# Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################
if {![package vsatisfies [package provide Tcl] 8.4]} {return}
if {[string length [package provide Eagle]] > 0} then {return}
set pkgd(savedDir) $dir; set pkgd(dirs) [list $pkgd(savedDir)]
for {set pkgd(i) 0} {$pkgd(i) < [llength $pkgd(dirs)]} {incr pkgd(i)} {
set pkgd(dir) [lindex $pkgd(dirs) $pkgd(i)]
if {$pkgd(i) > 0} then {
set pkgd(file) [file join $pkgd(dir) pkgIndex.tcl]
if {[file exists $pkgd(file)]} then {
set dir $pkgd(dir); source $pkgd(file)
}
}
eval lappend pkgd(dirs) \
[lsort [glob -nocomplain -types {d} [file join $pkgd(dir) *]]]
}
set dir $pkgd(savedDir); unset -nocomplain pkgd
}]]
return ""
}
#
# NOTE: This procedure attempts to download the Package Signing Keys from
# the remote server and save it to a local file. This procedure may
# raise script errors. The fileName argument is the name of the file
# where the downloaded data should be written. This procedure is only
# intended to be used from the "pkgr_setup.eagle" tool script and may
# go away in later versions of this package.
#
# <internal>
proc downloadAndSaveOpenPgpKeyFile { fileName } {
variable baseUri
variable openPgpKeyUri
variable openPgpKeyUriFallback
variable openPgpKeyUrn
variable openPgpKeyUrnFallback1
set errors [list]
foreach substUri [list $openPgpKeyUri $openPgpKeyUriFallback] {
#
# NOTE: Attempt to download the Package Signing Keys using the
# configured URI.
#
if {[catch {
#
# NOTE: First, build the actual URI where the Package Signing
# Keys should be obtained, performing any applicable
# substitutions in the URI prior to using it as the
# basis for downloading the Package Signing Keys file.
#
set uri [subst $substUri]
#
# NOTE: Then, in one step, download the file from the package
# file server and write it to the specified local file.
#
downloadOneUriToFile $fileName $uri false false
} result] == 0} then {
#
# NOTE: Ok, success. We are done.
#
return ""
} else {
#
# NOTE: Keep track of all errors that are encountered while
# trying to download the Package Signing Keys, for later
# reporting.
#
lappend errors [list $uri $result]
}
}
#
# NOTE: Make sure there is always an error message.
#
if {[llength $errors] == 0} then {
lappend errors "no URIs are available for package signing keys"
}
error $errors
}
#
# NOTE: This procedure returns non-zero if the specified file seems to be
# an OpenPGP signature file. The fileName argument is the name of
# the file to check, which may or may not exist. The nameOnly
# argument should be non-zero to ignore the contents of the file.
#
proc isOpenPgpSignatureFileName { fileName nameOnly } {
if {[string length $fileName] == 0} then {
return false
}
set extension [file extension $fileName]
if {$extension eq ".txt" || $extension eq ".asc"} then {
if {!$nameOnly && [file exists $fileName]} then {
return [::PackageRepository::isOpenPgpSignature \
[readFile $fileName]]
} else {
return true
}
} else {
return false
}
}
#
# NOTE: This procedure returns non-zero if the specified file seems to be
# a Harpy script certificate file. The fileName argument is the name
# of the file to check, which may or may not exist. The nameOnly
# argument should be non-zero to ignore the contents of the file.
#
# <notUsed>
proc isHarpyCertificateFileName { fileName nameOnly } {
if {[string length $fileName] == 0} then {
return false
}
set extension [file extension $fileName]
if {$extension eq ".harpy"} then {
if {!$nameOnly && [file exists $fileName]} then {
return [::PackageRepository::isHarpyCertificate \
[readFile $fileName]]
} else {
return true
}
} else {
return false
}
}
#
# NOTE: This procedure attempts to verify the specified OpenPGP signature
# file. If the forcePgp parameter is non-zero verification will be
# attempted even when the specified file does not appear to be an
# OpenPGP signature file. This procedure may raise script errors.
#
proc maybeVerifyOpenPgpSignature { fileName forcePgp } {
#
# NOTE: Is this temporary package file actually just an OpenPGP
# signature file? If so, skip it.
#
if {$forcePgp || \
[isOpenPgpSignatureFileName $fileName true]} then {
#
# NOTE: Attempt to verify the OpenPGP signature. If this fails,
# an error is raised.
#
::PackageRepository::probeForOpenPgpInstallation
::PackageRepository::openPgpMustBeInstalled
if {![::PackageRepository::verifyOpenPgpSignature \
$fileName]} then {
error [appendArgs \
"bad OpenPGP signature \"" $fileName \"]
}
}
}
#
# NOTE: This procedure returns the auto-path for the language specified by
# the language argument. An empty list is returned if the auto-path
# does not exist in the target language. This procedure may raise
# script errors.
#
proc getAutoPath { language } {
if {[string length $language] == 0 || $language eq "eagle"} then {
if {[isEagle]} then {
if {![info exists ::auto_path]} then {
return [list]
}
return $::auto_path
} else {
::PackageRepository::eagleMustBeReady
eagle {
if {![info exists ::auto_path]} then {
return [list]
}
return $::auto_path
}
}
} elseif {$language eq "tcl"} then {
if {[isEagle]} then {
tcl eval [tcl primary] {
if {![info exists ::auto_path]} then {
return [list]
}
return $::auto_path
}
} else {
if {![info exists ::auto_path]} then {
return [list]
}
return $::auto_path
}
} else {
error "unsupported language, no idea how to query auto-path"
}
}
#
# NOTE: This procedure adds a directory to the auto-path of the specified
# language (i.e. native Tcl or Eagle). The directory will not be
# added if it is already present. The language argument must be the
# literal string "eagle" or the literal string "tcl". The directory
# argument is the fully qualified path for the directory to add to
# the auto-path.
#
proc addToAutoPath { language directory } {
#
# NOTE: Add the specified directory to the auto-path if not already
# present.
#
if {[string length $language] == 0 || $language eq "eagle"} then {
if {[isEagle]} then {
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path $directory] == -1} then {
lappend ::auto_path $directory
}
} else {
::PackageRepository::eagleMustBeReady
eagle [string map [list %directory% $directory] {
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path {%directory%}] == -1} then {
lappend ::auto_path {%directory%}
}
}]
}
} elseif {$language eq "tcl"} then {
if {[isEagle]} then {
tcl eval [tcl primary] [string map [list %directory% $directory] {
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path {%directory%}] == -1} then {
lappend ::auto_path {%directory%}
}
}]
} else {
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path $directory] == -1} then {
lappend ::auto_path $directory
}
}
} else {
error "unsupported language, no idea how to modify auto-path"
}
}
#
# NOTE: This procedure adds a directory to the auto-path of the specified
# language (i.e. native Tcl or Eagle). The directory will not be
# added if it is already present. The language argument must be the
# literal string "eagle" or the literal string "tcl". The directory
# argument is the fully qualified path for the directory to add to
# the auto-path. The directory will not be added if it falls under
# a directory already in the auto-path.
#
proc maybeAddToAutoPath { language directory } {
#
# NOTE: Verify that the directory to be added is valid and exists. If
# not, do nothing.
#
if {[string length $directory] == 0 || \
![file isdirectory $directory]} then {
return false
}
#
# NOTE: Normalize the specified directory. This is necessary so that
# we can compare apples-to-apples within the auto-path.
#
set directory [file normalize $directory]
set directoryLength [string length $directory]
#
# NOTE: Query the auto-path for the target language.
#
set autoPath [getAutoPath $language]
#
# NOTE: Check each directory in the auto-path to see if the specified
# directory is already underneath it.
#
foreach autoDirectory $autoPath {
#
# NOTE: Normalize the auto-path directory. This is necessary so
# that we can compare apples-to-apples with the specified
# directory.
#
set autoDirectory [file normalize $autoDirectory]
set autoDirectoryLength [string length $autoDirectory]
#
# NOTE: Prefix match is impossible if the length of the specified
# directory is less than the length of this directory in the
# auto-path.
#
if {$directoryLength < $autoDirectoryLength} then {
continue
}
#
# NOTE: If the initial portion of the specified directory is the
# same as this directory in the auto-path, it must reside
# underneath it. In that case, there is no need to modify
# the auto-path, bail out now.
#
set last [expr {$autoDirectoryLength - 1}]
if {[string range $directory 0 $last] eq $autoDirectory} then {
return false
}
}
#
# NOTE: At this point, it is pretty safe to assume that the specified
# directory is not in the auto-path, nor underneath a directory
# within the auto-path.
#
addToAutoPath $language $directory
return true
}
#
# NOTE: This procedure attempts to verify that an instance of Mono and its
# associated runtimes are installed locally. There are no arguments.
# The return value is non-zero if Mono appears to be installed and
# available for use; otherwise, the return value is zero.
#
proc isMonoInstalled {} {
variable monoFileNameOnly
variable monoInstalledCommand
variable monoInstalledPattern
if {[isEagle]} then {
if {[catch {
eval exec -success Success [subst $monoInstalledCommand]
} result]} then {
return false
}
} else {
if {[catch {
eval exec [subst $monoInstalledCommand]
} result]} then {
return false
}
}
if {![info exists result] || \
![regexp -- $monoInstalledPattern $result]} then {
return false
}
return true
}
#
# NOTE: This procedure attempts to verify that an instance of .NET Core
# and its associated runtimes are installed locally. There are no
# arguments. The return value is non-zero if .NET Core appears to
# be installed and available for use; otherwise, the return value
# is zero.
#
proc isDotNetCoreInstalled {} {
variable dotnetFileNameOnly
variable dotnetInstalledCommand
variable dotnetInstalledPattern
if {[isEagle]} then {
if {[catch {
eval exec -success Success [subst $dotnetInstalledCommand]
} result]} then {
return false
}
} else {
if {[catch {
eval exec [subst $dotnetInstalledCommand]
} result]} then {
return false
}
}
if {![info exists result] || \
![regexp -- $dotnetInstalledPattern [string trim $result]]} then {
return false
}
return true
}
#
# NOTE: This procedure attempts to verify that some runtime is available to
# run CLR applications locally (e.g. the .NET Framework or Mono JIT).
# There are no arguments. The return value is non-zero if it appears
# that CLR applications should be runnable locally; otherwise, the
# return value is zero.
#
proc canUseMsilPlatform {} {
if {[isWindows]} then {
#
# HACK: Assume that all Windows operating systems have a compatible
# version of the .NET Framework is installed -AND- that it can
# be used to run any CLR application.
#
return true
} else {
#
# HACK: On all other platforms, assume that Mono -OR- .NET Core can
# be used to run any CLR application.
#
return [expr {[isMonoInstalled] || [isDotNetCoreInstalled]}]
}
}
#
# NOTE: This procedure verifies that the specified value is indeed a valid
# package name. The packageName argument is the value to verify.
# This procedure may raise script errors.
#
# <internal>
proc verifyPackageName { packageName } {
if {[string length $packageName] > 0 && \
![regexp -nocase -- {^[A-Z][0-9A-Z\.]*$} $packageName]} then {
error "package name must be alphanumeric and start with a letter"
}
}
#
# NOTE: This procedure verifies that the specified value is indeed a valid
# patch level. The patchLevel argument is the value to verify. This
# procedure may raise script errors.
#
# <internal>
proc verifyPackagePatchLevel { patchLevel } {
if {[string length $patchLevel] > 0 && \
![regexp -nocase -- {^\d+\.\d+(?:\.\d+){0,2}$} $patchLevel]} then {
error "patch level must use dotted decimal notation"
}
}
#
# NOTE: This procedure verifies the combination of language and version
# specified by the caller. The language argument must be one of the
# literal strings "eagle", "tcl", or "client". The version argument
# must be one of the literal strings "8.4", "8.5", "8.6", or "8.7"
# when the language is "tcl" -OR- the literal string "1.0" when the
# language is "eagle". When the language is "client", the version
# match the major and minor portions of "1.0" and any remaining
# portions must be numeric. The varName argument is the name of a
# scalar variable in the context of the immediate caller that will
# receive a boolean value indicating if the specified language is
# actually a reference to the package downloader client itself.
#
# <internal>
proc verifyLanguageAndVersion { language version varName } {
if {[string length $varName] > 0} then {
upvar 1 $varName isClient
}
set isClient false
if {[string length $language] == 0 || $language eq "eagle"} then {
if {$version ne "1.0"} then {
error "unsupported Eagle version"
}
} elseif {$language eq "tcl"} then {
if {$version ne "8.4" && $version ne "8.5" && \
$version ne "8.6" && $version ne "8.7"} then {
error "unsupported Tcl version"
}
} elseif {$language eq "client"} then {
if {![regexp -- {^1\.0(?:\.\d+){0,2}$} $version]} then {
error "unsupported client version"
}
set isClient true
} else {
error "unsupported package language"
}
}
#
# NOTE: This procedure returns the name of the current platform. There are
# no arguments. An empty string will be returned if the name of the
# current platform cannot be determined for any reason.
#
# <internal>
proc getPlatform {} {
global tcl_platform
if {[info exists tcl_platform(platform)]} then {
set platform $tcl_platform(platform)
if {[info exists tcl_platform(machine)]} then {
set machine $tcl_platform(machine)
} else {
set machine ""
}
if {[info exists tcl_platform(os)]} then {
set os $tcl_platform(os)
} else {
set os ""
}
switch -exact -- $platform {
unix {
switch -exact -- $os {
Darwin {
switch -exact -- $machine {
"Power Macintosh" {
return macosx-power
}
x86_64 {
return macosx-x64
}
}
}
Linux {
switch -exact -- $machine {
i386 {
return linux-x86
}
x86_64 {
return linux-x64
}
alpha -
armv4l -
armv6l -
armv7l -
ia64 -
ppc {
return [appendArgs linux- $machine]
}
}
}
}
}
windows {
switch -exact -- $machine {
intel -
ia32_on_win64 {
return win32-x86
}
arm {
return [appendArgs win32- $machine]
}
amd64 {
return win64-x64
}
ia64 -
arm64 {
return [appendArgs win64- $machine]
}
}
}
}
}
return ""
}
#
# NOTE: This procedure verifies that the specified value is indeed a valid
# version identifier. The versionId argument is the value to verify.
# This procedure may raise script errors.
#
# <internal>
proc verifyVersionId { versionId } {
if {[string length $versionId] > 0 && \
![regexp -nocase -- {^[0-9A-F]*$} $versionId]} then {
error "version Id must be hexadecimal"
}
}
#
# NOTE: This procedure verifies the platform specified by the caller. The
# platform argument must be an empty string -OR- one of the literal
# strings "msil" or "neutral", or one of the values returned by the
# [getPlatform] procedure. An empty string means that the associated
# entity does not require a specific platform. The varName argument
# is the name of a variable in the context of the immediate caller
# that will receive a modified platform name, if applicable. Upon
# failure, a script error will be raised. The return value is
# undefined.
#
# <internal>
proc verifyPlatform { platform varName } {
#
# NOTE: The platform name must be matched exactly and case-sensitively.
#
switch -exact -- $platform {
"" {
#
# NOTE: The empty string means "attempt to automatically detect" the
# necessary platform based on context information that may be
# present in the context of the immediate caller. If this is
# not possible, a script error will be raised.
#
upvar 1 language language
if {![info exists language]} then {
error "unable to detect language"
}
upvar 1 version version
if {![info exists version]} then {
error "unable to detect version"
}
upvar 1 packageName packageName
if {[info exists packageName]} then {
set localPackageName $packageName
} else {
set localPackageName ""
}
upvar 1 fileNames fileNames
if {[info exists fileNames]} then {
set localFileNames $fileNames
} else {
set localFileNames [list]
}
upvar 1 usePgp usePgp
if {[info exists usePgp]} then {
set localUsePgp $usePgp
} else {
set localUsePgp false
}
#
# NOTE: Since not all potential callers to this procedure may login
# first, attempt to do that now, if necessary.
#
maybeResetCookieAndLoginSimple
#
# NOTE: Download the list of platforms associated with this package
# from the package repository server. This may fail and raise
# a script error.
#
set platforms [downloadAllPlatforms \
$language $version $localPackageName $localFileNames $localUsePgp]
if {[string length $varName] > 0} then {
upvar 1 $varName newPlatform
}
#
# NOTE: First, check the current platform and the neutral platform,
# in that order, to see if that platform is supported by the
# package being saught.
#
set thesePlatforms [list [getPlatform] neutral]
#
# NOTE: Next, optionally, allow the "msil" platform to be checked.
# Currently, this is always applicable on Windows; however,
# on all other platforms this depends on having Mono and its
# associated runtimes installed locally.
#
if {[canUseMsilPlatform]} then {
lappend thesePlatforms msil
}
#
# NOTE: Check each applicable platform, in order, stopping when a
# supported platform is found for the package being saught.
#
foreach thisPlatform $thesePlatforms {
if {[lsearch -exact $platforms $thisPlatform] != -1} then {
set newPlatform $thisPlatform
return
}
}
#
# NOTE: If this point is reached, there are no supported platforms
# that are compatible with the current one for the specified
# package.
#
error "could not automatically detect platform"
}
msil {
#
# NOTE: Forbid the "msil" platform if it is not available for use.
#
if {![canUseMsilPlatform]} then {
error "platform \"msil\" does not appear to be supported"
}
}
neutral -
win32-arm -
win32-x86 -
win64-arm64 -
win64-ia64 -
win64-x64 {
#
# NOTE: This platform name is supported verbatim, do nothing.
#
}
default {
error "unsupported package platform"
}
}
}
#
# NOTE: This procedure checks the current login cookie to make sure that
# it exists -AND- conforms to the correct format.
#
proc haveValidLoginCookie {} {
variable loginCookie
if {![info exists loginCookie]} then {
return false
}
if {[isEagle] || \
([info exists tcl_version] && $tcl_version >= 8.5)} then {
if {[string is list -strict $loginCookie]} then {
return false
}
}
if {[llength $loginCookie] != 2} then {
return false
}
return true
}
#
# NOTE: This procedure issues a request to an HTTP(S) server. It returns
# the raw response data verbatim. It may raise a script error. It
# will always use the currently configured HTTP(S) login cookie, if
# any; therefore, it should really only be used for requests to the
# package file server. The uri argument is the fully qualified URI
# to request. The allowHtml argument should be non-zero if raw HTML
# should be allowed in the response data.
#
proc getPackageFile { uri {allowHtml false} } {
variable loginCookie
variable quiet
if {[isEagle]} then {
if {![info exists ::eagle_platform(compileOptions)]} then {
error "missing compile options from Eagle platform array"
}
if {[lsearch -exact -- \
$::eagle_platform(compileOptions) TEST] == -1} then {
error "cannot download: library missing TEST compile-option"
}
if {[lsearch -exact -- \
$::eagle_platform(compileOptions) NETWORK] == -1} then {
error "cannot download: library missing NETWORK compile-option"
}
if {![object invoke Eagle._Tests.Default \
TestHasScriptNewWebClientCallback ""]} then {
set error null
set code [object invoke Eagle._Tests.Default \
TestSetScriptNewWebClientCallback "" true true error]
if {$code ne "Ok"} then {
error [getStringFromObjectHandle $error]
}
}
if {[haveValidLoginCookie]} then {
set script [object create String {
if {[methodName ToString] eq "GetWebRequest"} then {
webRequest Headers.Add Cookie [join $loginCookie =]
}
}]
set data [uri download \
-timeouttype network -inline \
-webclientdata $script -- $uri]
} else {
set data [uri download \
-timeouttype network -inline -- $uri]
}
} else {
set options [list -binary true]
if {[haveValidLoginCookie]} then {
lappend options -headers [list Cookie [join $loginCookie =]]
}
set data [eval ::PackageRepository::getFileViaHttp \
[list $uri] [list 20] [list stdout] [list $quiet] $options]
}
#
# HACK: Check for the typical Fossil error response(s), which is an
# HTML page that may contain something like "Artifact 'X' does
# not exist in this repository").
#
if {!$allowHtml && [string range $data 0 14] eq "<!DOCTYPE html>"} then {
error "bad package file response data, appears to be HTML page"
}
return $data
}
#
# NOTE: This procedure returns the prefix for fully qualified variable
# names that MAY be present in the global namespace. There are
# no arguments.
#
proc getDownloadVarNamePrefix {} {
return ::pkgd_; # TODO: Make non-global?
}
#
# NOTE: This procedure resets the currently configured login cookie, if
# any, and then attempts to login using the configured package
# repository server API key -OR- using the public access account.
# Upon success, it will set the login cookie to the one from the
# raw response data. Upon failure, a script error will be raised.
# There are no arguments.
#
# <public>
proc resetCookieAndLoginSimple {} {
variable publicPassword
variable publicUserName
set apiKey [lindex [::PackageRepository::getApiKeys \
[getDownloadVarNamePrefix] true] 0]
if {[string length $apiKey] > 0} then {
return [resetCookieAndLogin $apiKey $apiKey]
}
if {[string length $publicUserName] > 0 && \
[string length $publicPassword] > 0} then {
return [resetCookieAndLogin $publicUserName $publicPassword]
}
error "missing API keys and no public login credentials configured"
}
#
# NOTE: This procedure attempts to login using the configured package
# repository server API key -OR- using the public access account,
# if not already logged in. Upon success, it will set the login
# cookie to the one from the raw response data. Upon failure, a
# script error will be raised. There are no arguments.
#
# <internal>
proc maybeResetCookieAndLoginSimple {} {
variable loginCookie
#
# NOTE: Attempt to verify that we are currently logged in. If so, do
# nothing; otherwise, attempt to login.
#
if {![haveValidLoginCookie]} then {
resetCookieAndLoginSimple
}
}
#
# NOTE: This procedure resets the currently configured login cookie, if
# any, and then attempts to login using the specified user name and
# password. Upon success, it will set the login cookie to the one
# from the raw response data. Upon failure, a script error will be
# raised. The userName argument must be the name of a package file
# server user with at least Fossil Check-Out (o) permissions on the
# package file server. The password argument must be the plaintext
# password that is associated with the specified user name.
#
# <public>
proc resetCookieAndLogin { userName password } {
variable baseUri
variable loginCookie
variable loginUri
variable loginUrn
#
# NOTE: Build the full URI for the login request, performing any
# applicable substitutions in the URI prior to using it as
# the basis for logging into the repository.
#
set uri [subst $loginUri]
#
# NOTE: Reset the old login cookie, if any. Then, issue a new login
# request, capturing the raw response data.
#
set loginCookie [list]; set data [getPackageFile $uri]
#
# NOTE: Attempt to extract the necessary values from the raw response
# data.
#
set pattern(1) {"authToken":"(.*?)"}; # TODO: *HACK* Keep updated.
if {![regexp -- $pattern(1) $data dummy authToken]} then {
error "login response missing \"authToken\""
}
set pattern(2) {"loginCookieName":"(.*?)"}; # TODO: *HACK* Keep updated.
if {![regexp -- $pattern(2) $data dummy loginCookieName]} then {
error "login response missing \"loginCookieName\""
}
#
# NOTE: Set the login cookie to the one freshly extracted from the raw
# response data.
#
set loginCookie [list $loginCookieName $authToken]
#
# NOTE: Always return an empty string (i.e. and not any response data).
#
return ""
}
#
# NOTE: This procedure attempts to logout using the currently configured
# login cookie, if any, and then resets the login cookie. There
# are no arguments. This procedure may raise a script error.
#
# <public>
proc logoutAndResetCookie {} {
variable baseUri
variable loginCookie
variable logoutUri
variable logoutUrn
#
# NOTE: Attempt to verify that we are currently logged in.
#
if {![haveValidLoginCookie]} then {
error "missing or invalid login cookie"
}
#
# NOTE: Build the full URI for the logout request, performing any
# applicable substitutions in the URI prior to using it as
# the basis for logging out of the repository.
#
set authToken [lindex $loginCookie 1]
set uri [subst $logoutUri]
#
# NOTE: Reset the old login cookie, if any. Then, issue a new login
# request, capturing the raw response data.
#
set data [getPackageFile $uri]
#
# NOTE: Attempt to extract the necessary values from the raw response
# data.
#
set pattern(1) {"name":"nobody"}; # TODO: *HACK* Keep updated.
if {![regexp -- $pattern(1) $data dummy]} then {
error "logout response missing \"name\""
}
#
# NOTE: Reset the login cookie.
#
set loginCookie [list]
#
# NOTE: Always return an empty string (i.e. and not any response data).
#
return ""
}
#
# NOTE: This procedure returns a unique temporary directory where one or
# more files may be saved. The prefix argument is a prefix for the
# directory name and it may be an empty string. There is no attempt
# to actually create the resulting directory.
#
proc getUniqueTempDirectory { {prefix ""} } {
variable temporaryRootDirectory
variable verboseTemporaryDirectory
set suffix [::PackageRepository::getUniqueSuffix]
if {[string length $prefix] > 0} then {
set result [file join $temporaryRootDirectory \
[appendArgs $prefix $suffix]]
} else {
set result [file join $temporaryRootDirectory \
$suffix]
}
if {$verboseTemporaryDirectory} then {
pkgLog [appendArgs \
"returning temporary directory name \"" $result \
"\" for prefix \"" $prefix \"...]
}
return $result
}
#
# NOTE: This procedure creates a new interpreter, which may be "safe", and
# places a reference to it in a variable in the context of the caller
# identified by the varName argument. The created interpreter has a
# fully functioning [package] command ensemble; all other commands do
# nothing and return nothing. This procedure may raise script errors.
#
proc createInterp { varName } {
#
# NOTE: Prepare to provide the caller with the newly created interpreter
# reference.
#
upvar 1 $varName interp
#
# NOTE: Create a "safe" interpreter and set the global "dir" variable to
# a single period. Generally, this is the only variable used by a
# package index file. It should be noted that since [set] will be
# a NOP, attempts to use other variables in the specified package
# index file (e.g. ones [set] within it) will fail.
#
set interp [interp create -safe]
interp eval $interp [list set dir .]
#
# NOTE: First, obtain the list of child namespaces to delete, if any, and
# then delete them all. This should leave the global namespace and
# its commands / variables untouched.
#
set namespaces [interp eval $interp [list namespace children ::]]
foreach namespace $namespaces {
catch {
interp eval $interp [list namespace delete $namespace]
}
}
#
# NOTE: Next, obtain the list of global commands and delete all of them
# except the [proc] and [package] commands. The [proc] command is
# handled specially (last) and the [package] command is retained.
#
set commands [interp eval $interp [list info commands]]
foreach command $commands {
if {$command ne "proc" && $command ne "package"} then {
interp eval $interp [list proc $command args ""]; # NOP
}
}
if {![isEagle]} then {
#
# HACK: The "safe" interpreters in native Tcl do not contain
# the [file] command at all, not even for [file join]
# and [file split], which may be used in package index
# files; therefore, add it as a NOP command.
#
interp eval $interp [list proc file args ""]; # NOP
}
#
# NOTE: Next, disable the [proc] command. This must be done last
# because it is used to disable (i.e. via NOP) all the other
# global commands.
#
interp eval $interp [list proc proc args ""]; # NOP
#
# NOTE: Finally, return nothing as the created interpreter reference
# is placed directly into the variable specified by the caller.
#
return ""
}
#
# NOTE: This procedure evaluates a script file and attempts to determine the
# list of new [package ifneeded] scripts added by it. When successful
# it returns a list-of-lists. Each element of the outer list contains
# a package name and the list of its versions in descending order; in
# the event of failure, empty lists may be returned for the outer list
# or for a list of versions. The interp argument is the interp to use
# when evaluating the file specified by the fileName argument. This
# procedure may raise script errors.
#
proc getIfNeededVersions { interp fileName } {
set result [list]
set oldPackageNames [interp eval $interp [list package names]]
interp invokehidden $interp source $fileName; # [package ifneeded], etc.
set newPackageNames [interp eval $interp [list package names]]
foreach packageName $newPackageNames {
if {[lsearch -exact $oldPackageNames $packageName] == -1} then {
lappend result [list $packageName [lsort -decreasing \
-command [list package vcompare] [interp eval \
$interp [list package versions $packageName]]]]
}
}
return $result
}
#
# NOTE: This procedure attempts to extract a package version information
# from the specified file. The fileName argument is the local file
# name to read. This procedure may raise script errors.
#
proc extractVersionsFromFile { fileName } {
switch -exact -- [file tail $fileName] {
VERSION {
return [list [string trim [readFile $fileName]]]
}
pkgIndex.eagle -
pkgIndex.tcl {
#
# TODO: Evaluate the package index file in a new "safe"
# interpreter and obtain the newly added [package
# ifneeded] version(s)?
#
if {[catch {createInterp interp} error] == 0} then {
set result [getIfNeededVersions $interp $fileName]
} else {
pkgLog [appendArgs \
"could not create interp to extract versions: " \
$error]
set result [list]
}
if {[info exists interp]} then {
catch {interp delete $interp}
unset interp; # REDUNDANT
}
return $result
}
}
}
#
# NOTE: This procedure checks if there is a higher version available of the
# specified package on the package file server. The language argument
# must be one of the literal strings "eagle", "tcl", or "client". The
# version argument must be one of the literal strings "8.4", "8.5", or
# "8.6" when the language is "tcl" -OR- the literal string "1.0" when
# the language is either "eagle" or "client". The platform argument
# must be an empty string -OR- one of the literal strings "msil" or
# "neutral", or one of the values returned by the [getPlatform]
# procedure. An empty string means that the associated package does
# not require a specific platform. The packageName argument is a
# directory name relative to the language and version-specific
# directory on the package file server and may be an empty string.
# The usePgp argument should be non-zero when an OpenPGP signature
# file needs to be downloaded and verified for the downloaded file.
#
# <public>
proc checkForHigherVersion { language version platform packageName usePgp } {
variable clientDirectory
variable persistentRootDirectory
verifyPackageName $packageName
verifyLanguageAndVersion $language $version isClient
verifyPlatform $platform platform
set temporaryDirectory [getUniqueTempDirectory pkgd_ver_]
if {$isClient} then {
set persistentDirectory $clientDirectory
} else {
verifyPersistentRootDirectory
set persistentDirectory $persistentRootDirectory
}
set fileNamesOnly [list VERSION pkgIndex.eagle pkgIndex.tcl]
foreach fileNameOnly $fileNamesOnly {
set fileName [file join $packageName $fileNameOnly]
set downloadFileName [file join $temporaryDirectory $fileName]
file mkdir [file dirname $downloadFileName]
if {[catch {
downloadOneFile $language $version $platform \
$fileName $downloadFileName $usePgp
}] == 0} then {
if {$usePgp} then {
downloadOneFile $language $version $platform \
[appendArgs $fileName .asc] \
[appendArgs $downloadFileName .asc] $usePgp
}
set localFileName [file join $persistentDirectory $fileName]
set compare [package vcompare \
[lindex [extractVersionsFromFile $downloadFileName] 0] \
[lindex [extractVersionsFromFile $localFileName] 0]]
if {[isEagle]} then {
file delete -recursive -- $temporaryDirectory
} else {
file delete -force -- $temporaryDirectory
}
return [expr {$compare > 0}]
}
}
error "could not check higher version: no supported file names"
}
#
# NOTE: This procedure attempts to guess a package name based on a list of
# its files. It relies upon the fact that all packages must include
# a package index file. The language argument must be one of the
# literal strings "eagle", "tcl", or "client". The fileNames argument
# must be the list of file names to be downloaded. The package name,
# if one can be detected, is returned; otherwise, an empty string will
# be returned.
#
proc guessPackageNameFromFileNames { language fileNames } {
set packageIndexFileNameOnly [getPackageIndexFileName $language]
if {[string length $packageIndexFileNameOnly] > 0} then {
foreach fileName $fileNames {
set fileNameOnly [file tail $fileName]
if {$fileNameOnly eq $packageIndexFileNameOnly} then {
set directory [file dirname $fileName]
if {[string length $directory] > 0} then {
return [file tail $directory]
}
}
}
}
return ""
}
#
# NOTE: This procedure downloads a manitest from the package file server,
# writing its contents to the specified local file name. It can also
# verify the OpenPGP signature. The language argument must be one of
# the literal strings "eagle", "tcl", or "client". The version
# argument must be one of the literal strings "8.4", "8.5", or "8.6"
# when the language is "tcl" -OR- the literal string "1.0" when the
# language is either "eagle" or "client". The packageName argument
# is a directory name relative to the language and version-specific
# directory on the package file server and may be an empty string.
# The fileNames argument is the list of file names to be downloaded.
# The usePgp argument should be non-zero when an OpenPGP signature
# needs to be verified for the downloaded file.
#
proc downloadAllPlatforms { language version packageName fileNames usePgp } {
variable baseUri
variable branchName
variable platformsUri
variable platformsUrn
#
# NOTE: Verify that the package name, language, and version are correct.
#
verifyPackageName $packageName
verifyLanguageAndVersion $language $version isClient
set temporaryDirectory [getUniqueTempDirectory pkgd_plat_]
set localFileName [file join $temporaryDirectory manifest.txt]
file mkdir [file dirname $localFileName]
#
# NOTE: First, build the final URI to download from the remote package
# repository, performing any applicable substitutions in the URI
# prior to using it as the basis for fetching the platform list.
#
set uri [subst $platformsUri]
#
# NOTE: Then, in one step, download the file from the package file
# server and write it to the specified local file. Also, make
# sure it has a valid OpenPGP signature because all manifests on
# the server should be signed.
#
downloadOneUriToFile $localFileName $uri $usePgp true
#
# NOTE: Initialize list of platforms to return. This will be populated
# based on the platform directories available in the downloaded
# manfiest data.
#
set platforms [list]
#
# NOTE: Read the (OpenPGP verified) manifest data from the local file
# and split it into lines.
#
set data [readFile $localFileName]; set lines [split $data \n]
#
# NOTE: Figure out the pattern to use when matching against the file
# names in the manifest data. If available, this will include
# the package name; otherwise, platform names for all packages
# will be considered.
#
if {[string length $packageName] == 0} then {
set packageName [guessPackageNameFromFileNames $language $fileNames]
}
if {[string length $packageName] > 0} then {
set pattern [file join $language $version * $packageName *]
} else {
set pattern [file join $language $version *]
}
#
# NOTE: For package files that are not part of the client package,
# put them inside the "packages" sub-directory.
#
if {$isClient} then {
set index 2; # client/1.0/<neutral>/fileName.ext
} else {
set pattern [file join packages $pattern]
set index 3; # packages/tcl/8.4/<neutral>/pkgName1.0/fileName.ext
}
foreach line $lines {
if {[string range $line 0 1] eq "F "} then {
set fileName [lindex [split $line " "] 1]
if {[string match $pattern $fileName]} then {
set directory [lindex [file split $fileName] $index]
if {[string length $directory] > 0 && \
[lsearch -exact $platforms $directory] == -1} then {
lappend platforms $directory
}
}
}
}
if {[isEagle]} then {
file delete -recursive -- $temporaryDirectory
} else {
file delete -force -- $temporaryDirectory
}
return [lsort -unique $platforms]
}
#
# NOTE: This procedure downloads a single URI from the package file server
# and writes the result to a local file. The localFileName argument
# is the file name where the downloaded file should be written. The
# The uri argument is the URI to download. The usePgp argument should
# be non-zero when the OpenPGP signature file needs to be verified for
# the downloaded file. The return value is undefined.
#
proc downloadOneUriToFile { localFileName uri usePgp forcePgp } {
#
# NOTE: Then, in one step, download the URI from the package file
# server and write it to the specified local file.
#
writeFile $localFileName [getPackageFile $uri]
#
# NOTE: Is use of OpenPGP for signature verification enabled? Also,
# did we just download an OpenPGP signature file?
#
if {$usePgp} then {
#
# NOTE: Maybe attempt to verify the OpenPGP signature. If this
# fails, an error is raised.
#
maybeVerifyOpenPgpSignature $localFileName $forcePgp
}
}
#
# NOTE: This procedure downloads a single file from the package file server,
# writing its contents to the specified local file name. It can also
# verify the OpenPGP signatures. When an OpenPGP signature file is
# downloaded, this procedure assumes the corresponding data file was
# already downloaded (i.e. since OpenPGP needs both to perform the
# signature checks). The language argument must be one of the
# literal strings "eagle", "tcl", or "client". The version argument
# must be one of the literal strings "8.4", "8.5", or "8.6" when the
# language is "tcl" -OR- the literal string "1.0" when the language
# is either "eagle" or "client". The platform argument must be an
# empty string -OR- one of the literal strings "msil" or "neutral", or
# one of the values returned by the [getPlatform] procedure. An empty
# string means that the associated package does not require a specific
# platform. The fileName argument is a file name relative to the
# language and version-specific directory on the package file server.
# The localFileName argument is the file name where the downloaded
# file should be written. The usePgp argument should be non-zero when
# the OpenPGP signature file needs to be verified for the downloaded
# file.
#
proc downloadOneFile {
language version platform fileName localFileName usePgp } {
variable baseUri
variable branchName
variable downloadUri
variable downloadUrn
#
# NOTE: Verify that the package language, version, and platform are
# correct.
#
verifyLanguageAndVersion $language $version isClient
verifyPlatform $platform platform
#
# NOTE: First, build the full relative file name to download from
# the remote package repository.
#
set fileName [file join $language $version $platform $fileName]
#
# NOTE: For package files that are not part of the client package,
# put them inside the "packages" sub-directory.
#
if {!$isClient} then {
set fileName [file join packages $fileName]
}
#
# NOTE: Perform any applicable substitutions in the URI prior to
# using it as the basis for downloading the package file.
#
set uri [subst $downloadUri]
#
# NOTE: Then, in one step, download the file from the package file
# server and write it to the specified local file.
#
downloadOneUriToFile $localFileName $uri $usePgp false
}
#
# NOTE: This procedure attempts to download a list of files, optionally
# persisting them for subsequent uses by the target language.
# The language argument must be one of the literal strings "eagle",
# "tcl", or "client". The version argument must be one of the
# literal strings "8.4", "8.5", or "8.6" when the language is "tcl"
# -OR- the literal string "1.0" when the language is either "eagle"
# or "client". The platform argument must be an empty string -OR-
# one of the literal strings "msil" or "neutral", or one of the values
# returned by the [getPlatform] procedure. An empty string means
# that the associated package does not require a specific platform.
# The fileNames argument must be a well-formed list of file names to
# download, each one relative to the language and version-specific
# directory on the package file server. The options argument must
# be a dictionary of name/value pairs. The -persistent option should
# be non-zero if the downloaded files should be saved to permanent
# storage for subsequent use. The -usePgp option should be non-zero
# when an OpenPGP signature file needs to be downloaded and verified
# for each downloaded file. The -useAutoPath option should be
# non-zero to modify the auto-path to include the temporary or
# persistent directories containing the downloaded files. The
# -allowUpdate option should be non-zero to allow existing package
# files to be overwritten.
#
# <public>
proc downloadFiles { language version platform fileNames options } {
variable clientDirectory
variable persistentRootDirectory
variable viaInstall
set persistent [string is true -strict \
[getDictionaryValue $options -persistent]]
set overwrite [string is true -strict \
[getDictionaryValue $options -overwrite]]
set usePgp [string is true -strict \
[getDictionaryValue $options -usePgp]]
set useAutoPath [string is true -strict \
[getDictionaryValue $options -useAutoPath]]
set allowUpdate [string is true -strict \
[getDictionaryValue $options -allowUpdate]]
#
# NOTE: Verify that the package language, version, and platform are
# correct.
#
verifyLanguageAndVersion $language $version isClient
verifyPlatform $platform platform
set temporaryDirectory [getUniqueTempDirectory pkgd_lib_]
if {$isClient} then {
set persistentDirectory $clientDirectory
} else {
verifyPersistentRootDirectory
set persistentDirectory $persistentRootDirectory
}
set downloadedFileNames [list]
foreach fileName $fileNames {
if {[string length $fileName] == 0 || \
[file pathtype $fileName] ne "relative"} then {
error [appendArgs \
"bad file name \"" $fileName "\", not relative"]
}
set directoryParts [file split [file dirname $fileName]]
if {[llength $directoryParts] == 0} then {
error [appendArgs \
"bad file name \"" $fileName "\", no directory parts"]
}
set directory(temporary) [file normalize [eval \
file join [list $temporaryDirectory] $directoryParts]]
set directory(persistent) [file normalize [eval \
file join [list $persistentDirectory] $directoryParts]]
set fileNameOnly [file tail $fileName]
set downloadFileName [file normalize [file join \
$directory(temporary) $fileNameOnly]]
if {[file exists $downloadFileName]} then {
error [appendArgs \
"temporary file name \"" $downloadFileName \
"\" already exists"]
}
if {$persistent || $viaInstall} then {
if {!$overwrite} then {
set persistentFileName [file normalize [file join \
$directory(persistent) $fileNameOnly]]
if {[file exists $persistentFileName]} then {
continue
}
}
}
file mkdir [file dirname $downloadFileName]
downloadOneFile $language $version $platform \
$fileName $downloadFileName $usePgp
lappend downloadedFileNames [list \
$fileNameOnly $directory(temporary) $directory(persistent)]
if {$usePgp && \
![isOpenPgpSignatureFileName $downloadFileName true]} then {
downloadOneFile $language $version $platform \
[appendArgs $fileName .asc] \
[appendArgs $downloadFileName .asc] $usePgp
lappend downloadedFileNames [list \
[appendArgs $fileNameOnly .asc] $directory(temporary) \
$directory(persistent)]
}
}
set downloadDirectories [list]
foreach downloadedFileName $downloadedFileNames {
set directory(temporary) [lindex $downloadedFileName 1]
if {$persistent || $viaInstall} then {
set fileNameOnly [lindex $downloadedFileName 0]
set directory(persistent) [lindex $downloadedFileName 2]
file mkdir $directory(persistent)
set command [list file copy]
#
# NOTE: When updating the package repository client files, always
# use the -force option to overwrite existing files. Also,
# if we are allow updates, use the -force option.
#
if {$isClient || $allowUpdate} then {
lappend command -force
}
lappend command --
lappend command [file join $directory(temporary) $fileNameOnly]
lappend command [file join $directory(persistent) $fileNameOnly]
eval $command
lappend downloadDirectories $directory(persistent)
} else {
lappend downloadDirectories $directory(temporary)
}
}
#
# NOTE: Does the package need to be persisted locally? This can be set
# via the direct caller or via the installer tool.
#
set addPersistentDirectoryToAutoPath false
if {$persistent || $viaInstall} then {
#
# NOTE: In Eagle, a slightly different command is required to delete
# an entire directory tree.
#
if {[isEagle]} then {
file delete -recursive -- $temporaryDirectory
} else {
file delete -force -- $temporaryDirectory
}
#
# NOTE: When the target language is native Tcl, try to create the
# "root" package index, if necessary.
#
if {$language eq "tcl"} then {
maybeCreateRootTclPackageIndex
set addPersistentDirectoryToAutoPath true
}
}
#
# NOTE: Sort the list of directories that downloaded files were written
# to, removing any duplicates in the process.
#
set downloadDirectories [lsort -unique $downloadDirectories]
if {$useAutoPath} then {
#
# NOTE: The auto-path, for whatever language this package belongs to,
# needs to be modified.
#
if {$addPersistentDirectoryToAutoPath} then {
#
# NOTE: The downloaded package was persisted -AND- will be handled
# by the "root" package index; therefore, just make sure the
# package persistence root directory is in the auto-path and
# then return only that directory in the result.
#
maybeAddToAutoPath $language $persistentDirectory
set downloadDirectories [list $persistentDirectory]
} else {
#
# NOTE: Check each unique download directory for a package index
# file. If a directory has a package index for the target
# language, add to the auto-path for the target language.
#
set packageIndexFileNameOnly [getPackageIndexFileName $language]
if {[string length $packageIndexFileNameOnly] > 0} then {
foreach downloadDirectory $downloadDirectories {
if {[file exists [file join \
$downloadDirectory $packageIndexFileNameOnly]]} then {
addToAutoPath $language $downloadDirectory
}
}
}
}
}
#
# NOTE: Always return the list of directories that were actually added
# to the auto-path, if any.
#
return $downloadDirectories
}
#
# NOTE: This procedure adds temporary package directories to the auto-path
# of the specified language (i.e. native Tcl or Eagle). Directories
# will not be added if already present. The language argument must
# be the literal string "eagle" or the literal string "tcl". The
# pattern argument is the optional pattern to match against each of
# the candidate temporary package directories. If the pattern is an
# empty string then all candidate temporary package directories will
# be added to the auto-path; otherwise, the pattern will be matched
# against the final portion of the temporary package directory name
# and only those temporary package directories that actually match
# the pattern will be added to the auto-path. The options argument
# must be a dictionary of name/value pairs. This procedure does not
# currently support any options. This procedure may raise script
# errors. This procedure assumes the local temporary directory is
# writable only by applications that are implicitly trusted by the
# current user. If this assumption does not hold on your platform,
# DO NOT USE THIS PROCEDURE AS IT MAY BE UNSAFE.
#
# <public>
proc maybeAddTemporaryPackagesToAutoPath { language options {pattern ""} } {
variable temporaryRootDirectory
variable verboseTemporaryDirectory
#
# NOTE: Initially, no temporary package directories have been added
# to the auto-path.
#
set result [list]; set packageNames [list]
#
# NOTE: What is the package index file name for this language? Each
# candidate temporary package directory will be checked to see
# if it contains this file; otherwise, it will not be added to
# the auto-path.
#
set packageIndexFileNameOnly [getPackageIndexFileName $language]
#
# HACK: Obtain the list of candidate temporary package directories
# that may need to be added to the auto-path. The prefix we
# use here is considered "well-known" by this package.
#
set directories(1) [lsort [glob -nocomplain -types {d} \
[file join $temporaryRootDirectory pkgd_lib_*]]]
foreach directory(1) $directories(1) {
set directories(2) [lsort [glob -nocomplain -types {d} \
[file join $directory(1) *]]]
foreach directory(2) $directories(2) {
set directoryNameOnly(2) [file tail $directory(2)]
set packageName $directoryNameOnly(2); # HACK: Well-known.
if {[lsearch -exact $packageNames $packageName] == -1} then {
if {[string length $pattern] == 0 || \
[string match $pattern $directoryNameOnly(2)]} then {
if {[string length $packageIndexFileNameOnly] == 0 || \
[file exists [file join $directory(2) \
$packageIndexFileNameOnly]]} then {
if {[maybeAddToAutoPath $language $directory(2)]} then {
lappend packageNames $directoryNameOnly(2)
lappend result $directory(2)
if {$verboseTemporaryDirectory} then {
pkgLog [appendArgs \
"added temporary package directory named \"" \
$directory(2) "\" to auto-path..."]
}
}
}
}
}
}
}
return $result
}
#
# NOTE: This package requires the package repository client package.
#
package require Eagle.Package.Repository
#
# NOTE: This package requires that support for namespaces, which is an
# optional feature of Eagle, must be enabled.
#
if {[isEagle] && ![namespace enable]} then {
error "namespaces must be enabled for this package"
}
#
# NOTE: Attempt to read optional settings file now. This may override
# one or more of the variable setup in the next step.
#
::PackageRepository::maybeReadSettingsFiles [info script]
#
# NOTE: Setup the variables, within this namespace, used by this script.
#
setupDownloadVars [info script] false
#
# NOTE: Setup the server, version, and URI variables, in this namespace,
# that are used by this script.
#
setupDownloadServerVars false
setupDownloadVersionVars false
setupDownloadUriVars false
#
# NOTE: If necessary, add the package persistence root directory to the
# auto-path for the current language. This will only be done if
# it falls outside of the existing auto-path.
#
variable persistentRootDirectory
maybeAddToAutoPath [expr {[isEagle] ? "eagle" : "tcl"}] \
$persistentRootDirectory
#
# NOTE: Provide the package to the interpreter.
#
package provide Eagle.Package.Downloader 1.0.10
}
|