| ︙ | | |
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
|
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.
# to request. The allowHtml argument should be non-zero if raw HTML
# should be allowed in the response data.
#
proc getPackageFile { uri } {
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
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
|
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 =]
}
}]
return [uri download -inline -webclientdata $script -- $uri]
set data [uri download -inline -webclientdata $script -- $uri]
} else {
return [uri download -inline -- $uri]
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 =]]
}
return [eval ::PackageRepository::getFileViaHttp \
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
|
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
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
"returning temporary directory name \"" $result \
"\" for prefix \"" $prefix \"...]
}
return $result
}
#
# NOTE: TBD
#
proc createInterp { varName } {
upvar 1 $varName interp
set interp [interp create -safe]
interp eval $interp [list set dir .]
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 {
interp eval $interp [list proc file args ""]; # NOP
}
interp eval $interp [list proc proc args ""]; # NOP
return ""
}
#
# NOTE: TBD
#
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
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
|
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
|
+
+
+
-
-
+
+
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
-
+
+
+
+
+
|
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 VERSION]
set downloadFileName [file join $temporaryDirectory $fileName]
set fileName [file join $packageName $fileNameOnly]
set downloadFileName [file join $temporaryDirectory $fileName]
file mkdir [file dirname $downloadFileName]
file mkdir [file dirname $downloadFileName]
if {[catch {
downloadOneFile $language $version $platform \
$fileName $downloadFileName $usePgp
if {$usePgp} then {
downloadOneFile $language $version $platform \
[appendArgs $fileName .asc] \
[appendArgs $downloadFileName .asc] $usePgp
}
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 localFileName [file join $persistentDirectory $fileName]
set compare [package vcompare \
[string trim [readFile $downloadFileName]] \
[string trim [readFile $localFileName]]]
set compare [package vcompare \
[lindex [extractVersionsFromFile $downloadFileName] 0] \
[lindex [extractVersionsFromFile $localFileName] 0]]
if {[isEagle]} then {
file delete -recursive -- $temporaryDirectory
} else {
file delete -force -- $temporaryDirectory
}
if {[isEagle]} then {
file delete -recursive -- $temporaryDirectory
} else {
file delete -force -- $temporaryDirectory
}
return [expr {$compare > 0}]
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
|
| ︙ | | |