###############################################################################
#
# pkgr_upload.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Repository Client (Upload Tool)
#
# 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 ::PackageUploader {
  #
  # NOTE: This procedure is used to report errors that prevent this tool
  #       from running to completion (e.g. invalid command line arguments,
  #       etc).  It may be used to report a specific error.  It will always
  #       emit the command line usage information.
  #
  proc usage { {error ""} } {
    if {[string length $error] > 0} then {puts stdout $error}

    puts stdout "usage:\
  [file tail [info nameofexecutable]]\
  [file tail [info script]] \[apiKey\] \[package\] \[patchLevel\]\
  \[language\] \[version\] \[platform\] \[fileName1\] ... \[fileNameN\]"

    exit 1
  }

  #
  # NOTE: This procedure sets up the default values for all configuration
  #       parameters used by the package uploader client.  There are no
  #       arguments.
  #
  proc setupUploadVars {} {
    #
    # NOTE: This variable must exist and must be the fully qualified path
    #       of the directory containing this script.
    #
    variable pkgr_path

    if {![info exists pkgr_path]} then {
      error "required namespace variable 'pkgr_path' does not exist"
    }

    #
    # NOTE: The project code for the Fossil repository.  This will be checked
    #       prior to staging or committing any files.
    #
    variable projectCode; # DEFAULT: 9ceada8dbb8678898e5b2c05386e73b3ff2c2dec

    if {![info exists projectCode]} then {
      set projectCode 9ceada8dbb8678898e5b2c05386e73b3ff2c2dec
    }

    #
    # NOTE: What is the fully qualified path to the directory containing
    #       package client toolset?
    #
    variable scriptDirectory; # DEFAULT: <scriptDir>

    if {![info exists scriptDirectory]} then {
      set scriptDirectory $pkgr_path
    }

    #
    # NOTE: The command to use when attempting to check for changes prior to
    #       staging files using Fossil.
    #
    variable fossilChangesCommand; # DEFAULT fossil changes ...

    if {![info exists fossilChangesCommand]} then {
      set fossilChangesCommand {fossil changes --chdir {${checkoutDirectory}}}
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that the Fossil checkout has no changes staged.  Generally, this
    #       pattern should only match an empty string.
    #
    variable fossilChangesPattern; # DEFAULT: {^$}

    if {![info exists fossilChangesPattern]} then {
      set fossilChangesPattern {^$}
    }

    #
    # NOTE: The command to use when attempting to check the checkout status
    #       prior to staging files using Fossil.
    #
    variable fossilInfoCommand; # DEFAULT fossil info ...

    if {![info exists fossilInfoCommand]} then {
      set fossilInfoCommand {fossil info --chdir {${scriptDirectory}}}
    }

    #
    # NOTE: The regular expression pattern used when attempting to extract
    #       the root directory for the Fossil checkout.
    #
    variable fossilInfoLocalRootPattern; # DEFAULT: {^local-root:\s+(.*?)$}

    if {![info exists fossilInfoLocalRootPattern]} then {
      set fossilInfoLocalRootPattern {^local-root:\s+(.*?)$}
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that the Fossil checkout belongs to the correct project.
    #
    variable fossilInfoProjectCodePattern; # DEFAULT: {^project-code:\\s+...\$}

    if {![info exists fossilInfoProjectCodePattern]} then {
      set fossilInfoProjectCodePattern [appendArgs \
          {^project-code:\\s+${projectCode}\$}]
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that the Fossil checkout is sitting on the correct branch.
    #
    variable fossilInfoTagsPattern; # DEFAULT: {^tags:\s+trunk(?:,|$)}

    if {![info exists fossilInfoTagsPattern]} then {
      set fossilInfoTagsPattern {^tags:\s+trunk(?:,|$)}
    }

    #
    # NOTE: The command to use when attempting to reset the checkout to the
    #       default branch prior to staging files using Fossil.
    #
    variable fossilUpdateCommand; # DEFAULT fossil update trunk ...

    if {![info exists fossilUpdateCommand]} then {
      set fossilUpdateCommand \
          {fossil update trunk --chdir {${checkoutDirectory}}}
    }

    #
    # NOTE: The command to use when attempting to stage package files using
    #       Fossil.
    #
    variable fossilAddCommand; # DEFAULT fossil add ...

    if {![info exists fossilAddCommand]} then {
      set fossilAddCommand \
          {fossil add --chdir {${targetDirectory}} {${fileName}}}
    }

    #
    # NOTE: The command to use when attempting to commit package files using
    #       Fossil.
    #
    variable fossilCommitCommand; # DEFAULT fossil commit ...

    if {![info exists fossilCommitCommand]} then {
      set fossilCommitCommand {fossil commit -m {${comment}}\
          --branch {${branch}} --user anonymous --chdir \
          {${checkoutDirectory}} --no-prompt}
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that Fossil committed a set of files.
    #
    variable fossilCommitPattern; # DEFAULT: {^New_Version: ([0-9a-f]{40})$}

    if {![info exists fossilCommitPattern]} then {
      set fossilCommitPattern {^New_Version: ([0-9a-f]{40})$}
    }

    #
    # NOTE: Emit diagnostic messages when a new package is submitted?
    #
    variable verboseMetadataSubmit; # DEFAULT: false

    if {![info exists verboseMetadataSubmit]} then {
      set verboseMetadataSubmit false
    }
  }

  #
  # NOTE: This procedure sets up the default values for all configuration
  #       parameters used by the package uploader client that require the
  #       location of the checkout directory.  There are no arguments.
  #
  proc setupCheckoutVars {} {
    #
    # NOTE: What is the fully qualified path to the root directory of the
    #       Fossil checkout containing the package client toolset?  This
    #       procedure may raise script errors.
    #
    variable checkoutDirectory; # DEFAULT: <checkoutDir>

    if {![info exists checkoutDirectory]} then {
      set checkoutDirectory [getCheckoutDirectory]
    }
  }

  #
  # NOTE: This procedure returns a string value, formatted for use within a
  #       script block being processed by the [string map] command.  The
  #       value argument is the string value to format.  No return value is
  #       reserved to indicate an error.  This procedure may not raise any
  #       script errors.
  #
  proc formatStringMapValue { value } {
    if {[string length $value] == 0} then {
      return \"\"
    }

    set list [list $value]

    if {$value eq $list} then {
      return $value
    } else {
      return $list
    }
  }

  #
  # NOTE: This procedure counts the common path components for two paths.  The
  #       count is returned, zero if there are no common path components.  The
  #       path1 and path2 arguments are the paths to compare.  This procedure
  #       may not raise script errors.
  #
  proc countCommonPathParts { path1 path2 } {
    set parts1 [file split $path1]
    set length1 [llength $parts1]

    set parts2 [file split $path2]
    set length2 [llength $parts2]

    set length [expr {min($length1, $length2)}]

    for {set index 0} {$index < $length} {incr index} {
      set part1 [lindex $parts1 $index]
      set part2 [lindex $parts2 $index]

      if {$part1 ne $part2} then {
        return $index
      }
    }

    return $length
  }

  #
  # NOTE: This procedure processes a list of (fully?) qualified file names and
  #       tries to determine their common containing directory, if any.  The
  #       fileNames argument is the list of (fully?) qualified file names to
  #       process.  This procedure may not raise script errors.  If there is
  #       no common containing directory, an empty string is returned.
  #
  proc getCommonContainingDirectory { fileNames } {
    set length [llength $fileNames]

    if {$length == 0} then {
      return ""
    }

    set oldFileName [lindex $fileNames 0]

    if {$length == 1} then {
      return [file dirname $oldFileName]
    }

    set minimumCount 0

    for {set index 1} {$index < $length} {incr index} {
      set newFileName [lindex $fileNames $index]
      set newCount [countCommonPathParts $oldFileName $newFileName]

      if {$newCount == 0} then {
        return ""
      }

      if {$minimumCount == 0 || $newCount < $minimumCount} then {
        set oldFileName $newFileName
        set minimumCount $newCount
      }
    }

    if {$minimumCount == 0} then {
      return ""
    }

    incr minimumCount -1

    return [eval file join [lrange [file split $oldFileName] 0 $minimumCount]]
  }

  #
  # NOTE: This procedure attempts to process a list of (fully?) qualified file
  #       names and return the corresponding list of relative file names.  The
  #       fileNames argument is the list of (fully?) qualified file names to
  #       process.  The maximumLevels argument is the maximum path depth that
  #       is allowed for all file names.  This procedure may raise script
  #       errors.
  #
  proc getRelativeFileNames { fileNames maximumLevels } {
    set directory [getCommonContainingDirectory $fileNames]
    set directoryParts [file split $directory]
    set fileNameIndex [expr {[llength $directoryParts] - 1}]

    if {$fileNameIndex < 0} then {
      error [appendArgs \
          "invalid containing directory \"" $directory \
          "\": cannot go up one level"]
    }

    set relativeFileNames [list]

    foreach fileName $fileNames {
      set fileNameParts [lrange \
          [file split $fileName] $fileNameIndex end]

      if {$maximumLevels > 0 && \
          [llength $fileNameParts] > $maximumLevels} then {
        error [appendArgs \
            "depth for file name \"" $fileName \
            "\" exceeds maximum (" $maximumLevels )]
      }

      set relativeFileName [eval file join $fileNameParts]

      if {[string length $relativeFileName] == 0 || \
          [file pathtype $relativeFileName] ne "relative"} then {
        error [appendArgs \
            "bad file name \"" $relativeFileName "\", not relative"]
      }

      lappend relativeFileNames $relativeFileName
    }

    return $relativeFileNames
  }

  #
  # NOTE: This procedure attempts to create a script chunk that appends the
  #       specified list of file names to a list variable.  The fileNames
  #       argument is the list of (fully?) qualified file names to append to
  #       the list variable.  The maximumLevels argument is the maximum path
  #       depth that is allowed for all file names.  This procedure may raise
  #       script errors.
  #
  proc getScriptChunkForFileNames { fileNames maximumLevels } {
    set result ""
    set relativeFileNames [getRelativeFileNames $fileNames $maximumLevels]

    foreach relativeFileName $relativeFileNames {
      if {[string length $result] > 0} then {
        append result \n
      }

      append result {  lappend fileNames [file join }
      append result [file split $relativeFileName]
      append result \]
    }

    return $result
  }

  #
  # NOTE: This procedure creates and returns a script block designed for use
  #       with the package repository server in order to download and provide
  #       a package consisting of a set of files.  The serverId argument is
  #       the identifier for the specific server to use, if any.  The
  #       versionId argument is the identifier for the specific version to use,
  #       if any.  The language argument must be the literal string "eagle" or
  #       the literal string "tcl".  The version argument must be one of the
  #       literal strings "8.4", "8.5", or "8.6" when the language is "tcl"
  #       -OR- the literal string "1.0" when the language is "eagle".  The
  #       platform argument must be an empty string -OR- one of the literal
  #       strings "neutral", "win32-arm", "win32-x86", "win64-arm64",
  #       "win64-ia64", or "win64-x64".  The fileNames argument is the list of
  #       (fully?) qualified file names to be downloaded when the associated
  #       package is being provided.  The options argument is reserved for
  #       future use, it should be an empty list.
  #
  # <public>
  proc createRepositoryScript {
          serverId versionId language version platform fileNames options } {
    ::PackageDownloader::verifyServerId $serverId
    ::PackageDownloader::verifyVersionId $versionId
    ::PackageDownloader::verifyLanguageAndVersion $language $version isClient

    set prologue ""

    if {[string length $serverId] > 0} then {
      append prologue "  ::PackageDownloader::useServerId " $serverId \n
    }

    if {[string length $versionId] > 0} then {
      append prologue "  ::PackageDownloader::useVersionId " $versionId \n
    }

    append prologue "  "

    return [string trim [string map [list \r\n \n \
        %language% [formatStringMapValue $language] \
        %version% [formatStringMapValue $version] \
        %platform% [formatStringMapValue $platform] \
        %prologue% $prologue %ns% ::PackageDownloader \
        %backslash% \\  %fileNames% \
        [getScriptChunkForFileNames $fileNames 2]] {
apply [list [list] {
  package require Eagle.Package.Downloader

%prologue%%ns%::resetCookieAndLoginSimple

  set fileNames [list]

%fileNames%

  set options [list %backslash%
      -persistent false -usePgp true -useAutoPath true]

  %ns%::downloadFiles %language% %version% %platform% $fileNames $options
  %ns%::logoutAndResetCookie
}]
    }]]
  }

  #
  # NOTE: This procedure creates textual data that conforms to the content
  #       type "multipart/form-data", per RFC 2388.  The boundary argument
  #       is a boundary value, as specified in section 4.1 of the RFC.  The
  #       request argument is the dictionary of name/value pairs to include
  #       in the form body.  This procedure may not raise script errors.
  #
  proc createMultipartFormData { boundary request } {
    set result ""

    foreach {name value} $request {
      append result -- $boundary \r\n
      append result "Content-Disposition: form-data; name=\""
      append result $name \"\r\n\r\n
      append result $value \r\n
    }

    if {[string length $result] > 0} then {
      append result -- $boundary --\r\n
    }

    if {[isEagle]} then {
      return [object create -alias String $result]
    } else {
      return $result
    }
  }

  #
  # NOTE: This procedure returns the full URI to use when submitting a new
  #       package to the package repository server.  There are no arguments.
  #       This procedure may raise script errors.
  #
  proc getSubmitUri {} {
    #
    # NOTE: Fetch the base URI for the package repository server.  If it
    #       is not available for some reason, just return an empty string
    #       to the caller (i.e. as we cannot do anything productive).
    #
    set baseUri [::PackageRepository::getLookupBaseUri]

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

    #
    # NOTE: Build the HTTP request URI and include the standard query
    #       parameters (with constant values) for this request type.
    #
    if {[isEagle]} then {
      return [appendArgs \
          $baseUri ?raw=1&method=submit]
    } else {
      package require http 2.0

      return [appendArgs \
          $baseUri ? [::http::formatQuery raw 1 method submit]]
    }
  }

  #
  # NOTE: This procedure attempts to submit the metadata for a new package to
  #       the package repository server.  Upon success, an empty string will
  #       be returned.  Upon failure, a script error will be raised.  The
  #       apiKey argument is the list of API keys to use.  The package argument
  #       is the name of the package.  The patchLevel argument is the specific
  #       patch level being submitted.  The language argument must be an empty
  #       string, "Tcl", or "Eagle".  If it is an empty string, the current
  #       language will be assumed.  The script argument is the script to be
  #       evaluated when the package needs to be provided.  The certificate
  #       argument is the certificate associated with the script, which may be
  #       an OpenPGP signature or a Harpy script certificate.
  #
  # <public>
  proc submitPackageMetadata {
          apiKey package patchLevel language script certificate } {
    variable verboseMetadataSubmit

    #
    # NOTE: Fetch the submission URI for the package repository server.  If
    #       it is not available for some reason, raise a script error.
    #
    set uri [getSubmitUri]

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

    if {[string length $language] == 0} then {
      set language [expr {[isEagle] ? "Eagle" : "Tcl"}]
    }

    if {[isEagle]} then {
      set boundary [string map \
          [list + "" / "" = ""] [base64 encode [expr {randstr(50)}]]]
    } else {
      set boundary [::PackageRepository::getUniqueSuffix]
    }

    set contentType [appendArgs \
        "multipart/form-data; boundary=" $boundary]

    set formData [createMultipartFormData $boundary \
        [list apiKey $apiKey package $package patchLevel \
        $patchLevel language $language script $script \
        certificate $certificate]]

    if {[isEagle]} then {
      if {![object invoke Eagle._Tests.Default \
          TestHasScriptNewWebClientCallback ""]} then {
        set error null

        set code [object invoke Eagle._Tests.Default \
            TestSetScriptNewWebClientCallback "" true true error]

        if {$code ne "Ok"} then {
          error [getStringFromObjectHandle $error]
        }
      }

      set script [object create String {
        if {[methodName ToString] eq "GetWebRequest"} then {
          webRequest ContentType $contentType
        }
      }]

      set data [uri upload \
          -inline -raw -encoding identity -webclientdata \
          $script -data $formData $uri]
    } else {
      set options [list \
          -binary true -type $contentType -query $formData]

      set data [eval ::PackageRepository::getFileViaHttp \
          [list $uri] [list 20] [list stdout] [list \
          [expr {!$verboseMetadataSubmit}]] $options]
    }

    set code [::PackageRepository::getLookupCodeFromData $data]
    set result [::PackageRepository::getLookupResultFromData $data]

    if {[::PackageRepository::isLookupCodeOk $code]} then {
      return $result
    } else {
      error [appendArgs \
          "failed to submit package metadata: " $result]
    }
  }

  #
  # NOTE: This procedure attempts to query the root directory of the Fossil
  #       checkout.  There are no arguments.  An empty string is returned if
  #       the root directory of the Fossil checkout cannot be determined.
  #
  proc getCheckoutDirectory {} {
    variable fossilInfoCommand
    variable fossilInfoLocalRootPattern
    variable scriptDirectory

    if {[isEagle]} then {
      set scriptDirectory [::PackageRepository::formatExecArgument \
          $scriptDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      if {[catch {
        eval exec [subst $fossilInfoCommand]
      } result]} then {
        return false
      }
    }

    if {![info exists result] || ![regexp -line -- \
        $fossilInfoLocalRootPattern $result dummy directory]} then {
      return ""
    }

    return [string trim $directory]
  }

  #
  # NOTE: This procedure attempts to verify that the root directory of the
  #       Fossil checkout is present, valid, and is actually a directory.
  #       There are no arguments.  Script errors will be raised if any of
  #       the checks fail.
  #
  proc verifyCheckoutDirectory {} {
    variable checkoutDirectory

    if {![info exists checkoutDirectory]} then {
      error "checkout directory is missing"
    }

    if {[string length $checkoutDirectory] == 0} then {
      error "checkout directory is invalid"
    }

    if {![file isdir $checkoutDirectory]} then {
      error [appendArgs \
          "checkout directory \"" $checkoutDirectory \
          "\" is not really a directory"]
    }
  }

  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       not contain any (stray) changes.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThereAreNoChanges {} {
    variable checkoutDirectory
    variable fossilChangesCommand
    variable fossilChangesPattern

    verifyCheckoutDirectory

    if {[isEagle]} then {
      set checkoutDirectory [::PackageRepository::formatExecArgument \
          $checkoutDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilChangesCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      if {[catch {
        eval exec [subst $fossilChangesCommand]
      } result]} then {
        return false
      }
    }

    if {![info exists result] || \
        ![regexp -- $fossilChangesPattern $result]} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       belong to the correct project.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThisIsTheCorrectProject {} {
    variable fossilInfoCommand
    variable fossilInfoProjectCodePattern
    variable projectCode
    variable scriptDirectory

    if {[isEagle]} then {
      set scriptDirectory [::PackageRepository::formatExecArgument \
          $scriptDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      if {[catch {
        eval exec [subst $fossilInfoCommand]
      } result]} then {
        return false
      }
    }

    if {![info exists result] || ![regexp -line -- \
        [subst $fossilInfoProjectCodePattern] $result]} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       belong to the correct branch.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThisIsTheCorrectBranch {} {
    variable fossilInfoCommand
    variable fossilInfoTagsPattern
    variable scriptDirectory

    if {[isEagle]} then {
      set scriptDirectory [::PackageRepository::formatExecArgument \
          $scriptDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      if {[catch {
        eval exec [subst $fossilInfoCommand]
      } result]} then {
        return false
      }
    }

    if {![info exists result] || \
        ![regexp -line -- $fossilInfoTagsPattern $result]} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure attempts to change the branch for the checkout
  #       directory.  There are no arguments.  This procedure may raise
  #       script errors.
  #
  proc changeToTheCorrectBranch {} {
    variable checkoutDirectory
    variable fossilUpdateCommand

    verifyCheckoutDirectory

    if {[isEagle]} then {
      set checkoutDirectory [::PackageRepository::formatExecArgument \
          $checkoutDirectory]

      if {[catch {
        eval exec -success Success [subst $fossilUpdateCommand]
      } error]} then {
        error [appendArgs \
            "could not change branch: " $error]
      }
    } else {
      if {[catch {
        eval exec [subst $fossilUpdateCommand]
      } error]} then {
        error [appendArgs \
            "could not change branch: " $error]
      }
    }
  }

  #
  # NOTE: This procedure attempts to stage the specified package file using
  #       Fossil.  The targetDirectory argument is the fully qualified path
  #       to the package platform directory.  The fileName argument is the
  #       relative name of the file to be staged.  This procedure may raise
  #       script errors.
  #
  proc stageOnePackageFile { targetDirectory fileName } {
    variable fossilAddCommand

    if {[isEagle]} then {
      set targetDirectory [::PackageRepository::formatExecArgument \
          $targetDirectory]

      set fileName [::PackageRepository::formatExecArgument $fileName]

      if {[catch {
        eval exec -success Success [subst $fossilAddCommand]
      } error]} then {
        error [appendArgs \
            "could not stage file \"" $fileName "\": " $error]
      }
    } else {
      if {[catch {
        eval exec [subst $fossilAddCommand]
      } error]} then {
        error [appendArgs \
            "could not stage file \"" $fileName "\": " $error]
      }
    }
  }

  #
  # NOTE: This procedure attempts to stage the specified package files using
  #       Fossil.  The fileNames argument is a list of (fully?) qualified
  #       local file names to stage.
  #
  # <public>
  proc stagePackageFiles { language version platform fileNames } {
    variable checkoutDirectory
    variable fossilAddCommand

    verifyCheckoutDirectory

    if {![verifyThereAreNoChanges]} then {
      error "cannot stage files: there are pending changes"
    }

    if {![verifyThisIsTheCorrectProject]} then {
      error "cannot stage files: wrong project"
    }

    if {![verifyThisIsTheCorrectBranch]} then {
      changeToTheCorrectBranch

      if {![verifyThisIsTheCorrectBranch]} then {
        error "cannot stage files: still on wrong branch"
      }
    }

    set targetDirectory [file join \
        $checkoutDirectory $language $version $platform]

    set relativeFileNames [getRelativeFileNames $fileNames 2]

    foreach fileName $fileNames relativeFileName $relativeFileNames {
      file mkdir [file join \
          $targetDirectory [file dirname $relativeFileName]]

      set checkoutFileName [file join $targetDirectory $relativeFileName]

      file copy $fileName $checkoutFileName

      if {![::PackageRepository::createOpenPgpSignature \
          $checkoutFileName]} then {
        error [appendArgs \
            "could not stage file \"" $fileName \
            "\": OpenPGP signing failed"]
      }

      stageOnePackageFile $targetDirectory $relativeFileName
      stageOnePackageFile $targetDirectory [appendArgs $relativeFileName .asc]
    }
  }

  #
  # NOTE: This procedure attempts to commit the staged package files to the
  #       remote package file repository using Fossil.  The varName argument
  #       is the name of a scalar variable in the context of the immediate
  #       caller that will receive the resulting Fossil check-in identifier.
  #
  # <public>
  proc commitPackageFiles { package patchLevel language version varName } {
    variable checkoutDirectory
    variable fossilCommitCommand
    variable fossilCommitPattern

    verifyCheckoutDirectory

    set branch [appendArgs pkg_ $package _ $patchLevel]

    set comment [appendArgs \
        "Add package " $package " v" $patchLevel " for " $language \
        " v" $version .]

    if {[isEagle]} then {
      set checkoutDirectory [::PackageRepository::formatExecArgument \
          $checkoutDirectory]

      set branch [::PackageRepository::formatExecArgument $branch]
      set comment [::PackageRepository::formatExecArgument $comment]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilCommitCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      if {[catch {
        eval exec [subst $fossilCommitCommand]
      } result]} then {
        return false
      }
    }

    if {[string length $varName] > 0} then {
      upvar 1 $varName checkin
    }

    if {![info exists result] || \
        ![regexp -line -- $fossilCommitPattern $result dummy checkin]} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure initializes the array containing data derived from
  #       the command line arguments, if any.  The argv argument should be
  #       the list of command line arguments.
  #
  proc setupArgumentData { argv } {
    variable argumentData

    if {![info exists argumentData(apiKey)]} then {
      set argumentData(apiKey) ""
    }

    if {![info exists argumentData(package)]} then {
      set argumentData(package) ""
    }

    if {![info exists argumentData(patchLevel)]} then {
      set argumentData(patchLevel) ""
    }

    if {![info exists argumentData(language)]} then {
      set argumentData(language) ""
    }

    if {![info exists argumentData(version)]} then {
      set argumentData(version) ""
    }

    if {![info exists argumentData(platform)]} then {
      set argumentData(platform) ""
    }

    if {![info exists argumentData(fileNames)]} then {
      set argumentData(fileNames) [list]
    }

    if {[llength $argv] >= 1} then {
      set argumentData(apiKey) [lindex $argv 0]
    }

    if {[llength $argv] >= 2} then {
      set argumentData(package) [lindex $argv 1]
    }

    if {[llength $argv] >= 3} then {
      set argumentData(patchLevel) [lindex $argv 2]
    }

    if {[llength $argv] >= 4} then {
      set argumentData(language) [lindex $argv 3]
    }

    if {[llength $argv] >= 5} then {
      set argumentData(version) [lindex $argv 4]
    }

    if {[llength $argv] >= 6} then {
      set argumentData(platform) [lindex $argv 5]
    }

    if {[llength $argv] >= 7} then {
      set argumentData(fileNames) [lrange $argv 6 end]
    }
  }

  #
  # NOTE: This procedure is used to determine if all the package submission
  #       data is available.  There are no arguments.  Non-zero is returned
  #       if all the package submission data is available.  This procedure
  #       should not raise script errors.
  #
  proc haveArgumentData {} {
    variable argumentData

    if {![info exists argumentData(apiKey)]} then {
      return false
    }

    if {[string length $argumentData(apiKey)] == 0} then {
      return false
    }

    if {![info exists argumentData(package)]} then {
      return false
    }

    if {[string length $argumentData(package)] == 0} then {
      return false
    }

    if {![info exists argumentData(patchLevel)]} then {
      return false
    }

    if {[string length $argumentData(patchLevel)] == 0} then {
      return false
    }

    if {![info exists argumentData(language)]} then {
      return false
    }

    if {[string length $argumentData(language)] == 0} then {
      return false
    }

    if {![info exists argumentData(version)]} then {
      return false
    }

    if {[string length $argumentData(version)] == 0} then {
      return false
    }

    if {![info exists argumentData(platform)]} then {
      return false
    }

    if {[string length $argumentData(platform)] == 0} then {
      return false
    }

    if {![info exists argumentData(fileNames)]} then {
      return false
    }

    if {[llength $argumentData(fileNames)] == 0} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure is an event handler.  It handles the Changed event
  #       for a text box.  It is not used when the user interface was built
  #       with Tk.  The varName argument is the name of the scalar variable
  #       that must be updated with the contents of the text box.  The sender
  #       and e arguments are provided by the framework and represent the
  #       control involved in the event and any extra data that may be
  #       necessary to process the event.
  #
  proc textBoxEventHandler { varName sender e } {
    set $varName [$sender Text]
  }

  #
  # NOTE: This procedure is an event handler.  It handles double-clicking the
  #       list box in both Tk and Eagle.  The varName argument is the name of
  #       the scalar variable that must be updated with the list of items from
  #       the list box -OR- the list of items from an interactive file picker
  #       dialog.  The args argument, which is only used for Eagle, is a list
  #       containing two elements.  The first element is the control involved
  #       in the event.  The second element is any extra data that may be
  #       necessary to process the event.
  #
  proc listBoxEventHandler { varName args } {
    if {[isEagle]} then {
      set sender [lindex $args 0]
      set e [lindex $args 1]

      set dialog [object create -alias OpenFileDialog]

      $dialog RestoreDirectory true
      $dialog Multiselect true
      $dialog ShowDialog

      set fileNames [$dialog -create FileNames]

      $sender Items.Clear
      $sender Items.AddRange $fileNames

      set list [object create -alias StringList $fileNames]
      set $varName [$list ToString]
    } else {
      set $varName [tk_getOpenFile -multiple true]
    }
  }

  #
  # NOTE: This procedure is an event handler.  It handles the Closed event for
  #       a WinForms form.  It is not used when the user interface was built
  #       with Tk.  The sender and e arguments are provided by the framework
  #       and represent the control involved in the event and any extra data
  #       that may be necessary to process the event.
  #
  proc handleFormClosedEvent { sender e } {
    variable forever; set forever 1; # NOTE: Terminate the [vwait].
  }

  #
  # NOTE: This procedure is an event handler.  It handles the submit button in
  #       both Tk and Eagle.  It starts the package submission process.  The
  #       args argument is not really used, it is a placeholder to make this
  #       procedure more portable between Tcl and Eagle.  This procedure may
  #       raise script errors.
  #
  proc submitEventHandler { args } {
    variable argumentData

    set batchMode [lindex $args 0]

    if {[isEagle]} then {
      set sender [lindex $args 1]; # NOTE: Disposal.
      set e [lindex $args 2]; # NOTE: Disposal.
    }

    if {[haveArgumentData]} then {
      set apiKey $argumentData(apiKey)
      set package $argumentData(package)
      set patchLevel $argumentData(patchLevel)
      set language $argumentData(language)
      set version $argumentData(version)
      set platform $argumentData(platform)
      set fileNames $argumentData(fileNames)

      ::PackageRepository::probeForOpenPgpInstallation
      ::PackageRepository::openPgpMustBeInstalled

      #
      # NOTE: THIS BLOCK REFERS TO SEVERAL UNTESTED PROCEDURES.
      #
      if {0} then {
        stagePackageFiles \
            [string tolower $language] $version $platform $fileNames

        if {![commitPackageFiles \
            $package $patchLevel [string totitle $language] $version \
            checkin]} then {
          error "failed to commit package files"
        }

        #
        # TODO: Is this the best heuristic here for figuring out that the
        #       platform should really be "automatic" in the repository?
        #
        if {$platform eq "neutral" || \
            $platform eq [::PackageDownloader::getPlatform]} then {
          set scriptPlatform ""
        } else {
          set scriptPlatform $platform
        }

        set script [createRepositoryScript \
            "" $checkin [string tolower $language] $version $scriptPlatform \
            $fileNames [list]]

        set scriptFileName [file join \
            [::PackageRepository::getFileTempDirectory PKGR_UPLOAD_TEMP] \
            [appendArgs pkgr_upload_ [::PackageRepository::getUniqueSuffix]]]

        writeFile $scriptFileName $script

        if {![::PackageRepository::createOpenPgpSignature \
            $scriptFileName]} then {
          error [appendArgs \
              "cannot submit package metadata: OpenPGP signing of \"" \
              $scriptFileName "\" failed"]
        }

        set certificate [readFile [appendArgs $scriptFileName .asc]]

        set result [submitPackageMetadata \
            $apiKey $package $patchLevel [string totitle $language] \
            $script $certificate]

        if {!$batchMode} then {
          set title [appendArgs \
              "Package Uploader Client: " [lindex [info level 0] 0]]

          if {[string length $result] > 0} then {
            set message [appendArgs \
                "Package was submitted successfully: " $result]
          } else {
            set message "Package was submitted successfully."
          }

          if {[isEagle]} then {
            catch {
              object invoke MessageBox Show $message $title
            }
          } else {
            catch {
              tk_messageBox -type ok -message $message -title $title
            }
          }
        }
      }
    } else {
      error "cannot initiate package submission: one or more fields missing"
    }
  }

  #
  # NOTE: This procedure is an event handler.  It handles the clear button in
  #       Tk and Eagle.  It is used to clear the package submission data.  The
  #       args argument is not really used, it is a placeholder to make this
  #       procedure more portable between Tcl and Eagle.  This procedure may
  #       raise script errors.
  #
  proc clearEventHandler { args } {
    variable argumentData

    if {[isEagle]} then {
      set sender [lindex $args 0]; # NOTE: Disposal.
      set e [lindex $args 1]; # NOTE: Disposal.

      variable widgets

      $widgets(2) Text ""
      $widgets(4) Text ""
      $widgets(6) Text ""
      $widgets(8) Text ""
      $widgets(10) Text ""
      $widgets(12) Text ""
      $widgets(14) Items.Clear
    } else {
      set argumentData(apiKey) ""
      set argumentData(package) ""
      set argumentData(patchLevel) ""
      set argumentData(language) ""
      set argumentData(version) ""
      set argumentData(platform) ""
    }

    #
    # NOTE: This is done for Tk because it will also clear the on-screen
    #       widget itself.  For Eagle, this is necessary because there is
    #       no "listvariable" option and clearing the on-screen widget has
    #       no impact on the underyling list.
    #
    set argumentData(fileNames) [list]
  }

  #
  # NOTE: This procedure creates the user interface for this tool using Eagle
  #       and WinForms.  The existing argument data, if any, will be used to
  #       populate it.  There are no arguments.
  #
  proc setupWinFormsUserInterface {} {
    variable argumentData
    variable widgets

    object load -import System.Windows.Forms

    set form [object create -alias Form]
    set widgets(0) $form

    $form Text "Package Uploader Client"

    ###########################################################################

    set widgets(1) [object create -alias Label]
    $widgets(1) Name lblApiKey
    $widgets(1) Text "API Key"

    ###########################################################################

    set widgets(2) [object create -alias TextBox]

    $widgets(2) Name txtApiKey
    $widgets(2) Text $argumentData(apiKey)

    $widgets(2) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(apiKey)]]]

    ###########################################################################

    set widgets(3) [object create -alias Label]
    $widgets(3) Name lblPackage
    $widgets(3) Text "Package Name"

    ###########################################################################

    set widgets(4) [object create -alias TextBox]

    $widgets(4) Name txtPackage
    $widgets(4) Text $argumentData(package)

    $widgets(4) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(package)]]]

    ###########################################################################

    set widgets(5) [object create -alias Label]
    $widgets(5) Name lblPatchLevel
    $widgets(5) Text "Package Patch Level"

    ###########################################################################

    set widgets(6) [object create -alias TextBox]

    $widgets(6) Name txtPatchLevel
    $widgets(6) Text $argumentData(patchLevel)

    $widgets(6) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(patchLevel)]]]

    ###########################################################################

    set widgets(7) [object create -alias Label]
    $widgets(7) Name lblLanguage
    $widgets(7) Text Language

    ###########################################################################

    set widgets(8) [object create -alias TextBox]

    $widgets(8) Name txtLanguage
    $widgets(8) Text $argumentData(language)

    $widgets(8) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(language)]]]

    ###########################################################################

    set widgets(9) [object create -alias Label]
    $widgets(9) Name lblVersion
    $widgets(9) Text Version

    ###########################################################################

    set widgets(10) [object create -alias TextBox]

    $widgets(10) Name txtVersion
    $widgets(10) Text $argumentData(version)

    $widgets(10) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(version)]]]

    ###########################################################################

    set widgets(11) [object create -alias Label]
    $widgets(11) Name lblPlatform
    $widgets(11) Text Platform

    ###########################################################################

    set widgets(12) [object create -alias TextBox]

    $widgets(12) Name txtPlatform
    $widgets(12) Text $argumentData(platform)

    $widgets(12) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(platform)]]]

    ###########################################################################

    set widgets(13) [object create -alias Label]
    $widgets(13) Name lblFileNames
    $widgets(13) Text Files

    ###########################################################################

    set widgets(14) [object create -alias ListBox]
    $widgets(14) Name lstFileNames

    $widgets(14) add_DoubleClick [namespace code \
        [list listBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(fileNames)]]]

    ###########################################################################

    set widgets(15) [object create -alias Button]
    $widgets(15) Name btnSubmit
    $widgets(15) Text Submit
    $widgets(15) add_Click [namespace code [list submitEventHandler false]]

    ###########################################################################

    set widgets(16) [object create -alias Button]
    $widgets(16) Name btnClear
    $widgets(16) Text Clear
    $widgets(16) add_Click [namespace code [list clearEventHandler]]

    ###########################################################################

    set horizontalMargin \
        [expr {([$form Width] - [$form ClientSize.Width]) / 2}]

    set verticalMargin \
        [expr {([$form Height] - [$form ClientSize.Height]) / 2}]

    ###########################################################################

    set top $verticalMargin

    foreach name [lsort -integer [array names widgets]] {
      if {$name eq "0"} then continue

      $widgets($name) Width [expr {
        [$form ClientSize.Width] - ($horizontalMargin * 2)
      }]

      $widgets($name) Left $horizontalMargin
      $widgets($name) Top $top
      $form Controls.Add $widgets($name)

      incr top [$widgets($name) Height]
      incr top $verticalMargin
    }

    $form add_Closed [namespace code [list handleFormClosedEvent]]
    $form MaximizeBox false
    $form AutoSize true
    $form Show

    after 0 [list nop]; # NOTE: Needed for the [vwait].
  }

  #
  # NOTE: This procedure creates the user interface for this tool using Tcl
  #       and Tk.  The existing argument data, if any, will be used to
  #       populate it.  There are no arguments.
  #
  proc setupTkUserInterface {} {
    variable widgets

    package require Tk
    catch {console show}

    catch {wm withdraw .}; set toplevel [toplevel .uploader]
    set widgets(toplevel) $toplevel

    wm title $toplevel "Package Uploader Client"
    wm minsize $toplevel 250 0

    ###########################################################################

    set widgets(label,apiKey) [label [appendArgs \
        $toplevel .l_apiKey] -text "API Key"]

    ###########################################################################

    set widgets(entry,apiKey) [entry [appendArgs \
        $toplevel .e_apiKey] -textvariable [appendArgs \
        [namespace current] ::argumentData(apiKey)]]

    ###########################################################################

    set widgets(label,package) [label [appendArgs \
        $toplevel .l_package] -text "Package Name"]

    ###########################################################################

    set widgets(entry,package) [entry [appendArgs \
        $toplevel .e_package] -textvariable [appendArgs \
        [namespace current] ::argumentData(package)]]

    ###########################################################################

    set widgets(label,patchLevel) [label [appendArgs \
        $toplevel .l_patchLevel] -text "Package Patch Level"]

    ###########################################################################

    set widgets(entry,patchLevel) [entry [appendArgs \
        $toplevel .e_patchLevel] -textvariable [appendArgs \
        [namespace current] ::argumentData(patchLevel)]]

    ###########################################################################

    set widgets(label,language) [label [appendArgs \
        $toplevel .l_language] -text Language]

    ###########################################################################

    set widgets(entry,language) [entry [appendArgs \
        $toplevel .e_language] -textvariable [appendArgs \
        [namespace current] ::argumentData(language)]]

    ###########################################################################

    set widgets(label,version) [label [appendArgs \
        $toplevel .l_version] -text Version]

    ###########################################################################

    set widgets(entry,version) [entry [appendArgs \
        $toplevel .e_version] -textvariable [appendArgs \
        [namespace current] ::argumentData(version)]]

    ###########################################################################

    set widgets(label,platform) [label [appendArgs \
        $toplevel .l_platform] -text Platform]

    ###########################################################################

    set widgets(entry,platform) [entry [appendArgs \
        $toplevel .e_platform] -textvariable [appendArgs \
        [namespace current] ::argumentData(platform)]]

    ###########################################################################

    set widgets(label,fileNames) [label [appendArgs \
        $toplevel .l_fileNames] -text Files]

    ###########################################################################

    set widgets(listbox,fileNames) [listbox [appendArgs \
        $toplevel .li_fileNames] -listvariable [appendArgs \
        [namespace current] ::argumentData(fileNames)]]

    bind $widgets(listbox,fileNames) <Double-Button-1> \
        [namespace code [list listBoxEventHandler [appendArgs \
        [namespace current] ::argumentData(fileNames)]]]

    ###########################################################################

    set widgets(button,submit) [button \
        [appendArgs $toplevel .b_submit] -text Submit -command \
        [namespace code [list submitEventHandler false]]]

    ###########################################################################

    set widgets(button,clear) [button \
        [appendArgs $toplevel .b_clear] -text Clear -command \
        [namespace code [list clearEventHandler]]]

    ###########################################################################

    pack $widgets(label,apiKey) $widgets(entry,apiKey) \
        $widgets(label,package) $widgets(entry,package) \
        $widgets(label,patchLevel) $widgets(entry,patchLevel) \
        $widgets(label,language) $widgets(entry,language) \
        $widgets(label,version) $widgets(entry,version) \
        $widgets(label,platform) $widgets(entry,platform) \
        $widgets(label,fileNames) $widgets(listbox,fileNames) \
        $widgets(button,submit) $widgets(button,clear) \
        -expand true -fill both

    pack $widgets(button,submit) $widgets(button,clear) \
        -anchor e -expand false -fill none
  }

  #
  # NOTE: Figure out the fully qualified path to the current script file.
  #       If necessary, add it to the auto-path for the interpreter.  The
  #       necessary supporting packages (i.e. the Package Repository and
  #       other support packages) that are assumed to exist in the same
  #       directory as the current script file.
  #
  variable pkgr_path; # DEFAULT: <unset>

  if {![info exists pkgr_path]} then {
    set pkgr_path [file normalize [file dirname [info script]]]

    if {![info exists ::auto_path] || \
        [lsearch -exact $::auto_path $pkgr_path] == -1} then {
      lappend ::auto_path $pkgr_path
    }
  }

  #
  # NOTE: *TODO* Pre-create the namespace for the Package Repository Client
  #       package and then forcibly adjust various settings to the values
  #       necessary for this tool.  In the future, this section may need to
  #       be tweaked to account for changes to the Package Repository Client
  #       package.
  #
  namespace eval ::PackageRepository {
    variable verboseUriDownload true
    variable autoRequireGaruda false
    variable autoLoadTcl false
    variable autoHook false
  }

  #
  # NOTE: This package requires both the package repository and downloader
  #       client packages.
  #
  package require Eagle.Package.Downloader

  #
  # NOTE: This package requires that support for namespaces, which is an
  #       optional feature of Eagle, must be enabled.
  #
  if {[isEagle] && ![namespace enable]} then {
    error "namespaces must be enabled for this package"
  }

  #
  # NOTE: Attempt to read optional settings file now.  This may override
  #       one or more of the variable setup in the next step.
  #
  ::PackageRepository::maybeReadSettingsFile [info script]

  #
  # NOTE: Setup the variables, within this namespace, used by this script.
  #
  setupUploadVars
  setupCheckoutVars

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

  #
  # NOTE: Process the command line arguments into their corresponding data
  #       values, which are contained in an array.
  #
  setupArgumentData [expr {[info exists ::argv] ? $::argv : [list]}]

  #
  # NOTE: Verify that the number of command line arguments meets the basic
  #       requirements of this tool.
  #
  if {[haveArgumentData]} then {
    #
    # NOTE: All necessary arguments were supplied on the command line, use
    #       batch mode.
    #
    if {[isEagle]} then {
      submitEventHandler true null null
    } else {
      submitEventHandler true
    }
  } else {
    #
    # NOTE: One or more of the necessary arguments were not supplied on the
    #       command line, use interactive mode.  This will create a graphical
    #       user interface, using Tk or WinForms.  If any of the necessary
    #       arguments were supplied on the command line, they will be used to
    #       populate those fields on the graphical user interface.
    #
    if {[isEagle]} then {
      setupWinFormsUserInterface
    } else {
      setupTkUserInterface
    }

    variable forever; vwait forever
  }
}
