System.Data.SQLite

Artifact [9369e70f5f]
Login

Artifact 9369e70f5f8b11660b4dbd7c39fcabc7f783b2f5:


###############################################################################
#
# 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 {
        package require Eagle.Update
        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: 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 [getTemporaryPath]

    set directory [file join $extractRootDirectory [appendArgs \
        ea-pt-di- [pid] - [string trim [clock seconds] -]]]

    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]
    return [file join $extractDirectory pkgr_an_d client 1.0 neutral]
  }

  #
  # 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 extractRootDirectory [getTemporaryPath]

    set directory [file join $extractRootDirectory [appendArgs \
        ea-td-di- [pid] - [string trim [clock seconds] -]]]

    set platform [machineToPlatform $::tcl_platform(machine) true]
    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]

    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

    set extractRootDirectory [getTemporaryPath]

    set directory [file join $extractRootDirectory [appendArgs \
        ea-st-di- [pid] - [string trim [clock seconds] -]]]

    if {[info exists ::eagle_platform(text)]} then {
      set platform [string tolower $::eagle_platform(text)]
    } else {
      set platform [string tolower netFx20]; # TODO: Good default?
    }

    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]
    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: Provide the Eagle "package toolset" package to the interpreter.
  #
  package provide Eagle.Package.Toolset \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}