︙ | | | ︙ | |
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
2 {set codeString return}
3 {set codeString break}
4 {set codeString continue}
default {set codeString [appendArgs unknown( $code )]}
}
if {[string length $result] > 0} then {
return [appendArgs $codeString ": " [list $result]]
} else {
return $codeString
}
}
#
# NOTE: This procedure emits a message to the package repository client
|
|
|
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
2 {set codeString return}
3 {set codeString break}
4 {set codeString continue}
default {set codeString [appendArgs unknown( $code )]}
}
if {[string length $result] > 0} then {
return [appendArgs $codeString ", " [list $result]]
} else {
return $codeString
}
}
#
# NOTE: This procedure emits a message to the package repository client
|
︙ | | | ︙ | |
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
|
#
# NOTE: This procedure returns non-zero if the specified string value
# looks like an OpenPGP signature. The value argument is the string
# to check. The value 27 used within this procedure is the length
# of the literal string "-----END PGP SIGNATURE-----".
#
# <public>
proc isPgpSignature { value } {
set value [string trim $value]
set length [string length $value]
if {$length == 0 || ([string first [string trim {
-----BEGIN PGP SIGNATURE-----
}] $value] == 0 && [string first [string trim {
-----END PGP SIGNATURE-----
|
|
|
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
|
#
# NOTE: This procedure returns non-zero if the specified string value
# looks like an OpenPGP signature. The value argument is the string
# to check. The value 27 used within this procedure is the length
# of the literal string "-----END PGP SIGNATURE-----".
#
# <public>
proc isOpenPgpSignature { value } {
set value [string trim $value]
set length [string length $value]
if {$length == 0 || ([string first [string trim {
-----BEGIN PGP SIGNATURE-----
}] $value] == 0 && [string first [string trim {
-----END PGP SIGNATURE-----
|
︙ | | | ︙ | |
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
|
# in the specified (named) file. Non-zero is only returned if the
# OpenPGP signature is verified successfully. A script error should
# not be raised by this procedure. The fileName argument must be
# the fully qualified path and file name of the OpenPGP signature
# file to verify.
#
# <public>
proc verifyPgpSignature { fileName } {
variable pgpCommand
if {[isEagle]} then {
set fileName [appendArgs \" $fileName \"]
if {[catch {
eval exec -success Success [subst $pgpCommand]
}] == 0} then {
return true
}
} else {
if {[catch {
eval exec [subst $pgpCommand] 2>@1
}] == 0} then {
return true
}
}
return false
}
|
|
|
|
|
|
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
|
# in the specified (named) file. Non-zero is only returned if the
# OpenPGP signature is verified successfully. A script error should
# not be raised by this procedure. The fileName argument must be
# the fully qualified path and file name of the OpenPGP signature
# file to verify.
#
# <public>
proc verifyOpenPgpSignature { fileName } {
variable openPgpCommand
if {[isEagle]} then {
set fileName [appendArgs \" $fileName \"]
if {[catch {
eval exec -success Success [subst $openPgpCommand]
}] == 0} then {
return true
}
} else {
if {[catch {
eval exec [subst $openPgpCommand] 2>@1
}] == 0} then {
return true
}
}
return false
}
|
︙ | | | ︙ | |
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
|
[namespace current] ::getFileTempName]]]
eagle [list proc $newProcName(3) {} [info body [appendArgs \
[namespace current] ::tclMustBeReady]]]
return [eagle $script(outer)]
}
} elseif {[isPgpSignature $metadata(certificate)]} then {
#
# NOTE: If there is no package script, there is nothing we
# can do here.
#
if {[string length $metadata(script)] > 0} then {
#
# NOTE: Figure out temporary file name for the downloaded script
|
|
|
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
|
[namespace current] ::getFileTempName]]]
eagle [list proc $newProcName(3) {} [info body [appendArgs \
[namespace current] ::tclMustBeReady]]]
return [eagle $script(outer)]
}
} elseif {[isOpenPgpSignature $metadata(certificate)]} then {
#
# NOTE: If there is no package script, there is nothing we
# can do here.
#
if {[string length $metadata(script)] > 0} then {
#
# NOTE: Figure out temporary file name for the downloaded script
|
︙ | | | ︙ | |
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
|
writeFile $fileName(2) $metadata(certificate)
}
#
# NOTE: Attempt to verify the OpenPGP signature for the package
# script.
#
if {[verifyPgpSignature $fileName(2)]} then {
#
# NOTE: Delete the temporary files that we created for the
# OpenPGP signature verification.
#
eval $script(cleanup)
} else {
#
# NOTE: Delete the temporary files that we created for the
# OpenPGP signature verification.
#
eval $script(cleanup)
#
# NOTE: OpenPGP signature verification failed. Raise an error
# and do not proceed with evaluating the package script.
#
error "bad PGP signature"
}
#
# NOTE: The OpenPGP signature was verified; use the downloaded
# package script verbatim.
#
set script(inner) $metadata(script)
|
|
|
|
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
|
writeFile $fileName(2) $metadata(certificate)
}
#
# NOTE: Attempt to verify the OpenPGP signature for the package
# script.
#
if {[verifyOpenPgpSignature $fileName(2)]} then {
#
# NOTE: Delete the temporary files that we created for the
# OpenPGP signature verification.
#
eval $script(cleanup)
} else {
#
# NOTE: Delete the temporary files that we created for the
# OpenPGP signature verification.
#
eval $script(cleanup)
#
# NOTE: OpenPGP signature verification failed. Raise an error
# and do not proceed with evaluating the package script.
#
error "bad OpenPGP signature"
}
#
# NOTE: The OpenPGP signature was verified; use the downloaded
# package script verbatim.
#
set script(inner) $metadata(script)
|
︙ | | | ︙ | |
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
|
}
}
}
} 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.
#
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
|
}
}
}
} else {
error "unsupported script certificate"
}
}
#
# NOTE: This procedure returns non-zero if the specified package appears to
# be present. The package argument is the name of the package being
# sought, it cannot be an empty string. The version argument must be
# a specific version -OR- a package specification that conforms to TIP
# #268.
#
proc isPackagePresent { package version } {
set command [list package present $package]
if {[string length $version] > 0} then {lappend command $version}
if {[set code [catch $command result]] == 0} then {
pkgLog [appendArgs \
"package \"" [formatPackageName $package $version] \
"\" was loaded: " [formatResult $code $result]]
return true
} else {
pkgLog [appendArgs \
"package \"" [formatPackageName $package $version] \
"\" was not loaded: " [formatResult $code $result]]
return false
}
}
#
# NOTE: This procedure returns non-zero if the specified package appears to
# be available. The package argument is the name of the package being
# sought, it cannot be an empty string. The version argument must be
# a specific version -OR- a package specification that conforms to TIP
# #268.
#
proc isPackageAvailable { package version } {
set packageVersions [package versions $package]
if {[llength $packageVersions] == 0} then {
pkgLog [appendArgs \
"package \"" [formatPackageName $package $version] \
"\" is not available: no versions"]
return false
}
if {[string length $version] == 0} then {
pkgLog [appendArgs \
"package \"" [formatPackageName $package $version] \
"\" is available: no version"]
return true
}
foreach packageVersion $packageVersions {
if {[package vsatisfies $packageVersion $version]} then {
pkgLog [appendArgs \
"package \"" [formatPackageName $package $version] \
"\" is available: version satisfied by \"" \
[formatPackageName $package $packageVersion] \"]
return true
}
}
pkgLog [appendArgs \
"package \"" [formatPackageName $package $version] \
"\" is not available: version not satisfied"]
return false
}
#
# 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.
#
|
︙ | | | ︙ | |
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
|
# here, because Eagle does not add a version argument when one is
# not explicitly supplied to the [package require] sub-command.
#
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
} result(2)]
if {$verboseUnknownResult} then {
pkgLog [appendArgs \
"saved handler results for package \"" [formatPackageName \
$package $version] "\" are " [formatResult $code(2) $result(2)]]
}
#
# NOTE: Maybe check for the package and then optionally log results.
#
if {$verboseUnknownResult} then {
set ifNeededVersion [getIfNeededVersion \
$package [packageRequirementToVersion $version]]
if {[string length $ifNeededVersion] > 0} then {
set command [list package ifneeded $package $ifNeededVersion]
if {[catch $command result(3)] == 0 && \
[string length $result(3)] > 0} then {
pkgLog [appendArgs \
"package script for \"" [formatPackageName $package \
$ifNeededVersion] "\" was added: " [list $result(3)]]
} else {
pkgLog [appendArgs \
"package script for \"" [formatPackageName $package \
$ifNeededVersion] "\" was not added: " [list $result(3)]]
}
} else {
pkgLog [appendArgs \
"package script for \"" [formatPackageName $package \
$ifNeededVersion] "\" was not added"]
}
set command [list package present $package]
if {[string length $version] > 0} then {lappend command $version}
if {[catch $command] == 0} then {
pkgLog [appendArgs \
"package \"" [formatPackageName $package $version] \
"\" was loaded"]
} else {
pkgLog [appendArgs \
"package \"" [formatPackageName $package $version] \
"\" was not loaded"]
}
}
}
#
# NOTE: This procedure evaluates the package repository client settings
# script file, if it exists. Any script errors raised are not
# masked. The script argument must be the fully qualified path
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
>
|
|
|
|
>
|
|
|
>
|
>
<
<
|
<
<
|
<
|
<
>
|
<
<
|
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
|
# here, because Eagle does not add a version argument when one is
# not explicitly supplied to the [package require] sub-command.
#
proc packageUnknownHandler { package {version ""} } {
variable verboseUnknownResult
#
# NOTE: First, run the saved [package unknown] handler.
#
set code(1) [catch {
runSavedPackageUnknownHandler $package $version
} result(1)]
if {$verboseUnknownResult} then {
pkgLog [appendArgs \
"initial saved handler results for package \"" \
[formatPackageName $package $version] "\" are " \
[formatResult $code(1) $result(1)]]
}
#
# NOTE: If the saved [package unknown] handler succeeded -AND- the
# package can now be loaded (or is somehow already loaded?),
# then skip running the repository handler.
#
if {$code(1) == 0 && ([isPackagePresent $package $version] || \
[isPackageAvailable $package $version])} then {
return
}
#
# NOTE: Next, run our special [package unknown] handler.
#
if {[canDownloadPackage $package]} then {
set code(2) [catch {
getPackageFromRepository $package $version handler
} result(2)]
if {$verboseUnknownResult} then {
pkgLog [appendArgs \
"repository handler results for package \"" \
[formatPackageName $package $version] "\" are " \
[formatResult $code(2) $result(2)]]
}
}
#
# NOTE: Next, run the saved [package unknown] handler.
#
set code(3) [catch {
runSavedPackageUnknownHandler $package $version
} result(3)]
if {$verboseUnknownResult} then {
pkgLog [appendArgs \
"subsequent saved handler results for package \"" \
[formatPackageName $package $version] "\" are " \
[formatResult $code(3) $result(3)]]
}
#
# NOTE: Maybe check for the package and then optionally log results.
#
if {$verboseUnknownResult} then {
set ifNeededVersion [getIfNeededVersion \
$package [packageRequirementToVersion $version]]
if {[string length $ifNeededVersion] > 0} then {
set command [list package ifneeded $package $ifNeededVersion]
if {[set code(4) [catch $command result(4)]] == 0 && \
[string length $result(4)] > 0} then {
pkgLog [appendArgs \
"package script for \"" [formatPackageName $package \
$ifNeededVersion] "\" was added: " [formatResult \
$code(4) $result(4)]]
} else {
pkgLog [appendArgs \
"package script for \"" [formatPackageName $package \
$ifNeededVersion] "\" was not added: " [formatResult \
$code(4) $result(4)]]
}
} else {
pkgLog [appendArgs \
"package script for \"" [formatPackageName $package \
$ifNeededVersion] "\" was not added"]
}
#
# NOTE: Check (and log) if the package is now present. The return
# value here is ignored.
#
isPackagePresent $package $version
}
}
#
# NOTE: This procedure evaluates the package repository client settings
# script file, if it exists. Any script errors raised are not
# masked. The script argument must be the fully qualified path
|
︙ | | | ︙ | |
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
|
}
}
#
# NOTE: The command to use when verifying OpenPGP signatures for the
# downloaded package scripts.
#
variable pgpCommand; # DEFAULT: gpg2 --verify {${fileName}}
if {![info exists pgpCommand]} then {
set pgpCommand {gpg2 --verify {${fileName}}}
}
#
# NOTE: Verify that the package script matches the current language
# when called from the [package unknown] handler?
#
variable strictUnknownLanguage; # DEFAULT: true
|
|
|
|
|
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
|
}
}
#
# NOTE: The command to use when verifying OpenPGP signatures for the
# downloaded package scripts.
#
variable openPgpCommand; # DEFAULT: gpg2 --verify {${fileName}}
if {![info exists openPgpCommand]} then {
set openPgpCommand {gpg2 --verify {${fileName}}}
}
#
# NOTE: Verify that the package script matches the current language
# when called from the [package unknown] handler?
#
variable strictUnknownLanguage; # DEFAULT: true
|
︙ | | | ︙ | |