source: MondoRescue/branches/3.2/MondoRescue/lib/MondoRescue/File.pm@ 3262

#!/usr/bin/perl -w
#
# File subroutines brought by the MondoRescue project
#
# $Id$
#
# Copyright B. Cornec 2008-2014
# Provided under the GPL v2

package MondoRescue::File;

use strict 'vars';
use Data::Dumper;
use English;
use Cwd;
use File::Basename;
use ProjectBuilder::Base;
use lib qw (lib);

# Inherit from the "Exporter" module which handles exporting functions.

use Exporter;

# Export, by default, all the functions into the namespace of
# any code which uses this module.

our @ISA = qw(Exporter);
our @EXPORT = qw(mr_file_read_all_link mr_file_process_ldd mr_file_normalize);

=pod

=head1 NAME

MondoRescue::File, part of the mondorescue.org

=head1 DESCRIPTION

This modules provides low level and generic functions for the Mondorescue project

=head1 USAGE

=over 4

=item B<mr_file_normalize>

This function normalize a path by removing .., . or // in paths given as parameters

=cut

#$pbdebug = 2;

sub mr_file_normalize {

my $f = shift;
my $dir = shift || undef;

# We modify based on the current dir, 
# except when we're asked to use another one (case of a target link)
my $newpath = cwd;
$newpath = $dir if (defined $dir);

return($f) if (not defined $f);

pb_log(2,"mr_file_normalize file: **$f**\n");
pb_log(2,"mr_file_normalize dir : **$dir**\n") if (defined $dir);

# Handle case of . at the start in path
if ($f =~ /^\.\//) {
    $f =~ s/^\.\//$newpath\//;
}
# Handle case of .. at the start in path
if ($f =~ /^\.\.\//) {
    my $dn = dirname(dirname($newpath));
    $f =~ s/^\.\.\//$dn\//;
}
# Now handles .. and . in the middle
$f =~ s|([^/]*)/([^/]+)/\.\./([^/]+)|$1/$3|g;
$f =~ s|([^/]*)/([^/]+)/\./([^/]+)|$1/$2/$3|g;
# Handle double /
$f =~ s|//|/|g;

return($f);
}

=over 4

=item B<mr_file_read_all_link>

This function returns all the links found for a given file passed as parameter
Example: mr_file_read_all_link(/lib64) returns (/lib64,/usr/lib64) on a system having a link from /lib64 to /usr/lib64
The return value is a hash of all input files pointing to hash of links

=cut

sub mr_file_read_all_link {

# TODO: Can be parallelized
our $files;

foreach my $f (@_) {
    pb_log(2,"mr_file_read_all_link: **$f**\n");
    # Normalize the path if with .. or . or // in it 
    $f = mr_file_normalize($f);

    my @fullpath = split(/\//,$f);
    my $curdir = "";
    while (@fullpath) {
        my $dir = shift @fullpath;
        pb_log(2,"curdir is now: $curdir** and dir: $dir**\n");
        next if ($dir eq "");
        
        my $link = readlink("$curdir/$dir");
        if (defined $link) {
            $link = mr_file_normalize($link,"$curdir/$dir");
            # It's a real symlink so handle it
            $files->{$f}->{"$curdir/$dir"} = 1;
            if (substr($link,0,1) eq "/") {
                $curdir = $link;
            } else {
                my $dn = "";
                $dn = $curdir if ($curdir ne "");
                $curdir = "$dn/$link";
            }
            if ((-e $curdir) && ((! -d $curdir) || (-l $curdir))) {
                my $h = mr_file_read_all_link($curdir);
                pb_log(2,"After Return h:\n".Dumper($h)."\n");
                foreach my $k (keys %$h) {
                    foreach my $l (keys %$k) {
                        # Use $f as key as we affects all the files 
                        # found in recursion to the current managed file
                        $files->{$f}->{$l} = 1;
                    }
                }
                pb_log(2,"After Return files:\n".Dumper($files)."\n");
            }
        } else {
            $curdir .= "/$dir";
        }
    }
    pb_log(2,"curdir is now: $curdir**\n");
    $files->{$f}->{$curdir} = 1 if (-e $curdir);
}
pb_log(1,"mr_file_read_all_link returns:\n".Dumper($files)."\n");
return($files);
}

=over 4

=item B<mr_file_process_ldd>

This 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
It takes a list of parameters which are the path of the binaries to analyze and for which we want its dependencies to be included

=cut

sub mr_file_process_ldd {

my $files;

foreach my $f (@_) {
    pb_log(2,"mr_file_process_ldd: **$f**\n");
    open(CMD,"ldd $f 2> /dev/null |") || die "You need ldd for mindi support";
    # Format is something like this:
    #  linux-vdso.so.1 (0x00007fff7c0ee000)
    #  libtermcap.so.2 => /lib64/libtermcap.so.2 (0x00007ff1f0b1b000)
    #  libdl.so.2 => /lib64/libdl.so.2 (0x00007ff1f0917000)
    #  libc.so.6 => /lib64/libc.so.6 (0x00007ff1f0564000)
    #  /lib64/ld-linux-x86-64.so.2 (0x00007ff1f0d1f000)
    my $answer = undef;
    while (<CMD>) {
        my ($empty,$orig,$symb,$dest,$hexa) = split(/\s+/);
        # print "**$orig**$symb**$dest**$hexa\n";
        $answer = $orig if ($orig =~ /^\//);
        $answer = $dest if ((defined $dest) && ($dest =~ /^\//));
        push @{$files->{$f}},$answer if (defined $answer);
    }
}
close(CMD);

return($files);
}

=back

=head1 WEB SITES

The 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/>.

=head1 USER MAILING LIST

For community exchanges around MondoRescue please use the list L<http://sourceforge.net/mailarchive/forum.php?forum_name=mondo-devel>

=head1 AUTHORS

The MondoRescue team lead by Bruno Cornec L<mailto:bruno@mondorescue.org>.

=head1 COPYRIGHT

MondoRescue is distributed under the GPL v2.0 license or later,
described in the file C<COPYING> included with the distribution.

=cut