source: MondoRescue/branches/3.2/MondoRescue/lib/MondoRescue/Kernel.pm@ 3354

#!/usr/bin/perl -w
#
# Subroutines related to Kernel brought by the MondoRescue project
#
# $Id$
#
# Copyright B. Cornec 2008-2015
# Provided under the GPL v2

package MondoRescue::Kernel;

use strict 'vars';
use Data::Dumper;
use File::Basename;
use POSIX "uname";
use lib qw (lib);
use ProjectBuilder::Base;
use ProjectBuilder::Conf;
use MondoRescue::Base;
use MondoRescue::Inventory;

# 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_kernel_get_version mr_kernel_get_modules);

=pod

=head1 NAME

MondoRescue::Kernel, part of the mondorescue.org

=head1 DESCRIPTION

This modules provides low level functions for Kernel support in the Mondorescue project

=head1 USAGE

=over 4

=item B<mr_kernel_get_version>

This function checks the kernel and returns back its version

=cut

sub mr_kernel_get_version {

my ($os,$ver,$kernelver,$rest);

# By default we don't know how it works for other OSes
$kernelver = "unknown";

my ($sysname, $nodename, $release, $version, $machine ) = uname();
$kernelver = $release if (defined $release);

return($kernelver);
}


=item B<mr_kernel_get_modules>

Tis function takes as input the kernel version to examined (can be undef in which case the running kernel is used) and a list of modules names to examined as well (can be undef in which case all modules ar taken)
This function returns back the modules path as a first argument and the list of relative modules path for the modules names passed.

Example:
mr_kernel_get_modules("3.8.13.4-desktop-1.mga3","ext3") returns
("/lib/modules/3.8.13.4-desktop-1.mga3", "kernel/fs/ext3/ext3.ko.xz","kernel/fs/jbd/jbd.ko.xz")

=cut

sub mr_kernel_get_modules {

my @allmodules = @_;
my $ver = shift @allmodules;
$ver = mr_kernel_get_version() if (not defined ($ver));

my $module = ""; 
my %modlist;
my %modpath;
my $void = "";
my @alllivemodules;
my @allmodpaths;
my $modulepath = "";

#print Dumper(@allmodules);

# First compute the list of "live" modules - run on the system
open(LSMOD, "cat /proc/modules |") or die "Unable to launch lsmod";
while (<LSMOD>) {
    next if (/^Module/);
    ($module, $void) = split(/ /);
    pb_log(2,"***$module***|***$void***\n");
    push @alllivemodules,$module;
}
close(LSMOD);

# If no module name list passed as parameter, then work on all modules of the system
if (not defined $allmodules[0]) {
    @allmodules = @alllivemodules;
}
#print Dumper(@allmodules);

# Now computes the dependencies of each module and store them in %modlist
# # Some depmods gives a full path, others a relative path to /lib/modules/$ver
open(DEPMOD, "/sbin/depmod -n $ver |") or die "Unable to launch depmod";
while (<DEPMOD>) {
    ($module, $void) = split(/:/);
    last if ($module =~ /^#/);
    chomp($void);
    $void =~ s/\s+//;
    $module = "/lib/modules/$ver/$module" if ($module !~ /^\/lib\/modules/);
    # Now module is a full path whatever depmod version
    $void = join(' ',map { "/lib/modules/$ver/".$_ } split(/ /,$void)) if ($void !~ /^\/lib\/modules/);
    # Now void is a full path of modules whatever depmod version
    $modlist{$module} = $void;
    my $m = basename($module,".ko",".o",".ko.gz",".ko.bz",".ko.xz",".o.gz",".o.bz",".o.xz");
    $modpath{$m} = $module;
    pb_log(2,"Depmod on $module gives $void\n");
}
close(DEPMOD);

#print Dumper(%modlist)."\n";

my $lib;
my $modulep;
my $kernelv;
my $modpath;

# Analyze each module to find its full path name
foreach my $m (@allmodules) {
    pb_log(1,"Analyzing $m\n");
    if (not defined $modpath{$m}) {
        pb_log(1,"WARNING: No modpath for module $m\n");
        next;
    }
    pb_log(2,"$m has a modpath of $modpath{$m}\n");
    open(MODINFO, "/sbin/modinfo -n $modpath{$m} 2>/dev/null |") or die "Unable to launch modinfo";
    $module = <MODINFO>;
    close(MODINFO);
    if ((not defined $module) || ($module =~ '^$')) {
        pb_log(1,"WARNING: No modinfo for module $m\n");
        next;
    }
    chomp($module);
    ($void,$lib,$modulep,$kernelv,$modpath) = split(/\//,$module,5);
    next if (not defined $modpath);
    if (not defined $modlist{$module}) {
        pb_log(0,"No modlist found for $module\n");
        next;
    }
    pb_log(2,"modpath: $module\n");
    push @allmodpaths,$module,split(/ /,$modlist{$module});
}
pb_log(1,"all modpaths: ".join(' ',@allmodpaths)."\n");
# From List::More
my %seen = ();
return(grep { not $seen{$_}++ } @allmodpaths);
}

=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

The mailing list of the project is available at L<mailto:mondo@lists.sf.net>
 
=head1 AUTHORS

The Mondorescue.org team L<http://www.mondorescue.org/> lead by Bruno Cornec L<mailto:bruno@mondorescue.org>.

=head1 COPYRIGHT

This module is distributed under the GPL v2.0 license
described in the file C<COPYING> included with the distribution.

=cut

1;