Index: client/1.0/neutral/pkgd.eagle ================================================================== --- client/1.0/neutral/pkgd.eagle +++ client/1.0/neutral/pkgd.eagle @@ -699,10 +699,38 @@ } else { return false } } + # + # NOTE: This procedure attempts to verify the OpenPGP signature file that + # is associated with the specified file. The forcePgp parameter is + # used to force verification attempts to be performed even when the + # file does not appear to be an OpenPGP signature file. + # + proc maybeVerifyOpenPgpSignature { fileName forcePgp } { + # + # NOTE: Is this temporary package file actually just an OpenPGP + # signature file? If so, skip it. + # + if {$forcePgp || \ + [isOpenPgpSignatureFileName $fileName true]} then { + # + # NOTE: Attempt to verify the OpenPGP signature. If this fails, + # an error is raised. + # + ::PackageRepository::probeForOpenPgpInstallation + ::PackageRepository::openPgpMustBeInstalled + + if {![::PackageRepository::verifyOpenPgpSignature \ + $fileName]} then { + error [appendArgs \ + "bad OpenPGP signature \"" $fileName \"] + } + } + } + # # NOTE: This procedure returns the auto-path for the language specified by # the language argument. An empty list is returned if the auto-path # does not exist in the target language. This procedure may raise # script errors. @@ -1750,17 +1778,17 @@ # must be the list of file names to be downloaded. The package name, # if one can be detected, is returned; otherwise, an empty string will # be returned. # proc guessPackageNameFromFileNames { language fileNames } { - set packageIndexFileName [getPackageIndexFileName $language] + set packageIndexFileNameOnly [getPackageIndexFileName $language] - if {[string length $packageIndexFileName] > 0} then { + if {[string length $packageIndexFileNameOnly] > 0} then { foreach fileName $fileNames { set fileNameOnly [file tail $fileName] - if {$fileNameOnly eq $packageIndexFileName} then { + if {$fileNameOnly eq $packageIndexFileNameOnly} then { set directory [file dirname $fileName] if {[string length $directory] > 0} then { return [file tail $directory] } @@ -1898,23 +1926,16 @@ # # NOTE: Is use of OpenPGP for signature verification enabled? Also, # did we just download an OpenPGP signature file? # - if {$usePgp && ($forcePgp || \ - [isOpenPgpSignatureFileName $localFileName true])} then { - # - # NOTE: Attempt to verify the OpenPGP signature. If this fails, - # an error is raised. - # - ::PackageRepository::probeForOpenPgpInstallation - ::PackageRepository::openPgpMustBeInstalled - - if {![::PackageRepository::verifyOpenPgpSignature $localFileName]} then { - error [appendArgs \ - "bad OpenPGP signature \"" $localFileName \"] - } + if {$usePgp} then { + # + # NOTE: Maybe attempt to verify the OpenPGP signature. If this + # fails, an error is raised. + # + maybeVerifyOpenPgpSignature $localFileName $forcePgp } } # # NOTE: This procedure downloads a single file from the package file server, @@ -2187,16 +2208,16 @@ # # NOTE: Check each unique download directory for a package index # file. If a directory has a package index for the target # language, add to the auto-path for the target language. # - set packageIndexFileName [getPackageIndexFileName $language] + set packageIndexFileNameOnly [getPackageIndexFileName $language] - if {[string length $packageIndexFileName] > 0} then { + if {[string length $packageIndexFileNameOnly] > 0} then { foreach downloadDirectory $downloadDirectories { if {[file exists [file join \ - $downloadDirectory $packageIndexFileName]]} then { + $downloadDirectory $packageIndexFileNameOnly]]} then { addToAutoPath $language $downloadDirectory } } } } @@ -2206,10 +2227,89 @@ # NOTE: Always return the list of directories that were actually added # to the auto-path, if any. # return $downloadDirectories } + + # + # NOTE: This procedure adds temporary package directories to the auto-path + # of the specified language (i.e. native Tcl or Eagle). Directories + # will not be added if already present. The language argument must + # be the literal string "eagle" or the literal string "tcl". The + # pattern argument is the optional pattern to match against each of + # the candidate temporary package directories. If the pattern is an + # empty string then all candidate temporary package directories will + # be added to the auto-path; otherwise, the pattern will be matched + # against the final portion of the temporary package directory name + # and only those temporary package directories that actually match + # the pattern will be added to the auto-path. The options argument + # must be a dictionary of name/value pairs. This procedure does not + # currently support any options. This procedure may raise script + # errors. This procedure assumes the local temporary directory is + # writable only by applications that are implicitly trusted by the + # current user. If this assumption does not hold on your platform, + # DO NOT USE THIS PROCEDURE AS IT MAY BE UNSAFE. + # + # + proc maybeAddTemporaryPackagesToAutoPath { language options {pattern *} } { + variable temporaryRootDirectory + variable verboseTemporaryDirectory + + # + # NOTE: Initially, no temporary package directories have been added + # to the auto-path. + # + set result [list]; set packageNames [list] + + # + # NOTE: What is the package index file name for this language? Each + # candidate temporary package directory will be checked to see + # if it contains this file; otherwise, it will not be added to + # the auto-path. + # + set packageIndexFileNameOnly [getPackageIndexFileName $language] + + # + # HACK: Obtain the list of candidate temporary package directories + # that may need to be added to the auto-path. The prefix we + # use here is considered "well-known" by this package. + # + set directories(1) [glob -nocomplain -types {d} \ + [file join $temporaryRootDirectory pkgd_lib_*]] + + foreach directory(1) $directories(1) { + set directories(2) [glob -nocomplain -types {d} \ + [file join $directory(1) *]] + + foreach directory(2) $directories(2) { + set directoryNameOnly(2) [file tail $directory(2)] + set packageName $directoryNameOnly(2); # HACK: Well-known. + + if {[lsearch -exact $packageNames $packageName] == -1} then { + if {[string length $pattern] == 0 || \ + [string match $pattern $directoryNameOnly(2)]} then { + if {[string length $packageIndexFileNameOnly] == 0 || \ + [file exists [file join $directory(2) \ + $packageIndexFileNameOnly]]} then { + if {[maybeAddToAutoPath $language $directory(2)]} then { + lappend packageNames $directoryNameOnly(2) + lappend result $directory(2) + + if {$verboseTemporaryDirectory} then { + pkgLog [appendArgs \ + "added temporary package directory named \"" \ + $directory(2) "\" to auto-path..."] + } + } + } + } + } + } + } + + return $result + } # # NOTE: This package requires the package repository client package. # package require Eagle.Package.Repository Index: client/1.0/neutral/pkgr.eagle ================================================================== --- client/1.0/neutral/pkgr.eagle +++ client/1.0/neutral/pkgr.eagle @@ -453,11 +453,11 @@ if {[file isdirectory $subDirectory]} then { foreach fileNameOnly $openPgpFileNamesOnly { set fileName [file join $subDirectory $fileNameOnly] - if {[file exists $fileName] && [file isfile $fileName]} then { + if {[file exists $fileName]} then { pkgLog [appendArgs \ "the OpenPGP directory is being initialized to \"" \ $subDirectory "\" based on OpenPGP file name \"" \ $fileNameOnly \"] @@ -2200,26 +2200,60 @@ 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 - # and file name for the primary package repository client script - # file. + # NOTE: This procedure returns the list of possible prefixes that should be + # considered for settings files. The scriptName parameter is the name + # of the script being evaluated, if any. The envVarName parameter is + # the name of an environment variable associated with the script being + # evaluated, if any. The all parameter should be non-zero to include + # all available prefixes, even if they are inapplicable to the current + # configuration. This procedure may raise script errors. + # + proc getSettingsPrefixes { scriptName envVarName all } { + global env + + set result [list] + + if {[info exists tcl_platform(user)]} then { + lappend result $tcl_platform(user) + } + + if {[catch {info hostname} hostName] == 0 && \ + [string length $hostName] > 0} then { + lappend result $hostName + } + + if {[string length $scriptName] > 0} then { + lappend result $scriptName + } + + if {$all || ([string length $envVarName] > 0 && \ + [info exists [appendArgs env(DEBUG_ $envVarName )]])} then { + lappend result debug + } + + lappend result ""; return $result + } + + # + # NOTE: This procedure evaluates package repository client settings script + # files, if they exists. Any script errors raised are not masked. + # The script argument must be the fully qualified path and file name + # for a package client toolset script file. # # proc maybeReadSettingsFiles { script } { global env global tcl_platform - if {[string length $script] == 0 || \ - ![file exists $script] || ![file isfile $script]} then { + if {[string length $script] == 0 || ![file exists $script]} then { return -1 } + set scriptPath [file normalize [file dirname $script]] set scriptTail [file tail $script] set scriptRootName [file rootname $scriptTail] set scriptExtension [file extension $scriptTail] set scriptUpperName [string toupper $scriptRootName] set scriptLowerName [string tolower $scriptRootName] @@ -2228,50 +2262,64 @@ env(NO_SETTINGS_ $scriptUpperName )]]} then { return -2 } set count 0 - set prefixes [list] - - if {[info exists tcl_platform(user)]} then { - lappend prefixes $tcl_platform(user) - } - - if {[catch {info hostname} hostName] == 0 && \ - [string length $hostName] > 0} then { - lappend prefixes $hostName - } - - lappend prefixes $scriptLowerName - - if {[info exists [appendArgs \ - env(DEBUG_ $scriptUpperName )]]} then { - lappend prefixes debug - } - - lappend prefixes "" - - foreach prefix $prefixes { + set allFileNamesOnly [list] + + set allPrefixes [getSettingsPrefixes \ + $scriptLowerName $scriptUpperName true] + + foreach prefix $allPrefixes { + if {[string length $prefix] > 0} then { + set prefix [appendArgs . $prefix] + } + + set fileNameOnly [appendArgs \ + $scriptRootName .settings $prefix \ + $scriptExtension] + + lappend allFileNamesOnly $fileNameOnly + } + + set scriptPrefixes [getSettingsPrefixes \ + $scriptLowerName $scriptUpperName false] + + foreach prefix $scriptPrefixes { if {[string length $prefix] > 0} then { set prefix [appendArgs . $prefix] } - set fileName [appendArgs \ - $scriptRootName .settings $prefix $scriptExtension] + set fileNameOnly [appendArgs \ + $scriptRootName .settings $prefix \ + $scriptExtension] + + set fileName [file join \ + $scriptPath $fileNameOnly] - if {[file exists $fileName] && [file isfile $fileName]} then { + if {[file exists $fileName]} then { uplevel 1 [list source $fileName]; incr count } } if {$count == 0} then { - set pattern [file join [file normalize [file dirname $script]] \ - [appendArgs $scriptRootName .settings.* $scriptExtension]] + set pattern [file join $scriptPath [appendArgs \ + $scriptRootName .settings.* $scriptExtension]] foreach fileName [glob -nocomplain -- $pattern] { - if {[file exists $fileName] && [file isfile $fileName]} then { - uplevel 1 [list source $fileName]; incr count + # + # BUGFIX: Do not consider any settings script file + # that may have already been evaluated via + # the above list(s) of script prefixes. + # + set fileNameOnly [file tail $fileName] + + if {[lsearch -exact \ + $allFileNamesOnly $fileNameOnly] == -1} then { + if {[file exists $fileName]} then { + uplevel 1 [list source $fileName]; incr count + } } } } return $count @@ -2293,11 +2341,11 @@ } if {[info exists env(PKGR_API_KEYS_FILE)]} then { set fileName $env(PKGR_API_KEYS_FILE) - if {[file exists $fileName] && [file isfile $fileName]} then { + if {[file exists $fileName]} then { uplevel 1 [list source $fileName] } } }