###############################################################################
#
# pkgd.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Downloader 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 ::PackageDownloader {
#
# NOTE: This procedure sets up the default values for all configuration
# parameters used by the package downloader client. There are no
# arguments.
#
proc setupDownloadVars {} {
#
# NOTE: Prevent progress messages from being displayed while downloading
# from the repository, etc? By default, this is enabled.
#
variable quiet; # DEFAULT: true
if {![info exists quiet]} then {
set quiet true
}
#
# NOTE: The base URI for the package distribution web site.
#
variable baseUri; # DEFAULT: https://urn.to/r/pkgd
if {![info exists baseUri]} then {
set baseUri https://urn.to/r/pkgd
}
#
# NOTE: The URI where a single package file may be found. This file will
# belong to a specific version of one package.
#
variable downloadUri; # DEFAULT: ${baseUri}?...&filename=${fileName}
if {![info exists downloadUri]} then {
set downloadUri {${baseUri}?download&ci=trunk&filename=${fileName}}
}
#
# NOTE: The root directory where any persistent packages will be saved.
#
variable persistentDirectory; # DEFAULT: [getPersistentRootDirectory]
if {![info exists persistentDirectory]} then {
set persistentDirectory [getPersistentRootDirectory]
}
}
#
# NOTE: This procedure returns the root directory where any packages that
# are downloaded should be saved to permanent storage for subsequent
# use. There are no arguments.
#
proc getPersistentRootDirectory {} {
#
# NOTE: Return a directory parallel to the one containing the library
# directory.
#
return [file join [file dirname [info library]] pkgd]
}
#
# NOTE: This procedure adds a directory to the auto-path of the specified
# language (i.e. native Tcl or Eagle). The directory will not be
# added if it is already present. The language argument must be the
# literal string "eagle" or the literal string "tcl". The directory
# argument is the fully qualified path for the directory to add to
# the auto-path.
#
# <public>
proc addToAutoPath { language directory } {
#
# NOTE: Add the specified directory to the auto-path if not already
# present.
#
if {[string length $language] == 0 || $language eq "eagle"} then {
if {[isEagle]} then {
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path $directory] == -1} then {
lappend ::auto_path $directory
}
} else {
::PackageRepository::eagleMustBeReady
eagle [string map [list %directory% $directory] {
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path {%directory%}] == -1} then {
lappend ::auto_path {%directory%}
}
}]
}
} elseif {$language eq "tcl"} then {
if {[isEagle]} then {
tcl eval [tcl master] [string map [list %directory% $directory] {
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path {%directory%}] == -1} then {
lappend ::auto_path {%directory%}
}
}]
} else {
if {![info exists ::auto_path] || \
[lsearch -exact $::auto_path $directory] == -1} then {
lappend ::auto_path $directory
}
}
} else {
error "unsupported language, no idea how to modify auto-path"
}
}
#
# NOTE: This procedure attempts to download a list of files, optionally
# persistening them for subsequent uses by the target language.
# The language argument must be the literal string "eagle" or the
# literal string "tcl". The version argument must be the literal
# string "8.4", "8.5", or "8.6" when the language is "tcl" -OR-
# the literal string "1.0" when the language is "eagle". The
# fileNames argument must be a well-formed list of file names to
# download, each one relative to the language/version-specific
# directory on the package file server. The persistent argument
# should be non-zero if the downloaded files should be saved to
# permanent storage for subsequent use. The usePgp argument
# should be non-zero when an OpenPGP signature file needs to be
# downloaded and verified for each downloaded file. The
# useAutoPath argument should be non-zero to modify the auto-path
# to include the temporary or persistent directories containing
# the downloaded files.
#
# <public>
proc downloadFiles {
language version fileNames persistent usePgp useAutoPath } {
variable baseUri
variable downloadUri
variable persistentDirectory
variable quiet
if {[string length $language] == 0 || $language eq "eagle"} then {
if {$version ne "1.0"} then {
error "unsupported Eagle version"
}
} elseif {$language eq "tcl"} then {
if {$version ne "8.4" && $version ne "8.5" && $version ne "8.6"} then {
error "unsupported Tcl version"
}
} else {
error "unsupported language"
}
if {$persistent} then {
set downloadRootDirectory $persistentDirectory
} else {
set directoryNameOnly [appendArgs \
pkgd_ [string trim [pid] -] _ [string trim [clock seconds] -]]
global env
if {[info exists env(PKGD_TEMP)]} then {
set downloadRootDirectory $env(PKGD_TEMP)
} elseif {[info exists env(TEMP)]} then {
set downloadRootDirectory $env(TEMP)
} elseif {[info exists env(TMP)]} then {
set downloadRootDirectory $env(TMP)
} else {
error "please set PKGD_TEMP (via environment) to temporary directory"
}
set downloadRootDirectory [file join \
$downloadRootDirectory $directoryNameOnly]
}
set downloadDirectories [list]
foreach fileName $fileNames {
if {[string length $fileName] == 0 || \
[file pathtype $fileName] ne "relative"} then {
error [appendArgs \
"bad file name \"" $fileName "\", not relative"]
}
set directoryParts [file split [file dirname $fileName]]
if {[llength $directoryParts] == 0} then {
error [appendArgs \
"bad file name \"" $fileName "\", no directory parts"]
}
set downloadDirectory [file normalize [eval file join \
[list $downloadRootDirectory] $directoryParts]]
set downloadFileName [file normalize [file join \
$downloadDirectory [file tail $fileName]]]
if {!$persistent} then {
catch {file delete $downloadFileName}
}
file mkdir [file dirname $downloadFileName]
set savedFileName $fileName
set fileName [file join $language $version $fileName]
set uri [subst $downloadUri]
set fileName $savedFileName
if {[isEagle]} then {
writeFile $downloadFileName \
[interp readorgetscriptfile -- "" $uri]
} else {
writeFile $downloadFileName \
[::PackageRepository::getFileViaHttp $uri 10 stdout $quiet]
}
if {$usePgp} then {
set downloadSignatureFileName [appendArgs $downloadFileName .asc]
set savedFileName $fileName
set fileName [file join \
$language $version [appendArgs $fileName .asc]]
set uri [subst $downloadUri]
set fileName $savedFileName
if {[isEagle]} then {
writeFile $downloadSignatureFileName \
[interp readorgetscriptfile -- "" $uri]
} else {
writeFile $downloadSignatureFileName \
[::PackageRepository::getFileViaHttp $uri 10 stdout $quiet]
}
if {![::PackageRepository::verifyPgpSignature \
$downloadSignatureFileName]} then {
error [appendArgs \
"bad PGP signature \"" $downloadSignatureFileName \"]
}
}
lappend downloadDirectories $downloadDirectory
}
set downloadDirectories [lsort -unique $downloadDirectories]
if {$useAutoPath} then {
foreach downloadDirectory $downloadDirectories {
addToAutoPath $language $downloadDirectory
}
}
return $downloadDirectories
}
#
# NOTE: Setup the variables, within this namespace, used by this script.
#
setupDownloadVars
#
# NOTE: This package requires the package repository client package.
#
package require Eagle.Package.Repository
#
# NOTE: Provide the package to the interpreter.
#
package provide Eagle.Package.Downloader \
[expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}