summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2005-05-19 08:26:54 +0000
committerPascal Rigaux <pixel@mandriva.com>2005-05-19 08:26:54 +0000
commit4b83d153ddfeb3ea6f6ce9965ef298c915c6fab6 (patch)
treeabd3015b7e064dd8eca2b21455df19b8d45a46e1
parentc6533f4fd04c3ed2cb04c99dda67402d1ff361c0 (diff)
downloaddrakx-4b83d153ddfeb3ea6f6ce9965ef298c915c6fab6.tar
drakx-4b83d153ddfeb3ea6f6ce9965ef298c915c6fab6.tar.gz
drakx-4b83d153ddfeb3ea6f6ce9965ef298c915c6fab6.tar.bz2
drakx-4b83d153ddfeb3ea6f6ce9965ef298c915c6fab6.tar.xz
drakx-4b83d153ddfeb3ea6f6ce9965ef298c915c6fab6.zip
many changes for use with rescue list
-rwxr-xr-xtools/install-xml-file-list136
1 files changed, 104 insertions, 32 deletions
diff --git a/tools/install-xml-file-list b/tools/install-xml-file-list
index df760ae32..1fac64ab7 100755
--- a/tools/install-xml-file-list
+++ b/tools/install-xml-file-list
@@ -6,17 +6,25 @@ use Data::Dumper;
use Config;
use Cwd 'cwd';
-@ARGV == 2 or die "usage: install-xml-file-list <xml file> <destination>\n";
+my $want_sudo = $ARGV[0] eq '--sudo' && shift @ARGV;
+
+@ARGV == 2 or die "usage: install-xml-file-list [--sudo] <xml file> <destination>\n";
my ($xml_file_list, $DEST) = @ARGV;
+my $sudo = '';
+if ($>) {
+ $sudo = "sudo" if $want_sudo;
+ $ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";
+}
+
+#$verbose = 1;
+
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);
@@ -31,7 +39,7 @@ final_cleanup();
sub final_cleanup() {
#- cpio creates directory 700, that's not nice
- system("find $DEST -type d | xargs chmod 755");
+ system("find $DEST -type d | xargs $sudo chmod 755");
}
sub handle_nodes {
@@ -92,6 +100,11 @@ sub group_by_n {
@r;
}
+sub identify_file {
+ my ($dev, $ino) = @_;
+ "$dev:$ino";
+}
+
sub all_files_rec_ {
my ($d) = @_;
@@ -123,6 +136,25 @@ sub install_needed_libraries {
copy_files('', $DEST, [ keys %needed_libraries ], '', '--dereference');
}
+sub collect_needed_perl_files {
+ my ($local_rep, $dest, @scripts) = @_;
+
+ my (%local, %global);
+ foreach my $script (@scripts) {
+ foreach (`strace -efile perl -cw -I$local_rep $script 2>&1`) {
+ my ($f) = /^open\("(.*?)",.*\)\s*=\s*\d+$/ or next;
+ if ($f =~ m!^\Q$local_rep\E/(.*)!) {
+ $local{$1} = 1;
+ } elsif (begins_with($f, '/dev/')) {
+ # skip
+ } elsif (begins_with($f, '/')) {
+ $global{$f} = 1;
+ }
+ }
+ }
+ [ keys %local ], [ keys %global ];
+}
+
sub copy_files {
my ($working_dir, $to_dir, $files, $b_flatten, @options) = @_;
@@ -131,12 +163,12 @@ sub copy_files {
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");
+ system("cd $working_dir ; $sudo 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");
+ open(my $F, "| cd $working_dir ; $sudo cpio $options $to_dir");
print $F "$_\n" foreach @$files;
close($F) or die "cpio $to_dir failed\n";
}
@@ -145,8 +177,9 @@ sub copy_files {
sub install {
my ($env, $text) = @_;
- my $from_dir = $env->{from}{dir};
+ my $from_dir = expand_macros($env->{from}{dir});
my $to_dir = $DEST . expand_macros($env->{to}{dir} || $env->{to}{flatten} && $from_dir || '');
+ my $copy_mode = $env->{mode}{copy} || '';
my $working_dir = '.';
my $expand = $env->{from}{expand} || '';
@@ -165,7 +198,7 @@ sub install {
@l == 1 || $b_full_glob or die "multiple match for $f\n";
} else {
- -e $f or die "missing file $f\n";
+ -e $f or die "missing file $f ($rel) in $working_dir\n";
}
if (@l == 1 && -d $l[0] && $b_recursive_dirs) {
@l = all_files_rec_($l[0]);
@@ -198,15 +231,32 @@ sub install {
} elsif ($expand eq 'binary') {
$disallow_from_dir->();
my @PATH = qw(/sbin /bin /usr/bin /usr/sbin /usr/X11R6/bin);
- foreach my $name (split(' ', $text)) {
+ foreach my $name (map { expand_macros($_) } 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;
+ if (@l > 1) {
+ my @m = grep { ! -l $_ } @l;
+ if (@m == 1) {
+ my $id = identify_file($m[0]);
+ push @files, grep { -l $_ && identify_file($_) eq $id } @l;
+ }
+ @l = @m if @m;
+ }
+ if (@l > 1) {
+ warn "many matches for binary $name: " . join(' ', @l) . ", choosing $l[0]\n";
+ }
+ my $f = $l[0];
+ while (1) {
+ push @files, $f;
+ my $l = readlink($f) or last;
+ if ($l =~ m!/!) {
+ warn "keeping symlink $f -> $l as is\n";
+ last;
+ }
+ $f = dirname($f) . '/' . $l;
}
- @l == 1 or die "many matches for binary $name: " . join(' ', @l) . "\n";
- push @files, @l;
}
+ $copy_mode = 'keep-links';
$env->{filter}{command} ||= 'strip';
} elsif ($expand eq 'rpm') {
@@ -224,6 +274,16 @@ sub install {
$disallow_from_dir->();
$from_dir = $Config{privlib};
@files = split(' ', $text);
+ } elsif ($expand =~ /collect-perl-files/) {
+ my (undef, $local, $to) = split(' ', $expand);
+
+ @files = split(' ', $text);
+ warn "collect-perl-files $local $to @files ($env->{filter}{command})\n";
+ my ($local_perl_files, $global_perl_files) = collect_needed_perl_files($local, $to, @files);
+ warn "collect-perl-files gave: ", join(' ', @$local_perl_files), "\n";
+ copy_and_filter("$working_dir/$local", "$DEST$to", $local_perl_files, $env->{filter}, '', '--dereference');
+ copy_and_filter('', $DEST, $global_perl_files, $env->{filter}, '', '--dereference');
+
} elsif ($expand) {
die "unknown expand method $expand\n";
} else {
@@ -238,33 +298,45 @@ sub install {
}
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);
+ copy_and_filter($working_dir, $to_dir, \@all_files, $env->{filter}, $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;
+sub copy_and_filter {
+ my ($working_dir, $to_dir, $all_files, $filter, $flatten, @copy_options) = @_;
- 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));
+ copy_files($working_dir, $to_dir, $all_files, $flatten, @copy_options);
+ apply_filter($to_dir, $filter, $all_files, $flatten);
+}
+
+sub apply_filter {
+ my ($to_dir, $filter, $all_files, $b_flatten) = @_;
+
+ chdir $to_dir;
+ foreach (group_by_n(20, $all_files)) {
+ my @l = $b_flatten ? (map { basename($_) } @$_) : (map { "./$_" } @$_);
+ @l = grep { ! -d $_ } @l;
+
+ if (my $subst = $filter->{subst}) {
+ system('perl', '-pi', '-e', $subst, @l);
+ }
+ if (my $command = $filter->{command}) {
+ $command = $initial_dir . "/$command" if $command =~ m!^..?/!;
+ if ($command =~ /simplify-drakx-modules/) {
+ @l = grep { !/\.so($|\.)/ } @l;
}
+ my @options = (
+ if_($command eq 'gzip', '-9f'),
+ if_($command eq 'strip', '2>/dev/null'),
+ );
+ warn "running $command @options @l\n";
+ system(join(' ', $command, @options, @l));
}
- chdir $initial_dir;
}
+ chdir $initial_dir;
}
sub decompose {