#!/usr/bin/perl -w
#
#############################################################################
# Copyright (c) 2014 Jean Delvare <jdelvare@suse.de>
# All Rights Reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of version 2 of the GNU General Public License as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#############################################################################
#
# The purpose of this script is to catch, and in most cases fix,
# inconsistencies between supported.conf and the set of modules being actually
# installed. It is recommended to run it on a complete set of installed modules
# (all flavors and architectures) otherwise you may get false positives. Note
# that you can pass as many modules directories as you want.
#
# Usage: supported-conf-fixup [OPTIONS] supported.conf [/lib/modules/x.x-flavor ...]
# Options:
# -h, --help Print usage and exit
# --mod-path Report wrong module paths
# --mod-missing Report missing modules
# --mask-path Report wrong mask paths
# --mask-missing Report missing mask paths
# --not-listed Report unlisted modules
# -v, --verbose Be verbose
# -o, --output file Write updated supported.conf to file
# --sort Sort the output file
#
# To do: better handling of _ vs -
# To do: better handling of .ko being optional
use strict;
use vars qw($sup_conf_file @sup_conf_data @supported_mod @supported_mask %supported
%installed $n_ins %installed_paths %builtin %not_listed $verbose
$check_mod_path $check_mod_missing $check_mask_path $check_mask_missing
$check_not_listed $output $n_err $n_corrected $usage $sort);
use File::Find;
use Getopt::Long;
use Fcntl;
# Data structures:
# @sup_conf_data contains raw lines from supported.conf
# @supported_mod contains hashes with the following keys:
# - line: line number in supported.conf
# - module path: relative path + module name
# @supported_mask contains hashes with the following keys:
# - line: line number in supported.conf
# - mask path: relative path + *
# %supported contains the same information as @supported_mod + @supported_mask,
# but as a module/mask path => line mapping
# %installed contains the list of installed modules, as a
# module name => module paths mapping
# %installed_paths records paths which contain installed modules (only
# keys are meaningful)
# %not_listed keys list installed modules which aren't listed in supported.conf
# (so their support status is unknown)
# %builtin contains the list of built-in modules, as a
# module name => module paths mapping
Getopt::Long::Configure("bundling");
$verbose = 0;
GetOptions(
"help|h" => \$usage,
"mod-path" => \$check_mod_path,
"mod-missing" => \$check_mod_missing,
"mask-path" => \$check_mask_path,
"mask-missing" => \$check_mask_missing,
"not-listed" => \$check_not_listed,
"verbose|v+" => \$verbose,
"output|o=s" => \$output,
"sort" => \$sort,
) or exit 1;
if ($usage || @ARGV < 1) {
print STDERR
"Usage: $0 [OPTIONS] supported.conf [/lib/modules/x.x-flavor ...]
Options:
-h, --help Print usage and exit
--mod-path Report wrong module paths
--mod-missing Report missing modules
--mask-path Report wrong mask paths
--mask-missing Report missing mask paths
--not-listed Report unlisted modules
-v, --verbose Be verbose
-o, --output file Write updated supported.conf to file
--sort Sort the output file
";
exit 1;
}
$sup_conf_file = shift @ARGV;
sub gather_path
{
my $file_or_dir = $_;
my $module_path = $File::Find::name;
my ($path, $module);
# Special case for modules.builtin
if ($file_or_dir eq "modules.builtin") {
open(BUILTIN, "<$file_or_dir") or die;
while (<BUILTIN>) {
next unless m,^kernel/(.*)/([^/]+)\.ko(\.xz|\.gz|\.zst)?$,;
$path = $1;
$module = $2;
if (exists $builtin{$module}) {
next if grep { $_ eq $path } @{$builtin{$module}};
# There can be duplicates with different paths across architectures
push @{$builtin{$module}}, $path;
} else {
$builtin{$module} = [ $path ];
}
}
close(BUILTIN);
return;
}
return unless $module_path =~ s,^(.*?/)?kernel/,,;
if (-f $file_or_dir) {
return unless $module_path =~ m,^(.*)/([^/]+)\.ko(\.xz|\.gz|\.zst)?$,;
$path = $1;
$module = $2;
if (exists $installed{$module}) {
return if grep { $_ eq $path } @{$installed{$module}};
# There can be duplicates with different paths across architectures
push @{$installed{$module}}, $path;
} else {
$installed{$module} = [ $path ];
}
$n_ins++;
$not_listed{"$path/$module"} = 1;
} elsif (-d $file_or_dir) {
$installed_paths{$module_path}++;
}
}
# First, gather all installed modules with their path
$n_ins = 0;
if (@ARGV) {
find(\&gather_path, @ARGV);
print "Found $n_ins installed modules\n";
}
sub matching_mask
{
my $module_path = shift;
foreach my $mask (@supported_mask) {
my $prefix = $mask->{module_path};
$prefix =~ s,/*,,;
return "$mask->{module_path} at line $mask->{line}"
if $module_path =~ m,^$prefix,;
}
}
# Then, parse supported.conf
open(SUP, $sup_conf_file) || die;
while (<SUP>) {
# Store raw data, needed to generate the updated file
push @sup_conf_data, $_;
chomp;
s/#.*$//; # Strip comments
s/\s+$//; # Strip trailing whitespace
next if m/^$/; # Skip blank lines
s/^([+-]([\w\d-]+)?\s)*\s*//; # Strip guards
my $new_entry = {
'line' => $.,
'module_path' => $_,
};
# Check for masks that come too early
my $matching_mask = matching_mask($_);
if (m/\/\*$/) {
print "WARNING: Mask $_ at line $. is shadowed by $matching_mask\n"
if $matching_mask;
push @supported_mask, $new_entry;
} else {
print "WARNING: Module $_ at line $. is shadowed by $matching_mask\n"
if $matching_mask;
push @supported_mod, $new_entry;
}
# Check for duplicate entries
if (exists $supported{$_}) {
print "WARNING: Duplicate entry $_, lines $supported{$_} and $.\n";
} else {
$supported{$_} = $.;
}
}
close(SUP);
print "Gathered ", scalar @supported_mod, " modules and ",
scalar @supported_mask, " masks from $sup_conf_file\n";
# Amongst all paths containing modules, list the ones which end the same as the parameter
sub candidate_paths
{
my $path = shift;
(my $last = $path) =~ s,.*/,,;
return grep { $_ =~ m,[\s/]$last$, } keys %installed_paths;
}
sub check_path
{
my $entry = $_;
my $module_path = $entry->{module_path};
my $line = $entry->{line};
my ($path, $module, $ext, $module_alt);
if ($module_path =~ m,^(.*)/\*$,) {
$path = $1;
# Mask, check that this directory exists
if (exists $installed_paths{$path}) {
# Mark all matching modules as listed
foreach $module (keys %not_listed) {
delete $not_listed{$module} if $module =~ m,^$path/,;
}
} else {
# Check if other installed paths end with the same component
my @candidate = candidate_paths($path);
if (0 == scalar @candidate) {
if ($check_mask_missing) {
print "$sup_conf_file: $line: Referenced path $path doesn't exist, no candidate\n"
if $verbose;
$n_err++;
# Delete that line
$sup_conf_data[$line - 1] = '';
$n_corrected++;
}
} elsif (1 == scalar @candidate) {
if ($check_mask_path) {
print "$sup_conf_file: $line: Mask path $path is wrong, correct is $candidate[0]\n"
if $verbose;
$n_err++;
# Update the path
$sup_conf_data[$line - 1] =~ s,(\s)$path/,$1$candidate[0]/,;
$n_corrected++;
# Strip trailing whitespace
$sup_conf_data[$line - 1] =~ s,\s*\n$,\n,;
}
} else {
if ($check_mask_path) {
$n_err++;
print "$sup_conf_file: $line: Referenced path $path doesn't exist, too many candidates (",
join(", ", @candidate), ")\n"
if $verbose;
}
}
}
return;
}
unless ($module_path =~ m,^(.*)/([^/]+)(\.ko)(\.xz|\.gz|\.zst)?$, ||
$module_path =~ m,^(.*)/([^/]+)$,) {
print STDERR "$sup_conf_file: $line: Unparsable module path: $module_path\n";
return;
}
$path = $1;
$module = $2;
$ext = defined $3 ? $3 : '';
# Exact name may be different so try all variants
if (!exists $installed{$module}) {
($module_alt = $module) =~ tr/-/_/;
if (exists $installed{$module_alt}) {
$module = $module_alt;
} else {
($module_alt = $module) =~ tr/_/-/;
if (exists $installed{$module_alt}) {
$module = $module_alt;
}
}
}
# Module, check if it exists
if (!exists $installed{$module}) {
if ($check_mod_missing) {
if (exists $builtin{$module}) {
print "$sup_conf_file: $line: Referenced module $module is built-in\n"
if $verbose >= 2;
} else {
print "$sup_conf_file: $line: Referenced module $module doesn't exist\n"
if $verbose;
$n_err++;
# Delete that line
$sup_conf_data[$line - 1] = '';
$n_corrected++;
}
}
if ($check_mod_path) {
if (exists $builtin{$module} && !grep { $_ eq $path } @{$builtin{$module}}) {
print "$sup_conf_file: $line: Referenced module $module may be built-in but path doesn't match (",
join(" and ", @{$builtin{$module}}),
", supported.conf says $path\n" if $verbose;
}
}
} elsif (!grep { $_ eq $path } @{$installed{$module}}) {
if ($check_mod_path) {
print "$sup_conf_file: $line: Path for module $module is wrong: installed at ",
join(" and ", @{$installed{$module}}),
", supported.conf says $path\n" if $verbose;
$n_err++;
# If there is only one candidate, assume it is right
if (1 == @{$installed{$module}}) {
# Update the path
$sup_conf_data[$line - 1] =~ s,(\s)$path/,$1$installed{$module}->[0]/,;
$n_corrected++;
# Attempt to preserve tab-based comment alignment
if ($sup_conf_data[$line - 1] =~ m,(\t+)#,) {
my $old_len = length "$path/$module$ext";
my $new_len = length "$installed{$module}->[0]/$module$ext";
my $align = (int($old_len / 8) + length $1) * 8;
my $new_spacing = "\t" x ($align / 8 - int($new_len / 8));
$sup_conf_data[$line - 1] =~ s,(\t+)#,$new_spacing#,;
}
# Strip trailing whitespace
$sup_conf_data[$line - 1] =~ s,\s*\n$,\n,;
}
}
}
# Mark as listed
delete $not_listed{"$path/$module"};
# Exact name may be different so try all variants
$module =~ tr/-/_/;
delete $not_listed{"$path/$module"};
$module =~ tr/_/-/;
delete $not_listed{"$path/$module"};
}
# Finally, compare both sets and report and/or correct inconsistencies
$n_err = $n_corrected = 0;
print "\n";
check_path($_) foreach (@supported_mod);
check_path($_) foreach (@supported_mask);
print "\nFound $n_err ", $n_err > 1 ? "errors" : "error", " (corrected $n_corrected)\n"
if ($check_mod_path || $check_mod_missing || $check_mask_path || $check_mask_missing);
# If requested, print unlisted modules
if ($check_not_listed) {
print "Modules installed but not listed in supported.conf:\n";
print "$_\n" foreach (sort keys %not_listed);
}
# Module name comparison function for sorting
sub modcmp
{
my $mod1 = $a;
my $mod2 = $b;
$mod1 =~ s/\s*#.*$//mg; # Strip comments
$mod2 =~ s/\s*#.*$//mg; # Strip comments
$mod1 =~ s/\n//g; # Strip empty lines
$mod2 =~ s/\n//g; # Strip empty lines
$mod1 =~ s/^([+-]([\w\d-]+)?\s)*\s*//; # Strip guards
$mod2 =~ s/^([+-]([\w\d-]+)?\s)*\s*//; # Strip guards
# Masks must always go after explict module names they match
return 1 if $mod1 =~ m/^(.*)\/\*$/ && substr($mod2, 0, length($1)) eq $1;
return -1 if $mod2 =~ m/^(.*)\/\*$/ && substr($mod1, 0, length($1)) eq $1;
return $mod1 cmp $mod2;
}
sub sort_data
{
my (@header, @sorted, $n, $comment);
# Preserve comments and blank lines at the top of supported.conf
for ($n = 0; $n < @sup_conf_data; $n++) {
last unless $sup_conf_data[$n] =~ m/^\s*(#|$)/;
push @header, $sup_conf_data[$n];
}
# Store all the rest in an array, except blank lines
for ($comment = ""; $n < @sup_conf_data; $n++) {
next if $sup_conf_data[$n] =~ m/^\s*$/;
# Comments are attached to the module which follows or precedes
# them. We use a heuristic to distinguish between the two
# cases: comments which start before column 24 are attached to
# the module which follows them, while comments which start
# after column 24 are attached to teh module which precedes
# them.
if ($sup_conf_data[$n] =~ m/^(\s*)#/) {
my $leading = $1;
$leading =~ s/ {1,7}\t/\t/g;
$leading =~ s/ {8}/\t/g;
if (length($leading) <= 3) {
$comment .= $sup_conf_data[$n];
} else {
$sorted[@sorted - 1] .= $sup_conf_data[$n];
}
next;
}
push @sorted, $comment . $sup_conf_data[$n];
$comment = "";
}
# Sort the module list
@sorted = sort modcmp @sorted;
# Merge the header and the module list
@sup_conf_data = (@header, @sorted);
}
# If requested, write a fixed version of supported.conf
if ($output) {
sort_data() if $sort;
open(OUTPUT, ">$output") || die;
for (my $n = 0; $n < @sup_conf_data; $n++) {
# Merge blank lines
print OUTPUT $sup_conf_data[$n]
unless $sup_conf_data[$n] eq "\n" && $sup_conf_data[$n - 1] eq "\n";
}
close(OUTPUT);
print "Fixed supported.conf saved as $output\n";
} elsif ($n_corrected) {
print "Use option -o to write out the corrected file\n";
} elsif ($sort) {
print "Use option -o to write out the sorted file\n";
}