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`" "$@" ; \
6 echo "ecosadmin.tcl: cannot find Tcl shell" ; exit 1' "$0" "$@"
10 #===============================================================================
14 # A package install/uninstall tool.
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 ## Copyright (C) 2003 John Dallaway
22 ## Copyright (C) 2004 eCosCentric Limited
24 ## eCos is free software; you can redistribute it and/or modify it under
25 ## the terms of the GNU General Public License as published by the Free
26 ## Software Foundation; either version 2 or (at your option) any later version.
28 ## eCos is distributed in the hope that it will be useful, but WITHOUT ANY
29 ## WARRANTY; without even the implied warranty of MERCHANTABILITY or
30 ## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
33 ## You should have received a copy of the GNU General Public License along
34 ## with eCos; if not, write to the Free Software Foundation, Inc.,
35 ## 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
37 ## As a special exception, if other files instantiate templates or use macros
38 ## or inline functions from this file, or you compile this file and link it
39 ## with other works to produce a work based on this file, this file does not
40 ## by itself cause the resulting work to be covered by the GNU General Public
41 ## License. However the source code for this file must still be made available
42 ## in accordance with section (3) of the GNU General Public License.
44 ## This exception does not invalidate any other reasons why a work based on
45 ## this file might be covered by the GNU General Public License.
47 ## Alternative licenses for eCos may be arranged by contacting Red Hat, Inc.
48 ## at http://sources.redhat.com/ecos/ecos-license/
49 ## -------------------------------------------
50 #####ECOSGPLCOPYRIGHTEND####
51 #===============================================================================
52 ######DESCRIPTIONBEGIN####
57 # Purpose: To install and uninstall packages from an eCos component
62 #####DESCRIPTIONEND####
63 #===============================================================================
69 # ----------------------------------------------------------------------------
70 # ecosadmin.tcl requires at least version 8.0 of Tcl, since it makes use of
71 # namespaces. It is possible that some users still have older versions.
73 if { [info tclversion] < 8.0 } {
74 puts "This script requires Tcl 8.0 or later. You are running Tcl [info patchlevel]."
79 # {{{ Namespace definition
81 # ----------------------------------------------------------------------------
82 # Namespaces. All code and variables in this script are kept in the namespace
83 # "ecosadmin". This is not really necessary for stand-alone operation, but if it
84 # ever becomes desirable to embed this script in a larger application then
85 # using a namespace is a lot easier.
87 # As a fringe benefit, all global variables can be declared inside this
88 # namespace and initialised.
91 namespace eval ecosadmin {
93 # Is this program running under Windows ?
94 variable windows_host [expr {$tcl_platform(platform) == "windows"}]
95 variable null_device ""
96 if { $windows_host != 0 } {
97 set ecosadmin::null_device "nul"
99 set ecosadmin::null_device "/dev/null"
103 # Where is the component repository ? The following input sources
105 # 1) the environment variable ECOS_REPOSITORY.
106 # 2) $argv0 should correspond to the location of the ecosadmin.tcl
109 variable component_repository ""
110 if { [info exists ::env(ECOS_REPOSITORY)] } {
111 # override the calculation of the repository location using the
112 # (undocumented) ECOS_REPOSITORY environment variable
113 set component_repository $::env(ECOS_REPOSITORY)
115 set component_repository [pwd]
116 if { [file dirname $argv0] != "." } {
117 set component_repository [file join $component_repository [file dirname $argv0]]
121 # Details of the command line arguments, if any.
122 variable list_packages_arg 0; # list
123 variable accept_license_arg 0; # --accept_license
124 variable extract_license_arg 0; # --extract_license
125 variable add_package ""; # add FILE
126 variable remove_package ""; # remove PACKAGE
127 variable merge_repository ""; # merge REPOSITORY
128 variable version_arg ""; # --version VER
130 # Details of all known packages, targets and templates
131 # read from the ecos.db file
132 variable known_packages ""
133 variable known_targets ""
134 variable known_templates ""
135 array set package_data {};
136 array set target_data {};
137 array set template_data {};
139 # List of packages merged from another repository
140 variable merge_packages ""
142 # What routines should be invoked for outputting fatal errors and
143 # for warning messages ?
144 variable fatal_error_handler ecosadmin::cli_fatal_error
145 variable warning_handler ecosadmin::cli_warning
146 variable report_handler ecosadmin::cli_report
148 # Keep or remove the CVS directories?
155 # ----------------------------------------------------------------------------
156 # Minimal infrastructure support.
158 # There must be some way of reporting fatal errors, of outputting warnings,
159 # and of generating report messages. The implementation of these things
160 # obviously depends on whether or not TK is present. In addition, if this
161 # script is being run inside a larger application then that larger
162 # application must be able to install its own versions of the routines.
164 # Once it is possible to report fatal errors, an assertion facility becomes
167 # These routines output fatal errors, warnings or miscellaneous messages.
168 # Their implementations depend on the mode in which this script is operating.
170 proc ecosadmin::fatal_error { msg } {
171 $ecosadmin::fatal_error_handler "$msg"
174 proc ecosadmin::warning { msg } {
175 $ecosadmin::warning_handler "$msg"
178 proc ecosadmin::report { msg } {
179 $ecosadmin::report_handler "$msg"
183 # Command line versions.
184 # NOTE: some formatting so that there are linebreaks at ~72 columns would be
187 proc ecosadmin::cli_fatal_error_handler { msg } {
191 proc ecosadmin::cli_warning_handler { msg } {
192 puts "ecosadmin warning: $msg"
195 proc ecosadmin::cli_report_handler { msg } {
200 # Determine the default destination for warnings and for fatal errors.
201 # After the first call to this function it is possible to use assertions.
203 proc ecosadmin::initialise_error_handling { } {
204 set ecosadmin::fatal_error_handler ecosadmin::cli_fatal_error_handler
205 set ecosadmin::warning_handler ecosadmin::cli_warning_handler
206 set ecosadmin::report_handler ecosadmin::cli_report_handler
210 # These routines can be used by containing programs to provide their
211 # own error handling.
213 proc ecosadmin::set_fatal_error_handler { fn } {
215 set ecosadmin::fatal_error_handler $fn
218 proc ecosadmin::set_warning_handler { fn } {
220 set ecosadmin::warning_handler $fn
223 proc ecosadmin::set_report_handler { fn } {
225 set ecosadmin::report_handler $fn
229 # A very simple assertion facility. It takes a single argument, an expression
230 # that should be evaluated in the calling function's scope, and on failure it
231 # should generate a fatal error.
233 proc ecosadmin::ASSERT { condition } {
234 set result [uplevel 1 [list expr $condition]]
236 if { $result == 0 } {
237 fatal_error "assertion predicate \"$condition\"\nin \"[info level -1]\""
244 # ----------------------------------------------------------------------------
245 # cdl_compare_version. This is a partial implementation of the full
246 # cdl_compare_version facility defined in the product specification. Its
247 # purpose is to order the various versions of a given package with
248 # the most recent version first. As a special case, "current" is
249 # always considered the most recent.
251 # There are similarities between cdl_compare_version and with Tcl's
252 # package vcompare, but cdl_compare_version is more general.
255 proc ecosadmin::cdl_compare_version { arg1 arg2 } {
257 if { $arg1 == $arg2 } {
260 if { $arg1 == "current"} {
263 if { $arg2 == "current" } {
276 set ch1 [string index $arg1 $index1]
277 set ch2 [string index $arg2 $index2]
281 if { ($ch1 == "") && ($ch2 == "") } {
283 # Both strings have terminated at the same time. There may have
284 # been some spurious leading zeroes in numbers.
287 } elseif { $ch1 == "" } {
289 # The first string has ended first. If ch2 is a separator then
290 # arg2 is a derived version, e.g. v0.3.p1 and hence newer. Otherwise ch2
291 # is an experimental version v0.3beta and hence older.
292 if { [string match \[-._\] $ch2] } {
297 } elseif { $ch2 == "" } {
299 # Equivalent to the above.
300 if { [string match \[-._\] $ch1] } {
307 # There is still data to be processed.
308 # Check for both strings containing numbers at the current index.
309 if { ( [string match \[0-9\] $ch1] ) && ( [string match \[0-9\] $ch2] ) } {
311 # Extract the entire numbers from the version string.
312 while { [string match \[0-9\] $ch1] } {
315 set ch1 [string index $arg1 $index1]
317 while { [string match \[0-9\] $ch2] } {
320 set ch2 [string index $arg2 $index2]
323 if { $num1 < $num2 } {
325 } elseif { $num1 > $num2 } {
331 # This is not numerical data. If the two characters are the same then
333 if { $ch1 == $ch2 } {
339 # Next check if both strings are at a separator. All separators can be
340 # used interchangeably.
341 if { ( [string match \[-._\] $ch1] ) && ( [string match \[-._\] $ch2] ) } {
347 # There are differences in the characters and they are not interchangeable.
348 # Just return a standard string comparison.
349 return [string compare $ch1 $ch2]
354 # {{{ Argument parsing
356 # ----------------------------------------------------------------------------
357 # The argv0 argument should be the name of this script. It can be used
358 # to get at the component repository location. If this script has been
359 # run incorrectly then currently it will fail: in future it may be
360 # desirable to check an environment variable instead.
362 # The argv argument is a string containing the rest of the arguments.
363 # If any of the arguments contain spaces then this argument will be
364 # surrounded by braces. If any of the arguments contain braces then
368 proc ecosadmin::parse_arguments { argv0 argv } {
372 # There are arguments. If any of the arguments contained
373 # spaces then these arguments will have been surrounded
374 # by braces, which is a nuisance. So start by turning the
375 # arguments into a numerically indexed array.
380 set args([incr argc]) $arg
383 # Now examine each argument with regular expressions. It is
384 # useful to have some variables filled in by the regexp
389 for { set i 1 } { $i <= $argc } { incr i } {
391 # Check for --list and the other simple ones.
392 if { [regexp -- {^-?-?list$} $args($i)] == 1 } {
393 set ecosadmin::list_packages_arg 1
397 # check for --version
398 if { [regexp -- {^-?-version=?(.*)$} $args($i) dummy match1] == 1 } {
399 if { $match1 != "" } {
400 set ecosadmin::version_arg $match1
403 fatal_error "missing argument after --version"
405 set ecosadmin::version_arg $args([incr i])
411 # check for --accept_license
412 if { [regexp -- {^-?-accept_license$} $args($i)] == 1 } {
413 set ecosadmin::accept_license_arg 1
417 # check for --extract_license
418 if { [regexp -- {^-?-extract_license$} $args($i)] == 1 } {
419 set ecosadmin::extract_license_arg 1
423 # check for the add command
424 if { [regexp -- {^-?-?add=?(.*)$} $args($i) dummy match1] == 1 } {
425 if { $match1 != "" } {
426 set ecosadmin::add_package $match1
429 fatal_error "missing argument after add"
431 set ecosadmin::add_package $args([incr i])
437 # check for the merge command
438 if { [regexp -- {^-?-?merge=?(.*)$} $args($i) dummy match1] == 1 } {
439 if { $match1 != "" } {
440 set ecosadmin::merge_repository $match1
443 fatal_error "missing argument after merge"
445 set ecosadmin::merge_repository $args([incr i])
451 # check for the remove command
452 if { [regexp -- {^-?-?remove=?(.*)$} $args($i) dummy match1] == 1 } {
453 if { $match1 != "" } {
454 set ecosadmin::remove_package $match1
457 fatal_error "missing argument after remove"
459 set ecosadmin::remove_package $args([incr i])
466 if { [regexp -- {^-?-srcdir=?([ \.\\/:_a-zA-Z0-9-]*)$} $args($i) dummy match1] == 1 } {
467 if { $match1 == "" } {
469 puts "ecosrelease: missing argument after --srcdir"
472 set match1 $args([incr i])
475 set ecosadmin::component_repository $match1
479 # An unrecognised argument.
480 fatal_error "invalid argument $args($i)"
484 # Convert user-specified UNIX-style Cygwin pathnames to Windows Tcl-style as necessary
485 set ecosadmin::component_repository [get_pathname_for_tcl $ecosadmin::component_repository]
486 set ecosadmin::add_package [get_pathname_for_tcl $ecosadmin::add_package]
487 set ecosadmin::merge_repository [get_pathname_for_tcl $ecosadmin::merge_repository]
491 # Display help information if the user has typed --help, -H, --H, or -help.
492 # The help text uses two hyphens for consistency with configure.
493 # Arguably this should change.
495 proc ecosadmin::argument_help { } {
497 puts "Usage: ecosadmin \[ command \]"
498 puts " commands are:"
499 puts " list : list packages"
500 puts " add FILE : add packages"
501 puts " remove PACKAGE \[ --version VER \] : remove a package"
507 proc ecosadmin::read_data { silentflag } {
509 ASSERT { $ecosadmin::component_repository != "" }
511 set ecosadmin::known_packages ""
512 set ecosadmin::known_targets ""
513 set ecosadmin::known_templates ""
515 # A safe interpreter is used to process the packages file.
516 # This is somewhat overcautious, but it is also harmless.
517 # The following two commands are made accessible to the slave
518 # interpreter and are responsible for updating the actual data.
519 proc add_known_package { name } {
520 lappend ::ecosadmin::known_packages $name
522 proc add_known_target { name } {
523 lappend ::ecosadmin::known_targets $name
525 proc add_known_template { name } {
526 lappend ::ecosadmin::known_templates $name
528 proc set_package_data { name value } {
529 set ::ecosadmin::package_data($name) $value
531 proc set_target_data { name value } {
532 set ::ecosadmin::target_data($name) $value
534 proc set_template_data { name value } {
535 set ::ecosadmin::template_data($name) $value
538 # Create the parser, add the aliased commands, and then define
539 # the routines that do the real work.
540 set parser [interp create -safe]
541 $parser alias add_known_package ecosadmin::add_known_package
542 $parser alias add_known_target ecosadmin::add_known_target
543 $parser alias add_known_template ecosadmin::add_known_template
544 $parser alias set_package_data ecosadmin::set_package_data
545 $parser alias set_target_data ecosadmin::set_target_data
546 $parser alias set_template_data ecosadmin::set_template_data
550 set current_package ""
551 set current_target ""
552 set current_template ""
554 proc package { name body } {
555 add_known_package $name
556 set_package_data "$name,alias" ""
557 set_package_data "$name,versions" ""
558 set_package_data "$name,dir" ""
559 set_package_data "$name,hardware" 0
560 set ::current_package $name
562 set ::current_package ""
565 proc target { name body } {
566 add_known_target $name
567 set_target_data "$name,packages" ""
568 set ::current_target $name
570 set ::current_target ""
574 # templates are no longer specified in the package database
575 proc template { name body } {
576 add_known_template $name
577 set_template_data "$name,packages" ""
578 set ::current_template $name
580 set ::current_template ""
584 proc packages { str } {
585 if { $::current_template != "" } {
586 set_template_data "$::current_template,packages" $str
587 } elseif { $::current_target != "" } {
588 set_target_data "$::current_target,packages" $str
594 proc directory { dir } {
595 set_package_data "$::current_package,dir" $dir
599 if { $::current_package != "" } {
600 set_package_data "$::current_package,alias" $str
605 set_package_data "$::current_package,hardware" 1
608 proc description { str } { }
609 proc disable { str } { }
610 proc enable { str } { }
611 proc script { str } { }
612 proc set_value { str1 str2 } { }
615 # The parser is ready to evaluate the script. To avoid having to give the
616 # safe interpreter file I/O capabilities, the file is actually read in
617 # here and then evaluated.
618 set filename [file join $ecosadmin::component_repository "ecos.db"]
620 set fd [open $filename r]
621 set script [read $fd]
626 if { $status != 0 } {
627 ecosadmin::fatal_error "parsing $filename:\n$message"
630 # The interpreter and the aliased commands are no longer required.
631 rename set_package_data {}
632 rename set_target_data {}
633 rename set_template_data {}
634 rename add_known_package {}
635 interp delete $parser
637 # At this stage the packages file has been read in. It is a good idea to
638 # check that all of these packages are present and correct, and incidentally
639 # figure out which versions are present.
640 foreach pkg $ecosadmin::known_packages {
642 set pkgdir [file join $ecosadmin::component_repository $ecosadmin::package_data($pkg,dir)]
643 if { ![file exists $pkgdir] || ![file isdir $pkgdir] } {
644 if { "" == $silentflag } {
645 warning "package $pkg at $pkgdir missing"
648 # Each subdirectory should correspond to a release. A utility routine
649 # is available for this.
650 set ecosadmin::package_data($pkg,versions) [locate_subdirs $pkgdir]
651 if { $ecosadmin::package_data($pkg,versions) == "" } {
652 fatal_error "package $pkg has no version directories"
655 # Sort all the versions using a version-aware comparison version
656 set ecosadmin::package_data($pkg,versions) [
657 lsort -command ecosadmin::cdl_compare_version $ecosadmin::package_data($pkg,versions)
663 # Given a package name as supplied by the user, return the internal package name.
664 # This involves searching through the list of aliases.
666 proc ecosadmin::find_package { name } {
668 foreach pkg $ecosadmin::known_packages {
669 if { [string toupper $pkg] == [string toupper $name] } {
673 foreach alias $ecosadmin::package_data($pkg,alias) {
674 if { [string toupper $alias] == [string toupper $name] } {
684 # {{{ Directory and file utilities
686 # ----------------------------------------------------------------------------
687 # Start with a number of utility routines to access all files in
688 # a directory, stripping out well-known files such as makefile.am.
689 # The routines take an optional pattern argument if only certain
690 # files are of interest.
692 # Note that symbolic links are returned as well as files.
694 proc ecosadmin::locate_files { dir { pattern "*"} } {
696 ASSERT { $dir != "" }
698 # Start by getting a list of all the files.
699 set filelist [glob -nocomplain -- [file join $dir $pattern]]
701 if { $pattern == "*" } {
702 # For "everything", include ".*" files, but excluding .
704 lappend filelist [glob -nocomplain -- [file join $dir ".\[a-zA-Z0-9\]*"]]
707 # Eliminate the pathnames from all of these files
709 foreach file $filelist {
710 if { [string range $file end end] != "~" } {
711 lappend filenames [file tail $file]
715 # Eliminate any subdirectories.
717 foreach name $filenames {
718 if { [file isdir [file join $dir $name]] } {
719 lappend subdirs $name
722 foreach subdir $subdirs {
723 set index [lsearch -exact $filenames $subdir]
724 set filenames [lreplace $filenames $index $index]
731 # This utility returns all sub-directories, as opposed to all files.
732 # A variant glob pattern is used here. This version is not recursive.
733 proc ecosadmin::locate_subdirs { dir { pattern "*" }} {
735 ASSERT { $dir != "" }
737 set dirlist [glob -nocomplain -- [file join $dir $pattern "."]]
739 # Eliminate the pathnames and the spurious /. at the end of each entry
741 foreach dir $dirlist {
742 lappend dirnames [file tail [file dirname $dir]]
745 # Get rid of the CVS directory, if any
746 if { $ecosadmin::keep_cvs == 0 } {
747 set index [lsearch -exact $dirnames "CVS"]
748 if { $index != -1 } {
749 set dirnames [lreplace $dirnames $index $index]
758 # A variant which is recursive. This one does not support a pattern.
760 proc ecosadmin::locate_all_subdirs { dir } {
762 ASSERT { $dir != "" }
765 foreach subdir [locate_subdirs $dir] {
766 lappend result $subdir
767 foreach x [locate_all_subdirs [file join $dir $subdir]] {
768 lappend result [file join $subdir $x]
775 # This routine returns a list of all the files in a given directory and in
776 # all subdirectories, preserving the subdirectory name.
778 proc ecosadmin::locate_all_files { dir { pattern "*" } } {
780 ASSERT { $dir != "" }
782 set files [locate_files $dir $pattern]
783 set subdirs [locate_subdirs $dir]
785 foreach subdir $subdirs {
786 set subfiles [locate_all_files [file join $dir $subdir] $pattern]
787 foreach file $subfiles {
788 lappend files [file join $subdir $file]
796 # Sometimes a directory may be empty, or contain just a CVS subdirectory,
797 # in which case there is no point in copying it across.
799 proc ecosadmin::is_empty_directory { dir } {
801 ASSERT { $dir != "" }
803 set contents [glob -nocomplain -- [file join $dir "*"]]
804 if { [llength $contents] == 0 } {
807 if { ([llength $contents] == 1) && [string match {*CVS} $contents] } {
814 # ----------------------------------------------------------------------------
815 # Take a cygwin32 filename such as //d/tmp/pkgobj and turn it into something
816 # acceptable to Tcl, i.e. d:/tmp/pkgobj. There are a few other complications...
818 proc ecosadmin::get_pathname_for_tcl { name } {
820 if { ( $ecosadmin::windows_host ) && ( $name != "" ) } {
822 # If there is no logical drive letter specified
823 if { [ string match "?:*" $name ] == 0 } {
825 # Invoke cygpath to resolve the POSIX-style path
826 if { [ catch { exec cygpath -w $name } result ] != 0 } {
827 fatal_error "processing filepath $name:\n$result"
833 # Convert backslashes to forward slashes
834 regsub -all -- {\\} $result "/" name
840 # ----------------------------------------------------------------------------
841 # Make sure that a newly created or copied file is writable. This operation
842 # is platform-specific. Under Unix at most the current user is given
843 # permission, since there does not seem to be any easy way to get hold
846 proc ecosadmin::make_writable { name } {
848 ASSERT { $name != "" }
849 ASSERT { [file isfile $name] }
851 if { [file writable $name] == 0 } {
852 if { $ecosadmin::windows_host != 0 } {
853 file attributes $name -readonly 0
855 set mask [file attributes $name -permissions]
856 set mask [expr $mask | 0200]
857 file attributes $name -permissions $mask
865 #-----------------------------------------------------------------------
866 # Procedure target_requires_missing_package determines whether a
867 # target entry is dependent on missing packages. It is called when
868 # filtering templates out of the database
870 proc ecosadmin::target_requires_missing_package { target } {
871 foreach package $ecosadmin::target_data($target,packages) {
872 if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
879 #-----------------------------------------------------------------------
880 # Procedure template_requires_missing_package determines whether a
881 # template entry is dependent on missing packages. It is called when
882 # filtering templates out of the database
884 proc ecosadmin::template_requires_missing_package { template } {
885 foreach package $ecosadmin::template_data($template,packages) {
886 if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
893 #-----------------------------------------------------------------------
894 # Procedure target_requires_any_package determines whether a target entry
895 # is dependent on specified packages. It is called when removing packages
896 # to determine whether a target should also be removed
898 proc ecosadmin::target_requires_any_package { target packages } {
899 foreach package $packages {
900 if { [ lsearch $ecosadmin::target_data($target,packages) $package ] != -1 } {
907 #-----------------------------------------------------------------------
908 # Procedure template_requires_any_package determines whether a template entry
909 # is dependent on specified packages. It is called when removing packages
910 # to determine whether a template should also be removed
912 proc ecosadmin::template_requires_any_package { template packages } {
913 foreach package $packages {
914 if { [ lsearch $ecosadmin::template_data($template,packages) $package ] != -1 } {
921 #-----------------------------------------------------------------------
922 # Procedure merge_new_packages adds any entries in the specified data
923 # file to the eCos repository database iff they are not already present
925 proc ecosadmin::merge_new_packages { datafile } {
927 # open the eCos database file for appending
928 set ecosfile [ file join $ecosadmin::component_repository "ecos.db" ]
929 variable outfile [ open $ecosfile a+ ]
931 # initialize the list of merged packages
932 set ecosadmin::merge_packages ""
934 # this procedure is called when the interpreter encounters a
935 # package command in the datafile
936 proc merge { command name body } {
937 ecosadmin::report "processing $command $name"
938 # append the new package/target/template only if it is not already known
939 if { ( ( $command == "package" ) && ( [ lsearch -exact $ecosadmin::known_packages $name ] == -1 ) ) ||
940 ( ( $command == "target" ) && ( [ lsearch -exact $ecosadmin::known_targets $name ] == -1 ) ) ||
941 ( ( $command == "template" ) && ( [ lsearch -exact $ecosadmin::known_templates $name ] == -1 ) ) } {
942 puts $ecosadmin::outfile "$command $name {$body}\n"
945 # add new packages to the list of merged packages
946 if { ( "package" == $command ) } {
947 lappend ecosadmin::merge_packages $name
951 # Create the parser, add the aliased commands, and then define
952 # the routines that do the real work.
953 set parser [ interp create -safe ]
954 $parser alias merge ecosadmin::merge
956 proc package { name body } {
957 merge "package" $name $body
960 proc template { name body } {
961 merge "template" $name $body
964 proc target { name body } {
965 merge "target" $name $body
969 # The parser is ready to evaluate the script. To avoid having to give the
970 # safe interpreter file I/O capabilities, the file is actually read in
971 # here and then evaluated.
973 set fd [ open $datafile r ]
974 set script [ read $fd ]
979 # The interpreter and the aliased commands are no longer required.
981 interp delete $parser
983 # close the eCos database file
987 if { $status != 0 } {
988 ecosadmin::fatal_error "parsing $datafile:\n$message"
992 #-----------------------------------------------------------------------
993 # Procedure filter_old_packages removes the specified packages/versions
994 # from the eCos repository database. Any targets and templates dependent
995 # on the removed packages are also removed.
997 proc ecosadmin::filter_old_packages { old_packages } {
999 # open the new eCos database file for writing
1000 set ecosfile [ file join $ecosadmin::component_repository "ecos.db.new" ]
1001 variable outfile [ open $ecosfile w ]
1002 variable filter_list $old_packages
1003 variable removed_packages ""
1005 # this procedure is called when the interpreter encounters a command in the datafile on the first pass
1006 # it generates a list of packages which will be removed on the second pass
1007 proc removelist { command name body } {
1008 if { [ lsearch $ecosadmin::filter_list $name ] != -1 } {
1009 # the package is in the filter list
1010 if { ( $ecosadmin::version_arg == "" ) || ( [ llength $ecosadmin::package_data($name,versions) ] == 1 ) } {
1011 # there is no version argument or only one version so add the package to the remove list
1012 set ::ecosadmin::removed_packages [ lappend ::ecosadmin::removed_packages $name ]
1017 # this procedure is called when the interpreter encounters a command in the datafile on the second pass
1018 proc filter { command name body } {
1019 if { ( $command == "target" ) && ( ( [ target_requires_any_package $name $ecosadmin::removed_packages ] != 0 ) || ( [ target_requires_missing_package $name ] != 0 ) ) } {
1020 # the target requires a package which has been removed so remove the target
1021 ecosadmin::report "removing target $name"
1022 } elseif { ( $command == "template" ) && ( ( [ template_requires_any_package $name $ecosadmin::removed_packages ] != 0 ) || ( [ template_requires_missing_package $name ] != 0 ) ) } {
1023 # the template requires a package which has been removed so remove the template
1024 ecosadmin::report "removing template $name"
1025 } elseif { [ lsearch $ecosadmin::filter_list $name ] == -1 } {
1026 # the package is not in the filter list so copy the data to the new database
1027 puts $ecosadmin::outfile "$command $name {$body}\n"
1029 # the package is in the filter list
1030 set package_dir [ file join $ecosadmin::component_repository $ecosadmin::package_data($name,dir) ]
1031 if { ( $ecosadmin::version_arg != "" ) && ( [ llength $ecosadmin::package_data($name,versions) ] > 1 ) } {
1032 # there are multiple versions and only one version will be removed
1033 # so copy the data to the new database and only remove one version directory
1034 set package_dir [ file join $package_dir $ecosadmin::version_arg ]
1035 ecosadmin::report "removing package $name $ecosadmin::version_arg"
1036 puts $ecosadmin::outfile "$command $name {$body}\n"
1038 # there is no version argument or only one version so delete the package directory
1039 ecosadmin::report "removing package $name"
1041 if { [ catch { file delete -force -- $package_dir } message ] != 0 } {
1042 # issue a warning if package deletion failed - this is not fatal
1043 ecosadmin::warning $message
1045 set dir [ file dirname $package_dir ]
1046 while { [ llength [ glob -nocomplain -- [ file join $dir "*" ] ] ] == 0 } {
1047 # the parent of the deleted directory is now empty so delete it
1048 if { [ catch { file delete -- $dir } message ] != 0 } {
1049 # issue a warning if empty directory deletion failed - this is not fatal
1050 ecosadmin::warning $message
1052 set dir [ file dirname $dir ]
1057 # Create the parser, add the aliased commands, and then define
1058 # the routines that do the real work.
1059 set parser [ interp create -safe ]
1061 proc package { name body } {
1062 filter "package" $name $body
1065 proc template { name body } {
1066 filter "template" $name $body
1069 proc target { name body } {
1070 filter "target" $name $body
1074 # The parser is ready to evaluate the script. To avoid having to give the
1075 # safe interpreter file I/O capabilities, the file is actually read in
1076 # here and then evaluated.
1077 set filename [ file join $ecosadmin::component_repository "ecos.db" ]
1078 set status [ catch {
1079 set fd [ open $filename r ]
1080 set script [ read $fd ]
1083 # first pass to generate a list of packages which will be removed
1084 $parser alias filter ecosadmin::removelist
1085 $parser eval $script
1087 # second pass to remove the packages, targets and templates
1088 $parser alias filter ecosadmin::filter
1089 $parser eval $script
1092 # The interpreter and the aliased commands are no longer required.
1094 interp delete $parser
1096 # close the new eCos database file
1100 if { $status != 0 } {
1101 ecosadmin::fatal_error "parsing $filename:\n$message"
1104 # replace the old eCos database file with the new one
1105 file rename -force $ecosfile $filename
1108 # ----------------------------------------------------------------------------
1109 # Process_add_packages. This routine is responsible for installing packages
1110 # into the eCos repository using the gzip and tar tools which must be on
1114 proc ecosadmin::process_add_package { } {
1115 ASSERT { $ecosadmin::add_package != "" }
1116 ASSERT { $ecosadmin::component_repository != "" }
1118 # calculate the absolute path of the specified package archive
1119 # since we must change directory before extracting files
1120 # note that we cannot use "tar -C" to avoid changing directory
1121 # since "tar -C" only accepts relative paths
1122 set abs_package [ file join [ pwd ] $ecosadmin::add_package ]
1123 set datafile "pkgadd.db"
1124 set licensefile "pkgadd.txt"
1125 set logfile "pkgadd.log"
1126 cd $ecosadmin::component_repository
1128 # check for --extract_license on command line
1129 if { $ecosadmin::extract_license_arg == 1 } {
1130 # extract the license file (if any) from the specified gzipped tar archive
1131 file delete $licensefile
1132 catch { exec > $ecosadmin::null_device gzip -d < $abs_package | tar xf - $licensefile }
1136 # extract the package data file from the specified gzipped tar archive
1137 if { [ catch { exec > $ecosadmin::null_device gzip -d < $abs_package | tar xf - $datafile } message ] != 0 } {
1138 fatal_error "extracting $datafile:\n$message"
1141 # obtain license acceptance
1142 if { [ ecosadmin::accept_license $abs_package $licensefile ] != "y" } {
1143 file delete $datafile
1144 file delete $licensefile
1145 fatal_error "license agreement not accepted"
1148 # extract the remaining package contents and generate a list of extracted files
1149 if { [ catch { exec gzip -d < $abs_package | tar xvf - > $logfile } message ] != 0 } {
1150 file delete $logfile
1151 fatal_error "extracting files:\n$message"
1154 # read the list of extracted files from the log file
1155 set fd [ open $logfile r ]
1156 set message [ read $fd ]
1158 file delete $logfile
1160 # convert extracted text files to use the line-ending convention of the host
1161 set filelist [ split $message "\n" ]
1162 set binary_extension ".bin"
1163 foreach filename $filelist {
1164 if { [ file isfile $filename ] != 0 } {
1165 if { [ file extension $filename ] == $binary_extension } {
1166 # a binary file - so remove the binary extension
1167 file rename -force -- $filename [ file rootname $filename ]
1169 # a text file - so convert file to use native line-endings
1170 # read in the file (line-ending conversion is implicit)
1171 set fd [ open $filename "r" ]
1172 set filetext [ read $fd ]
1175 # write the file out again
1176 set fd [ open $filename "w" ]
1177 puts -nonewline $fd $filetext
1183 # merge the new package information into the eCos database file as necessary
1184 ecosadmin::merge_new_packages [ file join $ecosadmin::component_repository $datafile ]
1186 # delete the database and license files
1187 file delete $datafile
1188 file delete $licensefile
1190 # read the revised database back in and remove any
1191 # targets and templates with missing packages
1193 filter_old_packages ""
1196 # ----------------------------------------------------------------------------
1197 # Process_remove_package. This routine is responsible for uninstalling a
1198 # package from the eCos repository
1201 proc ecosadmin::process_remove_package { } {
1202 ASSERT { $ecosadmin::remove_package != "" }
1204 # get the formal package name
1205 set package_name [ ecosadmin::find_package $ecosadmin::remove_package ]
1206 if { $package_name == "" } {
1208 fatal_error "package not found"
1209 } elseif { $ecosadmin::version_arg == "" } {
1210 # version not specified
1211 # if { [ llength $ecosadmin::package_data($package_name,versions) ] > 1 } {
1212 # fatal_error "multiple versions, use --version"
1214 } elseif { [ lsearch $ecosadmin::package_data($package_name,versions) $ecosadmin::version_arg ] == -1 } {
1215 # specified version not found
1216 fatal_error "version not found"
1219 # filter out the old package from the eCos database file
1220 filter_old_packages $package_name
1223 # ----------------------------------------------------------------------------
1224 # Process_merge_repository. This routine is responsible for merging packages
1225 # from another repository into the eCos repository
1228 proc ecosadmin::process_merge_repository { } {
1229 ASSERT { $ecosadmin::merge_repository != "" }
1230 ASSERT { $ecosadmin::component_repository != "" }
1232 # merge new package and target information into the eCos database file as necessary
1233 # names of packages to be merged are placed in $ecosadmin::merge_packages
1234 ecosadmin::merge_new_packages [ file join $ecosadmin::merge_repository "ecos.db" ]
1236 # read the revised database back in to pick up new package paths, but ignore missing package directories
1239 # copy package directories into the repository as necessary
1240 # existing packages are never replaced but a another version may be added
1241 foreach pkg $ecosadmin::merge_packages {
1242 set newpkgdir [file join $ecosadmin::merge_repository $ecosadmin::package_data($pkg,dir)]
1243 foreach newpkgver [locate_subdirs $newpkgdir] {
1244 if { [lsearch $ecosadmin::package_data($pkg,versions) $newpkgver] == -1 } {
1245 ecosadmin::report "copying $pkg $newpkgver"
1246 file mkdir [ file join $ecosadmin::component_repository $ecosadmin::package_data($pkg,dir) ]
1247 file copy [ file join $newpkgdir $newpkgver ] [ file join $ecosadmin::component_repository $ecosadmin::package_data($pkg,dir) $newpkgver ]
1252 # read the revised database again to deliver warnings of missing package directories if necessary
1255 # copy new files from the pkgconf and templates directory hierarchies into the repository as necessary
1256 foreach topdir { pkgconf templates } {
1257 set repository_files [ ecosadmin::locate_all_files [ file join $ecosadmin::component_repository $topdir ] ]
1258 set merge_files [ ecosadmin::locate_all_files [ file join $ecosadmin::merge_repository $topdir ] ]
1259 foreach filename $merge_files {
1260 if { [lsearch $repository_files $filename] == -1 } {
1261 ecosadmin::report "copying $topdir file $filename"
1262 file mkdir [ file join $ecosadmin::component_repository $topdir [ file dirname $filename ] ]
1263 file copy [ file join $ecosadmin::merge_repository $topdir $filename ] [ file join $ecosadmin::component_repository $topdir $filename ]
1268 # copy files from the top level packages directory into the repository as necessary
1269 foreach filename [ glob -nocomplain -directory $ecosadmin::merge_repository -type f * ] {
1270 set destination [ file join $ecosadmin::component_repository [ file tail $filename ] ]
1271 if { 0 == [ file exists $destination ] } {
1272 ecosadmin::report "copying file [file tail $filename]"
1273 file copy $filename $destination
1278 # ----------------------------------------------------------------------------
1279 # Accept_license. This routine is responsible for displaying the package
1280 # license and obtaining user acceptance. It returns "y" if the license is
1284 proc ecosadmin::accept_license { archivename filename } {
1285 ASSERT { $ecosadmin::add_package != "" }
1287 # check for --accept_license on command line
1288 if { $ecosadmin::accept_license_arg == 1 } {
1289 # --accept_license specified so do not prompt for acceptance
1293 # extract the specified license file from the specified gzipped tar archive
1294 if { [ catch { exec > $ecosadmin::null_device gzip -d < $archivename | tar xf - $filename } message ] != 0 } {
1299 # read in the file and output to the user
1300 set fd [ open $filename "r" ]
1301 set filetext [ read $fd ]
1305 # prompt for acceptance
1306 puts -nonewline "Do you accept all the terms of the preceding license agreement? (y/n) "
1308 gets "stdin" response
1310 # return the first character of the response in lowercase
1311 return [ string tolower [ string index $response 0 ] ]
1314 # ----------------------------------------------------------------------------
1315 # Main(). This code only runs if the script is being run stand-alone rather
1316 # than as part of a larger application. The controlling predicate is the
1317 # existence of the variable ecosadmin_not_standalone which can be set by
1318 # the containing program if any.
1321 if { ! [info exists ecosadmin_not_standalone] } {
1323 # Decide where warnings and fatal errors should go.
1324 ecosadmin::initialise_error_handling
1326 # First, check for --help or any of the variants. If this script
1327 # is running in a larger program then it is assumed that the
1328 # containing program will not pass --help as an argument.
1329 if { ( $argv == "--help" ) || ( $argv == "-help" ) ||
1330 ( $argv == "--H" ) || ( $argv == "-H" ) || ($argv == "" ) } {
1332 ecosadmin::argument_help
1336 # catch any errors while processing the specified command
1339 # Parse the arguments and set the global variables appropriately.
1340 ecosadmin::parse_arguments $argv0 $argv
1342 # Read in the eCos repository database.
1343 ecosadmin::read_data ""
1345 # Process the ecosadmin command
1346 if { $ecosadmin::list_packages_arg != 0 } {
1347 foreach pkg $ecosadmin::known_packages {
1348 ecosadmin::report "$pkg: $ecosadmin::package_data($pkg,versions)"
1350 } elseif { $ecosadmin::add_package != "" } {
1351 ecosadmin::process_add_package
1352 } elseif { $ecosadmin::remove_package != "" } {
1353 ecosadmin::process_remove_package
1354 } elseif { $ecosadmin::merge_repository != "" } {
1355 ecosadmin::process_merge_repository
1358 } error_message ] != 0 } {
1360 # handle error message
1361 if { [ info exists gui_mode ] } {
1362 return $error_message
1364 puts "ecosadmin error: $error_message"