get_maintainer.pl: update from Linux kernel v4.16

The most significant change is the addition of the --self-test option
which allows to run a consistency check on all MAINTAINERS files.

Signed-off-by: Heinrich Schuchardt <xypron.glpk@gmx.de>

scripts/get_maintainer.pl

@@ -57,6 +57,7 @@ my $sections = 0;
 my $file_emails = 0;
 my $from_filename = 0;
 my $pattern_depth = 0;
+my $self_test = undef;
 my $version = 0;
 my $help = 0;
 my $find_maintainer_files = 1;
@@ -136,6 +137,7 @@ my %VCS_cmds_git = (
     "subject_pattern" => "^GitSubject: (.*)",
     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
     "file_exists_cmd" => "git ls-files \$file",
+    "list_files_cmd" => "git ls-files \$file",
 );
 
 my %VCS_cmds_hg = (
@@ -165,6 +167,7 @@ my %VCS_cmds_hg = (
     "subject_pattern" => "^HgSubject: (.*)",
     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
     "file_exists_cmd" => "hg files \$file",
+    "list_files_cmd" => "hg manifest -R \$file",
 );
 
 my $conf = which_conf(".get_maintainer.conf");
@@ -214,6 +217,14 @@ if (-f $ignore_file) {
     close($ignore);
 }
 
+if ($#ARGV > 0) {
+    foreach (@ARGV) {
+        if ($_ =~ /^-{1,2}self-test(?:=|$)/) {
+            die "$P: using --self-test does not allow any other option or argument\n";
+        }
+    }
+}
+
 if (!GetOptions(
 		'email!' => \$email,
 		'git!' => \$email_git,
@@ -250,6 +261,7 @@ if (!GetOptions(
 		'fe|file-emails!' => \$file_emails,
 		'f|file' => \$from_filename,
 		'find-maintainer-files' => \$find_maintainer_files,
+		'self-test:s' => \$self_test,
 		'v|version' => \$version,
 		'h|help|usage' => \$help,
 		)) {
@@ -266,6 +278,12 @@ if ($version != 0) {
     exit 0;
 }
 
+if (defined $self_test) {
+    read_all_maintainer_files();
+    self_test();
+    exit 0;
+}
+
 if (-t STDIN && !@ARGV) {
     # We're talking to a terminal, but have no command line arguments.
     die "$P: missing patchfile or -f file - use --help if necessary\n";
@@ -309,14 +327,17 @@ if (!top_of_kernel_tree($lk_path)) {
 my @typevalue = ();
 my %keyword_hash;
 my @mfiles = ();
+my @self_test_info = ();
 
 sub read_maintainer_file {
     my ($file) = @_;
 
     open (my $maint, '<', "$file")
 	or die "$P: Can't open MAINTAINERS file '$file': $!\n";
+    my $i = 1;
     while (<$maint>) {
 	my $line = $_;
+	chomp $line;
 
 	if ($line =~ m/^([A-Z]):\s*(.*)/) {
 	    my $type = $1;
@@ -336,9 +357,12 @@ sub read_maintainer_file {
 	    }
 	    push(@typevalue, "$type:$value");
 	} elsif (!(/^\s*$/ || /^\s*\#/)) {
-	    $line =~ s/\n$//g;
 	    push(@typevalue, $line);
 	}
+	if (defined $self_test) {
+	    push(@self_test_info, {file=>$file, linenr=>$i, line=>$line});
+	}
+	$i++;
     }
     close($maint);
 }
@@ -355,6 +379,9 @@ sub find_ignore_git {
     return grep { $_ !~ /^\.git$/; } @_;
 }
 
+read_all_maintainer_files();
+
+sub read_all_maintainer_files {
     if (-d "${lk_path}MAINTAINERS") {
         opendir(DIR, "${lk_path}MAINTAINERS") or die $!;
         my @files = readdir(DIR);
@@ -376,6 +403,7 @@ if ($find_maintainer_files) {
     foreach my $file (@mfiles) {
         read_maintainer_file("$file");
     }
+}
 
 #
 # Read mail address map
@@ -584,6 +612,135 @@ if ($web) {
 
 exit($exit);
 
+sub self_test {
+    my @lsfiles = ();
+    my @good_links = ();
+    my @bad_links = ();
+    my @section_headers = ();
+    my $index = 0;
+
+    @lsfiles = vcs_list_files($lk_path);
+
+    for my $x (@self_test_info) {
+	$index++;
+
+	## Section header duplication and missing section content
+	if (($self_test eq "" || $self_test =~ /\bsections\b/) &&
+	    $x->{line} =~ /^\S[^:]/ &&
+	    defined $self_test_info[$index] &&
+	    $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) {
+	    my $has_S = 0;
+	    my $has_F = 0;
+	    my $has_ML = 0;
+	    my $status = "";
+	    if (grep(m@^\Q$x->{line}\E@, @section_headers)) {
+		print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n");
+	    } else {
+		push(@section_headers, $x->{line});
+	    }
+	    my $nextline = $index;
+	    while (defined $self_test_info[$nextline] &&
+		   $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) {
+		my $type = $1;
+		my $value = $2;
+		if ($type eq "S") {
+		    $has_S = 1;
+		    $status = $value;
+		} elsif ($type eq "F" || $type eq "N") {
+		    $has_F = 1;
+		} elsif ($type eq "M" || $type eq "R" || $type eq "L") {
+		    $has_ML = 1;
+		}
+		$nextline++;
+	    }
+	    if (!$has_ML && $status !~ /orphan|obsolete/i) {
+		print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n");
+	    }
+	    if (!$has_S) {
+		print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n");
+	    }
+	    if (!$has_F) {
+		print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n");
+	    }
+	}
+
+	next if ($x->{line} !~ /^([A-Z]):\s*(.*)/);
+
+	my $type = $1;
+	my $value = $2;
+
+	## Filename pattern matching
+	if (($type eq "F" || $type eq "X") &&
+	    ($self_test eq "" || $self_test =~ /\bpatterns\b/)) {
+	    $value =~ s@\.@\\\.@g;       ##Convert . to \.
+	    $value =~ s/\*/\.\*/g;       ##Convert * to .*
+	    $value =~ s/\?/\./g;         ##Convert ? to .
+	    ##if pattern is a directory and it lacks a trailing slash, add one
+	    if ((-d $value)) {
+		$value =~ s@([^/])$@$1/@;
+	    }
+	    if (!grep(m@^$value@, @lsfiles)) {
+		print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n");
+	    }
+
+	## Link reachability
+	} elsif (($type eq "W" || $type eq "Q" || $type eq "B") &&
+		 $value =~ /^https?:/ &&
+		 ($self_test eq "" || $self_test =~ /\blinks\b/)) {
+	    next if (grep(m@^\Q$value\E$@, @good_links));
+	    my $isbad = 0;
+	    if (grep(m@^\Q$value\E$@, @bad_links)) {
+	        $isbad = 1;
+	    } else {
+		my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`;
+		if ($? == 0) {
+		    push(@good_links, $value);
+		} else {
+		    push(@bad_links, $value);
+		    $isbad = 1;
+		}
+	    }
+	    if ($isbad) {
+	        print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
+	    }
+
+	## SCM reachability
+	} elsif ($type eq "T" &&
+		 ($self_test eq "" || $self_test =~ /\bscm\b/)) {
+	    next if (grep(m@^\Q$value\E$@, @good_links));
+	    my $isbad = 0;
+	    if (grep(m@^\Q$value\E$@, @bad_links)) {
+	        $isbad = 1;
+            } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) {
+		print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n");
+	    } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) {
+		my $url = $1;
+		my $branch = "";
+		$branch = $3 if $3;
+		my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`;
+		if ($? == 0) {
+		    push(@good_links, $value);
+		} else {
+		    push(@bad_links, $value);
+		    $isbad = 1;
+		}
+	    } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) {
+		my $url = $1;
+		my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`;
+		if ($? == 0) {
+		    push(@good_links, $value);
+		} else {
+		    push(@bad_links, $value);
+		    $isbad = 1;
+		}
+	    }
+	    if ($isbad) {
+		print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
+	    }
+	}
+    }
+}
+
 sub ignore_email_address {
     my ($address) = @_;
 
@@ -861,6 +1018,7 @@ Other options:
   --sections => print all of the subsystem sections with pattern matches
   --letters => print all matching 'letter' types from all matching sections
   --mailmap => use .mailmap file (default: $email_use_mailmap)
+  --self-test => show potential issues with MAINTAINERS file content
   --version => show version
   --help => show this help information
 
@@ -2192,6 +2350,23 @@ sub vcs_file_exists {
     return $exists;
 }
 
+sub vcs_list_files {
+    my ($file) = @_;
+
+    my @lsfiles = ();
+
+    my $vcs_used = vcs_exists();
+    return 0 if (!$vcs_used);
+
+    my $cmd = $VCS_cmds{"list_files_cmd"};
+    $cmd =~ s/(\$\w+)/$1/eeg;   # interpolate $cmd
+    @lsfiles = &{$VCS_cmds{"execute_cmd"}}($cmd);
+
+    return () if ($? != 0);
+
+    return @lsfiles;
+}
+
 sub uniq {
     my (@parms) = @_;