Index: client/pkgr.eagle ================================================================== --- client/pkgr.eagle +++ client/pkgr.eagle @@ -32,12 +32,11 @@ # # NOTE: This procedure returns a formatted, possibly version-specific, # package name, for use in logging. # proc formatPackageName { package version } { - return [string trim [appendArgs \ - $package " " [getLookupVersion $version]]] + return [string trim [appendArgs $package " " $version]] } # # NOTE: This procedure returns a formatted script result. If the string # result is empty, only the return code is used. The code argument @@ -310,27 +309,29 @@ # a simple package version, if possible. An empty string will be # returned, if appropriate (i.e. any version should be allowed). # The requirement argument must be a package specification that # conforms to TIP #268. # - proc getLookupVersion { requirement } { - if {[set index [string first - $requirement]] != -1} then { - incr index -1; set requirement [string range $requirement 0 $index] - } - - if {[set index [string first a $requirement]] != -1 || \ - [set index [string first b $requirement]] != -1} then { - incr index -1; set requirement [string range $requirement 0 $index] - } - - if {$requirement eq "0"} then { - set requirement "" - } elseif {[regexp -- {^\d+$} $requirement]} then { - append requirement .0 - } - - return $requirement + proc packageRequirementToVersion { requirement } { + set result $requirement + + if {[set index [string first - $result]] != -1} then { + incr index -1; set result [string range $result 0 $index] + } + + if {[set index [string first a $result]] != -1 || \ + [set index [string first b $result]] != -1} then { + incr index -1; set result [string range $result 0 $index] + } + + if {$result eq "0"} then { + set result "" + } elseif {[regexp -- {^\d+$} $result]} then { + append result .0 + } + + return $result } # # NOTE: This procedure issues an HTTP request that should return metadata # that can be used to load and/or provide the specified package. @@ -412,10 +413,73 @@ # request to be considered successful. # return [expr {$code eq "OK"}] } + # + # NOTE: This procedure was stolen from the "common.tcl" script used by the + # package repository server. It has been modified to support both + # native Tcl and Eagle. It should be noted here that TIP #268 syntax + # is not supported by Eagle. For native Tcl, the requirement argument + # must be a package version or requirement conforming to the TIP #268 + # syntax. For Eagle, the requirement argument must be a simple dotted + # package version, with up to four components, without any 'a' or 'b'. + # The emptyOk argument should be non-zero if an empty string should be + # considered to be valid by the caller. The rangeOk argument should + # be non-zero if the version range syntax is allowed; this argument is + # ignored for Eagle because it requires TIP #268 support. + # + proc isValidPackageRequirement { requirement rangeOk {emptyOk false} } { + if {$emptyOk && [string length $requirement] == 0} then { + return true + } + + if {[isEagle]} then { + # + # NOTE: Eagle does not support TIP #268. Use the built-in sub-command + # that checks a version number. + # + return [string is version -strict $requirement] + } else { + # + # HACK: If a version range is not allowed, make sure that the dash + # character is not present. + # + if {!$rangeOk && [string first - $requirement] != -1} then { + return false + } + + # + # HACK: There is no direct way to check if a package requirement + # that uses the TIP #268 syntax is valid; however, we can + # purposely "misuse" the [package present] command for this + # purpose. We know the "Tcl" package is always present; + # therefore, if an error is raised here, then the package + # requirement is probably invalid. Unfortunately, the error + # message text has to be checked as well; otherwise, there + # is no way to verify version numbers that happen to be less + # than the running patch level of Tcl. + # + if {[catch {package present Tcl $requirement} error] == 0} then { + return true + } else { + # + # TODO: Maybe this will require updates in the future? + # + set pattern(1) "expected version number but got *" + set pattern(2) "expected versionMin-versionMax but got *" + + if {![string match $pattern(1) $error] && \ + ![string match $pattern(2) $error]} then { + return true + } else { + return false + } + } + } + } + # # NOTE: This procedure attempts to extract the package lookup metadata from # the lookup result. The result argument is the lookup result. The # varName argument is the name of an array variable, in the call frame # of the immediate caller, that should receive the extracted package @@ -422,10 +486,25 @@ # lookup metadata. The caller argument must be an empty string -OR- # the literal string "handler". # proc extractAndVerifyLookupMetadata { result varName caller } { variable strictUnknownLanguage + + # + # NOTE: Grab the returned patch level. It cannot be an empty string + # and it must conform to the TIP #268 requirements for a single + # package version. + # + set patchLevel [getDictionaryValue $result PatchLevel] + + if {[string length $patchLevel] == 0} then { + error "missing patch level" + } + + if {![isValidPackageRequirement $patchLevel false]} then { + error "bad patch level" + } # # NOTE: Grab the language for the package script. It must be an empty # string, "Tcl", or "Eagle". If it is an empty string, "Eagle" # will be assumed. @@ -484,10 +563,11 @@ # array variable name. # if {[string length $varName] > 0} then { upvar 1 $varName metadata + set metadata(patchLevel) $patchLevel set metadata(language) $language set metadata(script) $script set metadata(certificate) $certificate } } @@ -585,10 +665,17 @@ # NOTE: If the entire package metadata array is missing, fail. # if {![info exists metadata]} then { error "missing metadata" } + + # + # NOTE: If the patch level for the package is mising, fail. + # + if {![info exists metadata(patchLevel)]} then { + error "missing patch level" + } # # NOTE: If the language for the package script is mising, fail. # if {![info exists metadata(language)]} then { @@ -1031,11 +1118,11 @@ # # NOTE: Maybe check for the package and then optionally log results. # if {$verboseUnknownResult} then { set ifNeededVersion [getIfNeededVersion \ - $package [getLookupVersion $version]] + $package [packageRequirementToVersion $version]] if {[string length $ifNeededVersion] > 0} then { set command [list package ifneeded $package $ifNeededVersion] if {[catch $command result(3)] == 0 && \ @@ -1185,12 +1272,11 @@ foreach apiKey $apiKeys { # # NOTE: Issue the lookup request to the remote package repository. # - set data [getLookupData \ - $apiKey $package [getLookupVersion $version]] + set data [getLookupData $apiKey $package $version] # # NOTE: Attempt to grab the lookup code from the response data. # set code [getLookupCodeFromData $data] Index: client/pkgr.eagle.harpy ================================================================== --- client/pkgr.eagle.harpy +++ client/pkgr.eagle.harpy @@ -19,32 +19,32 @@ None Mistachkin Systems - f1d8f632-d9b8-416a-a64e-09e849166d1d + ba94806a-9b8d-4e88-bab7-13bf861cac0d SHA512 Script - 2016-08-17T23:14:24.3317891Z + 2016-08-19T00:09:46.0088359Z -1.00:00:00 0x2c322765603b5278 - jPuvGuBBk6RyXSNCczrf+4CzooFcaJAgtxA18ESaGkLqXDwdG0p4fWeTaAjjre761jw5uIDAbTVR - g9SsUvCWlfzEMifPwbWVkoz3+XS5mASE6WWmlPxi4NojcQOP1ouoUntarma+fJfuOZ/V23GLeuLO - 3RU45eu32uJeB70ho8lMvUUL8fdwHr0WitKwJbea6uHXlNDpx7o3UDd3zz1RAxTrEWYSUPSdblZT - ku9mHZ4DzMxrpHRLDfly7Ghf6Zxuh2qal/91YHERSwgKkBeExqvbyqwnPm8rg8OEVBfqfNNdc4tO - QT2gn4rhgvZsNvzJ/IBmVYvUOMvVP9WR/EBdIETqHXP1xLqIOU7P2I0lTKTnf8S9u8RGTeO0ckGk - wik1MOjHNQ2VEKeLeOpbpwJgh2jdxHz3XlrvaYG+pbxSr/rnMD3qKUUVQwg7GClacuXY2JMDFLuc - KhRmqmRw6AfOvlDsRXllkCcftHU6lRhCWUkCjL2u2dj6Vi8dj/lHlO+lVzCSZ5TTtYk4RmtUg9FV - aAoWvdRAe0XIPw+IzG1NzHbO2h6UMkii+C3YpNZdT1Z4ztOaw0W3x74SVbZ5Tr/6IEZc283gqVC/ - Td2Pfd3SVNud5oa+rnDkXi4nHE8y9FqWCK6FpmzOKbxKBud6Taa5LCMyNVaqfkjLbmZzCtgDjOqs - XdumD1Nur3y2+on0l8tLMz0dfk6U3MmUOdTOYX1wBdp9fGtgbDqgJlatpNlSCj9+cjhxQkpE/W2S - mKvt0mAGv/HySG0VVukjAlivTF+K8csjq/SWQec5vUfC/bGjQckpOUlVc5zhiDzhhcOUi6qbzNxJ - qC1MdH+KcVAFwjrPzdQSU4vnei/EZjUuXo2wsVMrCkUm3h8GOjQTCpVnEcCqgtenCpS9wjd81AX8 - B0T/LKAhx4swsIiVrYcVLMDLu8HTtZFlKw0XLwTu5r6BZDghhKC4ZBGEF7EvL0UfSxPMgCgNA4F5 - wUBsRMF73q5KFTOSdBqHOo64P3GfO08/N3wTORVQtLeBrAPKXqXWnNR2wYaLNwezL7hd6HdQAClB - +7z79+JyRezhtlkxhNRXnEHLz3GcWm/VV0xCXLxiAv1WrRsioEf7rBLP2easOI2a+t25I52LLUzP - ShqWyclTfLXYezXg3h5itouHgfxKvt7ojeLJRAKifVemTEEE1bF7yG3DYANfwTrJ3Oz2GqzABiU/ - mZiVluPjydeD7W8uhYt7cNafUG9nCHPLi+7HfcGh9LZQZDg/mb9B5TShkdoYOS8Pl5UhMDSv1P25 - GKrHMRI2VneZLlTFwRg2yjRuvhUrhM+Hy+RZ/HLbBUJbnEaWTh0u1d/0ZPp7Ne/ER5fn2MhIgA== + QwuM/tDLPKZLpAVJgsRw0+sjnxIouFcqm1IDjMqfdIv35x4sKBaXvMRTzid60II+xLcH7HlPB5yA + TdoxpEOpQDcxb1td6QA6x83QR/sNrHjENQhdBLRlMB85zb4BDYoeBxRZffaVJ9/DcUGMBFjaCnq9 + fvMwy8Zrfn9gchj62qIQi325ZmoAEjx9gNxqZ04VgKS9gVv/zrtCTjI0a005UnoCLvJ9pYwbI8JT + +froJJNq33wGV6AhZgtDz68oztHEoeo4VPnKK+eWNN6Prc3zmV4DBZp48PiQRqGjJlvjcnptazRl + A5dSgbCXhqQ3ZiZg1oCytoo44zskijZMXweS9XMXe4RFR2/norxDMpRVkGNjsg1Aa9Vp2MiyZt55 + 05VWuH6REndSOlN81GvIJGnRm/YKM2fplp98/EVrhQqMAR60RZvqsCgn+JTwgEL5SS40v+iK+1mM + fKTuJkox07Vn4swSFcDyXhZroloIYSQmK/Il1+MCyQbQXntzdGLN6onuK/3ZITZneAMFHnwYX/bz + Usyuixc3tP8dSVKz42ejdxRfMu9S3FakXLUOt9mWUvVIsS68wjyII4+GycvpbD4M3aHa7L8AiawD + qZNeRZ8Teksxhy1UGB10LvkVmmdNew+N6v1MPwVPCT607hJNmmztjp7UMch1mN/l79yzw1LvyM+F + eGe0vkfx+Z0FztiPh7F140zQumhktQl5ifl5yrt0hdNS9fGPI5PLyxbQuvstPo7PG9JNfLGRcnje + etkTVnmXN2g3jYIufHMT03pQZE3F4/FELoVPdddXbf/CnoN6ZRCvX1FiznA+7AHJB1Xhw4LhOqiq + erhj9JCAHjyqj+mgdybLeE+5Qzc3CXvWldTiFsthwl60JmiJ8zqElVOIyvIfhGveWN3WTfamQl4A + iHDIirJy/LYROkbMYFCpJy28xDl/E9l5r+mdW9mSsJMfToUT4Lg9qtVa90H8qzeGKp/DIOHM1MEG + cFDarH3qb8V1+hsbxMlku23kiJ/LYYIIthLY9WvAkJQXp7yM7Dm5yAkUvIrsjrKNdvQF0ZVmsvY9 + 4dt/xKbnOLGMwZldgHL18JU6tnqiLFHT8SXjJZVgM5swrfTxhOaZny/f4TebxiFbg6puIvkmFHXE + jOQz3so7pMb2LCzIme8WLDUsCdWX3KKSwtL1c0PGSjwEAtB6fPyqeJhTFXoUqAu6p64eqiu4uc4d + voY8o0BLHwsb1KduLHK/a96qRdCZrOFy8ppftMg1D4FP65696Fd9xulY6XWTaOCIRibWwdtUP/As + j3a9uwEU6kxYZw8IPQZmqGlrd1bDclzIEWTxD8tRgzVLWhErt6wRGf6V8whyHBllWBRzPgTciA==