###############################################################################
#
# pkgt.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Eagle Package Toolset Package File
#
# Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################
#
# NOTE: Use our own namespace here because even though we do not directly
# support namespaces ourselves, we do not want to pollute the global
# namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::Eagle {
#
# NOTE: This procedure sets up the default values for all configuration
# parameters used by this package. If the force argument is non-zero,
# any existing values will be overwritten and set back to their
# default values.
#
proc setupPackageToolsetVars { force } {
#
# NOTE: Using the [getAuxiliaryBaseUri] procedure requires the update
# package.
#
# NOTE: The base URI used to build the URIs for the Package Client
# Toolset downloads.
#
variable baseUri; # DEFAULT: [getAuxiliaryBaseUri] -OR- https://urn.to/r
if {$force || ![info exists baseUri]} then {
if {[isEagle]} then {
set baseUri [getAuxiliaryBaseUri]
} else {
set baseUri https://urn.to/r
}
}
#
# NOTE: The URN, relative to the base URI, where the Package Client
# Toolset may be downloaded.
#
variable packageToolsetUrn; # DEFAULT: pkg_client_only
if {$force || ![info exists packageToolsetUrn]} then {
set packageToolsetUrn pkg_client_only
}
#
# NOTE: The URI where the Package Client Toolset may be downloaded.
#
variable packageToolsetUri; # DEFAULT: ${baseUri}/${packageToolsetUrn}
if {$force || ![info exists packageToolsetUri]} then {
set packageToolsetUri {${baseUri}/${packageToolsetUrn}}
}
#
# NOTE: The URN, relative to the base URI, where the TclKit DLL for
# a particular platform may be downloaded.
#
variable tclKitDllUrn; # DEFAULT: tclkit_dll_${platform}
if {$force || ![info exists tclKitDllUrn]} then {
set tclKitDllUrn {tclkit_dll_${platform}}
}
#
# NOTE: The URI where the TclKit DLL for a particular platform may
# be downloaded.
#
variable tclKitDllUri; # DEFAULT: ${baseUri}/${urn}
if {$force || ![info exists tclKitDllUri]} then {
set tclKitDllUri {${baseUri}/${urn}}
}
#
# NOTE: The URN, relative to the base URI, where the Harpy and Badge
# plugins for a particular build may be downloaded.
#
variable securityToolsetUrn; # DEFAULT: security_toolset_${platform}
if {$force || ![info exists securityToolsetUrn]} then {
set securityToolsetUrn {security_toolset_${platform}}
}
#
# NOTE: The URI where the Harpy and Badge plugins for a particular
# build may be downloaded.
#
variable securityToolsetUri; # DEFAULT: ${baseUri}/${urn}
if {$force || ![info exists securityToolsetUri]} then {
set securityToolsetUri {${baseUri}/${urn}}
}
#
# NOTE: The URN, relative to the base URI, where license certificate
# requests should be sent.
#
variable licenseUrn; # DEFAULT: get_license_01
if {$force || ![info exists licenseUrn]} then {
set licenseUrn get_license_01
}
#
# NOTE: The URI where license certificate requests should be sent.
#
variable licenseUri; # DEFAULT: ${baseUri}/${urn}
if {$force || ![info exists licenseUri]} then {
set licenseUri {${baseUri}/${urn}}
}
#
# NOTE: The URN, relative to the base URI, where script evaluation
# requests should be submitted to the "safe" sandbox.
#
variable sandboxEvalUrn; # DEFAULT: eval_01
if {$force || ![info exists sandboxEvalUrn]} then {
set sandboxEvalUrn eval_01
}
#
# NOTE: The URI where script evaluation requests should be submitted
# to the "safe" sandbox.
#
variable sandboxEvalUri; # DEFAULT: ${baseUri}/${urn}
if {$force || ![info exists sandboxEvalUri]} then {
set sandboxEvalUri {${baseUri}/${urn}}
}
}
#
# NOTE: This procedure attempts to download and extract the Package Client
# Toolset. The optional channel argument is the output channel where
# diagnostic information is sent. The optional quiet argument should
# be non-zero to prevent diagnostic information from being emitted.
# This procedure may raise script errors. The return value is the
# full path to the directory that should be added to the auto-path.
#
proc downloadAndExtractPackageClientToolset {
{channel stdout} {quiet false} } {
setupPackageToolsetVars false
variable baseUri
variable packageToolsetUri
variable packageToolsetUrn
package require Eagle.Test
package require Eagle.Unzip
set extractRootDirectory [getPackageInstallPath pkgd ea-pt-di]
set uri [subst $packageToolsetUri]
set fileName [getTemporaryFileName]
if {[isEagle]} then {
uri download $uri $fileName
} else {
package require Eagle.Tools.Common
namespace import \
::Eagle::Tools::Common::getFileViaHttp \
::Eagle::Tools::Common::writeFile
set data [getFileViaHttp $uri 20 $channel $quiet -binary true]
writeFile $fileName $data
}
set extractDirectory [extractZipArchive \
$fileName $extractRootDirectory true]
return [file join $extractDirectory pkgr_an_d client 1.0 neutral]
}
#
# NOTE: This procedure attempts to load (via [package require]) the package
# client toolset. It is designed to be used in conjunction with the
# [downloadAndExtractPackageClientToolset] procedure, above. Support
# is included for specifying an extra auto-path directory and API key
# to use. By default, the [package unknown] handler is hooked to add
# the remote package repository lookup functionality. Eagle supports
# extra script security via signed script certificates, which will be
# enabled by default, unless it is unavailable.
#
proc loadPackageClientToolset {
{directory auto} {apiKeys ""} {hookUnknown true} {enableSecurity true}
{strictSecurity false} {debug false} } {
#
# NOTE: When running in Eagle, namespace support must be available and
# enabled.
#
if {[isEagle] && ![namespace enable]} then {
error "namespace support must be enabled"
}
#
# NOTE: Does the caller want automatic discovery of the directory that
# contains the (downloaded?) package client toolset? Currently,
# this only works on Windows and searches the temporary download
# location, which normally obtains its value from the environment
# variable TEMP.
#
if {$directory eq "auto"} then {
#
# NOTE: First, before doing anything else, see if the package client
# toolset is already installed somewhere it can be loaded from.
#
set needDirectory true
if {[isEagle]} then {
#
# NOTE: Force Eagle to find *ALL* available package index files.
# This must be done in the global scope so that the special
# global variable 'dir' set by the package index loading
# subsystem can be accessed. Use [catch] here just in case
# a package index file raises a script error.
#
catch {
uplevel #0 [list package scan -host -normal -refresh]
}
} else {
#
# HACK: Force Tcl to find *ALL* available package index files.
# Without this, checking for the available versions of a
# package using [package versions] likely will not succeed
# unless the package is already loaded. Use [catch] here
# just in case a package index file raises a script error.
#
catch {
package require [appendArgs \
bogus_package_ [string trim [clock seconds] -]]
}
}
#
# NOTE: Check and see if the package repository client is a known
# package now. If so, there is no need to search directories
# for it.
#
if {[llength [package versions Eagle.Package.Repository]] > 0} then {
set needDirectory false
}
#
# NOTE: Is searching for temporary download directories required at
# this point?
#
if {$needDirectory} then {
if {![isWindows]} then {
error "directory discovery not supported on this platform"
}
set extractRootDirectory [getPackageInstallPath]
foreach directory [findDirectoriesRecursive \
[file join $extractRootDirectory pkgr_an_d]] {
#
# NOTE: Reset directory we just found to include the necessary
# sub-directory components for the actual client files
# and then stop, thereby selecting the first match.
#
set directory [file join $directory client 1.0 neutral]; break
}
}
#
# NOTE: If no directory was found, just clear the directory name,
# which will cause auto-path modification(s) to be skipped.
#
if {$directory eq "auto"} then {
set directory ""
}
}
#
# NOTE: If there is a directory specified by the caller -OR- found
# via automatic directory discovery, add it to the auto-path
# now.
#
if {[string length $directory] > 0} then {
#
# NOTE: Only modify the auto-path if the directory is not already
# present. This prevents needless variable trace execution
# that rescans the various auto-path directories.
#
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path $directory] == -1} then {
lappend ::auto_path $directory
}
}
#
# NOTE: If the caller wants to enable extra diagnostic information,
# set the appropriate environment variables now.
#
if {$debug} then {
set ::env(DEBUG_PKGR) 1; set ::env(DEBUG_PKGD) 1
}
#
# NOTE: If the caller specified API keys, add them to the configured
# list of API keys for the package repository client now. This
# uses a special global variable.
#
if {[llength $apiKeys] > 0} then {
eval lappend ::pkgr_api_keys $apiKeys
}
#
# NOTE: If the caller wants to enable the extra Eagle script security,
# attempt to do that now. Only treat a failure here as fatal if
# the caller said so.
#
if {[isEagle] && $enableSecurity} then {
if {[catch {
uplevel 1 [list source enableSecurity]
} error] && $strictSecurity} then {
error $error
}
}
#
# NOTE: In Eagle, to actually enable make use of the [package unknown]
# handler, an interpreter flag must be disabled. If necessary,
# do that now.
#
if {[isEagle] && $hookUnknown} then {
object invoke -flags +NonPublic -objectflags +AutoFlagsEnum \
Interpreter.GetActive interpreterFlags -NoPackageUnknown
}
#
# NOTE: Finally, attempt to actually load the package repository client.
# This may fail for a number of reasons. The most likely failure
# case is when the directory containing the package is not found;
# however, there are other possible failure modes.
#
package require Eagle.Package.Repository
}
#
# NOTE: This procedure attempts to download and extract a native TclKit DLL
# for the current platform. The optional channel argument is the
# output channel where diagnostic information is sent. The optional
# quiet argument should be non-zero to prevent diagnostic information
# from being emitted. This procedure may raise script errors. The
# return value is the full path to the native TclKit DLL file.
#
proc downloadAndExtractNativeTclKitDll {
{channel stdout} {quiet false} } {
setupPackageToolsetVars false
variable baseUri
variable tclKitDllUri
variable tclKitDllUrn
package require Eagle.Test
package require Eagle.Unzip
set platform [machineToPlatform $::tcl_platform(machine) true]
set extractRootDirectory [getPackageInstallPath \
[appendArgs KitDll_ $platform] ea-td-di]
set urn [subst $tclKitDllUrn]; set uri [subst $tclKitDllUri]
set fileName [getTemporaryFileName]
if {[isEagle]} then {
uri download $uri $fileName
} else {
package require Eagle.Tools.Common
namespace import \
::Eagle::Tools::Common::getFileViaHttp \
::Eagle::Tools::Common::writeFile
set data [getFileViaHttp $uri 20 $channel $quiet -binary true]
writeFile $fileName $data
}
set extractDirectory [extractZipArchive \
$fileName $extractRootDirectory true]
return [lindex [glob -nocomplain \
[file join $extractDirectory lib *[info sharedlibextension]]] 0]
}
#
# NOTE: This procedure attempts to download and extract the Security Toolset,
# which includes the Harpy and Badge plugins. The optional channel
# argument is the output channel where diagnostic information is sent.
# The optional quiet argument should be non-zero to prevent diagnostic
# information from being emitted. This procedure may raise script
# errors. The return value is the full path to a directory that should
# contain the "Harpy1.0" and "Badge1.0" plugin directories.
#
proc downloadAndExtractSecurityToolset {
{channel stdout} {quiet false} } {
setupPackageToolsetVars false
variable baseUri
variable securityToolsetUri
variable securityToolsetUrn
package require Eagle.Test
package require Eagle.Unzip
if {[info exists ::eagle_platform(text)] && \
[string length $::eagle_platform(text)] > 0} then {
set platform [string tolower $::eagle_platform(text)]
} else {
set platform [string tolower netFx20]; # TODO: Good default?
}
set extractRootDirectory [getPackageInstallPath \
[appendArgs eee_ $platform] ea-st-di]
set dir [string map [list fx ""] $platform]; # netfx20 -> net20
set urn [subst $securityToolsetUrn]; set uri [subst $securityToolsetUri]
set fileName [getTemporaryFileName]
if {[isEagle]} then {
uri download $uri $fileName
} else {
package require Eagle.Tools.Common
namespace import \
::Eagle::Tools::Common::getFileViaHttp \
::Eagle::Tools::Common::writeFile
set data [getFileViaHttp $uri 20 $channel $quiet -binary true]
writeFile $fileName $data
}
set extractDirectory [extractZipArchive \
$fileName $extractRootDirectory true]
return [file join $extractDirectory build $dir lib]
}
#
# NOTE: This procedure attempts to request a license certificate for Eagle,
# which includes the Harpy and Badge plugins. The optional channel
# argument is the output channel where diagnostic information is sent.
# The optional quiet argument should be non-zero to prevent diagnostic
# information from being emitted. This procedure may raise script
# errors. The return value is the fully qualified file name for the
# resulting license certificate.
#
# WARNING: This procedure will send the short name and display name of the
# currently logged on user to the Eagle license server as they are
# required for a new license certificate to be issued. Abuse of
# this service may result in a permanent ban from the service and
# revocation of any previously issued license certificates.
#
proc requestLicenseCertificate {
{channel stdout} {quiet false} } {
setupPackageToolsetVars false
variable baseUri
variable licenseUri
variable licenseUrn
package require Eagle.Test
set certificateRootDirectory [getTemporaryPath]
set processDirectoryPrefix [file join $certificateRootDirectory \
[appendArgs ea-lc-di- [pid] -]]
#
# NOTE: Issue a warning to the user if it appears there is already a
# license certificate in a temporary directory that was created
# by this process. Hopefully, this should reduce the number of
# duplicate requests.
#
set varName1 YES_PLEASE_FORCE_A_LICENSE_CERTIFICATE_REQUEST
if {![info exists ::env($varName1)] && [isWindows]} then {
set processFileNames [list]
foreach processDirectory [findDirectories \
[appendArgs $processDirectoryPrefix *]] {
eval lappend processFileNames [findFiles \
[file join $processDirectory *]]
}
if {[llength $processFileNames] > 0} then {
set warningCommand [list]
if {[isEagle]} then {
lappend warningCommand host result Error
} else {
lappend warningCommand puts stderr
}
set varName2 Master_Certificate
lappend warningCommand [appendArgs \
"One or more temporary license certificate files " \
"apparently belonging to this process were found. " \
"If you wish to override this warning and force a " \
"new license certificate request to be submitted, " \
"set the \"" $varName1 "\" environment variable " \
"(to anything); however, please keep in mind that " \
"requesting too many license certificates and/or " \
"requesting license certificates too fast MAY be " \
"considered abusive behavior. Upon success, the " \
"resulting temporary license certificate file " \
"SHOULD be saved to a secure location on the local " \
"file system, e.g. the home directory associated " \
"with the user submitting the license certificate " \
"request. The fully qualified file name for the " \
"temporary license certificate MUST used as the " \
"value for the \"" $varName2 "\" environment " \
"variable; otherwise, it MAY NOT be found when one " \
"of its associated plugins attempts to load.\n"]
#
# NOTE: Emit our carefully worded license warning message.
#
eval $warningCommand
#
# NOTE: Return the first pre-existing license certificate file
# name that was found.
#
return [lindex $processFileNames 0]
}
}
set directory [appendArgs \
$processDirectoryPrefix [string trim [clock seconds] -]]
set urn [subst $licenseUrn]; set uri [subst $licenseUri]
if {![isEagle] || [catch {
object invoke System.Security.Principal.WindowsIdentity \
GetCurrent.Name
} userName]} then {
#
# HACK: Fallback to using a value from the "tcl_platform" array.
# For native Tcl, this is the only choice. For Eagle, it
# is used as a fallback.
#
if {[info exists ::tcl_platform(user)]} then {
set userName $::tcl_platform(user)
} else {
set userName "NO USER NAME"
}
}
if {![isEagle] || [catch {
object load System.DirectoryServices.AccountManagement
object invoke \
System.DirectoryServices.AccountManagement.UserPrincipal \
Current.DisplayName
} displayName]} then {
#
# HACK: Fallback to using a value from the "tcl_platform" array.
# This value is not set by native Tcl or Eagle; therefore,
# the user would have to set it manually prior to calling
# this procedure.
#
if {[info exists ::tcl_platform(userDisplayName)]} then {
set displayName $::tcl_platform(userDisplayName)
} else {
set displayName "NO DISPLAY NAME"
}
}
#
# NOTE: Add the necessary query parameters to the license request
# URI, making sure to properly escape their values.
#
if {[isEagle]} then {
append uri ?userName= [uri escape data $userName]
append uri &displayName= [uri escape data $displayName]
} else {
package require http 2.0
append uri ? [::http::formatQuery \
userName $userName displayName $displayName]
}
if {[isEagle]} then {
set data [uri download -inline $uri]
} else {
package require Eagle.Tools.Common
namespace import \
::Eagle::Tools::Common::getFileViaHttp \
::Eagle::Tools::Common::writeFile
set data [getFileViaHttp $uri 20 $channel $quiet -binary true]
package require Eagle.Auxiliary
}
if {[getDictionaryValue $data returnCode] ne "Ok"} then {
if {[string length $data] > 0} then {
error [appendArgs \
"request failed with error information: " $data]
} else {
error "request failed without providing error information"
}
}
set fileName [getTemporaryFileName]
writeFile $fileName [getDictionaryValue $data result]
set newFileName [file join $directory [file tail $fileName]]
file mkdir $directory; file copy $fileName $newFileName
file delete $fileName
return $newFileName
}
#
# NOTE: This procedure attempts to submit the specified script to a remote
# sandbox for evaluation. The apiKey parameter is the optional API
# key to use, which MAY enable additional permissions in the remote
# sandbox. The params parameter contains any optional extra names
# and values to include in the submitted query. Upon success, this
# procedure returns a Tcl dictionary that includes at least the keys
# "returnCode", "result", and "errorLine". The "returnCode" value
# will be "Ok", "Error", "Return", "Break", "Continue", or possibly
# a signed integer. The "result" value will be the textual result
# of the script or an error message. The "errorLine" value will be
# zero or the line where a script error was raised. This procedure
# may raise script errors.
#
proc evaluateInRemoteSandbox {
script {apiKey ""} {params ""} {channel stdout} {quiet false} } {
setupPackageToolsetVars false
variable baseUri
variable sandboxEvalUri
variable sandboxEvalUrn
set urn [subst $sandboxEvalUrn]
set uri [subst $sandboxEvalUri]
set query [list go 1 raw 1 script $script]
if {[string length $apiKey] > 0} then {
lappend query apiKey $apiKey
}
if {[llength $params] > 0} then {
eval lappend query $params
}
if {[isEagle]} then {
return [uri upload -inline -data $query $uri]
} else {
package require http 2.0
package require Eagle.Tools.Common
namespace import \
::Eagle::Tools::Common::getFileViaHttp
return [getFileViaHttp \
$uri 20 $channel $quiet -binary true \
-query [eval ::http::formatQuery $query]]
}
}
#
# NOTE: Provide the Eagle "package toolset" package to the interpreter.
#
package provide Eagle.Package.Toolset \
[expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}