#!/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 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 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 $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 () { 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 open(DEPMOD, "/sbin/depmod -n $ver |") or die "Unable to launch depmod"; while () { ($module, $void) = split(/:/); last if ($module =~ /^#/); chomp($void); $void =~ s/\s+//; $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; # Analyze each module to find its full path name 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 = ; 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); $modulepath = "/$lib/$modulep/$kernelv"; pb_log(2,"modpath: $modulepath/$modpath\n"); push @allmodpaths,"$modulepath/$modpath",map { "$modulepath/".$_ } split(/ /,$modlist{$modpath}); } 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. Bug reports should be filled using the trac instance of the project at L. =head1 USER MAILING LIST The mailing list of the project is available at L =head1 AUTHORS The Mondorescue.org team L lead by Bruno Cornec L. =head1 COPYRIGHT This module is distributed under the GPL v2.0 license described in the file C included with the distribution. =cut 1;