#!/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";

}