From 53fc42dd19e14154042e1fbe82ea0d5fc5a5e2f1 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Tue, 10 May 2005 08:40:01 +0000 Subject: create install-xml-file-list and use it to replace share/list and share/list.ARCH with share/list.xml --- tools/install-xml-file-list | 279 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 279 insertions(+) create mode 100755 tools/install-xml-file-list (limited to 'tools/install-xml-file-list') diff --git a/tools/install-xml-file-list b/tools/install-xml-file-list new file mode 100755 index 000000000..0cd1fc1cc --- /dev/null +++ b/tools/install-xml-file-list @@ -0,0 +1,279 @@ +#!/usr/bin/perl + +use MDK::Common; +use XML::Parser; +use Data::Dumper; +use Config; +use Cwd 'cwd'; + +@ARGV == 2 or die "usage: install-xml-file-list \n"; +my ($xml_file_list, $DEST) = @ARGV; + +my $initial_dir = cwd(); +my $ARCH = arch() =~ /i.86/ ? 'i386' : arch(); +my $LIB = arch() =~ /x86_64/ ? "lib64" : "lib"; + +my $base_cpio_options = '-pumd --quiet'; + +system("rm -rf $DEST"); + +my $tree = XML::Parser->new(Style => 'Tree')->parsefile($xml_file_list); + +my $main_node = decompose($tree); + +$main_node->{tag} eq 'list' or die "bad file $xml_file_list (main tag should be )\n"; + +handle_nodes({}, $main_node); + +install_needed_libraries(); + +final_cleanup(); + +sub final_cleanup() { + #- cpio creates directory 700, that's not nice + system("find $DEST -type d | xargs chmod 755"); +} + +sub handle_nodes { + my ($env, $e) = @_; + handle_node($env, decompose($_)) foreach @{$e->{l}}; +} +sub handle_node { + my ($env, $node) = @_; + + if (!$node->{tag} && $node->{text} !~ /\S/) { + } elsif (!$node->{tag}) { + install($env, $node->{text}); + } elsif ($node->{tag} eq 'if') { + my $cond = valid_cond($node->{attr}); + handle_nodes($env, $node) if $cond; + } elsif ($node->{tag} eq 'if-not') { + my $cond = valid_cond($node->{attr}); + handle_nodes($env, $node) if !$cond; + } elsif (member($node->{tag}, 'from', 'to', 'mode', 'filter')) { + handle_nodes(add_to_env($env, $node->{tag} => $node->{attr}), $node); + } else { + warn "expecting tag , not <$node->{tag}>\n"; + } +} + +sub valid_cond { + my ($attr) = @_; + every { + if ($_ eq 'ARCH') { + $ARCH =~ /$attr->{$_}/; + } else { + die ": unknown condition $_\n"; + } + } keys %$attr; +} + +sub add_to_env { + my ($env, $tag, $attr) = @_; + my %env = map_each { $::a => +{%$::b} } %$env; + foreach (keys %$attr) { + !$env{$tag}{$_} or die qq(overriding attribute <$tag $_="$env{$tag}{$_}"> with $_="$attr->{$_}"\n); + $env{$tag}{$_} = $attr->{$_}; + } + \%env; +} + +sub group_by_n { + my ($n, $l) = @_; + my (@r, $subl); + my $i = 0; + foreach (@$l) { + if ($i % $n == 0) { + push @r, $subl = []; + } + push @$subl, $_; + $i++; + } + @r; +} + +sub all_files_rec_ { + my ($d) = @_; + + $d, -d $d && ! -l $d ? map { all_files_rec_("$d/$_") } all($d) : (); +} + +sub expand_macros { + my ($f) = @_; + $f =~ s!\bLIB\b!$LIB!g; + $f =~ s!\bARCH\b!$ARCH!ge; + $f =~ s!\bREP4PMS\b!$ENV{REP4PMS} || die "REP4PMS undefined\n"!ge; + $f; +} + +my %needed_libraries; +sub collect_needed_libraries { + my (@to_check) = @_; + while (@to_check) { + my $to_check = join(' ', @to_check); + my @l = `ldd $to_check 2>/dev/null` =~ m! => (/\S+)!g; + foreach (@l) { + s!^(/lib(64)?/).*?/!$1! if $main_node->{attr}{'no-arch-libraries'}; #- replace /lib/tls or /lib/i686 with /lib + } + @to_check = grep { !$needed_libraries{$_}++ } @l; + @to_check = (); + } +} +sub install_needed_libraries { + copy_files('', $DEST, [ keys %needed_libraries ], '', '--dereference'); +} + +sub copy_files { + my ($working_dir, $to_dir, $files, $b_flatten, @options) = @_; + + if ($b_flatten) { + mkdir_p($to_dir); + my $options = join(' ', '-r', @options); + foreach (group_by_n(20, $files)) { + warn "cp $options to_dir $to_dir from $working_dir: @$_\n" if $verbose; + system("cd $working_dir ; cp $options @$_ $to_dir"); + } + } else { + my $options = join(' ', $base_cpio_options, @options); + warn "cpio $options to_dir $to_dir from $working_dir: @$files\n" if $verbose; + open(my $F, "| cd $working_dir ; cpio $options $to_dir"); + print $F "$_\n" foreach @$files; + close($F) or die "cpio $to_dir failed\n"; + } +} + +sub install { + my ($env, $text) = @_; + + my $from_dir = $env->{from}{dir}; + my $to_dir = $DEST . expand_macros($env->{to}{dir} || $env->{to}{flatten} && $from_dir || ''); + my $working_dir = '.'; + + my $expand = $env->{from}{expand} || ''; + + my $disallow_from_dir = sub { + !$from_dir or die "from dir not allowed with $expand binary\n"; + }; + + my $from_file = sub { + my ($rel, $b_full_glob, $b_recursive_dirs) = @_; + my $f = expand_macros($from_dir ? "$from_dir/$rel" : $rel); + my @l = $f; + chdir $working_dir; + if ($f =~ /\*/ || $b_full_glob) { + @l = glob($f) or die "no match for $f\n"; + + @l == 1 || $b_full_glob or die "multiple match for $f\n"; + } else { + -e $f or die "missing file $f\n"; + } + if (@l == 1 && -d $l[0] && $b_recursive_dirs) { + @l = all_files_rec_($l[0]); + } + @l = grep { !m!/CVS($|/)! } @l; + if (my $re = $env->{from}{matching}) { + @l = grep { eval $re } @l; + } + + collect_needed_libraries(grep { -x $_ } @l); + + chdir $initial_dir; + @l; + }; + + my @files; + if ($expand eq 'tar') { + foreach (split(' ', $text)) { + system('tar', 'xfj', $from_file->($_), '-C', $to_dir); + } + # not filling @files, things are already done + + } elsif ($expand eq 'command') { + @files = chomp_(`$text`); + + } elsif ($expand eq 'glob') { + #- glob done in $from_file + @files = split(' ', $text); + + } elsif ($expand eq 'binary') { + $disallow_from_dir->(); + my @PATH = qw(/sbin /bin /usr/bin /usr/sbin /usr/X11R6/bin); + foreach my $name (split(' ', $text)) { + my @l = grep { -x $_ } map { "$_/$name" } @PATH; + @l or die "can't find binary $name\n"; + if (my @m = grep { ! -l $_ } @l) { + @l = @m; + } + @l == 1 or die "many matches for binary $name: " . join(' ', @l) . "\n"; + push @files, @l; + } + $env->{filter}{command} ||= 'strip'; + + } elsif ($expand eq 'rpm') { + $disallow_from_dir->(); + foreach my $rpm (split(' ', $text)) { + my @l = chomp_(`rpm -ql $rpm`) or die "rpm $rpm must be installed\n"; + push @files, @l; + } + + } elsif ($expand eq 'perl') { + $disallow_from_dir->(); + $from_dir = '/usr/lib/perl5/vendor_perl/*'; + @files = split(' ', $text); + } elsif ($expand eq 'main-perl') { + $disallow_from_dir->(); + $from_dir = $Config{privlib}; + @files = split(' ', $text); + } elsif ($expand) { + die "unknown expand method $expand\n"; + } else { + @files = split(' ', $text); + + $env->{filter}{command} ||= 'strip' if $to_dir =~ m!/bin$!; + } + + if ($env->{to}{dir} && $from_dir) { + $working_dir = $from_dir; + undef $from_dir; + } + + my @all_files = map { $from_file->($_, $expand eq 'glob', $expand ne 'rpm') } @files; + + + my $copy_mode = $env->{mode}{copy} || ''; + my @options = ( + if_($copy_mode ne 'keep-links', '--dereference'), + ); + copy_files($working_dir, $to_dir, \@all_files, $env->{to}{flatten}, @options); + + { + chdir $to_dir; + foreach (group_by_n(20, \@all_files)) { + my @l = $env->{to}{flatten} ? (map { basename($_) } @$_) : (map { "./$_" } @$_); + @l = grep { ! -d $_ } @l; + + if (my $subst = $env->{filter}{subst}) { + system('perl', '-pi', '-e', $subst, @l); + } + if (my $command = $env->{filter}{command}) { + my @options = ( + if_($command eq 'gzip', '-9'), + if_($command eq 'strip', '2>/dev/null'), + ); + system(join(' ', $command, @options, @l)); + } + } + chdir $initial_dir; + } +} + +sub decompose { + my ($tree) = @_; + my ($tag, $val) = @$tree; + if ($tag eq '0') { + { text => $val }; + } else { + my ($attr, @l) = @$val; + { tag => $tag, attr => $attr, l => [ group_by2(@l) ] }; + } +} -- cgit v1.2.1