source: SVN/cambria/redboot/packages/ecosadmin.tcl @ 1

Last change on this file since 1 was 1, checked in by Tim Harvey, 2 years ago

restored latest version of files from server backup

Signed-off-by: Tim Harvey <tharvey@…>

  • Property svn:executable set to *
File size: 42.7 KB
Line 
1#!/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## Copyright (C) 2003 John Dallaway
22## Copyright (C) 2004 eCosCentric Limited
23##
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.
27##
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
31## for more details.
32##
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.
36##
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.
43##
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.
46##
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####
53#
54# Author(s):    jld
55# Contributors: bartv
56# Date:         1999-06-18
57# Purpose:      To install and uninstall packages from an eCos component
58#               repository
59# Description:
60# Usage:
61#
62#####DESCRIPTIONEND####
63#===============================================================================
64#
65
66# }}}
67# {{{  Version check
68
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.
72
73if { [info tclversion] < 8.0 } {
74        puts "This script requires Tcl 8.0 or later. You are running Tcl [info patchlevel]."
75        return
76}
77
78# }}}
79# {{{  Namespace definition
80
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.
86#
87# As a fringe benefit, all global variables can be declared inside this
88# namespace and initialised.
89#
90
91namespace eval ecosadmin {
92
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"
98        } else {
99                set ecosadmin::null_device "/dev/null"
100        }
101               
102
103        # Where is the component repository ? The following input sources
104        # are available:
105        # 1) the environment variable ECOS_REPOSITORY.
106        # 2) $argv0 should correspond to the location of the ecosadmin.tcl
107        #    script.
108        #
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)
114        } else {
115                set component_repository [pwd]
116                if { [file dirname $argv0] != "." } {
117                        set component_repository [file join $component_repository [file dirname $argv0]]
118                }
119        }
120
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
129       
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 {};
138
139        # List of packages merged from another repository
140        variable merge_packages ""
141       
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
147
148        # Keep or remove the CVS directories?
149        variable keep_cvs 0
150}
151
152# }}}
153# {{{  Infrastructure
154
155# ----------------------------------------------------------------------------
156# Minimal infrastructure support.
157#
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.
163#
164# Once it is possible to report fatal errors, an assertion facility becomes
165# feasible.
166#
167# These routines output fatal errors, warnings or miscellaneous messages.
168# Their implementations depend on the mode in which this script is operating.
169#
170proc ecosadmin::fatal_error { msg } {
171        $ecosadmin::fatal_error_handler "$msg"
172}
173
174proc ecosadmin::warning { msg } {
175        $ecosadmin::warning_handler "$msg"
176}
177
178proc ecosadmin::report { msg } {
179        $ecosadmin::report_handler "$msg"
180}
181
182#
183# Command line versions.
184# NOTE: some formatting so that there are linebreaks at ~72 columns would be
185# a good idea.
186#
187proc ecosadmin::cli_fatal_error_handler { msg } {
188        error "$msg"
189}
190
191proc ecosadmin::cli_warning_handler { msg } {
192        puts "ecosadmin warning: $msg"
193}
194
195proc ecosadmin::cli_report_handler { msg } {
196        puts "$msg"
197}
198
199#
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.
202#
203proc 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
207}
208
209#
210# These routines can be used by containing programs to provide their
211# own error handling.
212#
213proc ecosadmin::set_fatal_error_handler { fn } {
214        ASSERT { $fn != "" }
215        set ecosadmin::fatal_error_handler $fn
216}
217
218proc ecosadmin::set_warning_handler { fn } {
219        ASSERT { $fn != "" }
220        set ecosadmin::warning_handler $fn
221}
222
223proc ecosadmin::set_report_handler { fn } {
224        ASSERT { $fn != "" }
225        set ecosadmin::report_handler $fn
226}
227
228#
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.
232#
233proc ecosadmin::ASSERT { condition } {
234        set result [uplevel 1 [list expr $condition]]
235       
236        if { $result == 0 } {
237                fatal_error "assertion predicate \"$condition\"\nin \"[info level -1]\""
238        }
239}
240
241# }}}
242# {{{  Utilities
243
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.
250#
251# There are similarities between cdl_compare_version and with Tcl's
252# package vcompare, but cdl_compare_version is more general.
253#
254
255proc ecosadmin::cdl_compare_version { arg1 arg2 } {
256
257        if { $arg1 == $arg2 } {
258                return 0
259        }
260        if { $arg1 == "current"} {
261                return -1
262        }
263        if { $arg2 == "current" } {
264                return 1
265        }
266
267        set index1 0
268        set index2 0
269        set ch1    ""
270        set ch2    ""
271        set num1   ""
272        set num2   ""
273       
274        while { 1 } {
275
276                set ch1 [string index $arg1 $index1]
277                set ch2 [string index $arg2 $index2]
278                set num1 ""
279                set num2 ""
280
281                if { ($ch1 == "") && ($ch2 == "") } {
282               
283                        # Both strings have terminated at the same time. There may have
284                        # been some spurious leading zeroes in numbers.
285                        return 0
286               
287                } elseif { $ch1 == "" } {
288
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] } {
293                                return 1
294                        } else {
295                                return -1
296                        }
297                } elseif { $ch2 == "" } {
298
299                        # Equivalent to the above.
300                        if { [string match \[-._\] $ch1] } {
301                                return -1
302                        } else {
303                                return 1
304                        }
305                }
306
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] ) } {
310
311                        # Extract the entire numbers from the version string.
312                        while { [string match \[0-9\] $ch1] } {
313                                set  num1 "$num1$ch1"
314                                incr index1
315                                set  ch1 [string index $arg1 $index1]
316                        }
317                        while { [string match \[0-9\] $ch2] } {
318                                set  num2 "$num2$ch2"
319                                incr index2
320                                set ch2 [string index $arg2 $index2]
321                        }
322
323                        if { $num1 < $num2 } {
324                                return 1
325                        } elseif { $num1 > $num2 } {
326                                return -1
327                        }
328                        continue
329                }
330
331                # This is not numerical data. If the two characters are the same then
332                # move on.
333                if { $ch1 == $ch2 } {
334                        incr index1
335                        incr index2
336                        continue
337                }
338       
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] ) } {
342                        incr index1
343                        incr index2
344                        continue
345                }
346
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]
350        }
351}
352
353# }}}
354# {{{  Argument parsing
355
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.
361#
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
365# things will break.
366#
367
368proc ecosadmin::parse_arguments { argv0 argv } {
369
370        if { $argv != "" } {
371
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.
376
377                set argc 0
378                array set args { }
379                foreach arg $argv {
380                        set args([incr argc]) $arg
381                }
382
383                # Now examine each argument with regular expressions. It is
384                # useful to have some variables filled in by the regexp
385                # matching.
386                set dummy  ""
387                set match1 ""
388                set match2 ""
389                for { set i 1 } { $i <= $argc } { incr i } {
390
391                        # Check for --list and the other simple ones.
392                        if { [regexp -- {^-?-?list$} $args($i)] == 1 } {
393                                set ecosadmin::list_packages_arg 1
394                                continue
395                        }
396
397                        # check for --version
398                        if { [regexp -- {^-?-version=?(.*)$} $args($i) dummy match1] == 1 } {
399                                if { $match1 != "" } {
400                                        set ecosadmin::version_arg $match1
401                                } else {
402                                        if { $i == $argc } {
403                                                fatal_error "missing argument after --version"
404                                        } else {
405                                                set ecosadmin::version_arg $args([incr i])
406                                        }
407                                }
408                                continue
409                        }
410               
411                        # check for --accept_license
412                        if { [regexp -- {^-?-accept_license$} $args($i)] == 1 } {
413                                set ecosadmin::accept_license_arg 1
414                                continue
415                        }
416               
417                        # check for --extract_license
418                        if { [regexp -- {^-?-extract_license$} $args($i)] == 1 } {
419                                set ecosadmin::extract_license_arg 1
420                                continue
421                        }
422               
423                        # check for the add command
424                        if { [regexp -- {^-?-?add=?(.*)$} $args($i) dummy match1] == 1 } {
425                                if { $match1 != "" } {
426                                        set ecosadmin::add_package $match1
427                                } else {
428                                        if { $i == $argc } {
429                                                fatal_error "missing argument after add"
430                                        } else {
431                                                set ecosadmin::add_package $args([incr i])
432                                        }
433                                }
434                                continue
435                        }
436               
437                        # check for the merge command
438                        if { [regexp -- {^-?-?merge=?(.*)$} $args($i) dummy match1] == 1 } {
439                                if { $match1 != "" } {
440                                        set ecosadmin::merge_repository $match1
441                                } else {
442                                        if { $i == $argc } {
443                                                fatal_error "missing argument after merge"
444                                        } else {
445                                                set ecosadmin::merge_repository $args([incr i])
446                                        }
447                                }
448                                continue
449                        }
450               
451                        # check for the remove command
452                        if { [regexp -- {^-?-?remove=?(.*)$} $args($i) dummy match1] == 1 } {
453                                if { $match1 != "" } {
454                                        set ecosadmin::remove_package $match1
455                                } else {
456                                        if { $i == $argc } {
457                                                fatal_error "missing argument after remove"
458                                        } else {
459                                                set ecosadmin::remove_package $args([incr i])
460                                        }
461                                }
462                                continue
463                        }
464               
465                        # Check for --srcdir
466                        if { [regexp -- {^-?-srcdir=?([ \.\\/:_a-zA-Z0-9-]*)$} $args($i) dummy match1] == 1 } {
467                                if { $match1 == "" } {
468                                        if { $i == $argc } {
469                                                puts "ecosrelease: missing argument after --srcdir"
470                                                exit 1
471                                        } else {
472                                                set match1 $args([incr i])
473                                        }
474                                }
475                                set ecosadmin::component_repository $match1
476                                continue
477                        }
478           
479                        # An unrecognised argument.
480                        fatal_error "invalid argument $args($i)"
481                }
482        } 
483
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]
488}
489
490#
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.
494
495proc ecosadmin::argument_help { } {
496
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"
502}
503
504# }}}
505# {{{  Packages file
506
507proc ecosadmin::read_data { silentflag } {
508
509        ASSERT { $ecosadmin::component_repository != "" }
510
511        set ecosadmin::known_packages ""
512        set ecosadmin::known_targets ""
513        set ecosadmin::known_templates ""
514
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
521        }
522        proc add_known_target { name } {
523                lappend ::ecosadmin::known_targets $name
524        }
525        proc add_known_template { name } {
526                lappend ::ecosadmin::known_templates $name
527        }
528        proc set_package_data { name value } {
529                set ::ecosadmin::package_data($name) $value
530        }
531        proc set_target_data { name value } {
532                set ::ecosadmin::target_data($name) $value
533        }
534        proc set_template_data { name value } {
535                set ::ecosadmin::template_data($name) $value
536        }
537
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
547       
548        $parser eval {
549       
550        set current_package ""
551        set current_target ""
552        set current_template ""
553       
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
561                eval $body
562                set ::current_package ""
563        }
564
565        proc target { name body } {
566                add_known_target $name
567                set_target_data "$name,packages" ""
568                set ::current_target $name
569                eval $body
570                set ::current_target ""
571        }
572
573#if 0
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
579                eval $body
580                set ::current_template ""
581        }
582#endif
583
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
589                } else {
590                        ASSERT 0
591                }
592        }
593
594        proc directory { dir } {
595                set_package_data "$::current_package,dir" $dir
596        }
597
598        proc alias { str } {
599                if { $::current_package != "" } {
600                        set_package_data "$::current_package,alias" $str
601                }
602        }
603
604        proc hardware { } {
605                set_package_data "$::current_package,hardware" 1
606        }
607
608        proc description { str } { }
609        proc disable { str } { }
610        proc enable { str } { }
611        proc script { str } { }
612        proc set_value { str1 str2 } { }
613        }
614
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"]
619        set status [ catch {
620                set fd [open $filename r]
621                set script [read $fd]
622                close $fd
623                $parser eval $script
624} message ]
625
626        if { $status != 0 } {
627                ecosadmin::fatal_error "parsing $filename:\n$message"
628        }
629
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
636       
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 {
641
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"
646                        }
647                } else {
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"
653                        }
654                }
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)
658                ]
659        }
660}
661
662#
663# Given a package name as supplied by the user, return the internal package name.
664# This involves searching through the list of aliases.
665#
666proc ecosadmin::find_package { name } {
667
668        foreach pkg $ecosadmin::known_packages {
669                if { [string toupper $pkg] == [string toupper $name] } {
670                        return $pkg
671                }
672
673                foreach alias $ecosadmin::package_data($pkg,alias) {
674                        if { [string toupper $alias] == [string toupper $name] } {
675                                return $pkg
676                        }
677                }
678        }
679
680        return ""
681}
682
683# }}}
684# {{{  Directory and file utilities
685
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.
691#
692# Note that symbolic links are returned as well as files.
693#
694proc ecosadmin::locate_files { dir { pattern "*"} } {
695
696        ASSERT { $dir != "" }
697
698        # Start by getting a list of all the files.
699        set filelist [glob -nocomplain -- [file join $dir $pattern]]
700
701        if { $pattern == "*" } {
702                # For "everything", include ".*" files, but excluding .
703                # and .. directories
704                lappend filelist [glob -nocomplain -- [file join $dir ".\[a-zA-Z0-9\]*"]]
705        }
706
707        # Eliminate the pathnames from all of these files
708        set filenames ""
709        foreach file $filelist {
710                if { [string range $file end end] != "~" } {
711                        lappend filenames [file tail $file]
712                }
713        }
714
715        # Eliminate any subdirectories.
716        set subdirs ""
717        foreach name $filenames {
718                if { [file isdir [file join $dir $name]] } {
719                        lappend subdirs $name
720                }
721        }
722        foreach subdir $subdirs {
723                set index [lsearch -exact $filenames $subdir]
724                set filenames [lreplace $filenames $index $index]
725        }
726
727        return $filenames
728}
729
730#
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.
733proc ecosadmin::locate_subdirs { dir { pattern "*" }} {
734
735        ASSERT { $dir != "" }
736
737        set dirlist [glob -nocomplain -- [file join $dir $pattern "."]]
738
739        # Eliminate the pathnames and the spurious /. at the end of each entry
740        set dirnames ""
741        foreach dir $dirlist {
742                lappend dirnames [file tail [file dirname $dir]]
743        }
744
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]
750                }
751        }
752
753        # That should be it.
754        return $dirnames
755}
756
757#
758# A variant which is recursive. This one does not support a pattern.
759#
760proc ecosadmin::locate_all_subdirs { dir } {
761
762        ASSERT { $dir != "" }
763
764        set result ""
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]
769                }
770        }
771        return $result
772}
773
774#
775# This routine returns a list of all the files in a given directory and in
776# all subdirectories, preserving the subdirectory name.
777#
778proc ecosadmin::locate_all_files { dir { pattern "*" } } {
779
780        ASSERT { $dir != "" }
781
782        set files   [locate_files $dir $pattern]
783        set subdirs [locate_subdirs $dir]
784
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]
789                }
790        }
791
792        return $files
793}
794
795#
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.
798#
799proc ecosadmin::is_empty_directory { dir } {
800
801        ASSERT { $dir != "" }
802
803        set contents [glob -nocomplain -- [file join $dir "*"]]
804        if { [llength $contents] == 0 } {
805                return 1
806        }
807        if { ([llength $contents] == 1) && [string match {*CVS} $contents] } {
808                return 1
809        }
810        return 0
811}
812
813#
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...
817
818proc ecosadmin::get_pathname_for_tcl { name } {
819
820        if { ( $ecosadmin::windows_host ) && ( $name != "" ) } {
821
822                # If there is no logical drive letter specified
823                if { [ string match "?:*" $name ] == 0 } {
824
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"
828                        }
829                } else {
830                        set result $name
831                }
832
833                # Convert backslashes to forward slashes
834                regsub -all -- {\\} $result "/" name
835        }
836
837        return $name
838}
839
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
844# of the real umask.
845
846proc ecosadmin::make_writable { name } {
847
848        ASSERT { $name != "" }
849        ASSERT { [file isfile $name] }
850       
851        if { [file writable $name] == 0 } {
852                if { $ecosadmin::windows_host != 0 } {
853                        file attributes $name -readonly 0
854                } else {
855                        set mask [file attributes $name -permissions]
856                        set mask [expr $mask | 0200]
857                        file attributes $name -permissions $mask
858                }
859        }
860}
861
862# }}}
863# {{{  main()
864
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
869
870proc ecosadmin::target_requires_missing_package { target } {
871        foreach package $ecosadmin::target_data($target,packages) {
872                if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
873                        return 1
874                }
875        }
876        return 0
877}
878
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
883
884proc ecosadmin::template_requires_missing_package { template } {
885        foreach package $ecosadmin::template_data($template,packages) {
886                if { [ lsearch $ecosadmin::known_packages $package ] == -1 } {
887                        return 1
888                }
889        }
890        return 0
891}
892
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
897
898proc ecosadmin::target_requires_any_package { target packages } {
899        foreach package $packages {
900                if { [ lsearch $ecosadmin::target_data($target,packages) $package ] != -1 } {
901                        return 1
902                }
903        }
904        return 0
905}
906
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
911
912proc ecosadmin::template_requires_any_package { template packages } {
913        foreach package $packages {
914                if { [ lsearch $ecosadmin::template_data($template,packages) $package ] != -1 } {
915                        return 1
916                }
917        }
918        return 0
919}
920
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
924
925proc ecosadmin::merge_new_packages { datafile } {
926
927        # open the eCos database file for appending
928        set ecosfile [ file join $ecosadmin::component_repository "ecos.db" ]
929        variable outfile [ open $ecosfile a+ ]
930
931        # initialize the list of merged packages
932        set ecosadmin::merge_packages ""
933
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"
943                }
944               
945                # add new packages to the list of merged packages
946                if { ( "package" == $command ) } {
947                        lappend ecosadmin::merge_packages $name
948                }
949        }
950
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
955        $parser eval {
956                proc package { name body } {
957                        merge "package" $name $body
958                }
959
960                proc template { name body } {
961                        merge "template" $name $body
962                }
963
964                proc target { name body } {
965                        merge "target" $name $body
966                }
967        }
968
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.
972        set status [ catch {
973                set fd [ open $datafile r ]
974                set script [ read $fd ]
975                close $fd
976                $parser eval $script
977        } message ]
978
979        # The interpreter and the aliased commands are no longer required.
980        rename merge {}
981        interp delete $parser
982
983        # close the eCos database file
984        close $outfile
985
986        # report errors
987        if { $status != 0 } {
988                ecosadmin::fatal_error "parsing $datafile:\n$message"
989        }
990}
991
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.
996
997proc ecosadmin::filter_old_packages { old_packages } {
998
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 ""
1004
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 ]
1013                        }                       
1014                }
1015        }
1016
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"
1028                } else {
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"
1037                        } else {
1038                                # there is no version argument or only one version so delete the package directory
1039                                ecosadmin::report "removing package $name"
1040                        }
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
1044                        }
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
1051                                }
1052                                set dir [ file dirname $dir ]
1053                        }
1054                }
1055        }
1056
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 ]
1060        $parser eval {
1061                proc package { name body } {
1062                        filter "package" $name $body
1063                }
1064
1065                proc template { name body } {
1066                        filter "template" $name $body
1067                }
1068
1069                proc target { name body } {
1070                        filter "target" $name $body
1071                }
1072        }
1073
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 ]
1081                close $fd
1082
1083                # first pass to generate a list of packages which will be removed
1084                $parser alias filter ecosadmin::removelist
1085                $parser eval $script
1086
1087                # second pass to remove the packages, targets and templates
1088                $parser alias filter ecosadmin::filter
1089                $parser eval $script
1090        } message ]
1091
1092        # The interpreter and the aliased commands are no longer required.
1093        rename filter {}
1094        interp delete $parser
1095
1096        # close the new eCos database file
1097        close $outfile
1098
1099        # report errors
1100        if { $status != 0 } {
1101                ecosadmin::fatal_error "parsing $filename:\n$message"
1102        }
1103
1104        # replace the old eCos database file with the new one
1105        file rename -force $ecosfile $filename
1106}
1107
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
1111# the path
1112#
1113
1114proc ecosadmin::process_add_package { } {
1115        ASSERT { $ecosadmin::add_package != "" }
1116        ASSERT { $ecosadmin::component_repository != "" }
1117
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
1127
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 }
1133                return
1134        }
1135
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"
1139        }
1140
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"
1146        }
1147
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"
1152        }
1153
1154        # read the list of extracted files from the log file
1155        set fd [ open $logfile r ]
1156        set message [ read $fd ]
1157        close $fd
1158        file delete $logfile
1159
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 ]
1168                        } else {
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 ]
1173                                close $fd
1174
1175                                # write the file out again
1176                                set fd [ open $filename "w" ]
1177                                puts -nonewline $fd $filetext
1178                                close $fd
1179                        }
1180                }
1181        }
1182
1183        # merge the new package information into the eCos database file as necessary
1184        ecosadmin::merge_new_packages [ file join $ecosadmin::component_repository $datafile ]
1185
1186        # delete the database and license files
1187        file delete $datafile
1188        file delete $licensefile
1189
1190        # read the revised database back in and remove any
1191        # targets and templates with missing packages
1192        read_data ""
1193        filter_old_packages ""
1194}
1195
1196# ----------------------------------------------------------------------------
1197# Process_remove_package. This routine is responsible for uninstalling a
1198# package from the eCos repository
1199#
1200
1201proc ecosadmin::process_remove_package { } {
1202        ASSERT { $ecosadmin::remove_package != "" }
1203
1204        # get the formal package name
1205        set package_name [ ecosadmin::find_package $ecosadmin::remove_package ]
1206        if { $package_name == "" } {
1207                # package not found
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"
1213#               }
1214        } elseif { [ lsearch $ecosadmin::package_data($package_name,versions) $ecosadmin::version_arg ] == -1 } {
1215                # specified version not found
1216                fatal_error "version not found"
1217        }
1218       
1219        # filter out the old package from the eCos database file
1220        filter_old_packages $package_name
1221}
1222
1223# ----------------------------------------------------------------------------
1224# Process_merge_repository. This routine is responsible for merging packages
1225# from another repository into the eCos repository
1226#
1227
1228proc ecosadmin::process_merge_repository { } {
1229        ASSERT { $ecosadmin::merge_repository != "" }
1230        ASSERT { $ecosadmin::component_repository != "" }
1231
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" ]
1235       
1236        # read the revised database back in to pick up new package paths, but ignore missing package directories
1237        read_data "silent"
1238       
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 ]
1248                        }
1249                }
1250        }
1251
1252        # read the revised database again to deliver warnings of missing package directories if necessary
1253        read_data ""
1254
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 ]
1264                        }
1265                }
1266        }
1267
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
1274                }
1275        }
1276}
1277
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
1281# accepted.
1282#
1283
1284proc ecosadmin::accept_license { archivename filename } {
1285        ASSERT { $ecosadmin::add_package != "" }
1286
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
1290                return "y"
1291        }
1292
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 } {
1295                # no license file
1296                return "y"
1297        }
1298
1299        # read in the file and output to the user
1300        set fd [ open $filename "r" ]
1301        set filetext [ read $fd ]
1302        close $fd
1303        puts $filetext
1304
1305        # prompt for acceptance
1306        puts -nonewline "Do you accept all the terms of the preceding license agreement? (y/n) "
1307        flush "stdout"
1308        gets "stdin" response
1309
1310        # return the first character of the response in lowercase
1311        return [ string tolower [ string index $response 0 ] ]
1312}
1313
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.
1319#
1320
1321if { ! [info exists ecosadmin_not_standalone] } {
1322
1323        # Decide where warnings and fatal errors should go.
1324        ecosadmin::initialise_error_handling
1325
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 == "" ) } {
1331
1332                ecosadmin::argument_help
1333                return
1334        }
1335
1336        # catch any errors while processing the specified command
1337        if { [ catch {
1338       
1339                # Parse the arguments and set the global variables appropriately.
1340                ecosadmin::parse_arguments $argv0 $argv
1341
1342                # Read in the eCos repository database.
1343                ecosadmin::read_data ""
1344       
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)"
1349                        }
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
1356                }
1357
1358        } error_message ] != 0 } { 
1359
1360                # handle error message
1361                if { [ info exists gui_mode ] } {
1362                        return $error_message
1363                }
1364                puts "ecosadmin error: $error_message"
1365        }
1366        return
1367}
1368
1369# }}}
Note: See TracBrowser for help on using the repository browser.