| 1 |
1254 |
phoenix |
#!/bin/bash
|
| 2 |
|
|
# restart using a Tcl shell \
|
| 3 |
|
|
exec sh -c 'for tclshell in tclsh tclsh83 cygtclsh80 ; do \
|
| 4 |
|
|
( echo | $tclshell ) 2> /dev/null && exec $tclshell "`( cygpath -w \"$0\" ) 2> /dev/null || echo $0`" "$@" ; \
|
| 5 |
|
|
done ; \
|
| 6 |
|
|
echo "ecosadmin.tcl: cannot find Tcl shell" ; exit 1' "$0" "$@"
|
| 7 |
|
|
|
| 8 |
|
|
# {{{ Banner
|
| 9 |
|
|
|
| 10 |
|
|
#===============================================================================
|
| 11 |
|
|
#
|
| 12 |
|
|
# ecosadmin.tcl
|
| 13 |
|
|
#
|
| 14 |
|
|
# A package install/uninstall tool.
|
| 15 |
|
|
#
|
| 16 |
|
|
#===============================================================================
|
| 17 |
|
|
#####ECOSGPLCOPYRIGHTBEGIN####
|
| 18 |
|
|
## -------------------------------------------
|
| 19 |
|
|
## This file is part of eCos, the Embedded Configurable Operating System.
|
| 20 |
|
|
## Copyright (C) 1998, 1999, 2000, 2001, 2002 Red Hat, Inc.
|
| 21 |
|
|
##
|
| 22 |
|
|
## eCos is free software; you can redistribute it and/or modify it under
|
| 23 |
|
|
## the terms of the GNU General Public License as published by the Free
|
| 24 |
|
|
## Software Foundation; either version 2 or (at your option) any later version.
|
| 25 |
|
|
##
|
| 26 |
|
|
## eCos is distributed in the hope that it will be useful, but WITHOUT ANY
|
| 27 |
|
|
## WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
| 28 |
|
|
## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
| 29 |
|
|
## for more details.
|
| 30 |
|
|
##
|
| 31 |
|
|
## You should have received a copy of the GNU General Public License along
|
| 32 |
|
|
## with eCos; if not, write to the Free Software Foundation, Inc.,
|
| 33 |
|
|
## 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
|
| 34 |
|
|
##
|
| 35 |
|
|
## As a special exception, if other files instantiate templates or use macros
|
| 36 |
|
|
## or inline functions from this file, or you compile this file and link it
|
| 37 |
|
|
## with other works to produce a work based on this file, this file does not
|
| 38 |
|
|
## by itself cause the resulting work to be covered by the GNU General Public
|
| 39 |
|
|
## License. However the source code for this file must still be made available
|
| 40 |
|
|
## in accordance with section (3) of the GNU General Public License.
|
| 41 |
|
|
##
|
| 42 |
|
|
## This exception does not invalidate any other reasons why a work based on
|
| 43 |
|
|
## this file might be covered by the GNU General Public License.
|
| 44 |
|
|
##
|
| 45 |
|
|
## Alternative licenses for eCos may be arranged by contacting Red Hat, Inc.
|
| 46 |
|
|
## at http://sources.redhat.com/ecos/ecos-license/
|
| 47 |
|
|
## -------------------------------------------
|
| 48 |
|
|
#####ECOSGPLCOPYRIGHTEND####
|
| 49 |
|
|
#===============================================================================
|
| 50 |
|
|
######DESCRIPTIONBEGIN####
|
| 51 |
|
|
#
|
| 52 |
|
|
# Author(s): jld
|
| 53 |
|
|
# Contributors: bartv
|
| 54 |
|
|
# Date: 1999-06-18
|
| 55 |
|
|
# Purpose: To install and uninstall packages from an eCos component
|
| 56 |
|
|
# repository
|
| 57 |
|
|
# Description:
|
| 58 |
|
|
# Usage:
|
| 59 |
|
|
#
|
| 60 |
|
|
#####DESCRIPTIONEND####
|
| 61 |
|
|
#===============================================================================
|
| 62 |
|
|
#
|
| 63 |
|
|
|
| 64 |
|
|
# }}}
|
| 65 |
|
|
# {{{ Version check
|
| 66 |
|
|
|
| 67 |
|
|
# ----------------------------------------------------------------------------
|
| 68 |
|
|
# ecosadmin.tcl requires at least version 8.0 of Tcl, since it makes use of
|
| 69 |
|
|
# namespaces. It is possible that some users still have older versions.
|
| 70 |
|
|
|
| 71 |
|
|
if { [info tclversion] < 8.0 } {
|
| 72 |
|
|
puts "This script requires Tcl 8.0 or later. You are running Tcl [info patchlevel]."
|
| 73 |
|
|
return
|
| 74 |
|
|
}
|
| 75 |
|
|
|
| 76 |
|
|
# }}}
|
| 77 |
|
|
# {{{ Namespace definition
|
| 78 |
|
|
|
| 79 |
|
|
# ----------------------------------------------------------------------------
|
| 80 |
|
|
# Namespaces. All code and variables in this script are kept in the namespace
|
| 81 |
|
|
# "ecosadmin". This is not really necessary for stand-alone operation, but if it
|
| 82 |
|
|
# ever becomes desirable to embed this script in a larger application then
|
| 83 |
|
|
# using a namespace is a lot easier.
|
| 84 |
|
|
#
|
| 85 |
|
|
# As a fringe benefit, all global variables can be declared inside this
|
| 86 |
|
|
# namespace and initialised.
|
| 87 |
|
|
#
|
| 88 |
|
|
|
| 89 |
|
|
namespace eval ecosadmin {
|
| 90 |
|
|
|
| 91 |
|
|
# Is this program running under Windows ?
|
| 92 |
|
|
variable windows_host [expr {$tcl_platform(platform) == "windows"}]
|
| 93 |
|
|
variable null_device ""
|
| 94 |
|
|
if { $windows_host != 0 } {
|
| 95 |
|
|
set ecosadmin::null_device "nul"
|
| 96 |
|
|
} else {
|
| 97 |
|
|
set ecosadmin::null_device "/dev/null"
|
| 98 |
|
|
}
|
| 99 |
|
|
|
| 100 |
|
|
|
| 101 |
|
|
# Where is the component repository ? The following input sources
|
| 102 |
|
|
# are available:
|
| 103 |
|
|
# 1) the environment variable ECOS_REPOSITORY.
|
| 104 |
|
|
# 2) $argv0 should correspond to the location of the ecosadmin.tcl
|
| 105 |
|
|
# script.
|
| 106 |
|
|
#
|
| 107 |
|
|
variable component_repository ""
|
| 108 |
|
|
if { [info exists ::env(ECOS_REPOSITORY)] } {
|
| 109 |
|
|
# override the calculation of the repository location using the
|
| 110 |
|
|
# (undocumented) ECOS_REPOSITORY environment variable
|
| 111 |
|
|
set component_repository $::env(ECOS_REPOSITORY)
|
| 112 |
|
|
} else {
|
| 113 |
|
|
set component_repository [pwd]
|
| 114 |
|
|
if { [file dirname $argv0] != "." } {
|
| 115 |
|
|
set component_repository [file join $component_repository [file dirname $argv0]]
|
| 116 |
|
|
}
|
| 117 |
|
|
}
|
| 118 |
|
|
|
| 119 |
|
|
# Details of the command line arguments, if any.
|
| 120 |
|
|
variable list_packages_arg 0; # list
|
| 121 |
|
|
variable accept_license_arg 0; # --accept_license
|
| 122 |
|
|
variable extract_license_arg 0; # --extract_license
|
| 123 |
|
|
variable add_package ""; # add FILE
|
| 124 |
|
|
variable remove_package ""; # remove PACKAGE
|
| 125 |
|
|
variable version_arg ""; # --version VER
|
| 126 |
|
|
|
| 127 |
|
|
# Details of all known packages, targets and templates
|
| 128 |
|
|
# read from the ecos.db file
|
| 129 |
|
|
variable known_packages ""
|
| 130 |
|
|
variable known_targets ""
|
| 131 |
|
|
variable known_templates ""
|
| 132 |
|
|
array set package_data {};
|
| 133 |
|
|
array set target_data {};
|
| 134 |
|
|
array set template_data {};
|
| 135 |
|
|
|
| 136 |
|
|
# What routines should be invoked for outputting fatal errors and
|
| 137 |
|
|
# for warning messages ?
|
| 138 |
|
|
variable fatal_error_handler ecosadmin::cli_fatal_error
|
| 139 |
|
|
variable warning_handler ecosadmin::cli_warning
|
| 140 |
|
|
variable report_handler ecosadmin::cli_report
|
| 141 |
|
|
|
| 142 |
|
|
# Keep or remove the CVS directories?
|
| 143 |
|
|
variable keep_cvs 0
|
| 144 |
|
|
}
|
| 145 |
|
|
|
| 146 |
|
|
# }}}
|
| 147 |
|
|
# {{{ Infrastructure
|
| 148 |
|
|
|
| 149 |
|
|
# ----------------------------------------------------------------------------
|
| 150 |
|
|
# Minimal infrastructure support.
|
| 151 |
|
|
#
|
| 152 |
|
|
# There must be some way of reporting fatal errors, of outputting warnings,
|
| 153 |
|
|
# and of generating report messages. The implementation of these things
|
| 154 |
|
|
# obviously depends on whether or not TK is present. In addition, if this
|
| 155 |
|
|
# script is being run inside a larger application then that larger
|
| 156 |
|
|
# application must be able to install its own versions of the routines.
|
| 157 |
|
|
#
|
| 158 |
|
|
# Once it is possible to report fatal errors, an assertion facility becomes
|
| 159 |
|
|
# feasible.
|
| 160 |
|
|
#
|
| 161 |
|
|
# These routines output fatal errors, warnings or miscellaneous messages.
|
| 162 |
|
|
# Their implementations depend on the mode in which this script is operating.
|
| 163 |
|
|
#
|
| 164 |
|
|
proc ecosadmin::fatal_error { msg } {
|
| 165 |
|
|
$ecosadmin::fatal_error_handler "$msg"
|
| 166 |
|
|
}
|
| 167 |
|
|
|
| 168 |
|
|
proc ecosadmin::warning { msg } {
|
| 169 |
|
|
$ecosadmin::warning_handler "$msg"
|
| 170 |
|
|
}
|
| 171 |
|
|
|
| 172 |
|
|
proc ecosadmin::report { msg } {
|
| 173 |
|
|
$ecosadmin::report_handler "$msg"
|
| 174 |
|
|
}
|
| 175 |
|
|
|
| 176 |
|
|
#
|
| 177 |
|
|
# Command line versions.
|
| 178 |
|
|
# NOTE: some formatting so that there are linebreaks at ~72 columns would be
|
| 179 |
|
|
# a good idea.
|
| 180 |
|
|
#
|
| 181 |
|
|
proc ecosadmin::cli_fatal_error_handler { msg } {
|
| 182 |
|
|
error "$msg"
|
| 183 |
|
|
}
|
| 184 |
|
|
|
| 185 |
|
|
proc ecosadmin::cli_warning_handler { msg } {
|
| 186 |
|
|
puts "ecosadmin warning: $msg"
|
| 187 |
|
|
}
|
| 188 |
|
|
|
| 189 |
|
|
proc ecosadmin::cli_report_handler { msg } {
|
| 190 |
|
|
puts "$msg"
|
| 191 |
|
|
}
|
| 192 |
|
|
|
| 193 |
|
|
#
|
| 194 |
|
|
# Determine the default destination for warnings and for fatal errors.
|
| 195 |
|
|
# After the first call to this function it is possible to use assertions.
|
| 196 |
|
|
#
|
| 197 |
|
|
proc ecosadmin::initialise_error_handling { } {
|
| 198 |
|
|
set ecosadmin::fatal_error_handler ecosadmin::cli_fatal_error_handler
|
| 199 |
|
|
set ecosadmin::warning_handler ecosadmin::cli_warning_handler
|
| 200 |
|
|
set ecosadmin::report_handler ecosadmin::cli_report_handler
|
| 201 |
|
|
}
|
| 202 |
|
|
|
| 203 |
|
|
#
|
| 204 |
|
|
# These routines can be used by containing programs to provide their
|
| 205 |
|
|
# own error handling.
|
| 206 |
|
|
#
|
| 207 |
|
|
proc ecosadmin::set_fatal_error_handler { fn } {
|
| 208 |
|
|
ASSERT { $fn != "" }
|
| 209 |
|
|
set ecosadmin::fatal_error_handler $fn
|
| 210 |
|
|
}
|
| 211 |
|
|
|
| 212 |
|
|
proc ecosadmin::set_warning_handler { fn } {
|
| 213 |
|
|
ASSERT { $fn != "" }
|
| 214 |
|
|
set ecosadmin::warning_handler $fn
|
| 215 |
|
|
}
|
| 216 |
|
|
|
| 217 |
|
|
proc ecosadmin::set_report_handler { fn } {
|
| 218 |
|
|
ASSERT { $fn != "" }
|
| 219 |
|
|
set ecosadmin::report_handler $fn
|
| 220 |
|
|
}
|
| 221 |
|
|
|
| 222 |
|
|
#
|
| 223 |
|
|
# A very simple assertion facility. It takes a single argument, an expression
|
| 224 |
|
|
# that should be evaluated in the calling function's scope, and on failure it
|
| 225 |
|
|
# should generate a fatal error.
|
| 226 |
|
|
#
|
| 227 |
|
|
proc ecosadmin::ASSERT { condition } {
|
| 228 |
|
|
set result [uplevel 1 [list expr $condition]]
|
| 229 |
|
|
|
| 230 |
|
|
if { $result == 0 } {
|
| 231 |
|
|
fatal_error "assertion predicate \"$condition\"\nin \"[info level -1]\""
|
| 232 |
|
|
}
|
| 233 |
|
|
}
|
| 234 |
|
|
|
| 235 |
|
|
# }}}
|
| 236 |
|
|
# {{{ Utilities
|
| 237 |
|
|
|
| 238 |
|
|
# ----------------------------------------------------------------------------
|
| 239 |
|
|
# cdl_compare_version. This is a partial implementation of the full
|
| 240 |
|
|
# cdl_compare_version facility defined in the product specification. Its
|
| 241 |
|
|
# purpose is to order the various versions of a given package with
|
| 242 |
|
|
# the most recent version first. As a special case, "current" is
|
| 243 |
|
|
# always considered the most recent.
|
| 244 |
|
|
#
|
| 245 |
|
|
# There are similarities between cdl_compare_version and with Tcl's
|
| 246 |
|
|
# package vcompare, but cdl_compare_version is more general.
|
| 247 |
|
|
#
|
| 248 |
|
|
|
| 249 |
|
|
proc ecosadmin::cdl_compare_version { arg1 arg2 } {
|
| 250 |
|
|
|
| 251 |
|
|
if { $arg1 == $arg2 } {
|
| 252 |
|
|
return 0
|
| 253 |
|
|
}
|
| 254 |
|
|
if { $arg1 == "current"} {
|
| 255 |
|
|
return -1
|
| 256 |
|
|
}
|
| 257 |
|
|
if { $arg2 == "current" } {
|
| 258 |
|
|
return 1
|
| 259 |
|
|
}
|
| 260 |
|
|
|
| 261 |
|
|
set index1 0
|
| 262 |
|
|
set index2 0
|
| 263 |
|
|
set ch1 ""
|
| 264 |
|
|
set ch2 ""
|
| 265 |
|
|
set num1 ""
|
| 266 |
|
|
set num2 ""
|
| 267 |
|
|
|
| 268 |
|
|
while { 1 } {
|
| 269 |
|
|
|
| 270 |
|
|
set ch1 [string index $arg1 $index1]
|
| 271 |
|
|
set ch2 [string index $arg2 $index2]
|
| 272 |
|
|
set num1 ""
|
| 273 |
|
|
set num2 ""
|
| 274 |
|
|
|
| 275 |
|
|
if { ($ch1 == "") && ($ch2 == "") } {
|
| 276 |
|
|
|
| 277 |
|
|
# Both strings have terminated at the same time. There may have
|
| 278 |
|
|
# been some spurious leading zeroes in numbers.
|
| 279 |
|
|
return 0
|
| 280 |
|
|
|
| 281 |
|
|
} elseif { $ch1 == "" } {
|
| 282 |
|
|
|
| 283 |
|
|
# The first string has ended first. If ch2 is a separator then
|
| 284 |
|
|
# arg2 is a derived version, e.g. v0.3.p1 and hence newer. Otherwise ch2
|
| 285 |
|
|
# is an experimental version v0.3beta and hence older.
|
| 286 |
|
|
if { [string match \[-._\] $ch2] } {
|
| 287 |
|
|
return 1
|
| 288 |
|
|
} else {
|
| 289 |
|
|
return -1
|
| 290 |
|
|
}
|
| 291 |
|
|
} elseif { $ch2 == "" } {
|
| 292 |
|
|
|
| 293 |
|
|
# Equivalent to the above.
|
| 294 |
|
|
if { [string match \[-._\] $ch1] } {
|
| 295 |
|
|
return -1
|
| 296 |
|
|
} else {
|
| 297 |
|
|
return 1
|
| 298 |
|
|
}
|
| 299 |
|
|
}
|
| 300 |
|
|
|
| 301 |
|
|
# There is still data to be processed.
|
| 302 |
|
|
# Check for both strings containing numbers at the current index.
|
| 303 |
|
|
if { ( [string match \[0-9\] $ch1] ) && ( [string match \[0-9\] $ch2] ) } {
|
| 304 |
|
|
|
| 305 |
|
|
# Extract the entire numbers from the version string.
|
| 306 |
|
|
while { [string match \[0-9\] $ch1] } {
|
| 307 |
|
|
set num1 "$num1$ch1"
|
| 308 |
|
|
incr index1
|
| 309 |
|
|
set ch1 [string index $arg1 $index1]
|
| 310 |
|
|
}
|
| 311 |
|
|
while { [string match \[0-9\] $ch2] } {
|
| 312 |
|
|
set num2 "$num2$ch2"
|
| 313 |
|
|
incr index2
|
| 314 |
|
|
set ch2 [string index $arg2 $index2]
|
| 315 |
|
|
}
|
| 316 |
|
|
|
| 317 |
|
|
if { $num1 < $num2 } {
|
| 318 |
|
|
return 1
|
| 319 |
|
|
} elseif { $num1 > $num2 } {
|
| 320 |
|
|
return -1
|
| 321 |
|
|
}
|
| 322 |
|
|
continue
|
| 323 |
|
|
}
|
| 324 |
|
|
|
| 325 |
|
|
# This is not numerical data. If the two characters are the same then
|
| 326 |
|
|
# move on.
|
| 327 |
|
|
if { $ch1 == $ch2 } {
|
| 328 |
|
|
incr index1
|
| 329 |
|
|
incr index2
|
| 330 |
|
|
continue
|
| 331 |
|
|
}
|
| 332 |
|
|
|
| 333 |
|
|
# Next check if both strings are at a separator. All separators can be
|
| 334 |
|
|
# used interchangeably.
|
| 335 |
|
|
if { ( [string match \[-._\] $ch1] ) && ( [string match \[-._\] $ch2] ) } {
|
| 336 |
|
|
incr index1
|
| 337 |
|
|
incr index2
|
| 338 |
|
|
continue
|
| 339 |
|
|
}
|
| 340 |
|
|
|
| 341 |
|
|
# There are differences in the characters and they are not interchangeable.
|
| 342 |
|
|
# Just return a standard string comparison.
|
| 343 |
|
|
return [string compare $ch1 $ch2]
|
| 344 |
|
|
}
|
| 345 |
|
|
}
|
| 346 |
|
|
|
| 347 |
|
|
# }}}
|
| 348 |
|
|
# {{{ Argument parsing
|
| 349 |
|
|
|
| 350 |
|
|
# ----------------------------------------------------------------------------
|
| 351 |
|
|
# The argv0 argument should be the name of this script. It can be used
|
| 352 |
|
|
# to get at the component repository location. If this script has been
|
| 353 |
|
|
# run incorrectly then currently it will fail: in future it may be
|
| 354 |
|
|
# desirable to check an environment variable instead.
|
| 355 |
|
|
#
|
| 356 |
|
|
# The argv argument is a string containing the rest of the arguments.
|
| 357 |
|
|
# If any of the arguments contain spaces then this argument will be
|
| 358 |
|
|
# surrounded by braces. If any of the arguments contain braces then
|
| 359 |
|
|
# things will break.
|
| 360 |
|
|
#
|
| 361 |
|
|
|
| 362 |
|
|
proc ecosadmin::parse_arguments { argv0 argv } {
|
| 363 |
|
|
|
| 364 |
|
|
if { $argv != "" } {
|
| 365 |
|
|
|
| 366 |
|
|
# There are arguments. If any of the arguments contained
|
| 367 |
|
|
# spaces then these arguments will have been surrounded
|
| 368 |
|
|
# by braces, which is a nuisance. So start by turning the
|
| 369 |
|
|
# arguments into a numerically indexed array.
|
| 370 |
|
|
|
| 371 |
|
|
set argc 0
|
| 372 |
|
|
array set args { }
|
| 373 |
|
|
foreach arg $argv {
|
| 374 |
|
|
set args([incr argc]) $arg
|
| 375 |
|
|
}
|
| 376 |
|
|
|
| 377 |
|
|
# Now examine each argument with regular expressions. It is
|
| 378 |
|
|
# useful to have some variables filled in by the regexp
|
| 379 |
|
|
# matching.
|
| 380 |
|
|
set dummy ""
|
| 381 |
|
|
set match1 ""
|
| 382 |
|
|
set match2 ""
|
| 383 |
|
|
for { set i 1 } { $i <= $argc } { incr i } {
|
| 384 |
|
|
|
| 385 |
|
|
# Check for --list and the other simple ones.
|
| 386 |
|
|
if { [regexp -- {^-?-?list$} $args($i)] == 1 } {
|
| 387 |
|
|
set ecosadmin::list_packages_arg 1
|
| 388 |
|
|
continue
|
| 389 |
|
|
}
|
| 390 |
|
|
|
| 391 |
|
|
# check for --version
|
| 392 |
|
|
if { [regexp -- {^-?-version=?(.*)$} $args($i) dummy match1] == 1 } {
|
| 393 |
|
|
if { $match1 != "" } {
|
| 394 |
|
|
set ecosadmin::version_arg $match1
|
| 395 |
|
|
} else {
|
| 396 |
|
|
if { $i == $argc } {
|
| 397 |
|
|
fatal_error "missing argument after --version"
|
| 398 |
|
|
} else {
|
| 399 |
|
|
set ecosadmin::version_arg $args([incr i])
|
| 400 |
|
|
}
|
| 401 |
|
|
}
|
| 402 |
|
|
continue
|
| 403 |
|
|
}
|
| 404 |
|
|
|
| 405 |
|
|
# check for --accept_license
|
| 406 |
|
|
if { [regexp -- {^-?-accept_license$} $args($i)] == 1 } {
|
| 407 |
|
|
set ecosadmin::accept_license_arg 1
|
| 408 |
|
|
continue
|
| 409 |
|
|
}
|
| 410 |
|
|
|
| 411 |
|
|
# check for --extract_license
|
| 412 |
|
|
if { [regexp -- {^-?-extract_license$} $args($i)] == 1 } {
|
| 413 |
|
|
set ecosadmin::extract_license_arg 1
|
| 414 |
|
|
continue
|
| 415 |
|
|
}
|
| 416 |
|
|
|
| 417 |
|
|
# check for the add command
|
| 418 |
|
|
if { [regexp -- {^-?-?add=?(.*)$} $args($i) dummy match1] == 1 } {
|
| 419 |
|
|
if { $match1 != "" } {
|
| 420 |
|
|
set ecosadmin::add_package $match1
|
| 421 |
|
|
} else {
|
| 422 |
|
|
if { $i == $argc } {
|
| 423 |
|
|
fatal_error "missing argument after add"
|
| 424 |
|
|
} else {
|
| 425 |
|
|
set ecosadmin::add_package $args([incr i])
|
| 426 |
|
|
}
|
| 427 |
|
|
}
|
| 428 |
|
|
continue
|
| 429 |
|
|
}
|
| 430 |
|
|
|
| 431 |
|
|
# check for the remove command
|
| 432 |
|
|
if { [regexp -- {^-?-?remove=?(.*)$} $args($i) dummy match1] == 1 } {
|
| 433 |
|
|
if { $match1 != "" } {
|
| 434 |
|
|
set ecosadmin::remove_package $match1
|
| 435 |
|
|
} else {
|
| 436 |
|
|
if { $i == $argc } {
|
| 437 |
|
|
fatal_error "missing argument after remove"
|
| 438 |
|
|
} else {
|
| 439 |
|
|
set ecosadmin::remove_package $args([incr i])
|
| 440 |
|
|
}
|
| 441 |
|
|
}
|
| 442 |
|
|
continue
|
| 443 |
|
|
}
|
| 444 |
|
|
|
| 445 |
|
|
# Check for --srcdir
|
| 446 |
|
|
if { [regexp -- {^-?-srcdir=?([ \.\\/:_a-zA-Z0-9-]*)$} $args($i) dummy match1] == 1 } {
|
| 447 |
|
|
if { $match1 == "" } {
|
| 448 |
|
|
if { $i == $argc } {
|
| 449 |
|
|
puts "ecosrelease: missing argument after --srcdir"
|
| 450 |
|
|
exit 1
|
| 451 |
|
|
} else {
|
| 452 |
|
|
set match1 $args([incr i])
|
| 453 |
|
|
}
|
| 454 |
|
|
}
|
| 455 |
|
|
set ecosadmin::component_repository $match1
|
| 456 |
|
|
continue
|
| 457 |
|
|
}
|
| 458 |
|
|
|
| 459 |
|
|
# An unrecognised argument.
|
| 460 |
|
|
fatal_error "invalid argument $args($i)"
|
| 461 |
|
|
}
|
| 462 |
|
|
}
|
| 463 |
|
|
|
| 464 |
|
|
# Convert user-specified UNIX-style Cygwin pathnames to Windows Tcl-style as necessary
|
| 465 |
|
|
set ecosadmin::component_repository [get_pathname_for_tcl $ecosadmin::component_repository]
|
| 466 |
|
|
set ecosadmin::add_package [get_pathname_for_tcl $ecosadmin::add_package]
|
| 467 |
|
|
}
|
| 468 |
|
|
|
| 469 |
|
|
#
|
| 470 |
|
|
# Display help information if the user has typed --help, -H, --H, or -help.
|
| 471 |
|
|
# The help text uses two hyphens for consistency with configure.
|
| 472 |
|
|
# Arguably this should change.
|
| 473 |
|
|
|
| 474 |
|
|
proc ecosadmin::argument_help { } {
|
| 475 |
|
|
|
| 476 |
|
|
puts "Usage: ecosadmin \[ command \]"
|
| 477 |
|
|
puts " commands are:"
|
| 478 |
|
|
puts " list : list packages"
|
| 479 |
|
|
puts " add FILE : add packages"
|
| 480 |
|
|
puts " remove PACKAGE \[ --version VER \] : remove a package"
|
| 481 |
|
|
}
|
| 482 |
|
|
|
| 483 |
|
|
# }}}
|
| 484 |
|
|
# {{{ Packages file
|
| 485 |
|
|
|
| 486 |
|
|
proc ecosadmin::read_data { } {
|
| 487 |
|
|
|
| 488 |
|
|
ASSERT { $ecosadmin::component_repository != "" }
|
| 489 |
|
|
|
| 490 |
|
|
set ecosadmin::known_packages ""
|
| 491 |
|
|
set ecosadmin::known_targets ""
|
| 492 |
|
|
set ecosadmin::known_templates ""
|
| 493 |
|
|
|
| 494 |
|
|
# A safe interpreter is used to process the packages file.
|
| 495 |
|
|
# This is somewhat overcautious, but it is also harmless.
|
| 496 |
|
|
# The following two commands are made accessible to the slave
|
| 497 |
|
|
# interpreter and are responsible for updating the actual data.
|
| 498 |
|
|
proc add_known_package { name } {
|
| 499 |
|
|
lappend ::ecosadmin::known_packages $name
|
| 500 |
|
|
}
|
| 501 |
|
|
proc add_known_target { name } {
|
| 502 |
|
|
lappend ::ecosadmin::known_targets $name
|
| 503 |
|
|
}
|
| 504 |
|
|
proc add_known_template { name } {
|
| 505 |
|
|
lappend ::ecosadmin::known_templates $name
|
| 506 |
|
|
}
|
| 507 |
|
|
proc set_package_data { name value } {
|
| 508 |
|
|
set ::ecosadmin::package_data($name) $value
|
| 509 |
|
|
}
|
| 510 |
|
|
proc set_target_data { name value } {
|
| 511 |
|
|
set ::ecosadmin::target_data($name) $value
|
| 512 |
|
|
}
|
| 513 |
|
|
proc set_template_data { name value } {
|
| 514 |
|
|
set ::ecosadmin::template_data($name) $value
|
| 515 |
|
|
}
|
| 516 |
|
|
|
| 517 |
|
|
# Create the parser, add the aliased commands, and then define
|
| 518 |
|
|
# the routines that do the real work.
|
| 519 |
|
|
set parser [interp create -safe]
|
| 520 |
|
|
$parser alias add_known_package ecosadmin::add_known_package
|
| 521 |
|
|
$parser alias add_known_target ecosadmin::add_known_target
|
| 522 |
|
|
$parser alias add_known_template ecosadmin::add_known_template
|
| 523 |
|
|
$parser alias set_package_data ecosadmin::set_package_data
|
| 524 |
|
|
$parser alias set_target_data ecosadmin::set_target_data
|
| 525 |
|
|
$parser alias set_template_data ecosadmin::set_template_data
|
| 526 |
|
|
|
| 527 |
|
|
$parser eval {
|
| 528 |
|
|
|
| 529 |
|
|
set current_package ""
|
| 530 |
|
|
set current_target ""
|
| 531 |
|
|
set current_template ""
|
| 532 |
|
|
|
| 533 |
|
|
proc package { name body } {
|
| 534 |
|
|
add_known_package $name
|
| 535 |
|
|
set_package_data "$name,alias" ""
|
| 536 |
|
|
set_package_data "$name,versions" ""
|
| 537 |
|
|
set_package_data "$name,dir" ""
|
| 538 |
|
|
set ::current_package $name
|
| 539 |
|
|
eval $body
|
| 540 |
|
|
set ::current_package ""
|
| 541 |
|
|
}
|
| 542 |
|
|
|
| 543 |
|
|
proc target { name body } {
|
| 544 |
|
|
add_known_target $name
|
| 545 |
|
|
set_target_data "$name,packages" ""
|
| 546 |
|
|
set ::current_target $name
|
| 547 |
|
|
eval $body
|
| 548 |
|
|
set ::current_target ""
|
| 549 |
|
|
}
|
| 550 |
|
|
|
| 551 |
|
|
#if 0
|
| 552 |
|
|
# templates are no longer specified in the package database
|
| 553 |
|
|
proc template { name body } {
|
| 554 |
|
|
add_known_template $name
|
| 555 |
|
|
set_template_data "$name,packages" ""
|
| 556 |
|
|
set ::current_template $name
|
| 557 |
|
|
eval $body
|
| 558 |
|
|
set ::current_template ""
|
| 559 |
|
|
}
|
| 560 |
|
|
#endif
|
| 561 |
|
|
|
| 562 |
|
|
proc packages { str } {
|
| 563 |
|
|
if { $::current_template != "" } {
|
| 564 |
|
|
set_template_data "$::current_template,packages" $str
|
| 565 |
|
|
} elseif { $::current_target != "" } {
|
| 566 |
|
|
set_target_data "$::current_target,packages" $str
|
| 567 |
|
|
} else {
|
| 568 |
|
|
ASSERT 0
|
| 569 |
|
|
}
|
| 570 |
|
|
}
|
| 571 |
|
|
|
| 572 |
|
|
proc directory { dir } {
|
| 573 |
|
|
set_package_data "$::current_package,dir" $dir
|
| 574 |
|
|
}
|
| 575 |
|
|
|
| 576 |
|
|
proc alias { str } {
|
| 577 |
|
|
if { $::current_package != "" } {
|
| 578 |
|
|
set_package_data "$::current_package,alias" $str
|
| 579 |
|
|
}
|
| 580 |
|
|
}
|
| 581 |
|
|
|
| 582 |
|
|
proc description { str } { }
|
| 583 |
|
|
proc disable { str } { }
|
| 584 |
|
|
proc enable { str } { }
|
| 585 |
|
|
proc hardware { } { }
|
| 586 |
|
|
proc script { str } { }
|
| 587 |
|
|
proc set_value { str1 str2 } { }
|
| 588 |
|
|
}
|
| 589 |
|
|
|
| 590 |
|
|
# The parser is ready to evaluate the script. To avoid having to give the
|
| 591 |
|
|
# safe interpreter file I/O capabilities, the file is actually read in
|
| 592 |
|
|
# here and then evaluated.
|
| 593 |
|
|
set filename [file join $ecosadmin::component_repository "ecos.db"]
|
| 594 |
|
|
set status [ catch {
|
| 595 |
|
|
set fd [open $filename r]
|
| 596 |
|
|
set script [read $fd]
|
| 597 |
|
|
close $fd
|
| 598 |
|
|
$parser eval $script
|
| 599 |
|
|
} message ]
|
| 600 |
|
|
|
| 601 |
|
|
if { $status != 0 } {
|
| 602 |
|
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
| 603 |
|
|
}
|
| 604 |
|
|
|
| 605 |
|
|
# The interpreter and the aliased commands are no longer required.
|
| 606 |
|
|
rename set_package_data {}
|
| 607 |
|
|
rename set_target_data {}
|
| 608 |
|
|
rename set_template_data {}
|
| 609 |
|
|
rename add_known_package {}
|
| 610 |
|
|
interp delete $parser
|
| 611 |
|
|
|
| 612 |
|
|
# At this stage the packages file has been read in. It is a good idea to
|
| 613 |
|
|
# check that all of these packages are present and correct, and incidentally
|
| 614 |
|
|
# figure out which versions are present.
|
| 615 |
|
|
foreach pkg $ecosadmin::known_packages {
|
| 616 |
|
|
|
| 617 |
|
|
set pkgdir [file join $ecosadmin::component_repository $ecosadmin::package_data($pkg,dir)]
|
| 618 |
|
|
if { ![file exists $pkgdir] || ![file isdir $pkgdir] } {
|
| 619 |
|
|
warning "package $pkg at $pkgdir missing"
|
| 620 |
|
|
} else {
|
| 621 |
|
|
|
| 622 |
|
|
# Each subdirectory should correspond to a release. A utility routine
|
| 623 |
|
|
# is available for this.
|
| 624 |
|
|
set ecosadmin::package_data($pkg,versions) [locate_subdirs $pkgdir]
|
| 625 |
|
|
if { $ecosadmin::package_data($pkg,versions) == "" } {
|
| 626 |
|
|
fatal_error "package $pkg has no version directories"
|
| 627 |
|
|
}
|
| 628 |
|
|
}
|
| 629 |
|
|
|
| 630 |
|
|
# Sort all the versions using a version-aware comparison version
|
| 631 |
|
|
set ecosadmin::package_data($pkg,versions) [
|
| 632 |
|
|
lsort -command ecosadmin::cdl_compare_version $ecosadmin::package_data($pkg,versions)
|
| 633 |
|
|
]
|
| 634 |
|
|
}
|
| 635 |
|
|
}
|
| 636 |
|
|
|
| 637 |
|
|
#
|
| 638 |
|
|
# Given a package name as supplied by the user, return the internal package name.
|
| 639 |
|
|
# This involves searching through the list of aliases.
|
| 640 |
|
|
#
|
| 641 |
|
|
proc ecosadmin::find_package { name } {
|
| 642 |
|
|
|
| 643 |
|
|
foreach pkg $ecosadmin::known_packages {
|
| 644 |
|
|
if { [string toupper $pkg] == [string toupper $name] } {
|
| 645 |
|
|
return $pkg
|
| 646 |
|
|
}
|
| 647 |
|
|
|
| 648 |
|
|
foreach alias $ecosadmin::package_data($pkg,alias) {
|
| 649 |
|
|
if { [string toupper $alias] == [string toupper $name] } {
|
| 650 |
|
|
return $pkg
|
| 651 |
|
|
}
|
| 652 |
|
|
}
|
| 653 |
|
|
}
|
| 654 |
|
|
|
| 655 |
|
|
return ""
|
| 656 |
|
|
}
|
| 657 |
|
|
|
| 658 |
|
|
# }}}
|
| 659 |
|
|
# {{{ Directory and file utilities
|
| 660 |
|
|
|
| 661 |
|
|
# ----------------------------------------------------------------------------
|
| 662 |
|
|
# Start with a number of utility routines to access all files in
|
| 663 |
|
|
# a directory, stripping out well-known files such as makefile.am.
|
| 664 |
|
|
# The routines take an optional pattern argument if only certain
|
| 665 |
|
|
# files are of interest.
|
| 666 |
|
|
#
|
| 667 |
|
|
# Note that symbolic links are returned as well as files.
|
| 668 |
|
|
#
|
| 669 |
|
|
proc ecosadmin::locate_files { dir { pattern "*"} } {
|
| 670 |
|
|
|
| 671 |
|
|
ASSERT { $dir != "" }
|
| 672 |
|
|
|
| 673 |
|
|
# Start by getting a list of all the files.
|
| 674 |
|
|
set filelist [glob -nocomplain -- [file join $dir $pattern]]
|
| 675 |
|
|
|
| 676 |
|
|
if { $pattern == "*" } {
|
| 677 |
|
|
# For "everything", include ".*" files, but excluding .
|
| 678 |
|
|
# and .. directories
|
| 679 |
|
|
lappend filelist [glob -nocomplain -- [file join $dir ".\[a-zA-Z0-9\]*"]]
|
| 680 |
|
|
}
|
| 681 |
|
|
|
| 682 |
|
|
# Eliminate the pathnames from all of these files
|
| 683 |
|
|
set filenames ""
|
| 684 |
|
|
foreach file $filelist {
|
| 685 |
|
|
if { [string range $file end end] != "~" } {
|
| 686 |
|
|
lappend filenames [file tail $file]
|
| 687 |
|
|
}
|
| 688 |
|
|
}
|
| 689 |
|
|
|
| 690 |
|
|
# Eliminate any subdirectories.
|
| 691 |
|
|
set subdirs ""
|
| 692 |
|
|
foreach name $filenames {
|
| 693 |
|
|
if { [file isdir [file join $dir $name]] } {
|
| 694 |
|
|
lappend subdirs $name
|
| 695 |
|
|
}
|
| 696 |
|
|
}
|
| 697 |
|
|
foreach subdir $subdirs {
|
| 698 |
|
|
set index [lsearch -exact $filenames $subdir]
|
| 699 |
|
|
set filenames [lreplace $filenames $index $index]
|
| 700 |
|
|
}
|
| 701 |
|
|
|
| 702 |
|
|
return $filenames
|
| 703 |
|
|
}
|
| 704 |
|
|
|
| 705 |
|
|
#
|
| 706 |
|
|
# This utility returns all sub-directories, as opposed to all files.
|
| 707 |
|
|
# A variant glob pattern is used here. This version is not recursive.
|
| 708 |
|
|
proc ecosadmin::locate_subdirs { dir { pattern "*" }} {
|
| 709 |
|
|
|
| 710 |
|
|
ASSERT { $dir != "" }
|
| 711 |
|
|
|
| 712 |
|
|
set dirlist [glob -nocomplain -- [file join $dir $pattern "."]]
|
| 713 |
|
|
|
| 714 |
|
|
# Eliminate the pathnames and the spurious /. at the end of each entry
|
| 715 |
|
|
set dirnames ""
|
| 716 |
|
|
foreach dir $dirlist {
|
| 717 |
|
|
lappend dirnames [file tail [file dirname $dir]]
|
| 718 |
|
|
}
|
| 719 |
|
|
|
| 720 |
|
|
# Get rid of the CVS directory, if any
|
| 721 |
|
|
if { $ecosadmin::keep_cvs == 0 } {
|
| 722 |
|
|
set index [lsearch -exact $dirnames "CVS"]
|
| 723 |
|
|
if { $index != -1 } {
|
| 724 |
|
|
set dirnames [lreplace $dirnames $index $index]
|
| 725 |
|
|
}
|
| 726 |
|
|
}
|
| 727 |
|
|
|
| 728 |
|
|
# That should be it.
|
| 729 |
|
|
return $dirnames
|
| 730 |
|
|
}
|
| 731 |
|
|
|
| 732 |
|
|
#
|
| 733 |
|
|
# A variant which is recursive. This one does not support a pattern.
|
| 734 |
|
|
#
|
| 735 |
|
|
proc ecosadmin::locate_all_subdirs { dir } {
|
| 736 |
|
|
|
| 737 |
|
|
ASSERT { $dir != "" }
|
| 738 |
|
|
|
| 739 |
|
|
set result ""
|
| 740 |
|
|
foreach subdir [locate_subdirs $dir] {
|
| 741 |
|
|
lappend result $subdir
|
| 742 |
|
|
foreach x [locate_all_subdirs [file join $dir $subdir]] {
|
| 743 |
|
|
lappend result [file join $subdir $x]
|
| 744 |
|
|
}
|
| 745 |
|
|
}
|
| 746 |
|
|
return $result
|
| 747 |
|
|
}
|
| 748 |
|
|
|
| 749 |
|
|
#
|
| 750 |
|
|
# This routine returns a list of all the files in a given directory and in
|
| 751 |
|
|
# all subdirectories, preserving the subdirectory name.
|
| 752 |
|
|
#
|
| 753 |
|
|
proc ecosadmin::locate_all_files { dir { pattern "*" } } {
|
| 754 |
|
|
|
| 755 |
|
|
ASSERT { $dir != "" }
|
| 756 |
|
|
|
| 757 |
|
|
set files [locate_files $dir $pattern]
|
| 758 |
|
|
set subdirs [locate_subdirs $dir]
|
| 759 |
|
|
|
| 760 |
|
|
foreach subdir $subdirs {
|
| 761 |
|
|
set subfiles [locate_all_files [file join $dir $subdir] $pattern]
|
| 762 |
|
|
foreach file $subfiles {
|
| 763 |
|
|
lappend files [file join $subdir $file]
|
| 764 |
|
|
}
|
| 765 |
|
|
}
|
| 766 |
|
|
|
| 767 |
|
|
return $files
|
| 768 |
|
|
}
|
| 769 |
|
|
|
| 770 |
|
|
#
|
| 771 |
|
|
# Sometimes a directory may be empty, or contain just a CVS subdirectory,
|
| 772 |
|
|
# in which case there is no point in copying it across.
|
| 773 |
|
|
#
|
| 774 |
|
|
proc ecosadmin::is_empty_directory { dir } {
|
| 775 |
|
|
|
| 776 |
|
|
ASSERT { $dir != "" }
|
| 777 |
|
|
|
| 778 |
|
|
set contents [glob -nocomplain -- [file join $dir "*"]]
|
| 779 |
|
|
if { [llength $contents] == 0 } {
|
| 780 |
|
|
return 1
|
| 781 |
|
|
}
|
| 782 |
|
|
if { ([llength $contents] == 1) && [string match {*CVS} $contents] } {
|
| 783 |
|
|
return 1
|
| 784 |
|
|
}
|
| 785 |
|
|
return 0
|
| 786 |
|
|
}
|
| 787 |
|
|
|
| 788 |
|
|
#
|
| 789 |
|
|
# ----------------------------------------------------------------------------
|
| 790 |
|
|
# Take a cygwin32 filename such as //d/tmp/pkgobj and turn it into something
|
| 791 |
|
|
# acceptable to Tcl, i.e. d:/tmp/pkgobj. There are a few other complications...
|
| 792 |
|
|
|
| 793 |
|
|
proc ecosadmin::get_pathname_for_tcl { name } {
|
| 794 |
|
|
|
| 795 |
|
|
if { ( $ecosadmin::windows_host ) && ( $name != "" ) } {
|
| 796 |
|
|
|
| 797 |
|
|
# If there is no logical drive letter specified
|
| 798 |
|
|
if { [ string match "?:*" $name ] == 0 } {
|
| 799 |
|
|
|
| 800 |
|
|
# Invoke cygpath to resolve the POSIX-style path
|
| 801 |
|
|
if { [ catch { exec cygpath -w $name } result ] != 0 } {
|
| 802 |
|
|
fatal_error "processing filepath $name:\n$result"
|
| 803 |
|
|
}
|
| 804 |
|
|
} else {
|
| 805 |
|
|
set result $name
|
| 806 |
|
|
}
|
| 807 |
|
|
|
| 808 |
|
|
# Convert backslashes to forward slashes
|
| 809 |
|
|
regsub -all -- {\\} $result "/" name
|
| 810 |
|
|
}
|
| 811 |
|
|
|
| 812 |
|
|
return $name
|
| 813 |
|
|
}
|
| 814 |
|
|
|
| 815 |
|
|
# ----------------------------------------------------------------------------
|
| 816 |
|
|
# Make sure that a newly created or copied file is writable. This operation
|
| 817 |
|
|
# is platform-specific. Under Unix at most the current user is given
|
| 818 |
|
|
# permission, since there does not seem to be any easy way to get hold
|
| 819 |
|
|
# of the real umask.
|
| 820 |
|
|
|
| 821 |
|
|
proc ecosadmin::make_writable { name } {
|
| 822 |
|
|
|
| 823 |
|
|
ASSERT { $name != "" }
|
| 824 |
|
|
ASSERT { [file isfile $name] }
|
| 825 |
|
|
|
| 826 |
|
|
if { [file writable $name] == 0 } {
|
| 827 |
|
|
if { $ecosadmin::windows_host != 0 } {
|
| 828 |
|
|
file attributes $name -readonly 0
|
| 829 |
|
|
} else {
|
| 830 |
|
|
set mask [file attributes $name -permissions]
|
| 831 |
|
|
set mask [expr $mask | 0200]
|
| 832 |
|
|
file attributes $name -permissions $mask
|
| 833 |
|
|
}
|
| 834 |
|
|
}
|
| 835 |
|
|
}
|
| 836 |
|
|
|
| 837 |
|
|
# }}}
|
| 838 |
|
|
# {{{ main()
|
| 839 |
|
|
|
| 840 |
|
|
#-----------------------------------------------------------------------
|
| 841 |
|
|
# Procedure target_requires_missing_package determines whether a
|
| 842 |
|
|
# target entry is dependent on missing packages. It is called when
|
| 843 |
|
|
# filtering templates out of the database
|
| 844 |
|
|
|
| 845 |
|
|
proc ecosadmin::target_requires_missing_package { target } {
|
| 846 |
|
|
foreach package $ecosadmin::target_data($target,packages) {
|
| 847 |
|
|
if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
|
| 848 |
|
|
return 1
|
| 849 |
|
|
}
|
| 850 |
|
|
}
|
| 851 |
|
|
return 0
|
| 852 |
|
|
}
|
| 853 |
|
|
|
| 854 |
|
|
#-----------------------------------------------------------------------
|
| 855 |
|
|
# Procedure template_requires_missing_package determines whether a
|
| 856 |
|
|
# template entry is dependent on missing packages. It is called when
|
| 857 |
|
|
# filtering templates out of the database
|
| 858 |
|
|
|
| 859 |
|
|
proc ecosadmin::template_requires_missing_package { template } {
|
| 860 |
|
|
foreach package $ecosadmin::template_data($template,packages) {
|
| 861 |
|
|
if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
|
| 862 |
|
|
return 1
|
| 863 |
|
|
}
|
| 864 |
|
|
}
|
| 865 |
|
|
return 0
|
| 866 |
|
|
}
|
| 867 |
|
|
|
| 868 |
|
|
#-----------------------------------------------------------------------
|
| 869 |
|
|
# Procedure target_requires_any_package determines whether a target entry
|
| 870 |
|
|
# is dependent on specified packages. It is called when removing packages
|
| 871 |
|
|
# to determine whether a target should also be removed
|
| 872 |
|
|
|
| 873 |
|
|
proc ecosadmin::target_requires_any_package { target packages } {
|
| 874 |
|
|
foreach package $packages {
|
| 875 |
|
|
if { [ lsearch $ecosadmin::target_data($target,packages) $package ] != -1 } {
|
| 876 |
|
|
return 1
|
| 877 |
|
|
}
|
| 878 |
|
|
}
|
| 879 |
|
|
return 0
|
| 880 |
|
|
}
|
| 881 |
|
|
|
| 882 |
|
|
#-----------------------------------------------------------------------
|
| 883 |
|
|
# Procedure template_requires_any_package determines whether a template entry
|
| 884 |
|
|
# is dependent on specified packages. It is called when removing packages
|
| 885 |
|
|
# to determine whether a template should also be removed
|
| 886 |
|
|
|
| 887 |
|
|
proc ecosadmin::template_requires_any_package { template packages } {
|
| 888 |
|
|
foreach package $packages {
|
| 889 |
|
|
if { [ lsearch $ecosadmin::template_data($template,packages) $package ] != -1 } {
|
| 890 |
|
|
return 1
|
| 891 |
|
|
}
|
| 892 |
|
|
}
|
| 893 |
|
|
return 0
|
| 894 |
|
|
}
|
| 895 |
|
|
|
| 896 |
|
|
#-----------------------------------------------------------------------
|
| 897 |
|
|
# Procedure merge_new_packages adds any entries in the specified data
|
| 898 |
|
|
# file to the eCos repository database iff they are not already present
|
| 899 |
|
|
|
| 900 |
|
|
proc ecosadmin::merge_new_packages { datafile } {
|
| 901 |
|
|
|
| 902 |
|
|
# open the eCos database file for appending
|
| 903 |
|
|
set ecosfile [ file join $ecosadmin::component_repository "ecos.db" ]
|
| 904 |
|
|
variable outfile [ open $ecosfile a+ ]
|
| 905 |
|
|
|
| 906 |
|
|
# this procedure is called when the interpreter encounters a
|
| 907 |
|
|
# package command in the datafile
|
| 908 |
|
|
proc merge { command name body } {
|
| 909 |
|
|
ecosadmin::report "adding $command $name"
|
| 910 |
|
|
# append the new package/target/template only if it is not already known
|
| 911 |
|
|
if { ( ( $command == "package" ) && ( [ lsearch -exact $ecosadmin::known_packages $name ] == -1 ) ) ||
|
| 912 |
|
|
( ( $command == "target" ) && ( [ lsearch -exact $ecosadmin::known_targets $name ] == -1 ) ) ||
|
| 913 |
|
|
( ( $command == "template" ) && ( [ lsearch -exact $ecosadmin::known_templates $name ] == -1 ) ) } {
|
| 914 |
|
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
| 915 |
|
|
}
|
| 916 |
|
|
}
|
| 917 |
|
|
|
| 918 |
|
|
# Create the parser, add the aliased commands, and then define
|
| 919 |
|
|
# the routines that do the real work.
|
| 920 |
|
|
set parser [ interp create -safe ]
|
| 921 |
|
|
$parser alias merge ecosadmin::merge
|
| 922 |
|
|
$parser eval {
|
| 923 |
|
|
proc package { name body } {
|
| 924 |
|
|
merge "package" $name $body
|
| 925 |
|
|
}
|
| 926 |
|
|
|
| 927 |
|
|
proc template { name body } {
|
| 928 |
|
|
merge "template" $name $body
|
| 929 |
|
|
}
|
| 930 |
|
|
|
| 931 |
|
|
proc target { name body } {
|
| 932 |
|
|
merge "target" $name $body
|
| 933 |
|
|
}
|
| 934 |
|
|
}
|
| 935 |
|
|
|
| 936 |
|
|
# The parser is ready to evaluate the script. To avoid having to give the
|
| 937 |
|
|
# safe interpreter file I/O capabilities, the file is actually read in
|
| 938 |
|
|
# here and then evaluated.
|
| 939 |
|
|
set filename [ file join $ecosadmin::component_repository $datafile ]
|
| 940 |
|
|
set status [ catch {
|
| 941 |
|
|
set fd [ open $filename r ]
|
| 942 |
|
|
set script [ read $fd ]
|
| 943 |
|
|
close $fd
|
| 944 |
|
|
$parser eval $script
|
| 945 |
|
|
} message ]
|
| 946 |
|
|
|
| 947 |
|
|
# The interpreter and the aliased commands are no longer required.
|
| 948 |
|
|
rename merge {}
|
| 949 |
|
|
interp delete $parser
|
| 950 |
|
|
|
| 951 |
|
|
# close the eCos database file
|
| 952 |
|
|
close $outfile
|
| 953 |
|
|
|
| 954 |
|
|
# report errors
|
| 955 |
|
|
if { $status != 0 } {
|
| 956 |
|
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
| 957 |
|
|
}
|
| 958 |
|
|
}
|
| 959 |
|
|
|
| 960 |
|
|
#-----------------------------------------------------------------------
|
| 961 |
|
|
# Procedure filter_old_packages removes the specified packages/versions
|
| 962 |
|
|
# from the eCos repository database. Any targets and templates dependent
|
| 963 |
|
|
# on the removed packages are also removed.
|
| 964 |
|
|
|
| 965 |
|
|
proc ecosadmin::filter_old_packages { old_packages } {
|
| 966 |
|
|
|
| 967 |
|
|
# open the new eCos database file for writing
|
| 968 |
|
|
set ecosfile [ file join $ecosadmin::component_repository "ecos.db.new" ]
|
| 969 |
|
|
variable outfile [ open $ecosfile w ]
|
| 970 |
|
|
variable filter_list $old_packages
|
| 971 |
|
|
variable removed_packages ""
|
| 972 |
|
|
|
| 973 |
|
|
# this procedure is called when the interpreter encounters a command in the datafile on the first pass
|
| 974 |
|
|
# it generates a list of packages which will be removed on the second pass
|
| 975 |
|
|
proc removelist { command name body } {
|
| 976 |
|
|
if { [ lsearch $ecosadmin::filter_list $name ] != -1 } {
|
| 977 |
|
|
# the package is in the filter list
|
| 978 |
|
|
if { ( $ecosadmin::version_arg == "" ) || ( [ llength $ecosadmin::package_data($name,versions) ] == 1 ) } {
|
| 979 |
|
|
# there is no version argument or only one version so add the package to the remove list
|
| 980 |
|
|
set ::ecosadmin::removed_packages [ lappend ::ecosadmin::removed_packages $name ]
|
| 981 |
|
|
}
|
| 982 |
|
|
}
|
| 983 |
|
|
}
|
| 984 |
|
|
|
| 985 |
|
|
# this procedure is called when the interpreter encounters a command in the datafile on the second pass
|
| 986 |
|
|
proc filter { command name body } {
|
| 987 |
|
|
if { ( $command == "target" ) && ( ( [ target_requires_any_package $name $ecosadmin::removed_packages ] != 0 ) || ( [ target_requires_missing_package $name ] != 0 ) ) } {
|
| 988 |
|
|
# the target requires a package which has been removed so remove the target
|
| 989 |
|
|
ecosadmin::report "removing target $name"
|
| 990 |
|
|
} elseif { ( $command == "template" ) && ( ( [ template_requires_any_package $name $ecosadmin::removed_packages ] != 0 ) || ( [ template_requires_missing_package $name ] != 0 ) ) } {
|
| 991 |
|
|
# the template requires a package which has been removed so remove the template
|
| 992 |
|
|
ecosadmin::report "removing template $name"
|
| 993 |
|
|
} elseif { [ lsearch $ecosadmin::filter_list $name ] == -1 } {
|
| 994 |
|
|
# the package is not in the filter list so copy the data to the new database
|
| 995 |
|
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
| 996 |
|
|
} else {
|
| 997 |
|
|
# the package is in the filter list
|
| 998 |
|
|
set package_dir [ file join $ecosadmin::component_repository $ecosadmin::package_data($name,dir) ]
|
| 999 |
|
|
if { ( $ecosadmin::version_arg != "" ) && ( [ llength $ecosadmin::package_data($name,versions) ] > 1 ) } {
|
| 1000 |
|
|
# there are multiple versions and only one version will be removed
|
| 1001 |
|
|
# so copy the data to the new database and only remove one version directory
|
| 1002 |
|
|
set package_dir [ file join $package_dir $ecosadmin::version_arg ]
|
| 1003 |
|
|
ecosadmin::report "removing package $name $ecosadmin::version_arg"
|
| 1004 |
|
|
puts $ecosadmin::outfile "$command $name {$body}\n"
|
| 1005 |
|
|
} else {
|
| 1006 |
|
|
# there is no version argument or only one version so delete the package directory
|
| 1007 |
|
|
ecosadmin::report "removing package $name"
|
| 1008 |
|
|
}
|
| 1009 |
|
|
if { [ catch { file delete -force -- $package_dir } message ] != 0 } {
|
| 1010 |
|
|
# issue a warning if package deletion failed - this is not fatal
|
| 1011 |
|
|
ecosadmin::warning $message
|
| 1012 |
|
|
}
|
| 1013 |
|
|
}
|
| 1014 |
|
|
}
|
| 1015 |
|
|
|
| 1016 |
|
|
# Create the parser, add the aliased commands, and then define
|
| 1017 |
|
|
# the routines that do the real work.
|
| 1018 |
|
|
set parser [ interp create -safe ]
|
| 1019 |
|
|
$parser eval {
|
| 1020 |
|
|
proc package { name body } {
|
| 1021 |
|
|
filter "package" $name $body
|
| 1022 |
|
|
}
|
| 1023 |
|
|
|
| 1024 |
|
|
proc template { name body } {
|
| 1025 |
|
|
filter "template" $name $body
|
| 1026 |
|
|
}
|
| 1027 |
|
|
|
| 1028 |
|
|
proc target { name body } {
|
| 1029 |
|
|
filter "target" $name $body
|
| 1030 |
|
|
}
|
| 1031 |
|
|
}
|
| 1032 |
|
|
|
| 1033 |
|
|
# The parser is ready to evaluate the script. To avoid having to give the
|
| 1034 |
|
|
# safe interpreter file I/O capabilities, the file is actually read in
|
| 1035 |
|
|
# here and then evaluated.
|
| 1036 |
|
|
set filename [ file join $ecosadmin::component_repository "ecos.db" ]
|
| 1037 |
|
|
set status [ catch {
|
| 1038 |
|
|
set fd [ open $filename r ]
|
| 1039 |
|
|
set script [ read $fd ]
|
| 1040 |
|
|
close $fd
|
| 1041 |
|
|
|
| 1042 |
|
|
# first pass to generate a list of packages which will be removed
|
| 1043 |
|
|
$parser alias filter ecosadmin::removelist
|
| 1044 |
|
|
$parser eval $script
|
| 1045 |
|
|
|
| 1046 |
|
|
# second pass to remove the packages, targets and templates
|
| 1047 |
|
|
$parser alias filter ecosadmin::filter
|
| 1048 |
|
|
$parser eval $script
|
| 1049 |
|
|
} message ]
|
| 1050 |
|
|
|
| 1051 |
|
|
# The interpreter and the aliased commands are no longer required.
|
| 1052 |
|
|
rename filter {}
|
| 1053 |
|
|
interp delete $parser
|
| 1054 |
|
|
|
| 1055 |
|
|
# close the new eCos database file
|
| 1056 |
|
|
close $outfile
|
| 1057 |
|
|
|
| 1058 |
|
|
# report errors
|
| 1059 |
|
|
if { $status != 0 } {
|
| 1060 |
|
|
ecosadmin::fatal_error "parsing $filename:\n$message"
|
| 1061 |
|
|
}
|
| 1062 |
|
|
|
| 1063 |
|
|
# replace the old eCos database file with the new one
|
| 1064 |
|
|
file rename -force $ecosfile $filename
|
| 1065 |
|
|
}
|
| 1066 |
|
|
|
| 1067 |
|
|
# ----------------------------------------------------------------------------
|
| 1068 |
|
|
# Process_add_packages. This routine is responsible for installing packages
|
| 1069 |
|
|
# into the eCos repository using the gzip and tar tools which must be on
|
| 1070 |
|
|
# the path
|
| 1071 |
|
|
#
|
| 1072 |
|
|
|
| 1073 |
|
|
proc ecosadmin::process_add_package { } {
|
| 1074 |
|
|
ASSERT { $ecosadmin::add_package != "" }
|
| 1075 |
|
|
ASSERT { $ecosadmin::component_repository != "" }
|
| 1076 |
|
|
|
| 1077 |
|
|
# calculate the absolute path of the specified package archive
|
| 1078 |
|
|
# since we must change directory before extracting files
|
| 1079 |
|
|
# note that we cannot use "tar -C" to avoid changing directory
|
| 1080 |
|
|
# since "tar -C" only accepts relative paths
|
| 1081 |
|
|
set abs_package [ file join [ pwd ] $ecosadmin::add_package ]
|
| 1082 |
|
|
set datafile "pkgadd.db"
|
| 1083 |
|
|
set licensefile "pkgadd.txt"
|
| 1084 |
|
|
set logfile "pkgadd.log"
|
| 1085 |
|
|
cd $ecosadmin::component_repository
|
| 1086 |
|
|
|
| 1087 |
|
|
# check for --extract_license on command line
|
| 1088 |
|
|
if { $ecosadmin::extract_license_arg == 1 } {
|
| 1089 |
|
|
# extract the license file (if any) from the specified gzipped tar archive
|
| 1090 |
|
|
file delete $licensefile
|
| 1091 |
|
|
catch { exec > $ecosadmin::null_device gzip -d < $abs_package | tar xf - $licensefile }
|
| 1092 |
|
|
return
|
| 1093 |
|
|
}
|
| 1094 |
|
|
|
| 1095 |
|
|
# extract the package data file from the specified gzipped tar archive
|
| 1096 |
|
|
if { [ catch { exec > $ecosadmin::null_device gzip -d < $abs_package | tar xf - $datafile } message ] != 0 } {
|
| 1097 |
|
|
fatal_error "extracting $datafile:\n$message"
|
| 1098 |
|
|
}
|
| 1099 |
|
|
|
| 1100 |
|
|
# obtain license acceptance
|
| 1101 |
|
|
if { [ ecosadmin::accept_license $abs_package $licensefile ] != "y" } {
|
| 1102 |
|
|
file delete $datafile
|
| 1103 |
|
|
file delete $licensefile
|
| 1104 |
|
|
fatal_error "license agreement not accepted"
|
| 1105 |
|
|
}
|
| 1106 |
|
|
|
| 1107 |
|
|
# extract the remaining package contents and generate a list of extracted files
|
| 1108 |
|
|
if { [ catch { exec gzip -d < $abs_package | tar xvf - > $logfile } message ] != 0 } {
|
| 1109 |
|
|
file delete $logfile
|
| 1110 |
|
|
fatal_error "extracting files:\n$message"
|
| 1111 |
|
|
}
|
| 1112 |
|
|
|
| 1113 |
|
|
# read the list of extracted files from the log file
|
| 1114 |
|
|
set fd [ open $logfile r ]
|
| 1115 |
|
|
set message [ read $fd ]
|
| 1116 |
|
|
close $fd
|
| 1117 |
|
|
file delete $logfile
|
| 1118 |
|
|
|
| 1119 |
|
|
# convert extracted text files to use the line-ending convention of the host
|
| 1120 |
|
|
set filelist [ split $message "\n" ]
|
| 1121 |
|
|
set binary_extension ".bin"
|
| 1122 |
|
|
foreach filename $filelist {
|
| 1123 |
|
|
if { [ file isfile $filename ] != 0 } {
|
| 1124 |
|
|
if { [ file extension $filename ] == $binary_extension } {
|
| 1125 |
|
|
# a binary file - so remove the binary extension
|
| 1126 |
|
|
file rename -force -- $filename [ file rootname $filename ]
|
| 1127 |
|
|
} else {
|
| 1128 |
|
|
# a text file - so convert file to use native line-endings
|
| 1129 |
|
|
# read in the file (line-ending conversion is implicit)
|
| 1130 |
|
|
set fd [ open $filename "r" ]
|
| 1131 |
|
|
set filetext [ read $fd ]
|
| 1132 |
|
|
close $fd
|
| 1133 |
|
|
|
| 1134 |
|
|
# write the file out again
|
| 1135 |
|
|
set fd [ open $filename "w" ]
|
| 1136 |
|
|
puts -nonewline $fd $filetext
|
| 1137 |
|
|
close $fd
|
| 1138 |
|
|
}
|
| 1139 |
|
|
}
|
| 1140 |
|
|
}
|
| 1141 |
|
|
|
| 1142 |
|
|
# merge the new package information into the eCos database file as necessary
|
| 1143 |
|
|
ecosadmin::merge_new_packages $datafile
|
| 1144 |
|
|
|
| 1145 |
|
|
# delete the database and license files
|
| 1146 |
|
|
file delete $datafile
|
| 1147 |
|
|
file delete $licensefile
|
| 1148 |
|
|
|
| 1149 |
|
|
# read the revised database back in and remove any
|
| 1150 |
|
|
# targets and templates with missing packages
|
| 1151 |
|
|
read_data
|
| 1152 |
|
|
filter_old_packages ""
|
| 1153 |
|
|
}
|
| 1154 |
|
|
|
| 1155 |
|
|
# ----------------------------------------------------------------------------
|
| 1156 |
|
|
# Process_remove_package. This routine is responsible for uninstalling a
|
| 1157 |
|
|
# package from the eCos repository
|
| 1158 |
|
|
#
|
| 1159 |
|
|
|
| 1160 |
|
|
proc ecosadmin::process_remove_package { } {
|
| 1161 |
|
|
ASSERT { $ecosadmin::remove_package != "" }
|
| 1162 |
|
|
|
| 1163 |
|
|
# get the formal package name
|
| 1164 |
|
|
set package_name [ ecosadmin::find_package $ecosadmin::remove_package ]
|
| 1165 |
|
|
if { $package_name == "" } {
|
| 1166 |
|
|
# package not found
|
| 1167 |
|
|
fatal_error "package not found"
|
| 1168 |
|
|
} elseif { $ecosadmin::version_arg == "" } {
|
| 1169 |
|
|
# version not specified
|
| 1170 |
|
|
# if { [ llength $ecosadmin::package_data($package_name,versions) ] > 1 } {
|
| 1171 |
|
|
# fatal_error "multiple versions, use --version"
|
| 1172 |
|
|
# }
|
| 1173 |
|
|
} elseif { [ lsearch $ecosadmin::package_data($package_name,versions) $ecosadmin::version_arg ] == -1 } {
|
| 1174 |
|
|
# specified version not found
|
| 1175 |
|
|
fatal_error "version not found"
|
| 1176 |
|
|
}
|
| 1177 |
|
|
|
| 1178 |
|
|
# filter out the old package from the eCos database file
|
| 1179 |
|
|
filter_old_packages $package_name
|
| 1180 |
|
|
}
|
| 1181 |
|
|
|
| 1182 |
|
|
# ----------------------------------------------------------------------------
|
| 1183 |
|
|
# Accept_license. This routine is responsible for displaying the package
|
| 1184 |
|
|
# license and obtaining user acceptance. It returns "y" if the license is
|
| 1185 |
|
|
# accepted.
|
| 1186 |
|
|
#
|
| 1187 |
|
|
|
| 1188 |
|
|
proc ecosadmin::accept_license { archivename filename } {
|
| 1189 |
|
|
ASSERT { $ecosadmin::add_package != "" }
|
| 1190 |
|
|
|
| 1191 |
|
|
# check for --accept_license on command line
|
| 1192 |
|
|
if { $ecosadmin::accept_license_arg == 1 } {
|
| 1193 |
|
|
# --accept_license specified so do not prompt for acceptance
|
| 1194 |
|
|
return "y"
|
| 1195 |
|
|
}
|
| 1196 |
|
|
|
| 1197 |
|
|
# extract the specified license file from the specified gzipped tar archive
|
| 1198 |
|
|
if { [ catch { exec > $ecosadmin::null_device gzip -d < $archivename | tar xf - $filename } message ] != 0 } {
|
| 1199 |
|
|
# no license file
|
| 1200 |
|
|
return "y"
|
| 1201 |
|
|
}
|
| 1202 |
|
|
|
| 1203 |
|
|
# read in the file and output to the user
|
| 1204 |
|
|
set fd [ open $filename "r" ]
|
| 1205 |
|
|
set filetext [ read $fd ]
|
| 1206 |
|
|
close $fd
|
| 1207 |
|
|
puts $filetext
|
| 1208 |
|
|
|
| 1209 |
|
|
# prompt for acceptance
|
| 1210 |
|
|
puts -nonewline "Do you accept all the terms of the preceding license agreement? (y/n) "
|
| 1211 |
|
|
flush "stdout"
|
| 1212 |
|
|
gets "stdin" response
|
| 1213 |
|
|
|
| 1214 |
|
|
# return the first character of the response in lowercase
|
| 1215 |
|
|
return [ string tolower [ string index $response 0 ] ]
|
| 1216 |
|
|
}
|
| 1217 |
|
|
|
| 1218 |
|
|
# ----------------------------------------------------------------------------
|
| 1219 |
|
|
# Main(). This code only runs if the script is being run stand-alone rather
|
| 1220 |
|
|
# than as part of a larger application. The controlling predicate is the
|
| 1221 |
|
|
# existence of the variable ecosadmin_not_standalone which can be set by
|
| 1222 |
|
|
# the containing program if any.
|
| 1223 |
|
|
#
|
| 1224 |
|
|
|
| 1225 |
|
|
if { ! [info exists ecosadmin_not_standalone] } {
|
| 1226 |
|
|
|
| 1227 |
|
|
# Decide where warnings and fatal errors should go.
|
| 1228 |
|
|
ecosadmin::initialise_error_handling
|
| 1229 |
|
|
|
| 1230 |
|
|
# First, check for --help or any of the variants. If this script
|
| 1231 |
|
|
# is running in a larger program then it is assumed that the
|
| 1232 |
|
|
# containing program will not pass --help as an argument.
|
| 1233 |
|
|
if { ( $argv == "--help" ) || ( $argv == "-help" ) ||
|
| 1234 |
|
|
( $argv == "--H" ) || ( $argv == "-H" ) || ($argv == "" ) } {
|
| 1235 |
|
|
|
| 1236 |
|
|
ecosadmin::argument_help
|
| 1237 |
|
|
return
|
| 1238 |
|
|
}
|
| 1239 |
|
|
|
| 1240 |
|
|
# catch any errors while processing the specified command
|
| 1241 |
|
|
if { [ catch {
|
| 1242 |
|
|
|
| 1243 |
|
|
# Parse the arguments and set the global variables appropriately.
|
| 1244 |
|
|
ecosadmin::parse_arguments $argv0 $argv
|
| 1245 |
|
|
|
| 1246 |
|
|
# Read in the eCos repository database.
|
| 1247 |
|
|
ecosadmin::read_data
|
| 1248 |
|
|
|
| 1249 |
|
|
# Process the ecosadmin command
|
| 1250 |
|
|
if { $ecosadmin::list_packages_arg != 0 } {
|
| 1251 |
|
|
foreach pkg $ecosadmin::known_packages {
|
| 1252 |
|
|
ecosadmin::report "$pkg: $ecosadmin::package_data($pkg,versions)"
|
| 1253 |
|
|
}
|
| 1254 |
|
|
} elseif { $ecosadmin::add_package != "" } {
|
| 1255 |
|
|
ecosadmin::process_add_package
|
| 1256 |
|
|
} elseif { $ecosadmin::remove_package != "" } {
|
| 1257 |
|
|
ecosadmin::process_remove_package
|
| 1258 |
|
|
}
|
| 1259 |
|
|
|
| 1260 |
|
|
} error_message ] != 0 } {
|
| 1261 |
|
|
|
| 1262 |
|
|
# handle error message
|
| 1263 |
|
|
if { [ info exists gui_mode ] } {
|
| 1264 |
|
|
return $error_message
|
| 1265 |
|
|
}
|
| 1266 |
|
|
puts "ecosadmin error: $error_message"
|
| 1267 |
|
|
}
|
| 1268 |
|
|
return
|
| 1269 |
|
|
}
|
| 1270 |
|
|
|
| 1271 |
|
|
# }}}
|
