Index: client/1.0/neutral/pkgd.eagle ================================================================== --- client/1.0/neutral/pkgd.eagle +++ client/1.0/neutral/pkgd.eagle @@ -1263,13 +1263,14 @@ # 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 { @@ -1303,24 +1304,35 @@ 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 ""} 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 @@ -1517,10 +1529,104 @@ } 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 } { + 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: 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 @@ -1551,37 +1657,45 @@ } 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}] + 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 Index: client/1.0/neutral/pkgr.eagle ================================================================== --- client/1.0/neutral/pkgr.eagle +++ client/1.0/neutral/pkgr.eagle @@ -417,22 +417,22 @@ # it already appeared to be available for use. # # proc probeForOpenPgpInstallation {} { global env - variable openPgpFileNameOnly - variable openPgpInstalledDirectory + variable openPgpFileNamesOnly + variable openPgpInstalledDirectories if {[catch {openPgpMustBeInstalled}] == 0} then { return true } - if {![info exists openPgpFileNameOnly]} then { + if {![info exists openPgpFileNamesOnly]} then { return false } - if {![info exists openPgpInstalledDirectory]} then { + if {![info exists openPgpInstalledDirectories]} then { return false } if {[isWindows]} then { if {[info exists env(ProgramFiles(x86))]} then { @@ -440,24 +440,33 @@ } elseif {[info exists env(ProgramFiles)]} then { set programFiles $env(ProgramFiles) } else { return false } - - set directory [file join $programFiles $openPgpInstalledDirectory] - } else { - set directory $openPgpInstalledDirectory } - if {![file isdirectory $directory]} then { - return false - } - - set fileName [file join $directory $openPgpFileNameOnly] - - if {[file exists $fileName] && [file isfile $fileName]} then { - return [addToPath $directory] + 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 } @@ -485,11 +494,11 @@ the package management subsystem included with your operating system. } set found false - foreach fileName $openPgpFileNamesOnly { + foreach fileNameOnly $openPgpFileNamesOnly { if {[isEagle]} then { if {[catch { eval exec -success Success [subst $openPgpInstalledCommand] } result] == 0} then { set found true; break @@ -511,23 +520,27 @@ 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 {$fileName ne $openPgpFileNameOnly} then { + if {$fileNameOnly ne $openPgpFileNameOnly} then { pkgLog [appendArgs \ "the OpenPGP file name is being changed from \"" \ - $openPgpFileNameOnly "\" to \"" $fileName \"] + $openPgpFileNameOnly "\" to \"" $fileNameOnly \"] - set openPgpFileNameOnly $fileName + set openPgpFileNameOnly $fileNameOnly } } else { # # NOTE: Configure the OpenPGP file name to the one that was just # found. # - set openPgpFileNameOnly $fileName + 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. @@ -2298,17 +2311,19 @@ # # 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 openPgpInstalledDirectory; # DEFAULT: [file join GNU GnuPG] + variable openPgpInstalledDirectories; # DEFAULT: [list ...] - if {![info exists openPgpInstalledDirectory]} then { + if {$force || ![info exists openPgpInstalledDirectories]} then { if {[isWindows]} then { - set openPgpInstalledDirectory [file join GNU GnuPG] + set openPgpInstalledDirectories [list \ + [file join gnupg bin] [file join GNU GnuPG]] } else { - set openPgpInstalledDirectory [file join / usr bin] + set openPgpInstalledDirectories [list \ + [file join / usr bin]] } } # # NOTE: These are the candidate names of the executable file used to @@ -2315,11 +2330,11 @@ # invoke the OpenPGP implementation, possibly without a file # extension. # variable openPgpFileNamesOnly; # DEFAULT: [list gpg2 gpg] - if {![info exists openPgpFileNamesOnly]} then { + if {$force || ![info exists openPgpFileNamesOnly]} then { if {[isWindows]} then { set openPgpFileNamesOnly [list gpg2.exe gpg.exe] } else { set openPgpFileNamesOnly [list gpg2 gpg] } @@ -2336,11 +2351,11 @@ # file. This must be configured according to the implementation # of OpenPGP in use. # variable openPgpImportCommand; # DEFAULT: gpg2 --import - if {![info exists openPgpImportCommand]} then { + if {$force || ![info exists openPgpImportCommand]} then { set openPgpImportCommand \ {{${openPgpFileNameOnly}} --import {${fileName}}} } # @@ -2348,11 +2363,11 @@ # 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 {![info exists openPgpImportPattern]} then { + 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 @@ -2359,22 +2374,22 @@ # installed locally. This must be configured according to the # implementation of OpenPGP in use. # variable openPgpInstalledCommand; # DEFAULT: gpg2 --version --homedir {} - if {![info exists openPgpInstalledCommand]} then { - set openPgpInstalledCommand {{${fileName}} --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 {![info exists openPgpInstalledPattern]} then { + if {$force || ![info exists openPgpInstalledPattern]} then { set openPgpInstalledPattern {^gpg \(GnuPG\) 2\.[0123]\.} } # # NOTE: The command to use when verifying OpenPGP signatures for the @@ -2381,11 +2396,11 @@ # downloaded package scripts. This must be configured according # to the implementation of OpenPGP in use. # variable openPgpVerifyCommand; # DEFAULT: gpg2 --verify {${fileName}} - if {![info exists openPgpVerifyCommand]} then { + if {$force || ![info exists openPgpVerifyCommand]} then { set openPgpVerifyCommand \ {{${openPgpFileNameOnly}} --verify {${fileName}}} } # @@ -2393,11 +2408,11 @@ # downloaded package scripts. This must be configured according # to the implementation of OpenPGP in use. # variable openPgpSignCommand; # DEFAULT: gpg2 --detach-sign ... - if {![info exists openPgpSignCommand]} then { + if {$force || ![info exists openPgpSignCommand]} then { set openPgpSignCommand "" append openPgpSignCommand \ {{${openPgpFileNameOnly}} --detach-sign --armor}