Changeset 3224 for branches/3.2


Ignore:
Timestamp:
Dec 30, 2013, 10:46:29 AM (6 years ago)
Author:
bruno
Message:
  • mr_file_read_all_link seems to be working correctly now.
  • test file for the latest mr functions (mr-process-ldd and mr-read-all-link)
Location:
branches/3.2
Files:
2 added
2 edited

Legend:

Unmodified
Added
Removed
  • branches/3.2/MondoRescue/lib/MondoRescue/File.pm

    r3222 r3224  
    1313use Data::Dumper;
    1414use English;
    15 use File::Find;
    16 use Cwd;
     15#use File::Basename;
    1716use lib qw (lib);
    1817
     
    2524
    2625our @ISA = qw(Exporter);
    27 our @EXPORT = qw(mr_file_read_all_link);
     26our @EXPORT = qw(mr_file_read_all_link mr_file_process_ldd);
    2827
    2928=pod
     
    4847=cut
    4948
    50 # Cf: http://www.stonehenge.com/merlyn/UnixReview/col27.html
    5149sub mr_file_read_all_link {
    5250
    53 my $dir = cwd;
    54 my $link;
     51# TODO: Can be parallelized
     52my %files;
    5553
    56 find sub {
    57     return unless -l;
    58     my @right = split /\//, $File::Find::name;
    59     my @left = do {
    60         @right && ($right[0] eq "") ?
    61         shift @right :            # quick way
    62         split /\//, $dir;
    63     };    # first element always null
    64     while (@right) {
    65         my $item = shift @right;
    66         next if $item eq "." or $item eq "";
    67         if ($item eq "..") {
    68             pop @left if @left > 1;
    69             next;
    70         }
    71         my $link = readlink(join "/", @left, $item);
     54foreach my $f (@_) {
     55    print "Processing $f**\n";
     56    # Normalize the path if with .. in it or //
     57    $f =~ s|([^/]*)/([^/]+)/\.\./([^/]+)|$1/$3|g;
     58    $f =~ s|//|/|g;
     59    my @fullpath = split(/\//,$f);
     60    my $curdir = "";
     61    while (@fullpath) {
     62        my $dir = shift @fullpath;
     63        print "curdir is now: $curdir** and dir: $dir**\n";
     64        next if (($dir eq ".") || ($dir eq ""));
     65        my $link = readlink("$curdir/$dir");
    7266        if (defined $link) {
    73             my @parts = split /\//, $link;
    74             if (@parts && ($parts[0] eq "")) { # absolute
    75                 @left = shift @parts;   # quick way
     67            # It's a real symlink so handle it
     68            if (defined $files{$f}) {
     69                $files{$f} .= "$curdir/$dir|";
     70            } else {
     71                $files{$f} = "$curdir/$dir|";
    7672            }
    77             unshift @right, @parts;
    78             next;
     73            if (substr($link,0,1) eq "/") {
     74                $curdir = $link;
     75            } else {
     76                my $dn = "";
     77                $dn = $curdir if ($curdir ne "");
     78                $curdir = "$dn/$link";
     79            }
     80            if ((! -d $curdir) || (-l $curdir)) {
     81                my $h = mr_file_read_all_link($curdir);
     82                print "File: $curdir - Return:\n".Dumper($h)."\n";
     83                foreach my $k (keys %$h) {
     84                    $files{$f} .= $h->{$k}."|";
     85                }
     86            }
    7987        } else {
    80             push @left, $item;
    81             next;
     88            $curdir .= "/$dir";
    8289        }
    8390    }
    84     #print "$File::Find::name is ", join("/", @left), "\n";
    85     $link = join("/", @left);
    86 }, @_;
    87 return($link);
     91    $files{$f} .= "$curdir";
    8892}
     93return(\%files);
     94}
     95
     96=over 4
     97
     98=item B<mr_file_process_ldd>
     99
     100This function keeps track of the dependencies of a binary with its dynamic libraries by analyzing the return of ldd on that binary and recursing on all the dependencies to provide the complete list of files needed to have this binary run in a mindi or chroot context
     101It takes a list of parameters which are the path of the binaries to analyze and for which we want its dependencies to be included
     102
     103=cut
     104
     105sub mr_file_process_ldd {
     106
     107my %files;
     108
     109foreach my $f (@_) {
     110    open(CMD,"ldd $f 2> /dev/null |") || die "You need ldd for mindi support";
     111    # Format is something like this:
     112    #  linux-vdso.so.1 (0x00007fff7c0ee000)
     113    #  libtermcap.so.2 => /lib64/libtermcap.so.2 (0x00007ff1f0b1b000)
     114    #  libdl.so.2 => /lib64/libdl.so.2 (0x00007ff1f0917000)
     115    #  libc.so.6 => /lib64/libc.so.6 (0x00007ff1f0564000)
     116    #  /lib64/ld-linux-x86-64.so.2 (0x00007ff1f0d1f000)
     117    my $answer = undef;
     118    while (<CMD>) {
     119        my ($empty,$orig,$symb,$dest,$hexa) = split(/\s+/);
     120        # print "**$orig**$symb**$dest**$hexa\n";
     121        $answer = $orig if ($orig =~ /^\//);
     122        $answer = $dest if ((defined $dest) && ($dest =~ /^\//));
     123        $files{$answer} = $answer if (defined $answer);
     124    }
     125}
     126close(CMD);
     127
     128return(\%files);
     129}
     130
     131=back
     132
     133=head1 WEB SITES
     134
     135The main Web site of the project is available at L<http://www.mondorescue.org>. Bug reports should be filled using the trac instance of the project at L<http://trac.mondorescue.org/>.
     136
     137=head1 USER MAILING LIST
     138
     139For community exchanges around MondoRescue please use the list L<http://sourceforge.net/mailarchive/forum.php?forum_name=mondo-devel>
     140
     141=head1 AUTHORS
     142
     143The MondoRescue team lead by Bruno Cornec L<mailto:bruno@mondorescue.org>.
     144
     145=head1 COPYRIGHT
     146
     147MondoRescue is distributed under the GPL v2.0 license or later,
     148described in the file C<COPYING> included with the distribution.
     149
     150=cut
     151
     152
  • branches/3.2/mindi/mindi-get-perl-modules

    r3223 r3224  
    1010
    1111use File::Find;
    12 use Cwd;
    1312use MondoRescue::File;
    1413
     
    107106# Adapted From /usr/lib/rpm/mandriva/perl.req
    108107# by Ken Estes Mail.com kestes@staff.mail.com
     108# used under the GPL
    109109
    110110sub mr_process_file {
Note: See TracChangeset for help on using the changeset viewer.