Changes In Branch pending Excluding Merge-Ins
This is equivalent to a diff from b2ec485564 to ffccb611a3
|
2020-03-27
| ||
| 20:58 | Various fixes related to package version checking and OpenPGP integration. check-in: 1ba61d8533 user: mistachkin tags: trunk | |
|
2020-03-26
| ||
| 15:12 | Add more comments. Closed-Leaf check-in: ffccb611a3 user: mistachkin tags: pending | |
| 14:52 | Add comments. check-in: cf6edd5132 user: mistachkin tags: pending | |
|
2020-03-24
| ||
| 23:23 | The 'probeForOpenPgpInstallation' procedure should check all names in 'openPgpFileNamesOnly'. Also, the 'probeForOpenPgpInstallation' procedure should recognize the new directory layout used by Windows GPG installations. The 'setupRepositoryOpenPgpVars' procedure should honor its 'force' argument. check-in: 071382dcf8 user: mistachkin tags: pending | |
|
2019-12-02
| ||
| 22:06 | Fix typos in the Harpy 'sign' tool. check-in: b2ec485564 user: mistachkin tags: trunk | |
|
2019-11-06
| ||
| 16:08 | Regenerate the documentation. check-in: 2fa0ad12f0 user: mistachkin tags: trunk | |
Modified client/1.0/neutral/pkgd.eagle from [a8520a0f88] to [eff6e99d05].
| ︙ | ︙ | |||
1261 1262 1263 1264 1265 1266 1267 | # # 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 | | > | | 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 |
#
# 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"
}
|
| ︙ | ︙ | |||
1301 1302 1303 1304 1305 1306 1307 |
if {[info exists loginCookie] && [llength $loginCookie] == 2} then {
set script [object create String {
if {[methodName ToString] eq "GetWebRequest"} then {
webRequest Headers.Add Cookie [join $loginCookie =]
}
}]
| | | | > > > > > > > > > > > | 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 |
if {[info exists loginCookie] && [llength $loginCookie] == 2} then {
set script [object create String {
if {[methodName ToString] eq "GetWebRequest"} then {
webRequest Headers.Add Cookie [join $loginCookie =]
}
}]
set data [uri download -inline -webclientdata $script -- $uri]
} else {
set data [uri download -inline -- $uri]
}
} else {
set options [list -binary true]
if {[info exists loginCookie] && [llength $loginCookie] == 2} 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.
#
|
| ︙ | ︙ | |||
1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 |
"returning temporary directory name \"" $result \
"\" for prefix \"" $prefix \"...]
}
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
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 |
"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
|
| ︙ | ︙ | |||
1549 1550 1551 1552 1553 1554 1555 |
if {$isClient} then {
set persistentDirectory $clientDirectory
} else {
verifyPersistentRootDirectory
set persistentDirectory $persistentRootDirectory
}
| > > > | | | > | | | | | | | | | | | | | | | | | | > > > > | 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 |
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
|
| ︙ | ︙ |
Modified client/1.0/neutral/pkgr.eagle from [8f2d9374a1] to [dd293526a1].
| ︙ | ︙ | |||
415 416 417 418 419 420 421 |
# OpenPGP installation directory was successfully detected and added
# to the PATH -OR- detecting and adding it was not necessary because
# it already appeared to be available for use.
#
# <internal>
proc probeForOpenPgpInstallation {} {
global env
| | | | | | > > > | | | | | < < | | | > > > > > | > > > | 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 |
# OpenPGP installation directory was successfully detected and added
# to the PATH -OR- detecting and adding it was not necessary because
# it already appeared to be available for use.
#
# <internal>
proc probeForOpenPgpInstallation {} {
global env
variable openPgpFileNamesOnly
variable openPgpInstalledDirectories
if {[catch {openPgpMustBeInstalled}] == 0} then {
return true
}
if {![info exists openPgpFileNamesOnly]} then {
return false
}
if {![info exists openPgpInstalledDirectories]} then {
return false
}
if {[isWindows]} then {
if {[info exists env(ProgramFiles(x86))]} then {
set programFiles $env(ProgramFiles\(x86\))
} elseif {[info exists env(ProgramFiles)]} then {
set programFiles $env(ProgramFiles)
} else {
return false
}
}
foreach directory $openPgpInstalledDirectories {
if {[isWindows]} then {
set subDirectory [file join $programFiles $directory]
} else {
set subDirectory $directory
}
if {[file isdirectory $subDirectory]} then {
foreach fileNameOnly $openPgpFileNamesOnly {
set fileName [file join $subDirectory $fileNameOnly]
if {[file exists $fileName] && [file isfile $fileName]} then {
pkgLog [appendArgs \
"the OpenPGP directory is being initialized to \"" \
$subDirectory "\" based on OpenPGP file name \"" \
$fileNameOnly \"]
return [addToPath $subDirectory]
}
}
}
}
return false
}
#
# NOTE: This procedure attempts to verify that a configured implementation
|
| ︙ | ︙ | |||
483 484 485 486 487 488 489 |
Alternatively, it may be possible to install GNU Privacy Guard (GPG) via
the package management subsystem included with your operating system.
}
set found false
| | | 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 |
Alternatively, it may be possible to install GNU Privacy Guard (GPG) via
the package management subsystem included with your operating system.
}
set found false
foreach fileNameOnly $openPgpFileNamesOnly {
if {[isEagle]} then {
if {[catch {
eval exec -success Success [subst $openPgpInstalledCommand]
} result] == 0} then {
set found true; break
}
} else {
|
| ︙ | ︙ | |||
509 510 511 512 513 514 515 |
# viable OpenPGP file name?
#
if {[info exists openPgpFileNameOnly]} then {
#
# NOTE: If the OpenPGP file name that we found before (?) does not
# match what we already have, issue a log message.
#
| | | | > > > > | | 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 |
# viable OpenPGP file name?
#
if {[info exists openPgpFileNameOnly]} then {
#
# NOTE: If the OpenPGP file name that we found before (?) does not
# match what we already have, issue a log message.
#
if {$fileNameOnly ne $openPgpFileNameOnly} then {
pkgLog [appendArgs \
"the OpenPGP file name is being changed from \"" \
$openPgpFileNameOnly "\" to \"" $fileNameOnly \"]
set openPgpFileNameOnly $fileNameOnly
}
} else {
#
# NOTE: Configure the OpenPGP file name to the one that was just
# found.
#
pkgLog [appendArgs \
"the OpenPGP file name is being initialized to \"" \
$fileNameOnly \"]
set openPgpFileNameOnly $fileNameOnly
}
} else {
#
# NOTE: If no viable OpenPGP file name was found, raise the error
# message.
#
error $message
|
| ︙ | ︙ | |||
2296 2297 2298 2299 2300 2301 2302 |
#
proc setupRepositoryOpenPgpVars { force } {
#
# NOTE: This is the name of the sub-directory containing the OpenPGP
# implementation. It is platform-specific. On Windows, this
# sub-directory is relative to the "Program Files" directory.
#
| | | | > | > | | | | | | | | | 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 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 |
#
proc setupRepositoryOpenPgpVars { force } {
#
# NOTE: This is the name of the sub-directory containing the OpenPGP
# implementation. It is platform-specific. On Windows, this
# sub-directory is relative to the "Program Files" directory.
#
variable openPgpInstalledDirectories; # DEFAULT: [list ...]
if {$force || ![info exists openPgpInstalledDirectories]} then {
if {[isWindows]} then {
set openPgpInstalledDirectories [list \
[file join gnupg bin] [file join GNU GnuPG]]
} else {
set openPgpInstalledDirectories [list \
[file join / usr bin]]
}
}
#
# NOTE: These are the candidate names of the executable file used to
# invoke the OpenPGP implementation, possibly without a file
# extension.
#
variable openPgpFileNamesOnly; # DEFAULT: [list gpg2 gpg]
if {$force || ![info exists openPgpFileNamesOnly]} then {
if {[isWindows]} then {
set openPgpFileNamesOnly [list gpg2.exe gpg.exe]
} else {
set openPgpFileNamesOnly [list gpg2 gpg]
}
}
#
# NOTE: This is the name of the executable file used to invoke the
# OpenPGP implementation, possibly without a file extension.
#
variable openPgpFileNameOnly; # DEFAULT: <unset>
#
# NOTE: The command to use when attempting to import an OpenPGP key
# file. This must be configured according to the implementation
# of OpenPGP in use.
#
variable openPgpImportCommand; # DEFAULT: gpg2 --import
if {$force || ![info exists openPgpImportCommand]} then {
set openPgpImportCommand \
{{${openPgpFileNameOnly}} --import {${fileName}}}
}
#
# NOTE: The regular expression pattern used when attempting to verify
# that OpenPGP successfully imported one or more keys. This must
# be configured according to the implementation of OpenPGP in use.
#
variable openPgpImportPattern; # DEFAULT: ^gpg: Total number processed...
if {$force || ![info exists openPgpImportPattern]} then {
set openPgpImportPattern {^gpg: Total number processed: [1-9]\d*$}
}
#
# NOTE: The command to use when attempting to verify that OpenPGP is
# installed locally. This must be configured according to the
# implementation of OpenPGP in use.
#
variable openPgpInstalledCommand; # DEFAULT: gpg2 --version --homedir {}
if {$force || ![info exists openPgpInstalledCommand]} then {
set openPgpInstalledCommand {{${fileNameOnly}} --version --homedir {}}
}
#
# NOTE: The regular expression pattern used when attempting to verify
# that OpenPGP is installed locally. This must be configured
# according to the implementation of OpenPGP in use.
#
variable openPgpInstalledPattern; # DEFAULT: ^gpg \(GnuPG\) 2\.[0123]\.
if {$force || ![info exists openPgpInstalledPattern]} then {
set openPgpInstalledPattern {^gpg \(GnuPG\) 2\.[0123]\.}
}
#
# NOTE: The command to use when verifying OpenPGP signatures for the
# downloaded package scripts. This must be configured according
# to the implementation of OpenPGP in use.
#
variable openPgpVerifyCommand; # DEFAULT: gpg2 --verify {${fileName}}
if {$force || ![info exists openPgpVerifyCommand]} then {
set openPgpVerifyCommand \
{{${openPgpFileNameOnly}} --verify {${fileName}}}
}
#
# NOTE: The command to use when creating OpenPGP signatures for the
# downloaded package scripts. This must be configured according
# to the implementation of OpenPGP in use.
#
variable openPgpSignCommand; # DEFAULT: gpg2 --detach-sign ...
if {$force || ![info exists openPgpSignCommand]} then {
set openPgpSignCommand ""
append openPgpSignCommand \
{{${openPgpFileNameOnly}} --detach-sign --armor}
append openPgpSignCommand \
{ --passphrase-file [formatExecArgument [getOpenPgpPassphraseFile]]}
|
| ︙ | ︙ |