| ︙ | | | ︙ | |
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
|
#
# 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.
#
proc getPackageFile { uri } {
variable loginCookie
variable quiet
if {[isEagle]} then {
if {![info exists ::eagle_platform(compileOptions)]} then {
error "missing compile options from Eagle platform array"
}
|
|
>
|
|
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
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
|
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]
} else {
return [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 \
[list $uri] [list 20] [list stdout] [list $quiet] $options]
}
}
#
# NOTE: This procedure returns the prefix for fully qualified variable
# names that MAY be present in the global namespace. There are
# no arguments.
#
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
|
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
|
"returning temporary directory name \"" $result \
"\" for prefix \"" $prefix \"...]
}
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 extractVersionFromFile { fileName } {
switch -exact -- [file tail $fileName] {
VERSION {
return [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)?
#
return ""
}
}
}
#
# 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
|
if {$isClient} then {
set persistentDirectory $clientDirectory
} else {
verifyPersistentRootDirectory
set persistentDirectory $persistentRootDirectory
}
set fileName [file join $packageName VERSION]
set downloadFileName [file join $temporaryDirectory $fileName]
file mkdir [file dirname $downloadFileName]
downloadOneFile $language $version $platform \
$fileName $downloadFileName $usePgp
if {$usePgp} then {
downloadOneFile $language $version $platform \
[appendArgs $fileName .asc] \
[appendArgs $downloadFileName .asc] $usePgp
}
set localFileName [file join $persistentDirectory $fileName]
set compare [package vcompare \
[string trim [readFile $downloadFileName]] \
[string trim [readFile $localFileName]]]
if {[isEagle]} then {
file delete -recursive -- $temporaryDirectory
} else {
file delete -force -- $temporaryDirectory
}
return [expr {$compare > 0}]
}
#
# 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
|
>
>
>
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
|
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
|
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 \
[extractVersionFromFile $downloadFileName] \
[extractVersionFromFile $localFileName]]
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
|
| ︙ | | | ︙ | |