Changeset 2725 in MondoRescue for branches/2.2.9/mindi-busybox/examples/depmod.pl

Timestamp:

Feb 25, 2011, 9:26:54 PM (13 years ago)

Author:

Bruno Cornec

Message:

• Update mindi-busybox to 1.18.3 to avoid problems with the tar command which is now failing on recent versions with busybox 1.7.3

File:

• branches/2.2.9/mindi-busybox/examples/depmod.pl (modified) (11 diffs)

branches/2.2.9/mindi-busybox/examples/depmod.pl

@@ -14 +14 @@
 # This program is free software; you can redistribute it and/or modify it
 # under the same terms as Perl itself.
-use Getopt::Long;
+use Getopt::Long qw(:config no_auto_abbrev no_ignore_case);
 use File::Find;
 use strict;
@@ -24 +24 @@
 my $kernelsyms="";
 my $symprefix="";
+my $all=0;
+my $quick=0;
+my $errsyms=0;
 my $stdout=0;
 my $verbose=0;
@@ -45 +48 @@
    -v --verbose       : Print out lots of debugging stuff
    -P --symbol-prefix : Symbol prefix
+   -a --all           : Probe all modules (default/only thing supported)
+   -e --errsyms       : Report any symbols not supplied by modules/kernel
 TXT
 
@@ -56 +61 @@
     "verbose|v"         => \$verbose,
     "symbol-prefix|P=s" => \$symprefix,
+    "all|a"             => \$all,
+    # unsupported options
+    "quick|A"           => \$quick,
+    # ignored options (for historical usage)
+    "quiet|q",
+    "root|r",
+    "unresolved-error|u"
 );
 
@@ -61 +73 @@
 die $usage unless $basedir && ( $kernel || $kernelsyms );
 die "can't use both -k and -F\n\n$usage" if $kernel && $kernelsyms;
+die "sorry, -A/--quick is not supported" if $quick;
+die "--errsyms requires --kernelsyms" if $errsyms && !$kernelsyms;
 
 # Strip any trailing or multiple slashes from basedir
-$basedir =~ s-(/)\1+-/-g;
+$basedir =~ s-/+$--g;
 
 # The base directory should contain /lib/modules somewhere
@@ -138 +152 @@
 }
 
+# build a complete dependency list for each module and make sure it
+# is kept in order proper order
+my $mod2 = {};
+sub maybe_unshift
+{
+    my ($array, $ele) = @_;
+    # chop off the leading path /lib/modules/<kver>/ as modprobe
+    # will handle relative paths just fine
+    $ele =~ s:^/lib/modules/[^/]*/::;
+    foreach (@{$array}) {
+        if ($_ eq $ele) {
+            return;
+        }
+    }
+    unshift (@{$array}, $ele);
+}
+sub add_mod_deps
+{
+    my ($depth, $mod, $mod2, $module, $this_module) = @_;
+
+    $depth .= " ";
+    warn "${depth}loading deps of module: $this_module\n" if $verbose;
+    if (length($depth) > 50) {
+        die "too much recursion (circular dependencies in modules?)";
+    }
+
+    foreach my $md (keys %{$mod->{$this_module}}) {
+        add_mod_deps ($depth, $mod, $mod2, $module, $md);
+        warn "${depth} outputting $md\n" if $verbose;
+        maybe_unshift (\@{$$mod2->{$module}}, $md);
+    }
+
+    if (!%{$mod->{$this_module}}) {
+        warn "${depth} no deps\n" if $verbose;
+    }
+}
+foreach my $module (keys %$mod) {
+    warn "filling out module: $module\n" if $verbose;
+    @{$mod2->{$module}} = ();
+    add_mod_deps ("", $mod, \$mod2, $module, $module);
+}
+
 # figure out where the output should go
 if ($stdout == 0) {
+    warn "writing $basedir/modules.dep\n" if $verbose;
     open(STDOUT, ">$basedir/modules.dep")
                              or die "cannot open $basedir/modules.dep: $!";
@@ -152 +209 @@
         print "\n\n";
     } else {
-        print "$module: ";
-        my @sorted = sort bydep keys %{$mod->{$module}};
+        my $shortmod = $module;
+        $shortmod =~ s:^/lib/modules/[^/]*/::;
+        print "$shortmod:";
+        my @sorted = @{$mod2->{$module}};
+        printf " " if @sorted;
         print join(" ",@sorted);
         print "\n";
@@ -164 +224 @@
     my ($name, $sym_ar, $exp, $dep) = @_;
 
-    my $ksymtab = grep m/ __ksymtab/, @$sym_ar;
+    my $ksymtab = grep m/ ${symprefix}__ksymtab/, @$sym_ar;
 
     # gather the exported symbols
@@ -170 +230 @@
         # explicitly exported
         foreach ( @$sym_ar ) {
-            / __ksymtab_(.*)$/ and do {
-                warn "sym = $1\n" if $verbose;
-                $exp->{$1} = $name;
+            / ${symprefix}__ksymtab_(.*)$/ and do {
+                my $sym = ${symprefix} . $1;
+                warn "sym = $sym\n" if $verbose;
+                $exp->{$sym} = $name;
             };
         }
@@ -178 +239 @@
         # exporting all symbols
         foreach ( @$sym_ar ) {
-            / [ABCDGRST] (.*)$/ and do {
+            / [ABCDGRSTW] (.*)$/ and do {
                 warn "syma = $1\n" if $verbose;
                 $exp->{$1} = $name;
@@ -190 +251 @@
     # gather the unresolved symbols
     foreach ( @$sym_ar ) {
-        !/ __this_module/ && / U (.*)$/ and do {
+        !/ ${symprefix}__this_module/ && / U (.*)$/ and do {
             warn "und = $1\n" if $verbose;
             push @{$dep->{$name}}, $1;