###############################################################################
#
# pkgr.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Repository Client
#
# 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 ::PackageRepository {
  #
  # NOTE: This package absolutely requires the Eagle core script library
  #       package, even when it is being used by native Tcl.  If needed,
  #       prior to loading this package, the native Tcl auto-path should
  #       be modified to include the "Eagle1.0" directory (i.e. the one
  #       containing the Eagle core script library file "init.eagle").
  #
  package require Eagle.Library

  proc stringIsList { value } {
    if {[isEagle]} then {
      return [string is list $value]
    } elseif {[info exists ::tcl_version] && $::tcl_version >= 8.5} then {
      return [string is list $value]
    } elseif {[catch {llength $value}] == 0} then {
      return true
    } else {
      return false
    }
  }

  proc getLookupVarNamePrefix {} {
    return ::rpkg_; # TODO: Make non-global?
  }

  proc getLookupVarNameSuffix {} {
    return [appendArgs \
        [string trim [pid] -] _ [string trim [clock seconds] -] _ \
        [string trim [clock clicks -milliseconds] -]]; # TODO: Bad?
  }

  proc getLookupApiKey {} {
    set varName [appendArgs [getLookupVarNamePrefix] api_key]

    if {[info exists $varName]} then {
      return [set $varName]
    }

    return ""; # NOTE: System default, which is "public".
  }

  proc getLookupBaseUri {} {
    set varName [appendArgs [getLookupVarNamePrefix] base_uri]

    if {[info exists $varName]} then {
      return [set $varName]
    }

    return https://urn.to/r/pkg; # NOTE: System default.
  }

  proc getLookupUri { apiKey package version } {
    set baseUri [getLookupBaseUri]

    if {[string length $baseUri] == 0} then {
      return ""
    }

    #
    # NOTE: Build the HTTP request URI using the specified query parameter
    #       values, escaping them as necessary.  Also, include the standard
    #       query parameters with constant values for this request type.
    #
    if {[isEagle]} then {
      return [appendArgs \
          $baseUri ?raw=1&method=lookup&apiKey= [uri escape uri $apiKey] \
          &package= [uri escape uri $package] &version= [uri escape uri \
          $version]]
    } else {
      package require http 2.0

      return [appendArgs \
          $baseUri ? [http::formatQuery raw 1 method lookup apiKey $apiKey \
          package $package version $version]]
    }
  }

  proc getLookupData { apiKey package version } {
    set uri [getLookupUri $apiKey $package $version]

    if {[string length $uri] == 0} then {
      return ""
    }

    if {[isEagle]} then {
      set data [uri download -inline $uri]
    } else {
      set data [getFileViaHttp $uri 10 stdout false]
    }

    set data [string map [list &lt\; < &gt\; > &quot\; \"] $data]
    set data [string map [list \r\n \n \r \n] $data]
    set data [string map [list \n \r\n] $data]
    set data [string trim $data]

    return $data
  }

  proc getLookupCodeFromData { data } {
    if {![stringIsList $data] || [llength $data] < 1} then {
      return ""
    }

    return [lindex $data 0]
  }

  proc getLookupResultFromData { data } {
    if {![stringIsList $data] || [llength $data] < 2} then {
      return ""
    }

    return [lindex $data 1]
  }

  proc isLookupCodeOk { code } {
    #
    # NOTE: The code must be the literal string "OK" for the package lookup
    #       request to be considered successful.
    #
    return [expr {$code eq "OK"}]
  }

  proc extractAndVerifyLookupMetadata { result varName } {
    #
    # 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.
    #
    set language [getDictionaryValue $result Language]

    if {[lsearch -exact [list "" Tcl Eagle] $language] == -1} then {
      error "unsupported language"
    }

    #
    # NOTE: Grab the package script.  If it is an empty string, then the
    #       package cannot be loaded and there is nothing to do.  In that
    #       case, just raise an error.
    #
    set ifNeeded [getDictionaryValue $result IfNeeded]

    if {[string length $ifNeeded] == 0} then {
      error "missing ifneeded script"
    }

    #
    # NOTE: Grab the package script certificate.  If it is an empty string
    #       then the package script is unsigned, which is not allowed by
    #       this client.  In that case, just raise an error.
    #
    set certificate [getDictionaryValue $result Certificate]

    if {[string length $certificate] == 0} then {
      error "missing script certificate"
    }

    #
    # NOTE: If the caller wants the package metadata, use the array variable
    #       name they specified.
    #
    if {[string length $varName] > 0} then {
      upvar 1 $varName metadata

      set metadata(language) $language
      set metadata(ifNeeded) $ifNeeded
      set metadata(certificate) $certificate
    }
  }

  proc tclMustBeReady {} {
    #
    # NOTE: This procedure is not allowed to actually load a native Tcl
    #       library; therefore, one must already be loaded.
    #
    if {![isEagle]} then {
      error "already running in Tcl language"
    }

    if {![tcl ready]} then {
      error "cannot use Tcl language, supporting library is not loaded"
    }
  }

  proc eagleMustBeReady {} {
    #
    # NOTE: This procedure is not allowed to actually load Garuda (and
    #       Eagle); therefore, they must already be loaded.
    #
    if {[isEagle]} then {
      error "already running in Eagle language"
    }

    if {[llength [info commands eagle]] == 0} then {
      error "cannot use Eagle language, supporting package is not loaded"
    }
  }

  proc eagleHasSecurity {} {
    #
    # NOTE: If possible, check if the current interpreter has security
    #       enabled.
    #
    if {[isEagle] && [llength [info commands object]] > 0} then {
      if {[catch {
        object invoke -flags +NonPublic Interpreter.GetActive HasSecurity
      } security] == 0 && $security} then {
        return true
      }
    }

    return false
  }

  proc processLookupMetadata { varName } {
    #
    # NOTE: If the metadata variable name appears to be invalid, fail.
    #
    if {[string length $varName] == 0} then {
      error "bad metadata"
    }

    #
    # NOTE: This procedure requires that the metadata array variable is
    #       present in the call frame immediately above this one.
    #
    upvar 1 $varName metadata

    #
    # NOTE: If the entire package metadata array is missing, fail.
    #
    if {![info exists metadata]} then {
      error "missing metadata"
    }

    #
    # NOTE: If the language for the package script is mising, fail.
    #
    if {![info exists metadata(language)]} then {
      error "missing language"
    }

    #
    # NOTE: If the package script is mising, fail.
    #
    if {![info exists metadata(ifNeeded)]} then {
      error "missing ifneeded script"
    }

    #
    # NOTE: If the package script certificate is mising, fail.
    #
    if {![info exists metadata(certificate)]} then {
      error "missing script certificate"
    }

    #
    # NOTE: Attempt to create a completely unique array variable name to
    #       hold the package metadata in this scripting language as well
    #       as possibly in the other necessary scripting language(s).
    #
    set newVarName [appendArgs \
        [getLookupVarNamePrefix] metadata_ [getLookupVarNameSuffix]]

    set newProcName(1) [appendArgs \
        [getLookupVarNamePrefix] eagleHasSecurity_ [getLookupVarNameSuffix]]

    set newProcName(2) [appendArgs \
        [getLookupVarNamePrefix] tclMustBeReady_ [getLookupVarNameSuffix]]

    #
    # NOTE: Create the Eagle script block that will be used to securely
    #       evaluate a signed package script.  This must be evaluated in
    #       Eagle because it uses several plugins only available there.
    #
    set script(outer) [string map [list \
        %metadata% $newVarName %eagleHasSecurity% $newProcName(1) \
        %tclMustBeReady% $newProcName(2)] {
      try {
        #
        # NOTE: If there is no package ifneeded script, there is nothing we
        #       can do here.
        #
        if {[string length ${%metadata%(ifNeeded)}] > 0} then {
          #
          # NOTE: Save the security state for the interpreter.  Then, attempt
          #       to enable it.  This will fail if one of the needed plugins
          #       cannot be loaded.
          #
          set savedSecurity [{%eagleHasSecurity%}]
          if {!$savedSecurity} then {source enableSecurity}

          try {
            #
            # NOTE: Figure out temporary file name for the downloaded script
            #       and its associated script certificate.
            #
            set fileName(1) [file tempname]
            set fileName(2) [appendArgs $fileName(1) .harpy]

            try {
              #
              # NOTE: Write the downloaded script to a temporary file.
              #
              writeFile $fileName(1) ${%metadata%(ifNeeded)}

              #
              # NOTE: Write the downloaded script certificateto a temporary
              #       file.
              #
              if {[string length ${%metadata%(certificate)}] > 0} then {
                writeFile $fileName(2) ${%metadata%(certificate)}
              }

              #
              # NOTE: This seems stupid.  Why are we reading the downloaded
              #       script from the temporary file when we already had it
              #       in memory?  The reason is that we need to make sure
              #       that the Harpy policy engine has a chance to check the
              #       downloaded script against its associated certificate.
              #       This will raise a script error if the script signature
              #       is missing or invalid.
              #
              set script(inner) [interp readorgetscriptfile -- \
                  "" $fileName(1)]

              #
              # NOTE: Determine the target language for the package script,
              #       which may or may not be the language that is currently
              #       evaluating this script (Eagle).  The default language,
              #       when one was not explicitly specified, is Eagle.  In
              #       the future, this may be changed, e.g. to use the file
              #       extension of the client script.
              #
              switch -exact -- ${%metadata%(language)} {
                "" -
                Eagle {
                  #
                  # NOTE: The target language is Eagle, which is evaluating
                  #       this script.  No special handling is needed here.
                  #
                  return [uplevel 1 $script(inner)]
                }
                Tcl {
                  #
                  # NOTE: The target language is Tcl; therefore, a bit of
                  #       special handling is needed here.
                  #
                  {%tclMustBeReady%}; return [tcl eval \
                      [tcl master] $script(inner)]
                }
                default {
                  error "unsupported language"
                }
              }
            } finally {
              #
              # NOTE: Delete any temporary files that we created during the
              #       signed script evaluation.
              #
              if {[string length $fileName(2)] > 0 && \
                  [file exists $fileName(2)]} then {
                catch {file delete $fileName(2)}
                unset -nocomplain fileName(2)
              }

              if {[string length $fileName(1)] > 0 && \
                  [file exists $fileName(1)]} then {
                catch {file delete $fileName(1)}
                unset -nocomplain fileName(1)
              }
            }
          } finally {
            #
            # NOTE: Restore the saved security state for the interpreter.
            #
            if {!$savedSecurity} then {source disableSecurity}
            unset -nocomplain savedSecurity
          }
        }
      } finally {
        rename {%tclMustBeReady%} ""
        rename {%eagleHasSecurity%} ""

        unset -nocomplain {%metadata%}
      }
    }]

    #
    # NOTE: Copy the package metadata into the fresh array variable,
    #       if necessary, marshalling it from native Tcl to Eagle.
    #
    if {[isEagle]} then {
      array set $newVarName [array get metadata]

      proc $newProcName(1) {} [info body [appendArgs \
          [namespace current] :: eagleHasSecurity]]

      proc $newProcName(2) {} [info body [appendArgs \
          [namespace current] :: tclMustBeReady]]

      return [eval $script(outer)]
    } else {
      eagleMustBeReady

      eagle [list array set $newVarName [array get metadata]]

      eagle [list proc $newProcName(1) {} [info body [appendArgs \
          [namespace current] :: eagleHasSecurity]]]

      eagle [list proc $newProcName(2) {} [info body [appendArgs \
          [namespace current] :: tclMustBeReady]]]

      return [eagle $script(outer)]
    }
  }

  proc main { package version } {
    set data [getLookupData [getLookupApiKey] $package $version]
    set code [getLookupCodeFromData $data]
    set result [getLookupResultFromData $data]

    if {![isLookupCodeOk $code]} then {
      error $result
    }

    extractAndVerifyLookupMetadata $result metadata
    processLookupMetadata metadata
  }

  if {![isEagle]} then {
    ###########################################################################
    ############################# BEGIN Tcl ONLY ##############################
    ###########################################################################

    #
    # NOTE: This procedure was stolen from the "getEagle.tcl" script.
    #
    proc pageProgress { channel type milliseconds } {
      #
      # NOTE: Show that something is happening...
      #
      catch {puts -nonewline $channel $type; flush $channel}

      #
      # NOTE: Make sure that we are scheduled to run again.
      #
      if {$milliseconds > 0} then {
        after $milliseconds [namespace code [list pageProgress \
            $channel $type $milliseconds]]
      }
    }

    #
    # NOTE: This procedure was stolen from the "getEagle.tcl" script.
    #
    proc getFileViaHttp { uri redirectLimit channel quiet args } {
      #
      # NOTE: This procedure requires the modern version of the HTTP package,
      #       which is typically included with the Tcl core distribution.
      #
      package require http 2.0

      #
      # NOTE: If the 'tls' package is available, always attempt to use HTTPS.
      #
      if {[catch {package require tls}] == 0} then {
        ::http::register https 443 ::tls::socket

        if {[string range $uri 0 6] eq "http://"} then {
          set uri [appendArgs https:// [string range $uri 7 end]]
        }
      }

      #
      # NOTE: Unless the caller forbids it, display progress messages during
      #       the download.
      #
      if {!$quiet} then {
        pageProgress $channel . 250
      }

      #
      # NOTE: All downloads are handled synchronously, which is not ideal;
      #       however, it is simple.  Keep going as long as there are less
      #       than X redirects.
      #
      set redirectCount 0

      while {1} {
        #
        # NOTE: Issue the HTTP request now, grabbing the resulting token.
        #
        set token [eval [list ::http::geturl $uri] $args]

        #
        # NOTE: Check the HTTP response code, in order to follow any HTTP
        #       redirect responses.
        #
        switch -exact -- [http::ncode $token] {
          301 -
          302 -
          303 -
          307 {
            #
            # NOTE: Unless the caller forbids it, display progress messages
            #       when an HTTP redirect is returned.
            #
            if {!$quiet} then {
              pageProgress $channel > 0
            }

            #
            # NOTE: We hit another HTTP redirect.  Stop if there are more
            #       than X.
            #
            incr redirectCount

            #
            # TODO: Maybe make this limit configurable?
            #
            if {$redirectCount > 10} then {
              #
              # NOTE: Just "give up" and return whatever data that we have
              #       now.
              #
              set data [::http::data $token]
              ::http::cleanup $token; break
            }

            #
            # NOTE: Grab the metadata associated with this HTTP response.
            #
            array set meta [::http::meta $token]

            #
            # NOTE: Is there actually a new URI (location) to use?
            #
            if {[info exist meta(Location)]} then {
              #
              # NOTE: Ok, grab it now.  Later, at the top of the loop,
              #       it will be used in the subsequent HTTP request.
              #
              set location $meta(Location); unset meta

              #
              # NOTE: For security, do NOT follow an HTTP redirect if
              #       it attempts to redirect from HTTPS to HTTP.
              #
              if {[string range $uri 0 7] eq "https://" && \
                  [string range $location 0 7] ne "https://"} then {
                #
                # NOTE: Just "give up" and return whatever data that
                #       we have now.
                #
                set data [::http::data $token]
                ::http::cleanup $token; break
              }

              #
              # NOTE: Replace the original URI with the new one, for
              #       use in the next HTTP request.
              #
              set uri $location

              #
              # NOTE: Cleanup the current HTTP token now beause a new
              #       one will be created for the next request.
              #
              ::http::cleanup $token
            } else {
              #
              # NOTE: Just "give up" and return whatever data that we
              #       have now.
              #
              set data [::http::data $token]
              ::http::cleanup $token; break
            }
          }
          default {
            #
            # NOTE: Ok, the HTTP response is actual data of some kind
            #       (which may be an error); however, it is not any
            #       kind of supported HTTP redirect.
            #
            set data [::http::data $token]
            ::http::cleanup $token; break
          }
        }
      }

      #
      # NOTE: If progress messages were emitted, start a fresh line.
      #
      if {!$quiet} then {
        catch {puts $channel [appendArgs " " $uri]; flush $channel}
      }

      return $data
    }

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

  #
  # NOTE: Provide the package to the interpreter.
  #
  package provide Eagle.Package.Repository \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}


<?xml version="1.0" encoding="utf-8"?>
<!--
    Eagle Enterprise Edition Script Certificate

    The format of this file is proprietary and may not be reverse
    engineered.

    This certificate file is subject to the terms of the license agreement
    located at:

    https://eagle.to/enterprise/license.html

    By using this file and/or the associated software, you agree to abide
    by the terms of the license agreement.

    PLEASE DO NOT EDIT THIS FILE.
    THE ASSOCIATED SOFTWARE MAY NOT WORK PROPERLY IF THIS FILE IS ALTERED.
-->
<Certificate xmlns="https://eagle.to/2011/harpy"
             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
             xmlns:xsd="http://www.w3.org/2001/XMLSchema">
  <Protocol>None</Protocol>
  <Vendor>Mistachkin Systems</Vendor>
  <Id>b69d609c-3b52-493c-87f8-d8b346636433</Id>
  <HashAlgorithm>SHA512</HashAlgorithm>
  <EntityType>Script</EntityType>
  <TimeStamp>2016-08-13T04:17:06.7998046Z</TimeStamp>
  <Duration>-1.00:00:00</Duration>
  <Key>0x2c322765603b5278</Key>
  <Signature>
    jXBpsUsOVA85vHjyXALN5e3JoJffjbhvyG4So3O/F6hBHoSsX2A2a62O0gWozfceicrVpYhpiDHP
    E9nxJZMWLyKtfkj9Ftt2GX8DUsWLy1hCqidfjTFGJoAG8UKi323Gu6pzL8Cugk3fb4jYDBrO6dR7
    nDqYnsE9XO91jLUjBMwmxq3/sOM/aSOjaEDhiDA6W3+hqg8wP9SfHdKZM2qnah5Og5FMpptaCOVY
    +TeqG38gFMtokEgd75jBOacc1EW/Dy40s733m/3P+mx2pux7xVjZTPrX3oLY/Ded+jg81VJp/ZRp
    JIe5VTVLNvdyQZVy0vtP48l6UhZAKv1wQ3CVqSoRz3/nlcyj15BAMLCNB74MgLe2Hm/F3bbnpUsQ
    VHAAmAK3nDgQMtU7oZS//J2S7w+9cFO8gI8OrpSUz/CkPmA1Nm3Ap4weo0QmE5hwlO8U5OGg9hBJ
    YwpTUnq7BUcH8bwKW4435VjrswOO4WxjwMUf6XK+q8IhLrIS1o0h9ln2jMzyM2vLMJVLHQGnouuJ
    MqZbYEZJXVIWt3OTTrFU8sOaYVCcl5jUluEkzPe/UHmXadujL2VVEbXdJS0eNlepcpNy672uMlZY
    MJlN5RRo9IhJiASiz1H7VYGQJ3agY+o2qyFG0RM7DBKztP7iXCmemm3J+u+Akzd8WTrJw/eiw8+D
    //asO6qLqHw+NWabCGkKJLJtD1umrbke2KGkpYL59uls6vNVNjd/FhAHCs1o5P2pidzi69jc4S89
    MFfltAvDuq5GycCoLnUlZaMyK2F48/blVL3kAAWGIEsvxFNM2taxwIsyKss+X4d0mCVHK4xO1uOl
    Mueu/ma/xo8c0Vb70nQoc6LcqiElQkc0CV/Q64HRqCG5er51+ysXr7arW+1cPjQzB9ebWZNyF2tG
    itclZMl1RYtcEnpzizWnAfOzc6phmBgG00sU9vIIoEnOOu8IajyyykWzgl3RWANP84ljbles+7f7
    CqfO0XoudPX7cvTUD081JMZ5z2Adm/ADXpM6COePE6zKUM7G7RNvcR89ZguL0zxnc4z8Awtq04tL
    5LW85btErQPX2lbj0I3vpVY+pCQElzJNPcHzARk4iymmS7jTlqLUJrm8I5vRt1DVJRL3ivvdD+Lg
    5dShVo1g37kxNNmgW6+ykesPpycKbNXyQXovGnMq+k03ocwj8Fu1vCX7AaQUsOQuciUkj2PyKE9s
    bv3od/vqhgPk582U1pYF0VzWYU412zxnGoCp+hcY4ZC81YyvDPejUyMUJhMHeqy6Z3Ot5NbUkp9l
    oAoblWlABjQtWrC7oJZWTwsxhegXkNmAnvk2cy3u/DxSBgnnjc7vMht4w9AXPiuzq0glHlMJeg==
  </Signature>
</Certificate>