#!/bin/bash
|
#!/bin/bash
|
# restart using a Tcl shell \
|
# restart using a Tcl shell \
|
exec sh -c 'for tclshell in tclsh tclsh83 cygtclsh80 ; do \
|
exec sh -c 'for tclshell in tclsh tclsh83 cygtclsh80 ; do \
|
( echo | $tclshell ) 2> /dev/null && exec $tclshell "`( cygpath -w \"$0\" ) 2> /dev/null || echo $0`" "$@" ; \
|
( echo | $tclshell ) 2> /dev/null && exec $tclshell "`( cygpath -w \"$0\" ) 2> /dev/null || echo $0`" "$@" ; \
|
done ; \
|
done ; \
|
echo "ecosadmin.tcl: cannot find Tcl shell" ; exit 1' "$0" "$@"
|
echo "ecosadmin.tcl: cannot find Tcl shell" ; exit 1' "$0" "$@"
|
|
|
# {{{ Banner
|
# {{{ Banner
|
|
|
#===============================================================================
|
#===============================================================================
|
#
|
#
|
# ecosadmin.tcl
|
# ecosadmin.tcl
|
#
|
#
|
# A package install/uninstall tool.
|
# A package install/uninstall tool.
|
#
|
#
|
#===============================================================================
|
#===============================================================================
|
#####ECOSGPLCOPYRIGHTBEGIN####
|
#####ECOSGPLCOPYRIGHTBEGIN####
|
## -------------------------------------------
|
## -------------------------------------------
|
## This file is part of eCos, the Embedded Configurable Operating System.
|
## This file is part of eCos, the Embedded Configurable Operating System.
|
## Copyright (C) 1998, 1999, 2000, 2001, 2002 Red Hat, Inc.
|
## Copyright (C) 1998, 1999, 2000, 2001, 2002 Red Hat, Inc.
|
##
|
##
|
## eCos is free software; you can redistribute it and/or modify it under
|
## eCos is free software; you can redistribute it and/or modify it under
|
## the terms of the GNU General Public License as published by the Free
|
## the terms of the GNU General Public License as published by the Free
|
## Software Foundation; either version 2 or (at your option) any later version.
|
## Software Foundation; either version 2 or (at your option) any later version.
|
##
|
##
|
## eCos is distributed in the hope that it will be useful, but WITHOUT ANY
|
## eCos is distributed in the hope that it will be useful, but WITHOUT ANY
|
## WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
## WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
## for more details.
|
## for more details.
|
##
|
##
|
## You should have received a copy of the GNU General Public License along
|
## You should have received a copy of the GNU General Public License along
|
## with eCos; if not, write to the Free Software Foundation, Inc.,
|
## with eCos; if not, write to the Free Software Foundation, Inc.,
|
## 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
|
## 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
|
##
|
##
|
## As a special exception, if other files instantiate templates or use macros
|
## As a special exception, if other files instantiate templates or use macros
|
## or inline functions from this file, or you compile this file and link it
|
## or inline functions from this file, or you compile this file and link it
|
## with other works to produce a work based on this file, this file does not
|
## with other works to produce a work based on this file, this file does not
|
## by itself cause the resulting work to be covered by the GNU General Public
|
## by itself cause the resulting work to be covered by the GNU General Public
|
## License. However the source code for this file must still be made available
|
## License. However the source code for this file must still be made available
|
## in accordance with section (3) of the GNU General Public License.
|
## in accordance with section (3) of the GNU General Public License.
|
##
|
##
|
## This exception does not invalidate any other reasons why a work based on
|
## This exception does not invalidate any other reasons why a work based on
|
## this file might be covered by the GNU General Public License.
|
## this file might be covered by the GNU General Public License.
|
##
|
##
|
## Alternative licenses for eCos may be arranged by contacting Red Hat, Inc.
|
## Alternative licenses for eCos may be arranged by contacting Red Hat, Inc.
|
## at http://sources.redhat.com/ecos/ecos-license/
|
## at http://sources.redhat.com/ecos/ecos-license/
|
## -------------------------------------------
|
## -------------------------------------------
|
#####ECOSGPLCOPYRIGHTEND####
|
#####ECOSGPLCOPYRIGHTEND####
|
#===============================================================================
|
#===============================================================================
|
######DESCRIPTIONBEGIN####
|
######DESCRIPTIONBEGIN####
|
#
|
#
|
# Author(s): jld
|
# Author(s): jld
|
# Contributors: bartv
|
# Contributors: bartv
|
# Date: 1999-06-18
|
# Date: 1999-06-18
|
# Purpose: To install and uninstall packages from an eCos component
|
# Purpose: To install and uninstall packages from an eCos component
|
# repository
|
# repository
|
# Description:
|
# Description:
|
# Usage:
|
# Usage:
|
#
|
#
|
#####DESCRIPTIONEND####
|
#####DESCRIPTIONEND####
|
#===============================================================================
|
#===============================================================================
|
#
|
#
|
|
|
# }}}
|
# }}}
|
# {{{ Version check
|
# {{{ Version check
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# ecosadmin.tcl requires at least version 8.0 of Tcl, since it makes use of
|
# ecosadmin.tcl requires at least version 8.0 of Tcl, since it makes use of
|
# namespaces. It is possible that some users still have older versions.
|
# namespaces. It is possible that some users still have older versions.
|
|
|
if { [info tclversion] < 8.0 } {
|
if { [info tclversion] < 8.0 } {
|
puts "This script requires Tcl 8.0 or later. You are running Tcl [info patchlevel]."
|
puts "This script requires Tcl 8.0 or later. You are running Tcl [info patchlevel]."
|
return
|
return
|
}
|
}
|
|
|
# }}}
|
# }}}
|
# {{{ Namespace definition
|
# {{{ Namespace definition
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Namespaces. All code and variables in this script are kept in the namespace
|
# Namespaces. All code and variables in this script are kept in the namespace
|
# "ecosadmin". This is not really necessary for stand-alone operation, but if it
|
# "ecosadmin". This is not really necessary for stand-alone operation, but if it
|
# ever becomes desirable to embed this script in a larger application then
|
# ever becomes desirable to embed this script in a larger application then
|
# using a namespace is a lot easier.
|
# using a namespace is a lot easier.
|
#
|
#
|
# As a fringe benefit, all global variables can be declared inside this
|
# As a fringe benefit, all global variables can be declared inside this
|
# namespace and initialised.
|
# namespace and initialised.
|
#
|
#
|
|
|
namespace eval ecosadmin {
|
namespace eval ecosadmin {
|
|
|
# Is this program running under Windows ?
|
# Is this program running under Windows ?
|
variable windows_host [expr {$tcl_platform(platform) == "windows"}]
|
variable windows_host [expr {$tcl_platform(platform) == "windows"}]
|
variable null_device ""
|
variable null_device ""
|
if { $windows_host != 0 } {
|
if { $windows_host != 0 } {
|
set ecosadmin::null_device "nul"
|
set ecosadmin::null_device "nul"
|
} else {
|
} else {
|
set ecosadmin::null_device "/dev/null"
|
set ecosadmin::null_device "/dev/null"
|
}
|
}
|
|
|
|
|
# Where is the component repository ? The following input sources
|
# Where is the component repository ? The following input sources
|
# are available:
|
# are available:
|
# 1) the environment variable ECOS_REPOSITORY.
|
# 1) the environment variable ECOS_REPOSITORY.
|
# 2) $argv0 should correspond to the location of the ecosadmin.tcl
|
# 2) $argv0 should correspond to the location of the ecosadmin.tcl
|
# script.
|
# script.
|
#
|
#
|
variable component_repository ""
|
variable component_repository ""
|
if { [info exists ::env(ECOS_REPOSITORY)] } {
|
if { [info exists ::env(ECOS_REPOSITORY)] } {
|
# override the calculation of the repository location using the
|
# override the calculation of the repository location using the
|
# (undocumented) ECOS_REPOSITORY environment variable
|
# (undocumented) ECOS_REPOSITORY environment variable
|
set component_repository $::env(ECOS_REPOSITORY)
|
set component_repository $::env(ECOS_REPOSITORY)
|
} else {
|
} else {
|
set component_repository [pwd]
|
set component_repository [pwd]
|
if { [file dirname $argv0] != "." } {
|
if { [file dirname $argv0] != "." } {
|
set component_repository [file join $component_repository [file dirname $argv0]]
|
set component_repository [file join $component_repository [file dirname $argv0]]
|
}
|
}
|
}
|
}
|
|
|
# Details of the command line arguments, if any.
|
# Details of the command line arguments, if any.
|
variable list_packages_arg 0; # list
|
variable list_packages_arg 0; # list
|
variable accept_license_arg 0; # --accept_license
|
variable accept_license_arg 0; # --accept_license
|
variable extract_license_arg 0; # --extract_license
|
variable extract_license_arg 0; # --extract_license
|
variable add_package ""; # add FILE
|
variable add_package ""; # add FILE
|
variable remove_package ""; # remove PACKAGE
|
variable remove_package ""; # remove PACKAGE
|
variable version_arg ""; # --version VER
|
variable version_arg ""; # --version VER
|
|
|
# Details of all known packages, targets and templates
|
# Details of all known packages, targets and templates
|
# read from the ecos.db file
|
# read from the ecos.db file
|
variable known_packages ""
|
variable known_packages ""
|
variable known_targets ""
|
variable known_targets ""
|
variable known_templates ""
|
variable known_templates ""
|
array set package_data {};
|
array set package_data {};
|
array set target_data {};
|
array set target_data {};
|
array set template_data {};
|
array set template_data {};
|
|
|
# What routines should be invoked for outputting fatal errors and
|
# What routines should be invoked for outputting fatal errors and
|
# for warning messages ?
|
# for warning messages ?
|
variable fatal_error_handler ecosadmin::cli_fatal_error
|
variable fatal_error_handler ecosadmin::cli_fatal_error
|
variable warning_handler ecosadmin::cli_warning
|
variable warning_handler ecosadmin::cli_warning
|
variable report_handler ecosadmin::cli_report
|
variable report_handler ecosadmin::cli_report
|
|
|
# Keep or remove the CVS directories?
|
# Keep or remove the CVS directories?
|
variable keep_cvs 0
|
variable keep_cvs 0
|
}
|
}
|
|
|
# }}}
|
# }}}
|
# {{{ Infrastructure
|
# {{{ Infrastructure
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Minimal infrastructure support.
|
# Minimal infrastructure support.
|
#
|
#
|
# There must be some way of reporting fatal errors, of outputting warnings,
|
# There must be some way of reporting fatal errors, of outputting warnings,
|
# and of generating report messages. The implementation of these things
|
# and of generating report messages. The implementation of these things
|
# obviously depends on whether or not TK is present. In addition, if this
|
# obviously depends on whether or not TK is present. In addition, if this
|
# script is being run inside a larger application then that larger
|
# script is being run inside a larger application then that larger
|
# application must be able to install its own versions of the routines.
|
# application must be able to install its own versions of the routines.
|
#
|
#
|
# Once it is possible to report fatal errors, an assertion facility becomes
|
# Once it is possible to report fatal errors, an assertion facility becomes
|
# feasible.
|
# feasible.
|
#
|
#
|
# These routines output fatal errors, warnings or miscellaneous messages.
|
# These routines output fatal errors, warnings or miscellaneous messages.
|
# Their implementations depend on the mode in which this script is operating.
|
# Their implementations depend on the mode in which this script is operating.
|
#
|
#
|
proc ecosadmin::fatal_error { msg } {
|
proc ecosadmin::fatal_error { msg } {
|
$ecosadmin::fatal_error_handler "$msg"
|
$ecosadmin::fatal_error_handler "$msg"
|
}
|
}
|
|
|
proc ecosadmin::warning { msg } {
|
proc ecosadmin::warning { msg } {
|
$ecosadmin::warning_handler "$msg"
|
$ecosadmin::warning_handler "$msg"
|
}
|
}
|
|
|
proc ecosadmin::report { msg } {
|
proc ecosadmin::report { msg } {
|
$ecosadmin::report_handler "$msg"
|
$ecosadmin::report_handler "$msg"
|
}
|
}
|
|
|
#
|
#
|
# Command line versions.
|
# Command line versions.
|
# NOTE: some formatting so that there are linebreaks at ~72 columns would be
|
# NOTE: some formatting so that there are linebreaks at ~72 columns would be
|
# a good idea.
|
# a good idea.
|
#
|
#
|
proc ecosadmin::cli_fatal_error_handler { msg } {
|
proc ecosadmin::cli_fatal_error_handler { msg } {
|
error "$msg"
|
error "$msg"
|
}
|
}
|
|
|
proc ecosadmin::cli_warning_handler { msg } {
|
proc ecosadmin::cli_warning_handler { msg } {
|
puts "ecosadmin warning: $msg"
|
puts "ecosadmin warning: $msg"
|
}
|
}
|
|
|
proc ecosadmin::cli_report_handler { msg } {
|
proc ecosadmin::cli_report_handler { msg } {
|
puts "$msg"
|
puts "$msg"
|
}
|
}
|
|
|
#
|
#
|
# Determine the default destination for warnings and for fatal errors.
|
# Determine the default destination for warnings and for fatal errors.
|
# After the first call to this function it is possible to use assertions.
|
# After the first call to this function it is possible to use assertions.
|
#
|
#
|
proc ecosadmin::initialise_error_handling { } {
|
proc ecosadmin::initialise_error_handling { } {
|
set ecosadmin::fatal_error_handler ecosadmin::cli_fatal_error_handler
|
set ecosadmin::fatal_error_handler ecosadmin::cli_fatal_error_handler
|
set ecosadmin::warning_handler ecosadmin::cli_warning_handler
|
set ecosadmin::warning_handler ecosadmin::cli_warning_handler
|
set ecosadmin::report_handler ecosadmin::cli_report_handler
|
set ecosadmin::report_handler ecosadmin::cli_report_handler
|
}
|
}
|
|
|
#
|
#
|
# These routines can be used by containing programs to provide their
|
# These routines can be used by containing programs to provide their
|
# own error handling.
|
# own error handling.
|
#
|
#
|
proc ecosadmin::set_fatal_error_handler { fn } {
|
proc ecosadmin::set_fatal_error_handler { fn } {
|
ASSERT { $fn != "" }
|
ASSERT { $fn != "" }
|
set ecosadmin::fatal_error_handler $fn
|
set ecosadmin::fatal_error_handler $fn
|
}
|
}
|
|
|
proc ecosadmin::set_warning_handler { fn } {
|
proc ecosadmin::set_warning_handler { fn } {
|
ASSERT { $fn != "" }
|
ASSERT { $fn != "" }
|
set ecosadmin::warning_handler $fn
|
set ecosadmin::warning_handler $fn
|
}
|
}
|
|
|
proc ecosadmin::set_report_handler { fn } {
|
proc ecosadmin::set_report_handler { fn } {
|
ASSERT { $fn != "" }
|
ASSERT { $fn != "" }
|
set ecosadmin::report_handler $fn
|
set ecosadmin::report_handler $fn
|
}
|
}
|
|
|
#
|
#
|
# A very simple assertion facility. It takes a single argument, an expression
|
# A very simple assertion facility. It takes a single argument, an expression
|
# that should be evaluated in the calling function's scope, and on failure it
|
# that should be evaluated in the calling function's scope, and on failure it
|
# should generate a fatal error.
|
# should generate a fatal error.
|
#
|
#
|
proc ecosadmin::ASSERT { condition } {
|
proc ecosadmin::ASSERT { condition } {
|
set result [uplevel 1 [list expr $condition]]
|
set result [uplevel 1 [list expr $condition]]
|
|
|
if { $result == 0 } {
|
if { $result == 0 } {
|
fatal_error "assertion predicate \"$condition\"\nin \"[info level -1]\""
|
fatal_error "assertion predicate \"$condition\"\nin \"[info level -1]\""
|
}
|
}
|
}
|
}
|
|
|
# }}}
|
# }}}
|
# {{{ Utilities
|
# {{{ Utilities
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# cdl_compare_version. This is a partial implementation of the full
|
# cdl_compare_version. This is a partial implementation of the full
|
# cdl_compare_version facility defined in the product specification. Its
|
# cdl_compare_version facility defined in the product specification. Its
|
# purpose is to order the various versions of a given package with
|
# purpose is to order the various versions of a given package with
|
# the most recent version first. As a special case, "current" is
|
# the most recent version first. As a special case, "current" is
|
# always considered the most recent.
|
# always considered the most recent.
|
#
|
#
|
# There are similarities between cdl_compare_version and with Tcl's
|
# There are similarities between cdl_compare_version and with Tcl's
|
# package vcompare, but cdl_compare_version is more general.
|
# package vcompare, but cdl_compare_version is more general.
|
#
|
#
|
|
|
proc ecosadmin::cdl_compare_version { arg1 arg2 } {
|
proc ecosadmin::cdl_compare_version { arg1 arg2 } {
|
|
|
if { $arg1 == $arg2 } {
|
if { $arg1 == $arg2 } {
|
return 0
|
return 0
|
}
|
}
|
if { $arg1 == "current"} {
|
if { $arg1 == "current"} {
|
return -1
|
return -1
|
}
|
}
|
if { $arg2 == "current" } {
|
if { $arg2 == "current" } {
|
return 1
|
return 1
|
}
|
}
|
|
|
set index1 0
|
set index1 0
|
set index2 0
|
set index2 0
|
set ch1 ""
|
set ch1 ""
|
set ch2 ""
|
set ch2 ""
|
set num1 ""
|
set num1 ""
|
set num2 ""
|
set num2 ""
|
|
|
while { 1 } {
|
while { 1 } {
|
|
|
set ch1 [string index $arg1 $index1]
|
set ch1 [string index $arg1 $index1]
|
set ch2 [string index $arg2 $index2]
|
set ch2 [string index $arg2 $index2]
|
set num1 ""
|
set num1 ""
|
set num2 ""
|
set num2 ""
|
|
|
if { ($ch1 == "") && ($ch2 == "") } {
|
if { ($ch1 == "") && ($ch2 == "") } {
|
|
|
# Both strings have terminated at the same time. There may have
|
# Both strings have terminated at the same time. There may have
|
# been some spurious leading zeroes in numbers.
|
# been some spurious leading zeroes in numbers.
|
return 0
|
return 0
|
|
|
} elseif { $ch1 == "" } {
|
} elseif { $ch1 == "" } {
|
|
|
# The first string has ended first. If ch2 is a separator then
|
# The first string has ended first. If ch2 is a separator then
|
# arg2 is a derived version, e.g. v0.3.p1 and hence newer. Otherwise ch2
|
# arg2 is a derived version, e.g. v0.3.p1 and hence newer. Otherwise ch2
|
# is an experimental version v0.3beta and hence older.
|
# is an experimental version v0.3beta and hence older.
|
if { [string match \[-._\] $ch2] } {
|
if { [string match \[-._\] $ch2] } {
|
return 1
|
return 1
|
} else {
|
} else {
|
return -1
|
return -1
|
}
|
}
|
} elseif { $ch2 == "" } {
|
} elseif { $ch2 == "" } {
|
|
|
# Equivalent to the above.
|
# Equivalent to the above.
|
if { [string match \[-._\] $ch1] } {
|
if { [string match \[-._\] $ch1] } {
|
return -1
|
return -1
|
} else {
|
} else {
|
return 1
|
return 1
|
}
|
}
|
}
|
}
|
|
|
# There is still data to be processed.
|
# There is still data to be processed.
|
# Check for both strings containing numbers at the current index.
|
# Check for both strings containing numbers at the current index.
|
if { ( [string match \[0-9\] $ch1] ) && ( [string match \[0-9\] $ch2] ) } {
|
if { ( [string match \[0-9\] $ch1] ) && ( [string match \[0-9\] $ch2] ) } {
|
|
|
# Extract the entire numbers from the version string.
|
# Extract the entire numbers from the version string.
|
while { [string match \[0-9\] $ch1] } {
|
while { [string match \[0-9\] $ch1] } {
|
set num1 "$num1$ch1"
|
set num1 "$num1$ch1"
|
incr index1
|
incr index1
|
set ch1 [string index $arg1 $index1]
|
set ch1 [string index $arg1 $index1]
|
}
|
}
|
while { [string match \[0-9\] $ch2] } {
|
while { [string match \[0-9\] $ch2] } {
|
set num2 "$num2$ch2"
|
set num2 "$num2$ch2"
|
incr index2
|
incr index2
|
set ch2 [string index $arg2 $index2]
|
set ch2 [string index $arg2 $index2]
|
}
|
}
|
|
|
if { $num1 < $num2 } {
|
if { $num1 < $num2 } {
|
return 1
|
return 1
|
} elseif { $num1 > $num2 } {
|
} elseif { $num1 > $num2 } {
|
return -1
|
return -1
|
}
|
}
|
continue
|
continue
|
}
|
}
|
|
|
# This is not numerical data. If the two characters are the same then
|
# This is not numerical data. If the two characters are the same then
|
# move on.
|
# move on.
|
if { $ch1 == $ch2 } {
|
if { $ch1 == $ch2 } {
|
incr index1
|
incr index1
|
incr index2
|
incr index2
|
continue
|
continue
|
}
|
}
|
|
|
# Next check if both strings are at a separator. All separators can be
|
# Next check if both strings are at a separator. All separators can be
|
# used interchangeably.
|
# used interchangeably.
|
if { ( [string match \[-._\] $ch1] ) && ( [string match \[-._\] $ch2] ) } {
|
if { ( [string match \[-._\] $ch1] ) && ( [string match \[-._\] $ch2] ) } {
|
incr index1
|
incr index1
|
incr index2
|
incr index2
|
continue
|
continue
|
}
|
}
|
|
|
# There are differences in the characters and they are not interchangeable.
|
# There are differences in the characters and they are not interchangeable.
|
# Just return a standard string comparison.
|
# Just return a standard string comparison.
|
return [string compare $ch1 $ch2]
|
return [string compare $ch1 $ch2]
|
}
|
}
|
}
|
}
|
|
|
# }}}
|
# }}}
|
# {{{ Argument parsing
|
# {{{ Argument parsing
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# The argv0 argument should be the name of this script. It can be used
|
# The argv0 argument should be the name of this script. It can be used
|
# to get at the component repository location. If this script has been
|
# to get at the component repository location. If this script has been
|
# run incorrectly then currently it will fail: in future it may be
|
# run incorrectly then currently it will fail: in future it may be
|
# desirable to check an environment variable instead.
|
# desirable to check an environment variable instead.
|
#
|
#
|
# The argv argument is a string containing the rest of the arguments.
|
# The argv argument is a string containing the rest of the arguments.
|
# If any of the arguments contain spaces then this argument will be
|
# If any of the arguments contain spaces then this argument will be
|
# surrounded by braces. If any of the arguments contain braces then
|
# surrounded by braces. If any of the arguments contain braces then
|
# things will break.
|
# things will break.
|
#
|
#
|
|
|
proc ecosadmin::parse_arguments { argv0 argv } {
|
proc ecosadmin::parse_arguments { argv0 argv } {
|
|
|
if { $argv != "" } {
|
if { $argv != "" } {
|
|
|
# There are arguments. If any of the arguments contained
|
# There are arguments. If any of the arguments contained
|
# spaces then these arguments will have been surrounded
|
# spaces then these arguments will have been surrounded
|
# by braces, which is a nuisance. So start by turning the
|
# by braces, which is a nuisance. So start by turning the
|
# arguments into a numerically indexed array.
|
# arguments into a numerically indexed array.
|
|
|
set argc 0
|
set argc 0
|
array set args { }
|
array set args { }
|
foreach arg $argv {
|
foreach arg $argv {
|
set args([incr argc]) $arg
|
set args([incr argc]) $arg
|
}
|
}
|
|
|
# Now examine each argument with regular expressions. It is
|
# Now examine each argument with regular expressions. It is
|
# useful to have some variables filled in by the regexp
|
# useful to have some variables filled in by the regexp
|
# matching.
|
# matching.
|
set dummy ""
|
set dummy ""
|
set match1 ""
|
set match1 ""
|
set match2 ""
|
set match2 ""
|
for { set i 1 } { $i <= $argc } { incr i } {
|
for { set i 1 } { $i <= $argc } { incr i } {
|
|
|
# Check for --list and the other simple ones.
|
# Check for --list and the other simple ones.
|
if { [regexp -- {^-?-?list$} $args($i)] == 1 } {
|
if { [regexp -- {^-?-?list$} $args($i)] == 1 } {
|
set ecosadmin::list_packages_arg 1
|
set ecosadmin::list_packages_arg 1
|
continue
|
continue
|
}
|
}
|
|
|
# check for --version
|
# check for --version
|
if { [regexp -- {^-?-version=?(.*)$} $args($i) dummy match1] == 1 } {
|
if { [regexp -- {^-?-version=?(.*)$} $args($i) dummy match1] == 1 } {
|
if { $match1 != "" } {
|
if { $match1 != "" } {
|
set ecosadmin::version_arg $match1
|
set ecosadmin::version_arg $match1
|
} else {
|
} else {
|
if { $i == $argc } {
|
if { $i == $argc } {
|
fatal_error "missing argument after --version"
|
fatal_error "missing argument after --version"
|
} else {
|
} else {
|
set ecosadmin::version_arg $args([incr i])
|
set ecosadmin::version_arg $args([incr i])
|
}
|
}
|
}
|
}
|
continue
|
continue
|
}
|
}
|
|
|
# check for --accept_license
|
# check for --accept_license
|
if { [regexp -- {^-?-accept_license$} $args($i)] == 1 } {
|
if { [regexp -- {^-?-accept_license$} $args($i)] == 1 } {
|
set ecosadmin::accept_license_arg 1
|
set ecosadmin::accept_license_arg 1
|
continue
|
continue
|
}
|
}
|
|
|
# check for --extract_license
|
# check for --extract_license
|
if { [regexp -- {^-?-extract_license$} $args($i)] == 1 } {
|
if { [regexp -- {^-?-extract_license$} $args($i)] == 1 } {
|
set ecosadmin::extract_license_arg 1
|
set ecosadmin::extract_license_arg 1
|
continue
|
continue
|
}
|
}
|
|
|
# check for the add command
|
# check for the add command
|
if { [regexp -- {^-?-?add=?(.*)$} $args($i) dummy match1] == 1 } {
|
if { [regexp -- {^-?-?add=?(.*)$} $args($i) dummy match1] == 1 } {
|
if { $match1 != "" } {
|
if { $match1 != "" } {
|
set ecosadmin::add_package $match1
|
set ecosadmin::add_package $match1
|
} else {
|
} else {
|
if { $i == $argc } {
|
if { $i == $argc } {
|
fatal_error "missing argument after add"
|
fatal_error "missing argument after add"
|
} else {
|
} else {
|
set ecosadmin::add_package $args([incr i])
|
set ecosadmin::add_package $args([incr i])
|
}
|
}
|
}
|
}
|
continue
|
continue
|
}
|
}
|
|
|
# check for the remove command
|
# check for the remove command
|
if { [regexp -- {^-?-?remove=?(.*)$} $args($i) dummy match1] == 1 } {
|
if { [regexp -- {^-?-?remove=?(.*)$} $args($i) dummy match1] == 1 } {
|
if { $match1 != "" } {
|
if { $match1 != "" } {
|
set ecosadmin::remove_package $match1
|
set ecosadmin::remove_package $match1
|
} else {
|
} else {
|
if { $i == $argc } {
|
if { $i == $argc } {
|
fatal_error "missing argument after remove"
|
fatal_error "missing argument after remove"
|
} else {
|
} else {
|
set ecosadmin::remove_package $args([incr i])
|
set ecosadmin::remove_package $args([incr i])
|
}
|
}
|
}
|
}
|
continue
|
continue
|
}
|
}
|
|
|
# Check for --srcdir
|
# Check for --srcdir
|
if { [regexp -- {^-?-srcdir=?([ \.\\/:_a-zA-Z0-9-]*)$} $args($i) dummy match1] == 1 } {
|
if { [regexp -- {^-?-srcdir=?([ \.\\/:_a-zA-Z0-9-]*)$} $args($i) dummy match1] == 1 } {
|
if { $match1 == "" } {
|
if { $match1 == "" } {
|
if { $i == $argc } {
|
if { $i == $argc } {
|
puts "ecosrelease: missing argument after --srcdir"
|
puts "ecosrelease: missing argument after --srcdir"
|
exit 1
|
exit 1
|
} else {
|
} else {
|
set match1 $args([incr i])
|
set match1 $args([incr i])
|
}
|
}
|
}
|
}
|
set ecosadmin::component_repository $match1
|
set ecosadmin::component_repository $match1
|
continue
|
continue
|
}
|
}
|
|
|
# An unrecognised argument.
|
# An unrecognised argument.
|
fatal_error "invalid argument $args($i)"
|
fatal_error "invalid argument $args($i)"
|
}
|
}
|
}
|
}
|
|
|
# Convert user-specified UNIX-style Cygwin pathnames to Windows Tcl-style as necessary
|
# Convert user-specified UNIX-style Cygwin pathnames to Windows Tcl-style as necessary
|
set ecosadmin::component_repository [get_pathname_for_tcl $ecosadmin::component_repository]
|
set ecosadmin::component_repository [get_pathname_for_tcl $ecosadmin::component_repository]
|
set ecosadmin::add_package [get_pathname_for_tcl $ecosadmin::add_package]
|
set ecosadmin::add_package [get_pathname_for_tcl $ecosadmin::add_package]
|
}
|
}
|
|
|
#
|
#
|
# Display help information if the user has typed --help, -H, --H, or -help.
|
# Display help information if the user has typed --help, -H, --H, or -help.
|
# The help text uses two hyphens for consistency with configure.
|
# The help text uses two hyphens for consistency with configure.
|
# Arguably this should change.
|
# Arguably this should change.
|
|
|
proc ecosadmin::argument_help { } {
|
proc ecosadmin::argument_help { } {
|
|
|
puts "Usage: ecosadmin \[ command \]"
|
puts "Usage: ecosadmin \[ command \]"
|
puts " commands are:"
|
puts " commands are:"
|
puts " list : list packages"
|
puts " list : list packages"
|
puts " add FILE : add packages"
|
puts " add FILE : add packages"
|
puts " remove PACKAGE \[ --version VER \] : remove a package"
|
puts " remove PACKAGE \[ --version VER \] : remove a package"
|
}
|
}
|
|
|
# }}}
|
# }}}
|
# {{{ Packages file
|
# {{{ Packages file
|
|
|
proc ecosadmin::read_data { } {
|
proc ecosadmin::read_data { } {
|
|
|
ASSERT { $ecosadmin::component_repository != "" }
|
ASSERT { $ecosadmin::component_repository != "" }
|
|
|
set ecosadmin::known_packages ""
|
set ecosadmin::known_packages ""
|
set ecosadmin::known_targets ""
|
set ecosadmin::known_targets ""
|
set ecosadmin::known_templates ""
|
set ecosadmin::known_templates ""
|
|
|
# A safe interpreter is used to process the packages file.
|
# A safe interpreter is used to process the packages file.
|
# This is somewhat overcautious, but it is also harmless.
|
# This is somewhat overcautious, but it is also harmless.
|
# The following two commands are made accessible to the slave
|
# The following two commands are made accessible to the slave
|
# interpreter and are responsible for updating the actual data.
|
# interpreter and are responsible for updating the actual data.
|
proc add_known_package { name } {
|
proc add_known_package { name } {
|
lappend ::ecosadmin::known_packages $name
|
lappend ::ecosadmin::known_packages $name
|
}
|
}
|
proc add_known_target { name } {
|
proc add_known_target { name } {
|
lappend ::ecosadmin::known_targets $name
|
lappend ::ecosadmin::known_targets $name
|
}
|
}
|
proc add_known_template { name } {
|
proc add_known_template { name } {
|
lappend ::ecosadmin::known_templates $name
|
lappend ::ecosadmin::known_templates $name
|
}
|
}
|
proc set_package_data { name value } {
|
proc set_package_data { name value } {
|
set ::ecosadmin::package_data($name) $value
|
set ::ecosadmin::package_data($name) $value
|
}
|
}
|
proc set_target_data { name value } {
|
proc set_target_data { name value } {
|
set ::ecosadmin::target_data($name) $value
|
set ::ecosadmin::target_data($name) $value
|
}
|
}
|
proc set_template_data { name value } {
|
proc set_template_data { name value } {
|
set ::ecosadmin::template_data($name) $value
|
set ::ecosadmin::template_data($name) $value
|
}
|
}
|
|
|
# Create the parser, add the aliased commands, and then define
|
# Create the parser, add the aliased commands, and then define
|
# the routines that do the real work.
|
# the routines that do the real work.
|
set parser [interp create -safe]
|
set parser [interp create -safe]
|
$parser alias add_known_package ecosadmin::add_known_package
|
$parser alias add_known_package ecosadmin::add_known_package
|
$parser alias add_known_target ecosadmin::add_known_target
|
$parser alias add_known_target ecosadmin::add_known_target
|
$parser alias add_known_template ecosadmin::add_known_template
|
$parser alias add_known_template ecosadmin::add_known_template
|
$parser alias set_package_data ecosadmin::set_package_data
|
$parser alias set_package_data ecosadmin::set_package_data
|
$parser alias set_target_data ecosadmin::set_target_data
|
$parser alias set_target_data ecosadmin::set_target_data
|
$parser alias set_template_data ecosadmin::set_template_data
|
$parser alias set_template_data ecosadmin::set_template_data
|
|
|
$parser eval {
|
$parser eval {
|
|
|
set current_package ""
|
set current_package ""
|
set current_target ""
|
set current_target ""
|
set current_template ""
|
set current_template ""
|
|
|
proc package { name body } {
|
proc package { name body } {
|
add_known_package $name
|
add_known_package $name
|
set_package_data "$name,alias" ""
|
set_package_data "$name,alias" ""
|
set_package_data "$name,versions" ""
|
set_package_data "$name,versions" ""
|
set_package_data "$name,dir" ""
|
set_package_data "$name,dir" ""
|
set ::current_package $name
|
set ::current_package $name
|
eval $body
|
eval $body
|
set ::current_package ""
|
set ::current_package ""
|
}
|
}
|
|
|
proc target { name body } {
|
proc target { name body } {
|
add_known_target $name
|
add_known_target $name
|
set_target_data "$name,packages" ""
|
set_target_data "$name,packages" ""
|
set ::current_target $name
|
set ::current_target $name
|
eval $body
|
eval $body
|
set ::current_target ""
|
set ::current_target ""
|
}
|
}
|
|
|
#if 0
|
#if 0
|
# templates are no longer specified in the package database
|
# templates are no longer specified in the package database
|
proc template { name body } {
|
proc template { name body } {
|
add_known_template $name
|
add_known_template $name
|
set_template_data "$name,packages" ""
|
set_template_data "$name,packages" ""
|
set ::current_template $name
|
set ::current_template $name
|
eval $body
|
eval $body
|
set ::current_template ""
|
set ::current_template ""
|
}
|
}
|
#endif
|
#endif
|
|
|
proc packages { str } {
|
proc packages { str } {
|
if { $::current_template != "" } {
|
if { $::current_template != "" } {
|
set_template_data "$::current_template,packages" $str
|
set_template_data "$::current_template,packages" $str
|
} elseif { $::current_target != "" } {
|
} elseif { $::current_target != "" } {
|
set_target_data "$::current_target,packages" $str
|
set_target_data "$::current_target,packages" $str
|
} else {
|
} else {
|
ASSERT 0
|
ASSERT 0
|
}
|
}
|
}
|
}
|
|
|
proc directory { dir } {
|
proc directory { dir } {
|
set_package_data "$::current_package,dir" $dir
|
set_package_data "$::current_package,dir" $dir
|
}
|
}
|
|
|
proc alias { str } {
|
proc alias { str } {
|
if { $::current_package != "" } {
|
if { $::current_package != "" } {
|
set_package_data "$::current_package,alias" $str
|
set_package_data "$::current_package,alias" $str
|
}
|
}
|
}
|
}
|
|
|
proc description { str } { }
|
proc description { str } { }
|
proc disable { str } { }
|
proc disable { str } { }
|
proc enable { str } { }
|
proc enable { str } { }
|
proc hardware { } { }
|
proc hardware { } { }
|
proc script { str } { }
|
proc script { str } { }
|
proc set_value { str1 str2 } { }
|
proc set_value { str1 str2 } { }
|
}
|
}
|
|
|
# The parser is ready to evaluate the script. To avoid having to give the
|
# The parser is ready to evaluate the script. To avoid having to give the
|
# safe interpreter file I/O capabilities, the file is actually read in
|
# safe interpreter file I/O capabilities, the file is actually read in
|
# here and then evaluated.
|
# here and then evaluated.
|
set filename [file join $ecosadmin::component_repository "ecos.db"]
|
set filename [file join $ecosadmin::component_repository "ecos.db"]
|
set status [ catch {
|
set status [ catch {
|
set fd [open $filename r]
|
set fd [open $filename r]
|
set script [read $fd]
|
set script [read $fd]
|
close $fd
|
close $fd
|
$parser eval $script
|
$parser eval $script
|
} message ]
|
} message ]
|
|
|
if { $status != 0 } {
|
if { $status != 0 } {
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
}
|
}
|
|
|
# The interpreter and the aliased commands are no longer required.
|
# The interpreter and the aliased commands are no longer required.
|
rename set_package_data {}
|
rename set_package_data {}
|
rename set_target_data {}
|
rename set_target_data {}
|
rename set_template_data {}
|
rename set_template_data {}
|
rename add_known_package {}
|
rename add_known_package {}
|
interp delete $parser
|
interp delete $parser
|
|
|
# At this stage the packages file has been read in. It is a good idea to
|
# At this stage the packages file has been read in. It is a good idea to
|
# check that all of these packages are present and correct, and incidentally
|
# check that all of these packages are present and correct, and incidentally
|
# figure out which versions are present.
|
# figure out which versions are present.
|
foreach pkg $ecosadmin::known_packages {
|
foreach pkg $ecosadmin::known_packages {
|
|
|
set pkgdir [file join $ecosadmin::component_repository $ecosadmin::package_data($pkg,dir)]
|
set pkgdir [file join $ecosadmin::component_repository $ecosadmin::package_data($pkg,dir)]
|
if { ![file exists $pkgdir] || ![file isdir $pkgdir] } {
|
if { ![file exists $pkgdir] || ![file isdir $pkgdir] } {
|
warning "package $pkg at $pkgdir missing"
|
warning "package $pkg at $pkgdir missing"
|
} else {
|
} else {
|
|
|
# Each subdirectory should correspond to a release. A utility routine
|
# Each subdirectory should correspond to a release. A utility routine
|
# is available for this.
|
# is available for this.
|
set ecosadmin::package_data($pkg,versions) [locate_subdirs $pkgdir]
|
set ecosadmin::package_data($pkg,versions) [locate_subdirs $pkgdir]
|
if { $ecosadmin::package_data($pkg,versions) == "" } {
|
if { $ecosadmin::package_data($pkg,versions) == "" } {
|
fatal_error "package $pkg has no version directories"
|
fatal_error "package $pkg has no version directories"
|
}
|
}
|
}
|
}
|
|
|
# Sort all the versions using a version-aware comparison version
|
# Sort all the versions using a version-aware comparison version
|
set ecosadmin::package_data($pkg,versions) [
|
set ecosadmin::package_data($pkg,versions) [
|
lsort -command ecosadmin::cdl_compare_version $ecosadmin::package_data($pkg,versions)
|
lsort -command ecosadmin::cdl_compare_version $ecosadmin::package_data($pkg,versions)
|
]
|
]
|
}
|
}
|
}
|
}
|
|
|
#
|
#
|
# Given a package name as supplied by the user, return the internal package name.
|
# Given a package name as supplied by the user, return the internal package name.
|
# This involves searching through the list of aliases.
|
# This involves searching through the list of aliases.
|
#
|
#
|
proc ecosadmin::find_package { name } {
|
proc ecosadmin::find_package { name } {
|
|
|
foreach pkg $ecosadmin::known_packages {
|
foreach pkg $ecosadmin::known_packages {
|
if { [string toupper $pkg] == [string toupper $name] } {
|
if { [string toupper $pkg] == [string toupper $name] } {
|
return $pkg
|
return $pkg
|
}
|
}
|
|
|
foreach alias $ecosadmin::package_data($pkg,alias) {
|
foreach alias $ecosadmin::package_data($pkg,alias) {
|
if { [string toupper $alias] == [string toupper $name] } {
|
if { [string toupper $alias] == [string toupper $name] } {
|
return $pkg
|
return $pkg
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
return ""
|
return ""
|
}
|
}
|
|
|
# }}}
|
# }}}
|
# {{{ Directory and file utilities
|
# {{{ Directory and file utilities
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Start with a number of utility routines to access all files in
|
# Start with a number of utility routines to access all files in
|
# a directory, stripping out well-known files such as makefile.am.
|
# a directory, stripping out well-known files such as makefile.am.
|
# The routines take an optional pattern argument if only certain
|
# The routines take an optional pattern argument if only certain
|
# files are of interest.
|
# files are of interest.
|
#
|
#
|
# Note that symbolic links are returned as well as files.
|
# Note that symbolic links are returned as well as files.
|
#
|
#
|
proc ecosadmin::locate_files { dir { pattern "*"} } {
|
proc ecosadmin::locate_files { dir { pattern "*"} } {
|
|
|
ASSERT { $dir != "" }
|
ASSERT { $dir != "" }
|
|
|
# Start by getting a list of all the files.
|
# Start by getting a list of all the files.
|
set filelist [glob -nocomplain -- [file join $dir $pattern]]
|
set filelist [glob -nocomplain -- [file join $dir $pattern]]
|
|
|
if { $pattern == "*" } {
|
if { $pattern == "*" } {
|
# For "everything", include ".*" files, but excluding .
|
# For "everything", include ".*" files, but excluding .
|
# and .. directories
|
# and .. directories
|
lappend filelist [glob -nocomplain -- [file join $dir ".\[a-zA-Z0-9\]*"]]
|
lappend filelist [glob -nocomplain -- [file join $dir ".\[a-zA-Z0-9\]*"]]
|
}
|
}
|
|
|
# Eliminate the pathnames from all of these files
|
# Eliminate the pathnames from all of these files
|
set filenames ""
|
set filenames ""
|
foreach file $filelist {
|
foreach file $filelist {
|
if { [string range $file end end] != "~" } {
|
if { [string range $file end end] != "~" } {
|
lappend filenames [file tail $file]
|
lappend filenames [file tail $file]
|
}
|
}
|
}
|
}
|
|
|
# Eliminate any subdirectories.
|
# Eliminate any subdirectories.
|
set subdirs ""
|
set subdirs ""
|
foreach name $filenames {
|
foreach name $filenames {
|
if { [file isdir [file join $dir $name]] } {
|
if { [file isdir [file join $dir $name]] } {
|
lappend subdirs $name
|
lappend subdirs $name
|
}
|
}
|
}
|
}
|
foreach subdir $subdirs {
|
foreach subdir $subdirs {
|
set index [lsearch -exact $filenames $subdir]
|
set index [lsearch -exact $filenames $subdir]
|
set filenames [lreplace $filenames $index $index]
|
set filenames [lreplace $filenames $index $index]
|
}
|
}
|
|
|
return $filenames
|
return $filenames
|
}
|
}
|
|
|
#
|
#
|
# This utility returns all sub-directories, as opposed to all files.
|
# This utility returns all sub-directories, as opposed to all files.
|
# A variant glob pattern is used here. This version is not recursive.
|
# A variant glob pattern is used here. This version is not recursive.
|
proc ecosadmin::locate_subdirs { dir { pattern "*" }} {
|
proc ecosadmin::locate_subdirs { dir { pattern "*" }} {
|
|
|
ASSERT { $dir != "" }
|
ASSERT { $dir != "" }
|
|
|
set dirlist [glob -nocomplain -- [file join $dir $pattern "."]]
|
set dirlist [glob -nocomplain -- [file join $dir $pattern "."]]
|
|
|
# Eliminate the pathnames and the spurious /. at the end of each entry
|
# Eliminate the pathnames and the spurious /. at the end of each entry
|
set dirnames ""
|
set dirnames ""
|
foreach dir $dirlist {
|
foreach dir $dirlist {
|
lappend dirnames [file tail [file dirname $dir]]
|
lappend dirnames [file tail [file dirname $dir]]
|
}
|
}
|
|
|
# Get rid of the CVS directory, if any
|
# Get rid of the CVS directory, if any
|
if { $ecosadmin::keep_cvs == 0 } {
|
if { $ecosadmin::keep_cvs == 0 } {
|
set index [lsearch -exact $dirnames "CVS"]
|
set index [lsearch -exact $dirnames "CVS"]
|
if { $index != -1 } {
|
if { $index != -1 } {
|
set dirnames [lreplace $dirnames $index $index]
|
set dirnames [lreplace $dirnames $index $index]
|
}
|
}
|
}
|
}
|
|
|
# That should be it.
|
# That should be it.
|
return $dirnames
|
return $dirnames
|
}
|
}
|
|
|
#
|
#
|
# A variant which is recursive. This one does not support a pattern.
|
# A variant which is recursive. This one does not support a pattern.
|
#
|
#
|
proc ecosadmin::locate_all_subdirs { dir } {
|
proc ecosadmin::locate_all_subdirs { dir } {
|
|
|
ASSERT { $dir != "" }
|
ASSERT { $dir != "" }
|
|
|
set result ""
|
set result ""
|
foreach subdir [locate_subdirs $dir] {
|
foreach subdir [locate_subdirs $dir] {
|
lappend result $subdir
|
lappend result $subdir
|
foreach x [locate_all_subdirs [file join $dir $subdir]] {
|
foreach x [locate_all_subdirs [file join $dir $subdir]] {
|
lappend result [file join $subdir $x]
|
lappend result [file join $subdir $x]
|
}
|
}
|
}
|
}
|
return $result
|
return $result
|
}
|
}
|
|
|
#
|
#
|
# This routine returns a list of all the files in a given directory and in
|
# This routine returns a list of all the files in a given directory and in
|
# all subdirectories, preserving the subdirectory name.
|
# all subdirectories, preserving the subdirectory name.
|
#
|
#
|
proc ecosadmin::locate_all_files { dir { pattern "*" } } {
|
proc ecosadmin::locate_all_files { dir { pattern "*" } } {
|
|
|
ASSERT { $dir != "" }
|
ASSERT { $dir != "" }
|
|
|
set files [locate_files $dir $pattern]
|
set files [locate_files $dir $pattern]
|
set subdirs [locate_subdirs $dir]
|
set subdirs [locate_subdirs $dir]
|
|
|
foreach subdir $subdirs {
|
foreach subdir $subdirs {
|
set subfiles [locate_all_files [file join $dir $subdir] $pattern]
|
set subfiles [locate_all_files [file join $dir $subdir] $pattern]
|
foreach file $subfiles {
|
foreach file $subfiles {
|
lappend files [file join $subdir $file]
|
lappend files [file join $subdir $file]
|
}
|
}
|
}
|
}
|
|
|
return $files
|
return $files
|
}
|
}
|
|
|
#
|
#
|
# Sometimes a directory may be empty, or contain just a CVS subdirectory,
|
# Sometimes a directory may be empty, or contain just a CVS subdirectory,
|
# in which case there is no point in copying it across.
|
# in which case there is no point in copying it across.
|
#
|
#
|
proc ecosadmin::is_empty_directory { dir } {
|
proc ecosadmin::is_empty_directory { dir } {
|
|
|
ASSERT { $dir != "" }
|
ASSERT { $dir != "" }
|
|
|
set contents [glob -nocomplain -- [file join $dir "*"]]
|
set contents [glob -nocomplain -- [file join $dir "*"]]
|
if { [llength $contents] == 0 } {
|
if { [llength $contents] == 0 } {
|
return 1
|
return 1
|
}
|
}
|
if { ([llength $contents] == 1) && [string match {*CVS} $contents] } {
|
if { ([llength $contents] == 1) && [string match {*CVS} $contents] } {
|
return 1
|
return 1
|
}
|
}
|
return 0
|
return 0
|
}
|
}
|
|
|
#
|
#
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Take a cygwin32 filename such as //d/tmp/pkgobj and turn it into something
|
# Take a cygwin32 filename such as //d/tmp/pkgobj and turn it into something
|
# acceptable to Tcl, i.e. d:/tmp/pkgobj. There are a few other complications...
|
# acceptable to Tcl, i.e. d:/tmp/pkgobj. There are a few other complications...
|
|
|
proc ecosadmin::get_pathname_for_tcl { name } {
|
proc ecosadmin::get_pathname_for_tcl { name } {
|
|
|
if { ( $ecosadmin::windows_host ) && ( $name != "" ) } {
|
if { ( $ecosadmin::windows_host ) && ( $name != "" ) } {
|
|
|
# If there is no logical drive letter specified
|
# If there is no logical drive letter specified
|
if { [ string match "?:*" $name ] == 0 } {
|
if { [ string match "?:*" $name ] == 0 } {
|
|
|
# Invoke cygpath to resolve the POSIX-style path
|
# Invoke cygpath to resolve the POSIX-style path
|
if { [ catch { exec cygpath -w $name } result ] != 0 } {
|
if { [ catch { exec cygpath -w $name } result ] != 0 } {
|
fatal_error "processing filepath $name:\n$result"
|
fatal_error "processing filepath $name:\n$result"
|
}
|
}
|
} else {
|
} else {
|
set result $name
|
set result $name
|
}
|
}
|
|
|
# Convert backslashes to forward slashes
|
# Convert backslashes to forward slashes
|
regsub -all -- {\\} $result "/" name
|
regsub -all -- {\\} $result "/" name
|
}
|
}
|
|
|
return $name
|
return $name
|
}
|
}
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Make sure that a newly created or copied file is writable. This operation
|
# Make sure that a newly created or copied file is writable. This operation
|
# is platform-specific. Under Unix at most the current user is given
|
# is platform-specific. Under Unix at most the current user is given
|
# permission, since there does not seem to be any easy way to get hold
|
# permission, since there does not seem to be any easy way to get hold
|
# of the real umask.
|
# of the real umask.
|
|
|
proc ecosadmin::make_writable { name } {
|
proc ecosadmin::make_writable { name } {
|
|
|
ASSERT { $name != "" }
|
ASSERT { $name != "" }
|
ASSERT { [file isfile $name] }
|
ASSERT { [file isfile $name] }
|
|
|
if { [file writable $name] == 0 } {
|
if { [file writable $name] == 0 } {
|
if { $ecosadmin::windows_host != 0 } {
|
if { $ecosadmin::windows_host != 0 } {
|
file attributes $name -readonly 0
|
file attributes $name -readonly 0
|
} else {
|
} else {
|
set mask [file attributes $name -permissions]
|
set mask [file attributes $name -permissions]
|
set mask [expr $mask | 0200]
|
set mask [expr $mask | 0200]
|
file attributes $name -permissions $mask
|
file attributes $name -permissions $mask
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
# }}}
|
# }}}
|
# {{{ main()
|
# {{{ main()
|
|
|
#-----------------------------------------------------------------------
|
#-----------------------------------------------------------------------
|
# Procedure target_requires_missing_package determines whether a
|
# Procedure target_requires_missing_package determines whether a
|
# target entry is dependent on missing packages. It is called when
|
# target entry is dependent on missing packages. It is called when
|
# filtering templates out of the database
|
# filtering templates out of the database
|
|
|
proc ecosadmin::target_requires_missing_package { target } {
|
proc ecosadmin::target_requires_missing_package { target } {
|
foreach package $ecosadmin::target_data($target,packages) {
|
foreach package $ecosadmin::target_data($target,packages) {
|
if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
|
if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
|
return 1
|
return 1
|
}
|
}
|
}
|
}
|
return 0
|
return 0
|
}
|
}
|
|
|
#-----------------------------------------------------------------------
|
#-----------------------------------------------------------------------
|
# Procedure template_requires_missing_package determines whether a
|
# Procedure template_requires_missing_package determines whether a
|
# template entry is dependent on missing packages. It is called when
|
# template entry is dependent on missing packages. It is called when
|
# filtering templates out of the database
|
# filtering templates out of the database
|
|
|
proc ecosadmin::template_requires_missing_package { template } {
|
proc ecosadmin::template_requires_missing_package { template } {
|
foreach package $ecosadmin::template_data($template,packages) {
|
foreach package $ecosadmin::template_data($template,packages) {
|
if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
|
if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
|
return 1
|
return 1
|
}
|
}
|
}
|
}
|
return 0
|
return 0
|
}
|
}
|
|
|
#-----------------------------------------------------------------------
|
#-----------------------------------------------------------------------
|
# Procedure target_requires_any_package determines whether a target entry
|
# Procedure target_requires_any_package determines whether a target entry
|
# is dependent on specified packages. It is called when removing packages
|
# is dependent on specified packages. It is called when removing packages
|
# to determine whether a target should also be removed
|
# to determine whether a target should also be removed
|
|
|
proc ecosadmin::target_requires_any_package { target packages } {
|
proc ecosadmin::target_requires_any_package { target packages } {
|
foreach package $packages {
|
foreach package $packages {
|
if { [ lsearch $ecosadmin::target_data($target,packages) $package ] != -1 } {
|
if { [ lsearch $ecosadmin::target_data($target,packages) $package ] != -1 } {
|
return 1
|
return 1
|
}
|
}
|
}
|
}
|
return 0
|
return 0
|
}
|
}
|
|
|
#-----------------------------------------------------------------------
|
#-----------------------------------------------------------------------
|
# Procedure template_requires_any_package determines whether a template entry
|
# Procedure template_requires_any_package determines whether a template entry
|
# is dependent on specified packages. It is called when removing packages
|
# is dependent on specified packages. It is called when removing packages
|
# to determine whether a template should also be removed
|
# to determine whether a template should also be removed
|
|
|
proc ecosadmin::template_requires_any_package { template packages } {
|
proc ecosadmin::template_requires_any_package { template packages } {
|
foreach package $packages {
|
foreach package $packages {
|
if { [ lsearch $ecosadmin::template_data($template,packages) $package ] != -1 } {
|
if { [ lsearch $ecosadmin::template_data($template,packages) $package ] != -1 } {
|
return 1
|
return 1
|
}
|
}
|
}
|
}
|
return 0
|
return 0
|
}
|
}
|
|
|
#-----------------------------------------------------------------------
|
#-----------------------------------------------------------------------
|
# Procedure merge_new_packages adds any entries in the specified data
|
# Procedure merge_new_packages adds any entries in the specified data
|
# file to the eCos repository database iff they are not already present
|
# file to the eCos repository database iff they are not already present
|
|
|
proc ecosadmin::merge_new_packages { datafile } {
|
proc ecosadmin::merge_new_packages { datafile } {
|
|
|
# open the eCos database file for appending
|
# open the eCos database file for appending
|
set ecosfile [ file join $ecosadmin::component_repository "ecos.db" ]
|
set ecosfile [ file join $ecosadmin::component_repository "ecos.db" ]
|
variable outfile [ open $ecosfile a+ ]
|
variable outfile [ open $ecosfile a+ ]
|
|
|
# this procedure is called when the interpreter encounters a
|
# this procedure is called when the interpreter encounters a
|
# package command in the datafile
|
# package command in the datafile
|
proc merge { command name body } {
|
proc merge { command name body } {
|
ecosadmin::report "adding $command $name"
|
ecosadmin::report "adding $command $name"
|
# append the new package/target/template only if it is not already known
|
# append the new package/target/template only if it is not already known
|
if { ( ( $command == "package" ) && ( [ lsearch -exact $ecosadmin::known_packages $name ] == -1 ) ) ||
|
if { ( ( $command == "package" ) && ( [ lsearch -exact $ecosadmin::known_packages $name ] == -1 ) ) ||
|
( ( $command == "target" ) && ( [ lsearch -exact $ecosadmin::known_targets $name ] == -1 ) ) ||
|
( ( $command == "target" ) && ( [ lsearch -exact $ecosadmin::known_targets $name ] == -1 ) ) ||
|
( ( $command == "template" ) && ( [ lsearch -exact $ecosadmin::known_templates $name ] == -1 ) ) } {
|
( ( $command == "template" ) && ( [ lsearch -exact $ecosadmin::known_templates $name ] == -1 ) ) } {
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
}
|
}
|
}
|
}
|
|
|
# Create the parser, add the aliased commands, and then define
|
# Create the parser, add the aliased commands, and then define
|
# the routines that do the real work.
|
# the routines that do the real work.
|
set parser [ interp create -safe ]
|
set parser [ interp create -safe ]
|
$parser alias merge ecosadmin::merge
|
$parser alias merge ecosadmin::merge
|
$parser eval {
|
$parser eval {
|
proc package { name body } {
|
proc package { name body } {
|
merge "package" $name $body
|
merge "package" $name $body
|
}
|
}
|
|
|
proc template { name body } {
|
proc template { name body } {
|
merge "template" $name $body
|
merge "template" $name $body
|
}
|
}
|
|
|
proc target { name body } {
|
proc target { name body } {
|
merge "target" $name $body
|
merge "target" $name $body
|
}
|
}
|
}
|
}
|
|
|
# The parser is ready to evaluate the script. To avoid having to give the
|
# The parser is ready to evaluate the script. To avoid having to give the
|
# safe interpreter file I/O capabilities, the file is actually read in
|
# safe interpreter file I/O capabilities, the file is actually read in
|
# here and then evaluated.
|
# here and then evaluated.
|
set filename [ file join $ecosadmin::component_repository $datafile ]
|
set filename [ file join $ecosadmin::component_repository $datafile ]
|
set status [ catch {
|
set status [ catch {
|
set fd [ open $filename r ]
|
set fd [ open $filename r ]
|
set script [ read $fd ]
|
set script [ read $fd ]
|
close $fd
|
close $fd
|
$parser eval $script
|
$parser eval $script
|
} message ]
|
} message ]
|
|
|
# The interpreter and the aliased commands are no longer required.
|
# The interpreter and the aliased commands are no longer required.
|
rename merge {}
|
rename merge {}
|
interp delete $parser
|
interp delete $parser
|
|
|
# close the eCos database file
|
# close the eCos database file
|
close $outfile
|
close $outfile
|
|
|
# report errors
|
# report errors
|
if { $status != 0 } {
|
if { $status != 0 } {
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
}
|
}
|
}
|
}
|
|
|
#-----------------------------------------------------------------------
|
#-----------------------------------------------------------------------
|
# Procedure filter_old_packages removes the specified packages/versions
|
# Procedure filter_old_packages removes the specified packages/versions
|
# from the eCos repository database. Any targets and templates dependent
|
# from the eCos repository database. Any targets and templates dependent
|
# on the removed packages are also removed.
|
# on the removed packages are also removed.
|
|
|
proc ecosadmin::filter_old_packages { old_packages } {
|
proc ecosadmin::filter_old_packages { old_packages } {
|
|
|
# open the new eCos database file for writing
|
# open the new eCos database file for writing
|
set ecosfile [ file join $ecosadmin::component_repository "ecos.db.new" ]
|
set ecosfile [ file join $ecosadmin::component_repository "ecos.db.new" ]
|
variable outfile [ open $ecosfile w ]
|
variable outfile [ open $ecosfile w ]
|
variable filter_list $old_packages
|
variable filter_list $old_packages
|
variable removed_packages ""
|
variable removed_packages ""
|
|
|
# this procedure is called when the interpreter encounters a command in the datafile on the first pass
|
# this procedure is called when the interpreter encounters a command in the datafile on the first pass
|
# it generates a list of packages which will be removed on the second pass
|
# it generates a list of packages which will be removed on the second pass
|
proc removelist { command name body } {
|
proc removelist { command name body } {
|
if { [ lsearch $ecosadmin::filter_list $name ] != -1 } {
|
if { [ lsearch $ecosadmin::filter_list $name ] != -1 } {
|
# the package is in the filter list
|
# the package is in the filter list
|
if { ( $ecosadmin::version_arg == "" ) || ( [ llength $ecosadmin::package_data($name,versions) ] == 1 ) } {
|
if { ( $ecosadmin::version_arg == "" ) || ( [ llength $ecosadmin::package_data($name,versions) ] == 1 ) } {
|
# there is no version argument or only one version so add the package to the remove list
|
# there is no version argument or only one version so add the package to the remove list
|
set ::ecosadmin::removed_packages [ lappend ::ecosadmin::removed_packages $name ]
|
set ::ecosadmin::removed_packages [ lappend ::ecosadmin::removed_packages $name ]
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
# this procedure is called when the interpreter encounters a command in the datafile on the second pass
|
# this procedure is called when the interpreter encounters a command in the datafile on the second pass
|
proc filter { command name body } {
|
proc filter { command name body } {
|
if { ( $command == "target" ) && ( ( [ target_requires_any_package $name $ecosadmin::removed_packages ] != 0 ) || ( [ target_requires_missing_package $name ] != 0 ) ) } {
|
if { ( $command == "target" ) && ( ( [ target_requires_any_package $name $ecosadmin::removed_packages ] != 0 ) || ( [ target_requires_missing_package $name ] != 0 ) ) } {
|
# the target requires a package which has been removed so remove the target
|
# the target requires a package which has been removed so remove the target
|
ecosadmin::report "removing target $name"
|
ecosadmin::report "removing target $name"
|
} elseif { ( $command == "template" ) && ( ( [ template_requires_any_package $name $ecosadmin::removed_packages ] != 0 ) || ( [ template_requires_missing_package $name ] != 0 ) ) } {
|
} elseif { ( $command == "template" ) && ( ( [ template_requires_any_package $name $ecosadmin::removed_packages ] != 0 ) || ( [ template_requires_missing_package $name ] != 0 ) ) } {
|
# the template requires a package which has been removed so remove the template
|
# the template requires a package which has been removed so remove the template
|
ecosadmin::report "removing template $name"
|
ecosadmin::report "removing template $name"
|
} elseif { [ lsearch $ecosadmin::filter_list $name ] == -1 } {
|
} elseif { [ lsearch $ecosadmin::filter_list $name ] == -1 } {
|
# the package is not in the filter list so copy the data to the new database
|
# the package is not in the filter list so copy the data to the new database
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
} else {
|
} else {
|
# the package is in the filter list
|
# the package is in the filter list
|
set package_dir [ file join $ecosadmin::component_repository $ecosadmin::package_data($name,dir) ]
|
set package_dir [ file join $ecosadmin::component_repository $ecosadmin::package_data($name,dir) ]
|
if { ( $ecosadmin::version_arg != "" ) && ( [ llength $ecosadmin::package_data($name,versions) ] > 1 ) } {
|
if { ( $ecosadmin::version_arg != "" ) && ( [ llength $ecosadmin::package_data($name,versions) ] > 1 ) } {
|
# there are multiple versions and only one version will be removed
|
# there are multiple versions and only one version will be removed
|
# so copy the data to the new database and only remove one version directory
|
# so copy the data to the new database and only remove one version directory
|
set package_dir [ file join $package_dir $ecosadmin::version_arg ]
|
set package_dir [ file join $package_dir $ecosadmin::version_arg ]
|
ecosadmin::report "removing package $name $ecosadmin::version_arg"
|
ecosadmin::report "removing package $name $ecosadmin::version_arg"
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
} else {
|
} else {
|
# there is no version argument or only one version so delete the package directory
|
# there is no version argument or only one version so delete the package directory
|
ecosadmin::report "removing package $name"
|
ecosadmin::report "removing package $name"
|
}
|
}
|
if { [ catch { file delete -force -- $package_dir } message ] != 0 } {
|
if { [ catch { file delete -force -- $package_dir } message ] != 0 } {
|
# issue a warning if package deletion failed - this is not fatal
|
# issue a warning if package deletion failed - this is not fatal
|
ecosadmin::warning $message
|
ecosadmin::warning $message
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
# Create the parser, add the aliased commands, and then define
|
# Create the parser, add the aliased commands, and then define
|
# the routines that do the real work.
|
# the routines that do the real work.
|
set parser [ interp create -safe ]
|
set parser [ interp create -safe ]
|
$parser eval {
|
$parser eval {
|
proc package { name body } {
|
proc package { name body } {
|
filter "package" $name $body
|
filter "package" $name $body
|
}
|
}
|
|
|
proc template { name body } {
|
proc template { name body } {
|
filter "template" $name $body
|
filter "template" $name $body
|
}
|
}
|
|
|
proc target { name body } {
|
proc target { name body } {
|
filter "target" $name $body
|
filter "target" $name $body
|
}
|
}
|
}
|
}
|
|
|
# The parser is ready to evaluate the script. To avoid having to give the
|
# The parser is ready to evaluate the script. To avoid having to give the
|
# safe interpreter file I/O capabilities, the file is actually read in
|
# safe interpreter file I/O capabilities, the file is actually read in
|
# here and then evaluated.
|
# here and then evaluated.
|
set filename [ file join $ecosadmin::component_repository "ecos.db" ]
|
set filename [ file join $ecosadmin::component_repository "ecos.db" ]
|
set status [ catch {
|
set status [ catch {
|
set fd [ open $filename r ]
|
set fd [ open $filename r ]
|
set script [ read $fd ]
|
set script [ read $fd ]
|
close $fd
|
close $fd
|
|
|
# first pass to generate a list of packages which will be removed
|
# first pass to generate a list of packages which will be removed
|
$parser alias filter ecosadmin::removelist
|
$parser alias filter ecosadmin::removelist
|
$parser eval $script
|
$parser eval $script
|
|
|
# second pass to remove the packages, targets and templates
|
# second pass to remove the packages, targets and templates
|
$parser alias filter ecosadmin::filter
|
$parser alias filter ecosadmin::filter
|
$parser eval $script
|
$parser eval $script
|
} message ]
|
} message ]
|
|
|
# The interpreter and the aliased commands are no longer required.
|
# The interpreter and the aliased commands are no longer required.
|
rename filter {}
|
rename filter {}
|
interp delete $parser
|
interp delete $parser
|
|
|
# close the new eCos database file
|
# close the new eCos database file
|
close $outfile
|
close $outfile
|
|
|
# report errors
|
# report errors
|
if { $status != 0 } {
|
if { $status != 0 } {
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
}
|
}
|
|
|
# replace the old eCos database file with the new one
|
# replace the old eCos database file with the new one
|
file rename -force $ecosfile $filename
|
file rename -force $ecosfile $filename
|
}
|
}
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Process_add_packages. This routine is responsible for installing packages
|
# Process_add_packages. This routine is responsible for installing packages
|
# into the eCos repository using the gzip and tar tools which must be on
|
# into the eCos repository using the gzip and tar tools which must be on
|
# the path
|
# the path
|
#
|
#
|
|
|
proc ecosadmin::process_add_package { } {
|
proc ecosadmin::process_add_package { } {
|
ASSERT { $ecosadmin::add_package != "" }
|
ASSERT { $ecosadmin::add_package != "" }
|
ASSERT { $ecosadmin::component_repository != "" }
|
ASSERT { $ecosadmin::component_repository != "" }
|
|
|
# calculate the absolute path of the specified package archive
|
# calculate the absolute path of the specified package archive
|
# since we must change directory before extracting files
|
# since we must change directory before extracting files
|
# note that we cannot use "tar -C" to avoid changing directory
|
# note that we cannot use "tar -C" to avoid changing directory
|
# since "tar -C" only accepts relative paths
|
# since "tar -C" only accepts relative paths
|
set abs_package [ file join [ pwd ] $ecosadmin::add_package ]
|
set abs_package [ file join [ pwd ] $ecosadmin::add_package ]
|
set datafile "pkgadd.db"
|
set datafile "pkgadd.db"
|
set licensefile "pkgadd.txt"
|
set licensefile "pkgadd.txt"
|
set logfile "pkgadd.log"
|
set logfile "pkgadd.log"
|
cd $ecosadmin::component_repository
|
cd $ecosadmin::component_repository
|
|
|
# check for --extract_license on command line
|
# check for --extract_license on command line
|
if { $ecosadmin::extract_license_arg == 1 } {
|
if { $ecosadmin::extract_license_arg == 1 } {
|
# extract the license file (if any) from the specified gzipped tar archive
|
# extract the license file (if any) from the specified gzipped tar archive
|
file delete $licensefile
|
file delete $licensefile
|
catch { exec > $ecosadmin::null_device gzip -d < $abs_package | tar xf - $licensefile }
|
catch { exec > $ecosadmin::null_device gzip -d < $abs_package | tar xf - $licensefile }
|
return
|
return
|
}
|
}
|
|
|
# extract the package data file from the specified gzipped tar archive
|
# extract the package data file from the specified gzipped tar archive
|
if { [ catch { exec > $ecosadmin::null_device gzip -d < $abs_package | tar xf - $datafile } message ] != 0 } {
|
if { [ catch { exec > $ecosadmin::null_device gzip -d < $abs_package | tar xf - $datafile } message ] != 0 } {
|
fatal_error "extracting $datafile:\n$message"
|
fatal_error "extracting $datafile:\n$message"
|
}
|
}
|
|
|
# obtain license acceptance
|
# obtain license acceptance
|
if { [ ecosadmin::accept_license $abs_package $licensefile ] != "y" } {
|
if { [ ecosadmin::accept_license $abs_package $licensefile ] != "y" } {
|
file delete $datafile
|
file delete $datafile
|
file delete $licensefile
|
file delete $licensefile
|
fatal_error "license agreement not accepted"
|
fatal_error "license agreement not accepted"
|
}
|
}
|
|
|
# extract the remaining package contents and generate a list of extracted files
|
# extract the remaining package contents and generate a list of extracted files
|
if { [ catch { exec gzip -d < $abs_package | tar xvf - > $logfile } message ] != 0 } {
|
if { [ catch { exec gzip -d < $abs_package | tar xvf - > $logfile } message ] != 0 } {
|
file delete $logfile
|
file delete $logfile
|
fatal_error "extracting files:\n$message"
|
fatal_error "extracting files:\n$message"
|
}
|
}
|
|
|
# read the list of extracted files from the log file
|
# read the list of extracted files from the log file
|
set fd [ open $logfile r ]
|
set fd [ open $logfile r ]
|
set message [ read $fd ]
|
set message [ read $fd ]
|
close $fd
|
close $fd
|
file delete $logfile
|
file delete $logfile
|
|
|
# convert extracted text files to use the line-ending convention of the host
|
# convert extracted text files to use the line-ending convention of the host
|
set filelist [ split $message "\n" ]
|
set filelist [ split $message "\n" ]
|
set binary_extension ".bin"
|
set binary_extension ".bin"
|
foreach filename $filelist {
|
foreach filename $filelist {
|
if { [ file isfile $filename ] != 0 } {
|
if { [ file isfile $filename ] != 0 } {
|
if { [ file extension $filename ] == $binary_extension } {
|
if { [ file extension $filename ] == $binary_extension } {
|
# a binary file - so remove the binary extension
|
# a binary file - so remove the binary extension
|
file rename -force -- $filename [ file rootname $filename ]
|
file rename -force -- $filename [ file rootname $filename ]
|
} else {
|
} else {
|
# a text file - so convert file to use native line-endings
|
# a text file - so convert file to use native line-endings
|
# read in the file (line-ending conversion is implicit)
|
# read in the file (line-ending conversion is implicit)
|
set fd [ open $filename "r" ]
|
set fd [ open $filename "r" ]
|
set filetext [ read $fd ]
|
set filetext [ read $fd ]
|
close $fd
|
close $fd
|
|
|
# write the file out again
|
# write the file out again
|
set fd [ open $filename "w" ]
|
set fd [ open $filename "w" ]
|
puts -nonewline $fd $filetext
|
puts -nonewline $fd $filetext
|
close $fd
|
close $fd
|
}
|
}
|
}
|
}
|
}
|
}
|
|
|
# merge the new package information into the eCos database file as necessary
|
# merge the new package information into the eCos database file as necessary
|
ecosadmin::merge_new_packages $datafile
|
ecosadmin::merge_new_packages $datafile
|
|
|
# delete the database and license files
|
# delete the database and license files
|
file delete $datafile
|
file delete $datafile
|
file delete $licensefile
|
file delete $licensefile
|
|
|
# read the revised database back in and remove any
|
# read the revised database back in and remove any
|
# targets and templates with missing packages
|
# targets and templates with missing packages
|
read_data
|
read_data
|
filter_old_packages ""
|
filter_old_packages ""
|
}
|
}
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Process_remove_package. This routine is responsible for uninstalling a
|
# Process_remove_package. This routine is responsible for uninstalling a
|
# package from the eCos repository
|
# package from the eCos repository
|
#
|
#
|
|
|
proc ecosadmin::process_remove_package { } {
|
proc ecosadmin::process_remove_package { } {
|
ASSERT { $ecosadmin::remove_package != "" }
|
ASSERT { $ecosadmin::remove_package != "" }
|
|
|
# get the formal package name
|
# get the formal package name
|
set package_name [ ecosadmin::find_package $ecosadmin::remove_package ]
|
set package_name [ ecosadmin::find_package $ecosadmin::remove_package ]
|
if { $package_name == "" } {
|
if { $package_name == "" } {
|
# package not found
|
# package not found
|
fatal_error "package not found"
|
fatal_error "package not found"
|
} elseif { $ecosadmin::version_arg == "" } {
|
} elseif { $ecosadmin::version_arg == "" } {
|
# version not specified
|
# version not specified
|
# if { [ llength $ecosadmin::package_data($package_name,versions) ] > 1 } {
|
# if { [ llength $ecosadmin::package_data($package_name,versions) ] > 1 } {
|
# fatal_error "multiple versions, use --version"
|
# fatal_error "multiple versions, use --version"
|
# }
|
# }
|
} elseif { [ lsearch $ecosadmin::package_data($package_name,versions) $ecosadmin::version_arg ] == -1 } {
|
} elseif { [ lsearch $ecosadmin::package_data($package_name,versions) $ecosadmin::version_arg ] == -1 } {
|
# specified version not found
|
# specified version not found
|
fatal_error "version not found"
|
fatal_error "version not found"
|
}
|
}
|
|
|
# filter out the old package from the eCos database file
|
# filter out the old package from the eCos database file
|
filter_old_packages $package_name
|
filter_old_packages $package_name
|
}
|
}
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Accept_license. This routine is responsible for displaying the package
|
# Accept_license. This routine is responsible for displaying the package
|
# license and obtaining user acceptance. It returns "y" if the license is
|
# license and obtaining user acceptance. It returns "y" if the license is
|
# accepted.
|
# accepted.
|
#
|
#
|
|
|
proc ecosadmin::accept_license { archivename filename } {
|
proc ecosadmin::accept_license { archivename filename } {
|
ASSERT { $ecosadmin::add_package != "" }
|
ASSERT { $ecosadmin::add_package != "" }
|
|
|
# check for --accept_license on command line
|
# check for --accept_license on command line
|
if { $ecosadmin::accept_license_arg == 1 } {
|
if { $ecosadmin::accept_license_arg == 1 } {
|
# --accept_license specified so do not prompt for acceptance
|
# --accept_license specified so do not prompt for acceptance
|
return "y"
|
return "y"
|
}
|
}
|
|
|
# extract the specified license file from the specified gzipped tar archive
|
# extract the specified license file from the specified gzipped tar archive
|
if { [ catch { exec > $ecosadmin::null_device gzip -d < $archivename | tar xf - $filename } message ] != 0 } {
|
if { [ catch { exec > $ecosadmin::null_device gzip -d < $archivename | tar xf - $filename } message ] != 0 } {
|
# no license file
|
# no license file
|
return "y"
|
return "y"
|
}
|
}
|
|
|
# read in the file and output to the user
|
# read in the file and output to the user
|
set fd [ open $filename "r" ]
|
set fd [ open $filename "r" ]
|
set filetext [ read $fd ]
|
set filetext [ read $fd ]
|
close $fd
|
close $fd
|
puts $filetext
|
puts $filetext
|
|
|
# prompt for acceptance
|
# prompt for acceptance
|
puts -nonewline "Do you accept all the terms of the preceding license agreement? (y/n) "
|
puts -nonewline "Do you accept all the terms of the preceding license agreement? (y/n) "
|
flush "stdout"
|
flush "stdout"
|
gets "stdin" response
|
gets "stdin" response
|
|
|
# return the first character of the response in lowercase
|
# return the first character of the response in lowercase
|
return [ string tolower [ string index $response 0 ] ]
|
return [ string tolower [ string index $response 0 ] ]
|
}
|
}
|
|
|
# ----------------------------------------------------------------------------
|
# ----------------------------------------------------------------------------
|
# Main(). This code only runs if the script is being run stand-alone rather
|
# Main(). This code only runs if the script is being run stand-alone rather
|
# than as part of a larger application. The controlling predicate is the
|
# than as part of a larger application. The controlling predicate is the
|
# existence of the variable ecosadmin_not_standalone which can be set by
|
# existence of the variable ecosadmin_not_standalone which can be set by
|
# the containing program if any.
|
# the containing program if any.
|
#
|
#
|
|
|
if { ! [info exists ecosadmin_not_standalone] } {
|
if { ! [info exists ecosadmin_not_standalone] } {
|
|
|
# Decide where warnings and fatal errors should go.
|
# Decide where warnings and fatal errors should go.
|
ecosadmin::initialise_error_handling
|
ecosadmin::initialise_error_handling
|
|
|
# First, check for --help or any of the variants. If this script
|
# First, check for --help or any of the variants. If this script
|
# is running in a larger program then it is assumed that the
|
# is running in a larger program then it is assumed that the
|
# containing program will not pass --help as an argument.
|
# containing program will not pass --help as an argument.
|
if { ( $argv == "--help" ) || ( $argv == "-help" ) ||
|
if { ( $argv == "--help" ) || ( $argv == "-help" ) ||
|
( $argv == "--H" ) || ( $argv == "-H" ) || ($argv == "" ) } {
|
( $argv == "--H" ) || ( $argv == "-H" ) || ($argv == "" ) } {
|
|
|
ecosadmin::argument_help
|
ecosadmin::argument_help
|
return
|
return
|
}
|
}
|
|
|
# catch any errors while processing the specified command
|
# catch any errors while processing the specified command
|
if { [ catch {
|
if { [ catch {
|
|
|
# Parse the arguments and set the global variables appropriately.
|
# Parse the arguments and set the global variables appropriately.
|
ecosadmin::parse_arguments $argv0 $argv
|
ecosadmin::parse_arguments $argv0 $argv
|
|
|
# Read in the eCos repository database.
|
# Read in the eCos repository database.
|
ecosadmin::read_data
|
ecosadmin::read_data
|
|
|
# Process the ecosadmin command
|
# Process the ecosadmin command
|
if { $ecosadmin::list_packages_arg != 0 } {
|
if { $ecosadmin::list_packages_arg != 0 } {
|
foreach pkg $ecosadmin::known_packages {
|
foreach pkg $ecosadmin::known_packages {
|
ecosadmin::report "$pkg: $ecosadmin::package_data($pkg,versions)"
|
ecosadmin::report "$pkg: $ecosadmin::package_data($pkg,versions)"
|
}
|
}
|
} elseif { $ecosadmin::add_package != "" } {
|
} elseif { $ecosadmin::add_package != "" } {
|
ecosadmin::process_add_package
|
ecosadmin::process_add_package
|
} elseif { $ecosadmin::remove_package != "" } {
|
} elseif { $ecosadmin::remove_package != "" } {
|
ecosadmin::process_remove_package
|
ecosadmin::process_remove_package
|
}
|
}
|
|
|
} error_message ] != 0 } {
|
} error_message ] != 0 } {
|
|
|
# handle error message
|
# handle error message
|
if { [ info exists gui_mode ] } {
|
if { [ info exists gui_mode ] } {
|
return $error_message
|
return $error_message
|
}
|
}
|
puts "ecosadmin error: $error_message"
|
puts "ecosadmin error: $error_message"
|
}
|
}
|
return
|
return
|
}
|
}
|
|
|
# }}}
|
# }}}
|
|
|
