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

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

package MondoRescue::Kernel;

use strict 'vars';
use Data::Dumper;
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 $ver = $_;
$ver = mr_kernel_get_version() if (not defined ($ver));
my @allmodules = @_;

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

# If no module names list passed as parameter, the work on all modules of the system
if (not defined $allmodules[0]) {
    open(LSMOD, "/sbin/lsmod |") or die "Unable to launch lsmod";
    while (<LSMOD>) {
        next if (/^Module/);
        ($module, $void) = split(/ /);
        push @allmodules,$module;
    }
    close(LSMOD);
}

open(DEPMOD, "/sbin/depmod -n $ver |") or die "Unable to launch depmod";
while (<DEPMOD>) {
    ($module, $void) = split(/:/);
    last if ($module =~ /^#/);
    chomp($void);
    $modlist{$module} = $void;
    pb_log(2,"Depmod on $module gives $void\n");
}
close(DEPMOD);

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

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

foreach my $m (@allmodules) {
    pb_log(1,"Analyzing $m\n");
    open(MODINFO, "/sbin/modinfo -n -k $ver $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);
    pb_log(2,"modpath: $modpath\n");
    push @allmodpaths,$modpath,split(/ /,$modlist{$modpath});
}
$modulepath = "/$lib/$modulep/$kernelv";
pb_log(1,"modules path: $modulepath\n");
pb_log(1,"all modpaths: ".join(' ',@allmodpaths)."\n");
return($modulepath,@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;