scripts/get_maintainer.pl

   1 #!/usr/bin/env perl
   2 # SPDX-License-Identifier: GPL-2.0
   3 #
   4 # (c) 2007, Joe Perches <joe@perches.com>
   5 #           created from checkpatch.pl
   6 #
   7 # Print selected MAINTAINERS information for
   8 # the files modified in a patch or for a file
   9 #
  10 # usage: perl scripts/get_maintainer.pl [OPTIONS] <patch>
  11 #        perl scripts/get_maintainer.pl [OPTIONS] -f <file>
  12
  13 use warnings;
  14 use strict;
  15
  16 my $P = $0;
  17 my $V = '0.26';
  18
  19 use Getopt::Long qw(:config no_auto_abbrev);
  20 use Cwd;
  21 use File::Find;
  22 use File::Spec::Functions;
  23 use open qw(:std :encoding(UTF-8));
  24
  25 my $cur_path = fastgetcwd() . '/';
  26 my $lk_path = "./";
  27 my $email = 1;
  28 my $email_usename = 1;
  29 my $email_maintainer = 1;
  30 my $email_reviewer = 1;
  31 my $email_fixes = 1;
  32 my $email_list = 1;
  33 my $email_moderated_list = 1;
  34 my $email_subscriber_list = 0;
  35 my $email_git_penguin_chiefs = 0;
  36 my $email_git = 0;
  37 my $email_git_all_signature_types = 0;
  38 my $email_git_blame = 0;
  39 my $email_git_blame_signatures = 1;
  40 my $email_git_fallback = 1;
  41 my $email_git_min_signatures = 1;
  42 my $email_git_max_maintainers = 5;
  43 my $email_git_min_percent = 5;
  44 my $email_git_since = "1-year-ago";
  45 my $email_hg_since = "-365";
  46 my $interactive = 0;
  47 my $email_remove_duplicates = 1;
  48 my $email_use_mailmap = 1;
  49 my $output_multiline = 1;
  50 my $output_separator = ", ";
  51 my $output_roles = 0;
  52 my $output_rolestats = 1;
  53 my $output_section_maxlen = 50;
  54 my $scm = 0;
  55 my $tree = 1;
  56 my $web = 0;
  57 my $bug = 0;
  58 my $subsystem = 0;
  59 my $status = 0;
  60 my $letters = "";
  61 my $keywords = 1;
  62 my $keywords_in_file = 0;
  63 my $sections = 0;
  64 my $email_file_emails = 0;
  65 my $from_filename = 0;
  66 my $pattern_depth = 0;
  67 my $self_test = undef;
  68 my $version = 0;
  69 my $help = 0;
  70 my $find_maintainer_files = 0;
  71 my $maintainer_path;
  72 my $vcs_used = 0;
  73
  74 my $exit = 0;
  75
  76 my @files = ();
  77 my @fixes = ();                 # If a patch description includes Fixes: lines
  78 my @range = ();
  79 my @keyword_tvi = ();
  80 my @file_emails = ();
  81
  82 my %commit_author_hash;
  83 my %commit_signer_hash;
  84
  85 my @penguin_chief = ();
  86 push(@penguin_chief, "Linus Torvalds:torvalds\@linux-foundation.org");
  87 #Andrew wants in on most everything - 2009/01/14
  88 #push(@penguin_chief, "Andrew Morton:akpm\@linux-foundation.org");
  89
  90 my @penguin_chief_names = ();
  91 foreach my $chief (@penguin_chief) {
  92     if ($chief =~ m/^(.*):(.*)/) {
  93         my $chief_name = $1;
  94         my $chief_addr = $2;
  95         push(@penguin_chief_names, $chief_name);
  96     }
  97 }
  98 my $penguin_chiefs = "\(" . join("|", @penguin_chief_names) . "\)";
  99
 100 # Signature types of people who are either
 101 #       a) responsible for the code in question, or
 102 #       b) familiar enough with it to give relevant feedback
 103 my @signature_tags = ();
 104 push(@signature_tags, "Signed-off-by:");
 105 push(@signature_tags, "Reviewed-by:");
 106 push(@signature_tags, "Acked-by:");
 107
 108 my $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 109
 110 # rfc822 email address - preloaded methods go here.
 111 my $rfc822_lwsp = "(?:(?:\\r\\n)?[ \\t])";
 112 my $rfc822_char = '[\\000-\\377]';
 113
 114 # VCS command support: class-like functions and strings
 115
 116 my %VCS_cmds;
 117
 118 my %VCS_cmds_git = (
 119     "execute_cmd" => \&git_execute_cmd,
 120     "available" => '(which("git") ne "") && (-e ".git")',
 121     "find_signers_cmd" =>
 122         "git log --no-color --follow --since=\$email_git_since " .
 123             '--numstat --no-merges ' .
 124             '--format="GitCommit: %H%n' .
 125                       'GitAuthor: %an <%ae>%n' .
 126                       'GitDate: %aD%n' .
 127                       'GitSubject: %s%n' .
 128                       '%b%n"' .
 129             " -- \$file",
 130     "find_commit_signers_cmd" =>
 131         "git log --no-color " .
 132             '--numstat ' .
 133             '--format="GitCommit: %H%n' .
 134                       'GitAuthor: %an <%ae>%n' .
 135                       'GitDate: %aD%n' .
 136                       'GitSubject: %s%n' .
 137                       '%b%n"' .
 138             " -1 \$commit",
 139     "find_commit_author_cmd" =>
 140         "git log --no-color " .
 141             '--numstat ' .
 142             '--format="GitCommit: %H%n' .
 143                       'GitAuthor: %an <%ae>%n' .
 144                       'GitDate: %aD%n' .
 145                       'GitSubject: %s%n"' .
 146             " -1 \$commit",
 147     "blame_range_cmd" => "git blame -l -L \$diff_start,+\$diff_length \$file",
 148     "blame_file_cmd" => "git blame -l \$file",
 149     "commit_pattern" => "^GitCommit: ([0-9a-f]{40,40})",
 150     "blame_commit_pattern" => "^([0-9a-f]+) ",
 151     "author_pattern" => "^GitAuthor: (.*)",
 152     "subject_pattern" => "^GitSubject: (.*)",
 153     "stat_pattern" => "^(\\d+)\\t(\\d+)\\t\$file\$",
 154     "file_exists_cmd" => "git ls-files \$file",
 155     "list_files_cmd" => "git ls-files \$file",
 156 );
 157
 158 my %VCS_cmds_hg = (
 159     "execute_cmd" => \&hg_execute_cmd,
 160     "available" => '(which("hg") ne "") && (-d ".hg")',
 161     "find_signers_cmd" =>
 162         "hg log --date=\$email_hg_since " .
 163             "--template='HgCommit: {node}\\n" .
 164                         "HgAuthor: {author}\\n" .
 165                         "HgSubject: {desc}\\n'" .
 166             " -- \$file",
 167     "find_commit_signers_cmd" =>
 168         "hg log " .
 169             "--template='HgSubject: {desc}\\n'" .
 170             " -r \$commit",
 171     "find_commit_author_cmd" =>
 172         "hg log " .
 173             "--template='HgCommit: {node}\\n" .
 174                         "HgAuthor: {author}\\n" .
 175                         "HgSubject: {desc|firstline}\\n'" .
 176             " -r \$commit",
 177     "blame_range_cmd" => "",            # not supported
 178     "blame_file_cmd" => "hg blame -n \$file",
 179     "commit_pattern" => "^HgCommit: ([0-9a-f]{40,40})",
 180     "blame_commit_pattern" => "^([ 0-9a-f]+):",
 181     "author_pattern" => "^HgAuthor: (.*)",
 182     "subject_pattern" => "^HgSubject: (.*)",
 183     "stat_pattern" => "^(\\d+)\t(\\d+)\t\$file\$",
 184     "file_exists_cmd" => "hg files \$file",
 185     "list_files_cmd" => "hg manifest -R \$file",
 186 );
 187
 188 my $conf = which_conf(".get_maintainer.conf");
 189 if (-f $conf) {
 190     my @conf_args;
 191     open(my $conffile, '<', "$conf")
 192         or warn "$P: Can't find a readable .get_maintainer.conf file $!\n";
 193
 194     while (<$conffile>) {
 195         my $line = $_;
 196
 197         $line =~ s/\s*\n?$//g;
 198         $line =~ s/^\s*//g;
 199         $line =~ s/\s+/ /g;
 200
 201         next if ($line =~ m/^\s*#/);
 202         next if ($line =~ m/^\s*$/);
 203
 204         my @words = split(" ", $line);
 205         foreach my $word (@words) {
 206             last if ($word =~ m/^#/);
 207             push (@conf_args, $word);
 208         }
 209     }
 210     close($conffile);
 211     unshift(@ARGV, @conf_args) if @conf_args;
 212 }
 213
 214 my @ignore_emails = ();
 215 my $ignore_file = which_conf(".get_maintainer.ignore");
 216 if (-f $ignore_file) {
 217     open(my $ignore, '<', "$ignore_file")
 218         or warn "$P: Can't find a readable .get_maintainer.ignore file $!\n";
 219     while (<$ignore>) {
 220         my $line = $_;
 221
 222         $line =~ s/\s*\n?$//;
 223         $line =~ s/^\s*//;
 224         $line =~ s/\s+$//;
 225         $line =~ s/#.*$//;
 226
 227         next if ($line =~ m/^\s*$/);
 228         if (rfc822_valid($line)) {
 229             push(@ignore_emails, $line);
 230         }
 231     }
 232     close($ignore);
 233 }
 234
 235 if ($#ARGV > 0) {
 236     foreach (@ARGV) {
 237         if ($_ =~ /^-{1,2}self-test(?:=|$)/) {
 238             die "$P: using --self-test does not allow any other option or argument\n";
 239         }
 240     }
 241 }
 242
 243 if (!GetOptions(
 244                 'email!' => \$email,
 245                 'git!' => \$email_git,
 246                 'git-all-signature-types!' => \$email_git_all_signature_types,
 247                 'git-blame!' => \$email_git_blame,
 248                 'git-blame-signatures!' => \$email_git_blame_signatures,
 249                 'git-fallback!' => \$email_git_fallback,
 250                 'git-chief-penguins!' => \$email_git_penguin_chiefs,
 251                 'git-min-signatures=i' => \$email_git_min_signatures,
 252                 'git-max-maintainers=i' => \$email_git_max_maintainers,
 253                 'git-min-percent=i' => \$email_git_min_percent,
 254                 'git-since=s' => \$email_git_since,
 255                 'hg-since=s' => \$email_hg_since,
 256                 'i|interactive!' => \$interactive,
 257                 'remove-duplicates!' => \$email_remove_duplicates,
 258                 'mailmap!' => \$email_use_mailmap,
 259                 'm!' => \$email_maintainer,
 260                 'r!' => \$email_reviewer,
 261                 'n!' => \$email_usename,
 262                 'l!' => \$email_list,
 263                 'fixes!' => \$email_fixes,
 264                 'moderated!' => \$email_moderated_list,
 265                 's!' => \$email_subscriber_list,
 266                 'multiline!' => \$output_multiline,
 267                 'roles!' => \$output_roles,
 268                 'rolestats!' => \$output_rolestats,
 269                 'separator=s' => \$output_separator,
 270                 'subsystem!' => \$subsystem,
 271                 'status!' => \$status,
 272                 'scm!' => \$scm,
 273                 'tree!' => \$tree,
 274                 'web!' => \$web,
 275                 'bug!' => \$bug,
 276                 'letters=s' => \$letters,
 277                 'pattern-depth=i' => \$pattern_depth,
 278                 'k|keywords!' => \$keywords,
 279                 'kf|keywords-in-file!' => \$keywords_in_file,
 280                 'sections!' => \$sections,
 281                 'fe|file-emails!' => \$email_file_emails,
 282                 'f|file' => \$from_filename,
 283                 'find-maintainer-files' => \$find_maintainer_files,
 284                 'mpath|maintainer-path=s' => \$maintainer_path,
 285                 'self-test:s' => \$self_test,
 286                 'v|version' => \$version,
 287                 'h|help|usage' => \$help,
 288                 )) {
 289     die "$P: invalid argument - use --help if necessary\n";
 290 }
 291
 292 if ($help != 0) {
 293     usage();
 294     exit 0;
 295 }
 296
 297 if ($version != 0) {
 298     print("${P} ${V}\n");
 299     exit 0;
 300 }
 301
 302 if (defined $self_test) {
 303     read_all_maintainer_files();
 304     self_test();
 305     exit 0;
 306 }
 307
 308 if (-t STDIN && !@ARGV) {
 309     # We're talking to a terminal, but have no command line arguments.
 310     die "$P: missing patchfile or -f file - use --help if necessary\n";
 311 }
 312
 313 $output_multiline = 0 if ($output_separator ne ", ");
 314 $output_rolestats = 1 if ($interactive);
 315 $output_roles = 1 if ($output_rolestats);
 316
 317 if ($sections || $letters ne "") {
 318     $sections = 1;
 319     $email = 0;
 320     $email_list = 0;
 321     $scm = 0;
 322     $status = 0;
 323     $subsystem = 0;
 324     $web = 0;
 325     $bug = 0;
 326     $keywords = 0;
 327     $keywords_in_file = 0;
 328     $interactive = 0;
 329 } else {
 330     my $selections = $email + $scm + $status + $subsystem + $web + $bug;
 331     if ($selections == 0) {
 332         die "$P:  Missing required option: email, scm, status, subsystem, web or bug\n";
 333     }
 334 }
 335
 336 if ($email &&
 337     ($email_maintainer + $email_reviewer +
 338      $email_list + $email_subscriber_list +
 339      $email_git + $email_git_penguin_chiefs + $email_git_blame) == 0) {
 340     die "$P: Please select at least 1 email option\n";
 341 }
 342
 343 if ($tree && !top_of_kernel_tree($lk_path)) {
 344     die "$P: The current directory does not appear to be "
 345         . "a linux kernel source tree.\n";
 346 }
 347
 348 ## Read MAINTAINERS for type/value pairs
 349
 350 my @typevalue = ();
 351 my %keyword_hash;
 352 my @mfiles = ();
 353 my @self_test_info = ();
 354
 355 sub read_maintainer_file {
 356     my ($file) = @_;
 357
 358     open (my $maint, '<', "$file")
 359         or die "$P: Can't open MAINTAINERS file '$file': $!\n";
 360     my $i = 1;
 361     while (<$maint>) {
 362         my $line = $_;
 363         chomp $line;
 364
 365         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 366             my $type = $1;
 367             my $value = $2;
 368
 369             ##Filename pattern matching
 370             if ($type eq "F" || $type eq "X") {
 371                 $value =~ s@\.@\\\.@g;       ##Convert . to \.
 372                 $value =~ s/\*/\.\*/g;       ##Convert * to .*
 373                 $value =~ s/\?/\./g;         ##Convert ? to .
 374                 ##if pattern is a directory and it lacks a trailing slash, add one
 375                 if ((-d $value)) {
 376                     $value =~ s@([^/])$@$1/@;
 377                 }
 378             } elsif ($type eq "K") {
 379                 $keyword_hash{@typevalue} = $value;
 380             }
 381             push(@typevalue, "$type:$value");
 382         } elsif (!(/^\s*$/ || /^\s*\#/)) {
 383             push(@typevalue, $line);
 384         }
 385         if (defined $self_test) {
 386             push(@self_test_info, {file=>$file, linenr=>$i, line=>$line});
 387         }
 388         $i++;
 389     }
 390     close($maint);
 391 }
 392
 393 sub find_is_maintainer_file {
 394     my ($file) = $_;
 395     return if ($file !~ m@/MAINTAINERS$@);
 396     $file = $File::Find::name;
 397     return if (! -f $file);
 398     push(@mfiles, $file);
 399 }
 400
 401 sub find_ignore_git {
 402     return grep { $_ !~ /^\.git$/; } @_;
 403 }
 404
 405 read_all_maintainer_files();
 406
 407 sub read_all_maintainer_files {
 408     my $path = "${lk_path}MAINTAINERS";
 409     if (defined $maintainer_path) {
 410         $path = $maintainer_path;
 411         # Perl Cookbook tilde expansion if necessary
 412         $path =~ s@^~([^/]*)@ $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7])@ex;
 413     }
 414
 415     if (-d $path) {
 416         $path .= '/' if ($path !~ m@/$@);
 417         if ($find_maintainer_files) {
 418             find( { wanted => \&find_is_maintainer_file,
 419                     preprocess => \&find_ignore_git,
 420                     no_chdir => 1,
 421                 }, "$path");
 422         } else {
 423             opendir(DIR, "$path") or die $!;
 424             my @files = readdir(DIR);
 425             closedir(DIR);
 426             foreach my $file (@files) {
 427                 push(@mfiles, "$path$file") if ($file !~ /^\./);
 428             }
 429         }
 430     } elsif (-f "$path") {
 431         push(@mfiles, "$path");
 432     } else {
 433         die "$P: MAINTAINER file not found '$path'\n";
 434     }
 435     die "$P: No MAINTAINER files found in '$path'\n" if (scalar(@mfiles) == 0);
 436     foreach my $file (@mfiles) {
 437         read_maintainer_file("$file");
 438     }
 439 }
 440
 441 sub maintainers_in_file {
 442     my ($file) = @_;
 443
 444     return if ($file =~ m@\bMAINTAINERS$@);
 445
 446     if (-f $file && ($email_file_emails || $file =~ /\.yaml$/)) {
 447         open(my $f, '<', $file)
 448             or die "$P: Can't open $file: $!\n";
 449         my $text = do { local($/) ; <$f> };
 450         close($f);
 451
 452         my @poss_addr = $text =~ m$[\p{L}\"\' \,\.\+-]*\s*[\,]*\s*[\(\<\{]{0,1}[A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+\.[A-Za-z0-9]+[\)\>\}]{0,1}$g;
 453         push(@file_emails, clean_file_emails(@poss_addr));
 454     }
 455 }
 456
 457 #
 458 # Read mail address map
 459 #
 460
 461 my $mailmap;
 462
 463 read_mailmap();
 464
 465 sub read_mailmap {
 466     $mailmap = {
 467         names => {},
 468         addresses => {}
 469     };
 470
 471     return if (!$email_use_mailmap || !(-f "${lk_path}.mailmap"));
 472
 473     open(my $mailmap_file, '<', "${lk_path}.mailmap")
 474         or warn "$P: Can't open .mailmap: $!\n";
 475
 476     while (<$mailmap_file>) {
 477         s/#.*$//; #strip comments
 478         s/^\s+|\s+$//g; #trim
 479
 480         next if (/^\s*$/); #skip empty lines
 481         #entries have one of the following formats:
 482         # name1 <mail1>
 483         # <mail1> <mail2>
 484         # name1 <mail1> <mail2>
 485         # name1 <mail1> name2 <mail2>
 486         # (see man git-shortlog)
 487
 488         if (/^([^<]+)<([^>]+)>$/) {
 489             my $real_name = $1;
 490             my $address = $2;
 491
 492             $real_name =~ s/\s+$//;
 493             ($real_name, $address) = parse_email("$real_name <$address>");
 494             $mailmap->{names}->{$address} = $real_name;
 495
 496         } elsif (/^<([^>]+)>\s*<([^>]+)>$/) {
 497             my $real_address = $1;
 498             my $wrong_address = $2;
 499
 500             $mailmap->{addresses}->{$wrong_address} = $real_address;
 501
 502         } elsif (/^(.+)<([^>]+)>\s*<([^>]+)>$/) {
 503             my $real_name = $1;
 504             my $real_address = $2;
 505             my $wrong_address = $3;
 506
 507             $real_name =~ s/\s+$//;
 508             ($real_name, $real_address) =
 509                 parse_email("$real_name <$real_address>");
 510             $mailmap->{names}->{$wrong_address} = $real_name;
 511             $mailmap->{addresses}->{$wrong_address} = $real_address;
 512
 513         } elsif (/^(.+)<([^>]+)>\s*(.+)\s*<([^>]+)>$/) {
 514             my $real_name = $1;
 515             my $real_address = $2;
 516             my $wrong_name = $3;
 517             my $wrong_address = $4;
 518
 519             $real_name =~ s/\s+$//;
 520             ($real_name, $real_address) =
 521                 parse_email("$real_name <$real_address>");
 522
 523             $wrong_name =~ s/\s+$//;
 524             ($wrong_name, $wrong_address) =
 525                 parse_email("$wrong_name <$wrong_address>");
 526
 527             my $wrong_email = format_email($wrong_name, $wrong_address, 1);
 528             $mailmap->{names}->{$wrong_email} = $real_name;
 529             $mailmap->{addresses}->{$wrong_email} = $real_address;
 530         }
 531     }
 532     close($mailmap_file);
 533 }
 534
 535 ## use the filenames on the command line or find the filenames in the patchfiles
 536
 537 if (!@ARGV) {
 538     push(@ARGV, "&STDIN");
 539 }
 540
 541 foreach my $file (@ARGV) {
 542     if ($file ne "&STDIN") {
 543         $file = canonpath($file);
 544         ##if $file is a directory and it lacks a trailing slash, add one
 545         if ((-d $file)) {
 546             $file =~ s@([^/])$@$1/@;
 547         } elsif (!(-f $file)) {
 548             die "$P: file '${file}' not found\n";
 549         }
 550     }
 551     if ($from_filename && (vcs_exists() && !vcs_file_exists($file))) {
 552         warn "$P: file '$file' not found in version control $!\n";
 553     }
 554     if ($from_filename || ($file ne "&STDIN" && vcs_file_exists($file))) {
 555         $file =~ s/^\Q${cur_path}\E//;  #strip any absolute path
 556         $file =~ s/^\Q${lk_path}\E//;   #or the path to the lk tree
 557         push(@files, $file);
 558         if ($file ne "MAINTAINERS" && -f $file && $keywords && $keywords_in_file) {
 559             open(my $f, '<', $file)
 560                 or die "$P: Can't open $file: $!\n";
 561             my $text = do { local($/) ; <$f> };
 562             close($f);
 563             foreach my $line (keys %keyword_hash) {
 564                 if ($text =~ m/$keyword_hash{$line}/x) {
 565                     push(@keyword_tvi, $line);
 566                 }
 567             }
 568         }
 569     } else {
 570         my $file_cnt = @files;
 571         my $lastfile;
 572
 573         open(my $patch, "< $file")
 574             or die "$P: Can't open $file: $!\n";
 575
 576         # We can check arbitrary information before the patch
 577         # like the commit message, mail headers, etc...
 578         # This allows us to match arbitrary keywords against any part
 579         # of a git format-patch generated file (subject tags, etc...)
 580
 581         my $patch_prefix = "";                  #Parsing the intro
 582
 583         while (<$patch>) {
 584             my $patch_line = $_;
 585             if (m/^ mode change [0-7]+ => [0-7]+ (\S+)\s*$/) {
 586                 my $filename = $1;
 587                 push(@files, $filename);
 588             } elsif (m/^rename (?:from|to) (\S+)\s*$/) {
 589                 my $filename = $1;
 590                 push(@files, $filename);
 591             } elsif (m/^diff --git a\/(\S+) b\/(\S+)\s*$/) {
 592                 my $filename1 = $1;
 593                 my $filename2 = $2;
 594                 push(@files, $filename1);
 595                 push(@files, $filename2);
 596             } elsif (m/^Fixes:\s+([0-9a-fA-F]{6,40})/) {
 597                 push(@fixes, $1) if ($email_fixes);
 598             } elsif (m/^\+\+\+\s+(\S+)/ or m/^---\s+(\S+)/) {
 599                 my $filename = $1;
 600                 $filename =~ s@^[^/]*/@@;
 601                 $filename =~ s@\n@@;
 602                 $lastfile = $filename;
 603                 push(@files, $filename);
 604                 $patch_prefix = "^[+-].*";      #Now parsing the actual patch
 605             } elsif (m/^\@\@ -(\d+),(\d+)/) {
 606                 if ($email_git_blame) {
 607                     push(@range, "$lastfile:$1:$2");
 608                 }
 609             } elsif ($keywords) {
 610                 foreach my $line (keys %keyword_hash) {
 611                     if ($patch_line =~ m/${patch_prefix}$keyword_hash{$line}/x) {
 612                         push(@keyword_tvi, $line);
 613                     }
 614                 }
 615             }
 616         }
 617         close($patch);
 618
 619         if ($file_cnt == @files) {
 620             warn "$P: file '${file}' doesn't appear to be a patch.  "
 621                 . "Add -f to options?\n";
 622         }
 623         @files = sort_and_uniq(@files);
 624     }
 625 }
 626
 627 @file_emails = uniq(@file_emails);
 628 @fixes = uniq(@fixes);
 629
 630 my %email_hash_name;
 631 my %email_hash_address;
 632 my @email_to = ();
 633 my %hash_list_to;
 634 my @list_to = ();
 635 my @scm = ();
 636 my @web = ();
 637 my @bug = ();
 638 my @subsystem = ();
 639 my @status = ();
 640 my %deduplicate_name_hash = ();
 641 my %deduplicate_address_hash = ();
 642
 643 my @maintainers = get_maintainers();
 644 if (@maintainers) {
 645     @maintainers = merge_email(@maintainers);
 646     output(@maintainers);
 647 }
 648
 649 if ($scm) {
 650     @scm = uniq(@scm);
 651     output(@scm);
 652 }
 653
 654 if ($status) {
 655     @status = uniq(@status);
 656     output(@status);
 657 }
 658
 659 if ($subsystem) {
 660     @subsystem = uniq(@subsystem);
 661     output(@subsystem);
 662 }
 663
 664 if ($web) {
 665     @web = uniq(@web);
 666     output(@web);
 667 }
 668
 669 if ($bug) {
 670     @bug = uniq(@bug);
 671     output(@bug);
 672 }
 673
 674 exit($exit);
 675
 676 sub self_test {
 677     my @lsfiles = ();
 678     my @good_links = ();
 679     my @bad_links = ();
 680     my @section_headers = ();
 681     my $index = 0;
 682
 683     @lsfiles = vcs_list_files($lk_path);
 684
 685     for my $x (@self_test_info) {
 686         $index++;
 687
 688         ## Section header duplication and missing section content
 689         if (($self_test eq "" || $self_test =~ /\bsections\b/) &&
 690             $x->{line} =~ /^\S[^:]/ &&
 691             defined $self_test_info[$index] &&
 692             $self_test_info[$index]->{line} =~ /^([A-Z]):\s*\S/) {
 693             my $has_S = 0;
 694             my $has_F = 0;
 695             my $has_ML = 0;
 696             my $status = "";
 697             if (grep(m@^\Q$x->{line}\E@, @section_headers)) {
 698                 print("$x->{file}:$x->{linenr}: warning: duplicate section header\t$x->{line}\n");
 699             } else {
 700                 push(@section_headers, $x->{line});
 701             }
 702             my $nextline = $index;
 703             while (defined $self_test_info[$nextline] &&
 704                    $self_test_info[$nextline]->{line} =~ /^([A-Z]):\s*(\S.*)/) {
 705                 my $type = $1;
 706                 my $value = $2;
 707                 if ($type eq "S") {
 708                     $has_S = 1;
 709                     $status = $value;
 710                 } elsif ($type eq "F" || $type eq "N") {
 711                     $has_F = 1;
 712                 } elsif ($type eq "M" || $type eq "R" || $type eq "L") {
 713                     $has_ML = 1;
 714                 }
 715                 $nextline++;
 716             }
 717             if (!$has_ML && $status !~ /orphan|obsolete/i) {
 718                 print("$x->{file}:$x->{linenr}: warning: section without email address\t$x->{line}\n");
 719             }
 720             if (!$has_S) {
 721                 print("$x->{file}:$x->{linenr}: warning: section without status \t$x->{line}\n");
 722             }
 723             if (!$has_F) {
 724                 print("$x->{file}:$x->{linenr}: warning: section without file pattern\t$x->{line}\n");
 725             }
 726         }
 727
 728         next if ($x->{line} !~ /^([A-Z]):\s*(.*)/);
 729
 730         my $type = $1;
 731         my $value = $2;
 732
 733         ## Filename pattern matching
 734         if (($type eq "F" || $type eq "X") &&
 735             ($self_test eq "" || $self_test =~ /\bpatterns\b/)) {
 736             $value =~ s@\.@\\\.@g;       ##Convert . to \.
 737             $value =~ s/\*/\.\*/g;       ##Convert * to .*
 738             $value =~ s/\?/\./g;         ##Convert ? to .
 739             ##if pattern is a directory and it lacks a trailing slash, add one
 740             if ((-d $value)) {
 741                 $value =~ s@([^/])$@$1/@;
 742             }
 743             if (!grep(m@^$value@, @lsfiles)) {
 744                 print("$x->{file}:$x->{linenr}: warning: no file matches\t$x->{line}\n");
 745             }
 746
 747         ## Link reachability
 748         } elsif (($type eq "W" || $type eq "Q" || $type eq "B") &&
 749                  $value =~ /^https?:/ &&
 750                  ($self_test eq "" || $self_test =~ /\blinks\b/)) {
 751             next if (grep(m@^\Q$value\E$@, @good_links));
 752             my $isbad = 0;
 753             if (grep(m@^\Q$value\E$@, @bad_links)) {
 754                 $isbad = 1;
 755             } else {
 756                 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $value`;
 757                 if ($? == 0) {
 758                     push(@good_links, $value);
 759                 } else {
 760                     push(@bad_links, $value);
 761                     $isbad = 1;
 762                 }
 763             }
 764             if ($isbad) {
 765                 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
 766             }
 767
 768         ## SCM reachability
 769         } elsif ($type eq "T" &&
 770                  ($self_test eq "" || $self_test =~ /\bscm\b/)) {
 771             next if (grep(m@^\Q$value\E$@, @good_links));
 772             my $isbad = 0;
 773             if (grep(m@^\Q$value\E$@, @bad_links)) {
 774                 $isbad = 1;
 775             } elsif ($value !~ /^(?:git|quilt|hg)\s+\S/) {
 776                 print("$x->{file}:$x->{linenr}: warning: malformed entry\t$x->{line}\n");
 777             } elsif ($value =~ /^git\s+(\S+)(\s+([^\(]+\S+))?/) {
 778                 my $url = $1;
 779                 my $branch = "";
 780                 $branch = $3 if $3;
 781                 my $output = `git ls-remote --exit-code -h "$url" $branch > /dev/null 2>&1`;
 782                 if ($? == 0) {
 783                     push(@good_links, $value);
 784                 } else {
 785                     push(@bad_links, $value);
 786                     $isbad = 1;
 787                 }
 788             } elsif ($value =~ /^(?:quilt|hg)\s+(https?:\S+)/) {
 789                 my $url = $1;
 790                 my $output = `wget --spider -q --no-check-certificate --timeout 10 --tries 1 $url`;
 791                 if ($? == 0) {
 792                     push(@good_links, $value);
 793                 } else {
 794                     push(@bad_links, $value);
 795                     $isbad = 1;
 796                 }
 797             }
 798             if ($isbad) {
 799                 print("$x->{file}:$x->{linenr}: warning: possible bad link\t$x->{line}\n");
 800             }
 801         }
 802     }
 803 }
 804
 805 sub ignore_email_address {
 806     my ($address) = @_;
 807
 808     foreach my $ignore (@ignore_emails) {
 809         return 1 if ($ignore eq $address);
 810     }
 811
 812     return 0;
 813 }
 814
 815 sub range_is_maintained {
 816     my ($start, $end) = @_;
 817
 818     for (my $i = $start; $i < $end; $i++) {
 819         my $line = $typevalue[$i];
 820         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 821             my $type = $1;
 822             my $value = $2;
 823             if ($type eq 'S') {
 824                 if ($value =~ /(maintain|support)/i) {
 825                     return 1;
 826                 }
 827             }
 828         }
 829     }
 830     return 0;
 831 }
 832
 833 sub range_has_maintainer {
 834     my ($start, $end) = @_;
 835
 836     for (my $i = $start; $i < $end; $i++) {
 837         my $line = $typevalue[$i];
 838         if ($line =~ m/^([A-Z]):\s*(.*)/) {
 839             my $type = $1;
 840             my $value = $2;
 841             if ($type eq 'M') {
 842                 return 1;
 843             }
 844         }
 845     }
 846     return 0;
 847 }
 848
 849 sub get_maintainers {
 850     %email_hash_name = ();
 851     %email_hash_address = ();
 852     %commit_author_hash = ();
 853     %commit_signer_hash = ();
 854     @email_to = ();
 855     %hash_list_to = ();
 856     @list_to = ();
 857     @scm = ();
 858     @web = ();
 859     @bug = ();
 860     @subsystem = ();
 861     @status = ();
 862     %deduplicate_name_hash = ();
 863     %deduplicate_address_hash = ();
 864     if ($email_git_all_signature_types) {
 865         $signature_pattern = "(.+?)[Bb][Yy]:";
 866     } else {
 867         $signature_pattern = "\(" . join("|", @signature_tags) . "\)";
 868     }
 869
 870     # Find responsible parties
 871
 872     my %exact_pattern_match_hash = ();
 873
 874     foreach my $file (@files) {
 875
 876         my %hash;
 877         my $tvi = find_first_section();
 878         while ($tvi < @typevalue) {
 879             my $start = find_starting_index($tvi);
 880             my $end = find_ending_index($tvi);
 881             my $exclude = 0;
 882             my $i;
 883
 884             #Do not match excluded file patterns
 885
 886             for ($i = $start; $i < $end; $i++) {
 887                 my $line = $typevalue[$i];
 888                 if ($line =~ m/^([A-Z]):\s*(.*)/) {
 889                     my $type = $1;
 890                     my $value = $2;
 891                     if ($type eq 'X') {
 892                         if (file_match_pattern($file, $value)) {
 893                             $exclude = 1;
 894                             last;
 895                         }
 896                     }
 897                 }
 898             }
 899
 900             if (!$exclude) {
 901                 for ($i = $start; $i < $end; $i++) {
 902                     my $line = $typevalue[$i];
 903                     if ($line =~ m/^([A-Z]):\s*(.*)/) {
 904                         my $type = $1;
 905                         my $value = $2;
 906                         if ($type eq 'F') {
 907                             if (file_match_pattern($file, $value)) {
 908                                 my $value_pd = ($value =~ tr@/@@);
 909                                 my $file_pd = ($file  =~ tr@/@@);
 910                                 $value_pd++ if (substr($value,-1,1) ne "/");
 911                                 $value_pd = -1 if ($value =~ /^\.\*/);
 912                                 if ($value_pd >= $file_pd &&
 913                                     range_is_maintained($start, $end) &&
 914                                     range_has_maintainer($start, $end)) {
 915                                     $exact_pattern_match_hash{$file} = 1;
 916                                 }
 917                                 if ($pattern_depth == 0 ||
 918                                     (($file_pd - $value_pd) < $pattern_depth)) {
 919                                     $hash{$tvi} = $value_pd;
 920                                 }
 921                             }
 922                         } elsif ($type eq 'N') {
 923                             if ($file =~ m/$value/x) {
 924                                 $hash{$tvi} = 0;
 925                             }
 926                         }
 927                     }
 928                 }
 929             }
 930             $tvi = $end + 1;
 931         }
 932
 933         foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
 934             add_categories($line, "");
 935             if ($sections) {
 936                 my $i;
 937                 my $start = find_starting_index($line);
 938                 my $end = find_ending_index($line);
 939                 for ($i = $start; $i < $end; $i++) {
 940                     my $line = $typevalue[$i];
 941                     if ($line =~ /^[FX]:/) {            ##Restore file patterns
 942                         $line =~ s/([^\\])\.([^\*])/$1\?$2/g;
 943                         $line =~ s/([^\\])\.$/$1\?/g;   ##Convert . back to ?
 944                         $line =~ s/\\\./\./g;           ##Convert \. to .
 945                         $line =~ s/\.\*/\*/g;           ##Convert .* to *
 946                     }
 947                     my $count = $line =~ s/^([A-Z]):/$1:\t/g;
 948                     if ($letters eq "" || (!$count || $letters =~ /$1/i)) {
 949                         print("$line\n");
 950                     }
 951                 }
 952                 print("\n");
 953             }
 954         }
 955
 956         maintainers_in_file($file);
 957     }
 958
 959     if ($keywords) {
 960         @keyword_tvi = sort_and_uniq(@keyword_tvi);
 961         foreach my $line (@keyword_tvi) {
 962             add_categories($line, ":Keyword:$keyword_hash{$line}");
 963         }
 964     }
 965
 966     foreach my $email (@email_to, @list_to) {
 967         $email->[0] = deduplicate_email($email->[0]);
 968     }
 969
 970     foreach my $file (@files) {
 971         if ($email &&
 972             ($email_git ||
 973              ($email_git_fallback &&
 974               $file !~ /MAINTAINERS$/ &&
 975               !$exact_pattern_match_hash{$file}))) {
 976             vcs_file_signoffs($file);
 977         }
 978         if ($email && $email_git_blame) {
 979             vcs_file_blame($file);
 980         }
 981     }
 982
 983     if ($email) {
 984         foreach my $chief (@penguin_chief) {
 985             if ($chief =~ m/^(.*):(.*)/) {
 986                 my $email_address;
 987
 988                 $email_address = format_email($1, $2, $email_usename);
 989                 if ($email_git_penguin_chiefs) {
 990                     push(@email_to, [$email_address, 'chief penguin']);
 991                 } else {
 992                     @email_to = grep($_->[0] !~ /${email_address}/, @email_to);
 993                 }
 994             }
 995         }
 996
 997         foreach my $email (@file_emails) {
 998             $email = mailmap_email($email);
 999             my ($name, $address) = parse_email($email);
1000
1001             my $tmp_email = format_email($name, $address, $email_usename);
1002             push_email_address($tmp_email, '');
1003             add_role($tmp_email, 'in file');
1004         }
1005     }
1006
1007     foreach my $fix (@fixes) {
1008         vcs_add_commit_signers($fix, "blamed_fixes");
1009     }
1010
1011     my @to = ();
1012     if ($email || $email_list) {
1013         if ($email) {
1014             @to = (@to, @email_to);
1015         }
1016         if ($email_list) {
1017             @to = (@to, @list_to);
1018         }
1019     }
1020
1021     if ($interactive) {
1022         @to = interactive_get_maintainers(\@to);
1023     }
1024
1025     return @to;
1026 }
1027
1028 sub file_match_pattern {
1029     my ($file, $pattern) = @_;
1030     if (substr($pattern, -1) eq "/") {
1031         if ($file =~ m@^$pattern@) {
1032             return 1;
1033         }
1034     } else {
1035         if ($file =~ m@^$pattern@) {
1036             my $s1 = ($file =~ tr@/@@);
1037             my $s2 = ($pattern =~ tr@/@@);
1038             if ($s1 == $s2) {
1039                 return 1;
1040             }
1041         }
1042     }
1043     return 0;
1044 }
1045
1046 sub usage {
1047     print <<EOT;
1048 usage: $P [options] patchfile
1049        $P [options] -f file|directory
1050 version: $V
1051
1052 MAINTAINER field selection options:
1053   --email => print email address(es) if any
1054     --git => include recent git \*-by: signers
1055     --git-all-signature-types => include signers regardless of signature type
1056         or use only ${signature_pattern} signers (default: $email_git_all_signature_types)
1057     --git-fallback => use git when no exact MAINTAINERS pattern (default: $email_git_fallback)
1058     --git-chief-penguins => include ${penguin_chiefs}
1059     --git-min-signatures => number of signatures required (default: $email_git_min_signatures)
1060     --git-max-maintainers => maximum maintainers to add (default: $email_git_max_maintainers)
1061     --git-min-percent => minimum percentage of commits required (default: $email_git_min_percent)
1062     --git-blame => use git blame to find modified commits for patch or file
1063     --git-blame-signatures => when used with --git-blame, also include all commit signers
1064     --git-since => git history to use (default: $email_git_since)
1065     --hg-since => hg history to use (default: $email_hg_since)
1066     --interactive => display a menu (mostly useful if used with the --git option)
1067     --m => include maintainer(s) if any
1068     --r => include reviewer(s) if any
1069     --n => include name 'Full Name <addr\@domain.tld>'
1070     --l => include list(s) if any
1071     --moderated => include moderated lists(s) if any (default: true)
1072     --s => include subscriber only list(s) if any (default: false)
1073     --remove-duplicates => minimize duplicate email names/addresses
1074     --roles => show roles (status:subsystem, git-signer, list, etc...)
1075     --rolestats => show roles and statistics (commits/total_commits, %)
1076     --file-emails => add email addresses found in -f file (default: 0 (off))
1077     --fixes => for patches, add signatures of commits with 'Fixes: <commit>' (default: 1 (on))
1078   --scm => print SCM tree(s) if any
1079   --status => print status if any
1080   --subsystem => print subsystem name if any
1081   --web => print website(s) if any
1082   --bug => print bug reporting info if any
1083
1084 Output type options:
1085   --separator [, ] => separator for multiple entries on 1 line
1086     using --separator also sets --nomultiline if --separator is not [, ]
1087   --multiline => print 1 entry per line
1088
1089 Other options:
1090   --pattern-depth => Number of pattern directory traversals (default: 0 (all))
1091   --keywords => scan patch for keywords (default: $keywords)
1092   --keywords-in-file => scan file for keywords (default: $keywords_in_file)
1093   --sections => print all of the subsystem sections with pattern matches
1094   --letters => print all matching 'letter' types from all matching sections
1095   --mailmap => use .mailmap file (default: $email_use_mailmap)
1096   --no-tree => run without a kernel tree
1097   --self-test => show potential issues with MAINTAINERS file content
1098   --version => show version
1099   --help => show this help information
1100
1101 Default options:
1102   [--email --tree --nogit --git-fallback --m --r --n --l --multiline
1103    --pattern-depth=0 --remove-duplicates --rolestats --keywords]
1104
1105 Notes:
1106   Using "-f directory" may give unexpected results:
1107       Used with "--git", git signators for _all_ files in and below
1108           directory are examined as git recurses directories.
1109           Any specified X: (exclude) pattern matches are _not_ ignored.
1110       Used with "--nogit", directory is used as a pattern match,
1111           no individual file within the directory or subdirectory
1112           is matched.
1113       Used with "--git-blame", does not iterate all files in directory
1114   Using "--git-blame" is slow and may add old committers and authors
1115       that are no longer active maintainers to the output.
1116   Using "--roles" or "--rolestats" with git send-email --cc-cmd or any
1117       other automated tools that expect only ["name"] <email address>
1118       may not work because of additional output after <email address>.
1119   Using "--rolestats" and "--git-blame" shows the #/total=% commits,
1120       not the percentage of the entire file authored.  # of commits is
1121       not a good measure of amount of code authored.  1 major commit may
1122       contain a thousand lines, 5 trivial commits may modify a single line.
1123   If git is not installed, but mercurial (hg) is installed and an .hg
1124       repository exists, the following options apply to mercurial:
1125           --git,
1126           --git-min-signatures, --git-max-maintainers, --git-min-percent, and
1127           --git-blame
1128       Use --hg-since not --git-since to control date selection
1129   File ".get_maintainer.conf", if it exists in the linux kernel source root
1130       directory, can change whatever get_maintainer defaults are desired.
1131       Entries in this file can be any command line argument.
1132       This file is prepended to any additional command line arguments.
1133       Multiple lines and # comments are allowed.
1134   Most options have both positive and negative forms.
1135       The negative forms for --<foo> are --no<foo> and --no-<foo>.
1136
1137 EOT
1138 }
1139
1140 sub top_of_kernel_tree {
1141     my ($lk_path) = @_;
1142
1143     if ($lk_path ne "" && substr($lk_path,length($lk_path)-1,1) ne "/") {
1144         $lk_path .= "/";
1145     }
1146     if (   (-f "${lk_path}COPYING")
1147         && (-f "${lk_path}CREDITS")
1148         && (-f "${lk_path}Kbuild")
1149         && (-e "${lk_path}MAINTAINERS")
1150         && (-f "${lk_path}Makefile")
1151         && (-f "${lk_path}README")
1152         && (-d "${lk_path}Documentation")
1153         && (-d "${lk_path}arch")
1154         && (-d "${lk_path}include")
1155         && (-d "${lk_path}drivers")
1156         && (-d "${lk_path}fs")
1157         && (-d "${lk_path}init")
1158         && (-d "${lk_path}ipc")
1159         && (-d "${lk_path}kernel")
1160         && (-d "${lk_path}lib")
1161         && (-d "${lk_path}scripts")) {
1162         return 1;
1163     }
1164     return 0;
1165 }
1166
1167 sub escape_name {
1168     my ($name) = @_;
1169
1170     if ($name =~ /[^\w \-]/ai) {         ##has "must quote" chars
1171         $name =~ s/(?<!\\)"/\\"/g;       ##escape quotes
1172         $name = "\"$name\"";
1173     }
1174
1175     return $name;
1176 }
1177
1178 sub parse_email {
1179     my ($formatted_email) = @_;
1180
1181     my $name = "";
1182     my $address = "";
1183
1184     if ($formatted_email =~ /^([^<]+)<(.+\@.*)>.*$/) {
1185         $name = $1;
1186         $address = $2;
1187     } elsif ($formatted_email =~ /^\s*<(.+\@\S*)>.*$/) {
1188         $address = $1;
1189     } elsif ($formatted_email =~ /^(.+\@\S*).*$/) {
1190         $address = $1;
1191     }
1192
1193     $name =~ s/^\s+|\s+$//g;
1194     $name =~ s/^\"|\"$//g;
1195     $name = escape_name($name);
1196     $address =~ s/^\s+|\s+$//g;
1197
1198     return ($name, $address);
1199 }
1200
1201 sub format_email {
1202     my ($name, $address, $usename) = @_;
1203
1204     my $formatted_email;
1205
1206     $name =~ s/^\s+|\s+$//g;
1207     $name =~ s/^\"|\"$//g;
1208     $name = escape_name($name);
1209     $address =~ s/^\s+|\s+$//g;
1210
1211     if ($usename) {
1212         if ("$name" eq "") {
1213             $formatted_email = "$address";
1214         } else {
1215             $formatted_email = "$name <$address>";
1216         }
1217     } else {
1218         $formatted_email = $address;
1219     }
1220
1221     return $formatted_email;
1222 }
1223
1224 sub find_first_section {
1225     my $index = 0;
1226
1227     while ($index < @typevalue) {
1228         my $tv = $typevalue[$index];
1229         if (($tv =~ m/^([A-Z]):\s*(.*)/)) {
1230             last;
1231         }
1232         $index++;
1233     }
1234
1235     return $index;
1236 }
1237
1238 sub find_starting_index {
1239     my ($index) = @_;
1240
1241     while ($index > 0) {
1242         my $tv = $typevalue[$index];
1243         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
1244             last;
1245         }
1246         $index--;
1247     }
1248
1249     return $index;
1250 }
1251
1252 sub find_ending_index {
1253     my ($index) = @_;
1254
1255     while ($index < @typevalue) {
1256         my $tv = $typevalue[$index];
1257         if (!($tv =~ m/^([A-Z]):\s*(.*)/)) {
1258             last;
1259         }
1260         $index++;
1261     }
1262
1263     return $index;
1264 }
1265
1266 sub get_subsystem_name {
1267     my ($index) = @_;
1268
1269     my $start = find_starting_index($index);
1270
1271     my $subsystem = $typevalue[$start];
1272     if ($output_section_maxlen && length($subsystem) > $output_section_maxlen) {
1273         $subsystem = substr($subsystem, 0, $output_section_maxlen - 3);
1274         $subsystem =~ s/\s*$//;
1275         $subsystem = $subsystem . "...";
1276     }
1277     return $subsystem;
1278 }
1279
1280 sub get_maintainer_role {
1281     my ($index) = @_;
1282
1283     my $i;
1284     my $start = find_starting_index($index);
1285     my $end = find_ending_index($index);
1286
1287     my $role = "unknown";
1288     my $subsystem = get_subsystem_name($index);
1289
1290     for ($i = $start + 1; $i < $end; $i++) {
1291         my $tv = $typevalue[$i];
1292         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1293             my $ptype = $1;
1294             my $pvalue = $2;
1295             if ($ptype eq "S") {
1296                 $role = $pvalue;
1297             }
1298         }
1299     }
1300
1301     $role = lc($role);
1302     if      ($role eq "supported") {
1303         $role = "supporter";
1304     } elsif ($role eq "maintained") {
1305         $role = "maintainer";
1306     } elsif ($role eq "odd fixes") {
1307         $role = "odd fixer";
1308     } elsif ($role eq "orphan") {
1309         $role = "orphan minder";
1310     } elsif ($role eq "obsolete") {
1311         $role = "obsolete minder";
1312     } elsif ($role eq "buried alive in reporters") {
1313         $role = "chief penguin";
1314     }
1315
1316     return $role . ":" . $subsystem;
1317 }
1318
1319 sub get_list_role {
1320     my ($index) = @_;
1321
1322     my $subsystem = get_subsystem_name($index);
1323
1324     if ($subsystem eq "THE REST") {
1325         $subsystem = "";
1326     }
1327
1328     return $subsystem;
1329 }
1330
1331 sub add_categories {
1332     my ($index, $suffix) = @_;
1333
1334     my $i;
1335     my $start = find_starting_index($index);
1336     my $end = find_ending_index($index);
1337
1338     push(@subsystem, $typevalue[$start]);
1339
1340     for ($i = $start + 1; $i < $end; $i++) {
1341         my $tv = $typevalue[$i];
1342         if ($tv =~ m/^([A-Z]):\s*(.*)/) {
1343             my $ptype = $1;
1344             my $pvalue = $2;
1345             if ($ptype eq "L") {
1346                 my $list_address = $pvalue;
1347                 my $list_additional = "";
1348                 my $list_role = get_list_role($i);
1349
1350                 if ($list_role ne "") {
1351                     $list_role = ":" . $list_role;
1352                 }
1353                 if ($list_address =~ m/([^\s]+)\s+(.*)$/) {
1354                     $list_address = $1;
1355                     $list_additional = $2;
1356                 }
1357                 if ($list_additional =~ m/subscribers-only/) {
1358                     if ($email_subscriber_list) {
1359                         if (!$hash_list_to{lc($list_address)}) {
1360                             $hash_list_to{lc($list_address)} = 1;
1361                             push(@list_to, [$list_address,
1362                                             "subscriber list${list_role}" . $suffix]);
1363                         }
1364                     }
1365                 } else {
1366                     if ($email_list) {
1367                         if (!$hash_list_to{lc($list_address)}) {
1368                             if ($list_additional =~ m/moderated/) {
1369                                 if ($email_moderated_list) {
1370                                     $hash_list_to{lc($list_address)} = 1;
1371                                     push(@list_to, [$list_address,
1372                                                     "moderated list${list_role}" . $suffix]);
1373                                 }
1374                             } else {
1375                                 $hash_list_to{lc($list_address)} = 1;
1376                                 push(@list_to, [$list_address,
1377                                                 "open list${list_role}" . $suffix]);
1378                             }
1379                         }
1380                     }
1381                 }
1382             } elsif ($ptype eq "M") {
1383                 if ($email_maintainer) {
1384                     my $role = get_maintainer_role($i);
1385                     push_email_addresses($pvalue, $role . $suffix);
1386                 }
1387             } elsif ($ptype eq "R") {
1388                 if ($email_reviewer) {
1389                     my $subsystem = get_subsystem_name($i);
1390                     push_email_addresses($pvalue, "reviewer:$subsystem" . $suffix);
1391                 }
1392             } elsif ($ptype eq "T") {
1393                 push(@scm, $pvalue . $suffix);
1394             } elsif ($ptype eq "W") {
1395                 push(@web, $pvalue . $suffix);
1396             } elsif ($ptype eq "B") {
1397                 push(@bug, $pvalue . $suffix);
1398             } elsif ($ptype eq "S") {
1399                 push(@status, $pvalue . $suffix);
1400             }
1401         }
1402     }
1403 }
1404
1405 sub email_inuse {
1406     my ($name, $address) = @_;
1407
1408     return 1 if (($name eq "") && ($address eq ""));
1409     return 1 if (($name ne "") && exists($email_hash_name{lc($name)}));
1410     return 1 if (($address ne "") && exists($email_hash_address{lc($address)}));
1411
1412     return 0;
1413 }
1414
1415 sub push_email_address {
1416     my ($line, $role) = @_;
1417
1418     my ($name, $address) = parse_email($line);
1419
1420     if ($address eq "") {
1421         return 0;
1422     }
1423
1424     if (!$email_remove_duplicates) {
1425         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1426     } elsif (!email_inuse($name, $address)) {
1427         push(@email_to, [format_email($name, $address, $email_usename), $role]);
1428         $email_hash_name{lc($name)}++ if ($name ne "");
1429         $email_hash_address{lc($address)}++;
1430     }
1431
1432     return 1;
1433 }
1434
1435 sub push_email_addresses {
1436     my ($address, $role) = @_;
1437
1438     my @address_list = ();
1439
1440     if (rfc822_valid($address)) {
1441         push_email_address($address, $role);
1442     } elsif (@address_list = rfc822_validlist($address)) {
1443         my $array_count = shift(@address_list);
1444         while (my $entry = shift(@address_list)) {
1445             push_email_address($entry, $role);
1446         }
1447     } else {
1448         if (!push_email_address($address, $role)) {
1449             warn("Invalid MAINTAINERS address: '" . $address . "'\n");
1450         }
1451     }
1452 }
1453
1454 sub add_role {
1455     my ($line, $role) = @_;
1456
1457     my ($name, $address) = parse_email($line);
1458     my $email = format_email($name, $address, $email_usename);
1459
1460     foreach my $entry (@email_to) {
1461         if ($email_remove_duplicates) {
1462             my ($entry_name, $entry_address) = parse_email($entry->[0]);
1463             if (($name eq $entry_name || $address eq $entry_address)
1464                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1465             ) {
1466                 if ($entry->[1] eq "") {
1467                     $entry->[1] = "$role";
1468                 } else {
1469                     $entry->[1] = "$entry->[1],$role";
1470                 }
1471             }
1472         } else {
1473             if ($email eq $entry->[0]
1474                 && ($role eq "" || !($entry->[1] =~ m/$role/))
1475             ) {
1476                 if ($entry->[1] eq "") {
1477                     $entry->[1] = "$role";
1478                 } else {
1479                     $entry->[1] = "$entry->[1],$role";
1480                 }
1481             }
1482         }
1483     }
1484 }
1485
1486 sub which {
1487     my ($bin) = @_;
1488
1489     foreach my $path (split(/:/, $ENV{PATH})) {
1490         if (-e "$path/$bin") {
1491             return "$path/$bin";
1492         }
1493     }
1494
1495     return "";
1496 }
1497
1498 sub which_conf {
1499     my ($conf) = @_;
1500
1501     foreach my $path (split(/:/, ".:$ENV{HOME}:.scripts")) {
1502         if (-e "$path/$conf") {
1503             return "$path/$conf";
1504         }
1505     }
1506
1507     return "";
1508 }
1509
1510 sub mailmap_email {
1511     my ($line) = @_;
1512
1513     my ($name, $address) = parse_email($line);
1514     my $email = format_email($name, $address, 1);
1515     my $real_name = $name;
1516     my $real_address = $address;
1517
1518     if (exists $mailmap->{names}->{$email} ||
1519         exists $mailmap->{addresses}->{$email}) {
1520         if (exists $mailmap->{names}->{$email}) {
1521             $real_name = $mailmap->{names}->{$email};
1522         }
1523         if (exists $mailmap->{addresses}->{$email}) {
1524             $real_address = $mailmap->{addresses}->{$email};
1525         }
1526     } else {
1527         if (exists $mailmap->{names}->{$address}) {
1528             $real_name = $mailmap->{names}->{$address};
1529         }
1530         if (exists $mailmap->{addresses}->{$address}) {
1531             $real_address = $mailmap->{addresses}->{$address};
1532         }
1533     }
1534     return format_email($real_name, $real_address, 1);
1535 }
1536
1537 sub mailmap {
1538     my (@addresses) = @_;
1539
1540     my @mapped_emails = ();
1541     foreach my $line (@addresses) {
1542         push(@mapped_emails, mailmap_email($line));
1543     }
1544     merge_by_realname(@mapped_emails) if ($email_use_mailmap);
1545     return @mapped_emails;
1546 }
1547
1548 sub merge_by_realname {
1549     my %address_map;
1550     my (@emails) = @_;
1551
1552     foreach my $email (@emails) {
1553         my ($name, $address) = parse_email($email);
1554         if (exists $address_map{$name}) {
1555             $address = $address_map{$name};
1556             $email = format_email($name, $address, 1);
1557         } else {
1558             $address_map{$name} = $address;
1559         }
1560     }
1561 }
1562
1563 sub git_execute_cmd {
1564     my ($cmd) = @_;
1565     my @lines = ();
1566
1567     my $output = `$cmd`;
1568     $output =~ s/^\s*//gm;
1569     @lines = split("\n", $output);
1570
1571     return @lines;
1572 }
1573
1574 sub hg_execute_cmd {
1575     my ($cmd) = @_;
1576     my @lines = ();
1577
1578     my $output = `$cmd`;
1579     @lines = split("\n", $output);
1580
1581     return @lines;
1582 }
1583
1584 sub extract_formatted_signatures {
1585     my (@signature_lines) = @_;
1586
1587     my @type = @signature_lines;
1588
1589     s/\s*(.*):.*/$1/ for (@type);
1590
1591     # cut -f2- -d":"
1592     s/\s*.*:\s*(.+)\s*/$1/ for (@signature_lines);
1593
1594 ## Reformat email addresses (with names) to avoid badly written signatures
1595
1596     foreach my $signer (@signature_lines) {
1597         $signer = deduplicate_email($signer);
1598     }
1599
1600     return (\@type, \@signature_lines);
1601 }
1602
1603 sub vcs_find_signers {
1604     my ($cmd, $file) = @_;
1605     my $commits;
1606     my @lines = ();
1607     my @signatures = ();
1608     my @authors = ();
1609     my @stats = ();
1610
1611     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1612
1613     my $pattern = $VCS_cmds{"commit_pattern"};
1614     my $author_pattern = $VCS_cmds{"author_pattern"};
1615     my $stat_pattern = $VCS_cmds{"stat_pattern"};
1616
1617     $stat_pattern =~ s/(\$\w+)/$1/eeg;          #interpolate $stat_pattern
1618
1619     $commits = grep(/$pattern/, @lines);        # of commits
1620
1621     @authors = grep(/$author_pattern/, @lines);
1622     @signatures = grep(/^[ \t]*${signature_pattern}.*\@.*$/, @lines);
1623     @stats = grep(/$stat_pattern/, @lines);
1624
1625 #    print("stats: <@stats>\n");
1626
1627     return (0, \@signatures, \@authors, \@stats) if !@signatures;
1628
1629     save_commits_by_author(@lines) if ($interactive);
1630     save_commits_by_signer(@lines) if ($interactive);
1631
1632     if (!$email_git_penguin_chiefs) {
1633         @signatures = grep(!/${penguin_chiefs}/i, @signatures);
1634     }
1635
1636     my ($author_ref, $authors_ref) = extract_formatted_signatures(@authors);
1637     my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
1638
1639     return ($commits, $signers_ref, $authors_ref, \@stats);
1640 }
1641
1642 sub vcs_find_author {
1643     my ($cmd) = @_;
1644     my @lines = ();
1645
1646     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1647
1648     if (!$email_git_penguin_chiefs) {
1649         @lines = grep(!/${penguin_chiefs}/i, @lines);
1650     }
1651
1652     return @lines if !@lines;
1653
1654     my @authors = ();
1655     foreach my $line (@lines) {
1656         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
1657             my $author = $1;
1658             my ($name, $address) = parse_email($author);
1659             $author = format_email($name, $address, 1);
1660             push(@authors, $author);
1661         }
1662     }
1663
1664     save_commits_by_author(@lines) if ($interactive);
1665     save_commits_by_signer(@lines) if ($interactive);
1666
1667     return @authors;
1668 }
1669
1670 sub vcs_save_commits {
1671     my ($cmd) = @_;
1672     my @lines = ();
1673     my @commits = ();
1674
1675     @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
1676
1677     foreach my $line (@lines) {
1678         if ($line =~ m/$VCS_cmds{"blame_commit_pattern"}/) {
1679             push(@commits, $1);
1680         }
1681     }
1682
1683     return @commits;
1684 }
1685
1686 sub vcs_blame {
1687     my ($file) = @_;
1688     my $cmd;
1689     my @commits = ();
1690
1691     return @commits if (!(-f $file));
1692
1693     if (@range && $VCS_cmds{"blame_range_cmd"} eq "") {
1694         my @all_commits = ();
1695
1696         $cmd = $VCS_cmds{"blame_file_cmd"};
1697         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1698         @all_commits = vcs_save_commits($cmd);
1699
1700         foreach my $file_range_diff (@range) {
1701             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1702             my $diff_file = $1;
1703             my $diff_start = $2;
1704             my $diff_length = $3;
1705             next if ("$file" ne "$diff_file");
1706             for (my $i = $diff_start; $i < $diff_start + $diff_length; $i++) {
1707                 push(@commits, $all_commits[$i]);
1708             }
1709         }
1710     } elsif (@range) {
1711         foreach my $file_range_diff (@range) {
1712             next if (!($file_range_diff =~ m/(.+):(.+):(.+)/));
1713             my $diff_file = $1;
1714             my $diff_start = $2;
1715             my $diff_length = $3;
1716             next if ("$file" ne "$diff_file");
1717             $cmd = $VCS_cmds{"blame_range_cmd"};
1718             $cmd =~ s/(\$\w+)/$1/eeg;           #interpolate $cmd
1719             push(@commits, vcs_save_commits($cmd));
1720         }
1721     } else {
1722         $cmd = $VCS_cmds{"blame_file_cmd"};
1723         $cmd =~ s/(\$\w+)/$1/eeg;               #interpolate $cmd
1724         @commits = vcs_save_commits($cmd);
1725     }
1726
1727     foreach my $commit (@commits) {
1728         $commit =~ s/^\^//g;
1729     }
1730
1731     return @commits;
1732 }
1733
1734 my $printed_novcs = 0;
1735 sub vcs_exists {
1736     %VCS_cmds = %VCS_cmds_git;
1737     return 1 if eval $VCS_cmds{"available"};
1738     %VCS_cmds = %VCS_cmds_hg;
1739     return 2 if eval $VCS_cmds{"available"};
1740     %VCS_cmds = ();
1741     if (!$printed_novcs && $email_git) {
1742         warn("$P: No supported VCS found.  Add --nogit to options?\n");
1743         warn("Using a git repository produces better results.\n");
1744         warn("Try Linus Torvalds' latest git repository using:\n");
1745         warn("git clone git://git.kernel.org/pub/scm/linux/kernel/git/torvalds/linux.git\n");
1746         $printed_novcs = 1;
1747     }
1748     return 0;
1749 }
1750
1751 sub vcs_is_git {
1752     vcs_exists();
1753     return $vcs_used == 1;
1754 }
1755
1756 sub vcs_is_hg {
1757     return $vcs_used == 2;
1758 }
1759
1760 sub vcs_add_commit_signers {
1761     return if (!vcs_exists());
1762
1763     my ($commit, $desc) = @_;
1764     my $commit_count = 0;
1765     my $commit_authors_ref;
1766     my $commit_signers_ref;
1767     my $stats_ref;
1768     my @commit_authors = ();
1769     my @commit_signers = ();
1770     my $cmd;
1771
1772     $cmd = $VCS_cmds{"find_commit_signers_cmd"};
1773     $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
1774
1775     ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, "");
1776     @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
1777     @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
1778
1779     foreach my $signer (@commit_signers) {
1780         $signer = deduplicate_email($signer);
1781     }
1782
1783     vcs_assign($desc, 1, @commit_signers);
1784 }
1785
1786 sub interactive_get_maintainers {
1787     my ($list_ref) = @_;
1788     my @list = @$list_ref;
1789
1790     vcs_exists();
1791
1792     my %selected;
1793     my %authored;
1794     my %signed;
1795     my $count = 0;
1796     my $maintained = 0;
1797     foreach my $entry (@list) {
1798         $maintained = 1 if ($entry->[1] =~ /^(maintainer|supporter)/i);
1799         $selected{$count} = 1;
1800         $authored{$count} = 0;
1801         $signed{$count} = 0;
1802         $count++;
1803     }
1804
1805     #menu loop
1806     my $done = 0;
1807     my $print_options = 0;
1808     my $redraw = 1;
1809     while (!$done) {
1810         $count = 0;
1811         if ($redraw) {
1812             printf STDERR "\n%1s %2s %-65s",
1813                           "*", "#", "email/list and role:stats";
1814             if ($email_git ||
1815                 ($email_git_fallback && !$maintained) ||
1816                 $email_git_blame) {
1817                 print STDERR "auth sign";
1818             }
1819             print STDERR "\n";
1820             foreach my $entry (@list) {
1821                 my $email = $entry->[0];
1822                 my $role = $entry->[1];
1823                 my $sel = "";
1824                 $sel = "*" if ($selected{$count});
1825                 my $commit_author = $commit_author_hash{$email};
1826                 my $commit_signer = $commit_signer_hash{$email};
1827                 my $authored = 0;
1828                 my $signed = 0;
1829                 $authored++ for (@{$commit_author});
1830                 $signed++ for (@{$commit_signer});
1831                 printf STDERR "%1s %2d %-65s", $sel, $count + 1, $email;
1832                 printf STDERR "%4d %4d", $authored, $signed
1833                     if ($authored > 0 || $signed > 0);
1834                 printf STDERR "\n     %s\n", $role;
1835                 if ($authored{$count}) {
1836                     my $commit_author = $commit_author_hash{$email};
1837                     foreach my $ref (@{$commit_author}) {
1838                         print STDERR "     Author: @{$ref}[1]\n";
1839                     }
1840                 }
1841                 if ($signed{$count}) {
1842                     my $commit_signer = $commit_signer_hash{$email};
1843                     foreach my $ref (@{$commit_signer}) {
1844                         print STDERR "     @{$ref}[2]: @{$ref}[1]\n";
1845                     }
1846                 }
1847
1848                 $count++;
1849             }
1850         }
1851         my $date_ref = \$email_git_since;
1852         $date_ref = \$email_hg_since if (vcs_is_hg());
1853         if ($print_options) {
1854             $print_options = 0;
1855             if (vcs_exists()) {
1856                 print STDERR <<EOT
1857
1858 Version Control options:
1859 g  use git history      [$email_git]
1860 gf use git-fallback     [$email_git_fallback]
1861 b  use git blame        [$email_git_blame]
1862 bs use blame signatures [$email_git_blame_signatures]
1863 c# minimum commits      [$email_git_min_signatures]
1864 %# min percent          [$email_git_min_percent]
1865 d# history to use       [$$date_ref]
1866 x# max maintainers      [$email_git_max_maintainers]
1867 t  all signature types  [$email_git_all_signature_types]
1868 m  use .mailmap         [$email_use_mailmap]
1869 EOT
1870             }
1871             print STDERR <<EOT
1872
1873 Additional options:
1874 0  toggle all
1875 tm toggle maintainers
1876 tg toggle git entries
1877 tl toggle open list entries
1878 ts toggle subscriber list entries
1879 f  emails in file       [$email_file_emails]
1880 k  keywords in file     [$keywords]
1881 r  remove duplicates    [$email_remove_duplicates]
1882 p# pattern match depth  [$pattern_depth]
1883 EOT
1884         }
1885         print STDERR
1886 "\n#(toggle), A#(author), S#(signed) *(all), ^(none), O(options), Y(approve): ";
1887
1888         my $input = <STDIN>;
1889         chomp($input);
1890
1891         $redraw = 1;
1892         my $rerun = 0;
1893         my @wish = split(/[, ]+/, $input);
1894         foreach my $nr (@wish) {
1895             $nr = lc($nr);
1896             my $sel = substr($nr, 0, 1);
1897             my $str = substr($nr, 1);
1898             my $val = 0;
1899             $val = $1 if $str =~ /^(\d+)$/;
1900
1901             if ($sel eq "y") {
1902                 $interactive = 0;
1903                 $done = 1;
1904                 $output_rolestats = 0;
1905                 $output_roles = 0;
1906                 last;
1907             } elsif ($nr =~ /^\d+$/ && $nr > 0 && $nr <= $count) {
1908                 $selected{$nr - 1} = !$selected{$nr - 1};
1909             } elsif ($sel eq "*" || $sel eq '^') {
1910                 my $toggle = 0;
1911                 $toggle = 1 if ($sel eq '*');
1912                 for (my $i = 0; $i < $count; $i++) {
1913                     $selected{$i} = $toggle;
1914                 }
1915             } elsif ($sel eq "0") {
1916                 for (my $i = 0; $i < $count; $i++) {
1917                     $selected{$i} = !$selected{$i};
1918                 }
1919             } elsif ($sel eq "t") {
1920                 if (lc($str) eq "m") {
1921                     for (my $i = 0; $i < $count; $i++) {
1922                         $selected{$i} = !$selected{$i}
1923                             if ($list[$i]->[1] =~ /^(maintainer|supporter)/i);
1924                     }
1925                 } elsif (lc($str) eq "g") {
1926                     for (my $i = 0; $i < $count; $i++) {
1927                         $selected{$i} = !$selected{$i}
1928                             if ($list[$i]->[1] =~ /^(author|commit|signer)/i);
1929                     }
1930                 } elsif (lc($str) eq "l") {
1931                     for (my $i = 0; $i < $count; $i++) {
1932                         $selected{$i} = !$selected{$i}
1933                             if ($list[$i]->[1] =~ /^(open list)/i);
1934                     }
1935                 } elsif (lc($str) eq "s") {
1936                     for (my $i = 0; $i < $count; $i++) {
1937                         $selected{$i} = !$selected{$i}
1938                             if ($list[$i]->[1] =~ /^(subscriber list)/i);
1939                     }
1940                 }
1941             } elsif ($sel eq "a") {
1942                 if ($val > 0 && $val <= $count) {
1943                     $authored{$val - 1} = !$authored{$val - 1};
1944                 } elsif ($str eq '*' || $str eq '^') {
1945                     my $toggle = 0;
1946                     $toggle = 1 if ($str eq '*');
1947                     for (my $i = 0; $i < $count; $i++) {
1948                         $authored{$i} = $toggle;
1949                     }
1950                 }
1951             } elsif ($sel eq "s") {
1952                 if ($val > 0 && $val <= $count) {
1953                     $signed{$val - 1} = !$signed{$val - 1};
1954                 } elsif ($str eq '*' || $str eq '^') {
1955                     my $toggle = 0;
1956                     $toggle = 1 if ($str eq '*');
1957                     for (my $i = 0; $i < $count; $i++) {
1958                         $signed{$i} = $toggle;
1959                     }
1960                 }
1961             } elsif ($sel eq "o") {
1962                 $print_options = 1;
1963                 $redraw = 1;
1964             } elsif ($sel eq "g") {
1965                 if ($str eq "f") {
1966                     bool_invert(\$email_git_fallback);
1967                 } else {
1968                     bool_invert(\$email_git);
1969                 }
1970                 $rerun = 1;
1971             } elsif ($sel eq "b") {
1972                 if ($str eq "s") {
1973                     bool_invert(\$email_git_blame_signatures);
1974                 } else {
1975                     bool_invert(\$email_git_blame);
1976                 }
1977                 $rerun = 1;
1978             } elsif ($sel eq "c") {
1979                 if ($val > 0) {
1980                     $email_git_min_signatures = $val;
1981                     $rerun = 1;
1982                 }
1983             } elsif ($sel eq "x") {
1984                 if ($val > 0) {
1985                     $email_git_max_maintainers = $val;
1986                     $rerun = 1;
1987                 }
1988             } elsif ($sel eq "%") {
1989                 if ($str ne "" && $val >= 0) {
1990                     $email_git_min_percent = $val;
1991                     $rerun = 1;
1992                 }
1993             } elsif ($sel eq "d") {
1994                 if (vcs_is_git()) {
1995                     $email_git_since = $str;
1996                 } elsif (vcs_is_hg()) {
1997                     $email_hg_since = $str;
1998                 }
1999                 $rerun = 1;
2000             } elsif ($sel eq "t") {
2001                 bool_invert(\$email_git_all_signature_types);
2002                 $rerun = 1;
2003             } elsif ($sel eq "f") {
2004                 bool_invert(\$email_file_emails);
2005                 $rerun = 1;
2006             } elsif ($sel eq "r") {
2007                 bool_invert(\$email_remove_duplicates);
2008                 $rerun = 1;
2009             } elsif ($sel eq "m") {
2010                 bool_invert(\$email_use_mailmap);
2011                 read_mailmap();
2012                 $rerun = 1;
2013             } elsif ($sel eq "k") {
2014                 bool_invert(\$keywords);
2015                 $rerun = 1;
2016             } elsif ($sel eq "p") {
2017                 if ($str ne "" && $val >= 0) {
2018                     $pattern_depth = $val;
2019                     $rerun = 1;
2020                 }
2021             } elsif ($sel eq "h" || $sel eq "?") {
2022                 print STDERR <<EOT
2023
2024 Interactive mode allows you to select the various maintainers, submitters,
2025 commit signers and mailing lists that could be CC'd on a patch.
2026
2027 Any *'d entry is selected.
2028
2029 If you have git or hg installed, you can choose to summarize the commit
2030 history of files in the patch.  Also, each line of the current file can
2031 be matched to its commit author and that commits signers with blame.
2032
2033 Various knobs exist to control the length of time for active commit
2034 tracking, the maximum number of commit authors and signers to add,
2035 and such.
2036
2037 Enter selections at the prompt until you are satisfied that the selected
2038 maintainers are appropriate.  You may enter multiple selections separated
2039 by either commas or spaces.
2040
2041 EOT
2042             } else {
2043                 print STDERR "invalid option: '$nr'\n";
2044                 $redraw = 0;
2045             }
2046         }
2047         if ($rerun) {
2048             print STDERR "git-blame can be very slow, please have patience..."
2049                 if ($email_git_blame);
2050             goto &get_maintainers;
2051         }
2052     }
2053
2054     #drop not selected entries
2055     $count = 0;
2056     my @new_emailto = ();
2057     foreach my $entry (@list) {
2058         if ($selected{$count}) {
2059             push(@new_emailto, $list[$count]);
2060         }
2061         $count++;
2062     }
2063     return @new_emailto;
2064 }
2065
2066 sub bool_invert {
2067     my ($bool_ref) = @_;
2068
2069     if ($$bool_ref) {
2070         $$bool_ref = 0;
2071     } else {
2072         $$bool_ref = 1;
2073     }
2074 }
2075
2076 sub deduplicate_email {
2077     my ($email) = @_;
2078
2079     my $matched = 0;
2080     my ($name, $address) = parse_email($email);
2081     $email = format_email($name, $address, 1);
2082     $email = mailmap_email($email);
2083
2084     return $email if (!$email_remove_duplicates);
2085
2086     ($name, $address) = parse_email($email);
2087
2088     if ($name ne "" && $deduplicate_name_hash{lc($name)}) {
2089         $name = $deduplicate_name_hash{lc($name)}->[0];
2090         $address = $deduplicate_name_hash{lc($name)}->[1];
2091         $matched = 1;
2092     } elsif ($deduplicate_address_hash{lc($address)}) {
2093         $name = $deduplicate_address_hash{lc($address)}->[0];
2094         $address = $deduplicate_address_hash{lc($address)}->[1];
2095         $matched = 1;
2096     }
2097     if (!$matched) {
2098         $deduplicate_name_hash{lc($name)} = [ $name, $address ];
2099         $deduplicate_address_hash{lc($address)} = [ $name, $address ];
2100     }
2101     $email = format_email($name, $address, 1);
2102     $email = mailmap_email($email);
2103     return $email;
2104 }
2105
2106 sub save_commits_by_author {
2107     my (@lines) = @_;
2108
2109     my @authors = ();
2110     my @commits = ();
2111     my @subjects = ();
2112
2113     foreach my $line (@lines) {
2114         if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2115             my $author = $1;
2116             $author = deduplicate_email($author);
2117             push(@authors, $author);
2118         }
2119         push(@commits, $1) if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
2120         push(@subjects, $1) if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
2121     }
2122
2123     for (my $i = 0; $i < @authors; $i++) {
2124         my $exists = 0;
2125         foreach my $ref(@{$commit_author_hash{$authors[$i]}}) {
2126             if (@{$ref}[0] eq $commits[$i] &&
2127                 @{$ref}[1] eq $subjects[$i]) {
2128                 $exists = 1;
2129                 last;
2130             }
2131         }
2132         if (!$exists) {
2133             push(@{$commit_author_hash{$authors[$i]}},
2134                  [ ($commits[$i], $subjects[$i]) ]);
2135         }
2136     }
2137 }
2138
2139 sub save_commits_by_signer {
2140     my (@lines) = @_;
2141
2142     my $commit = "";
2143     my $subject = "";
2144
2145     foreach my $line (@lines) {
2146         $commit = $1 if ($line =~ m/$VCS_cmds{"commit_pattern"}/);
2147         $subject = $1 if ($line =~ m/$VCS_cmds{"subject_pattern"}/);
2148         if ($line =~ /^[ \t]*${signature_pattern}.*\@.*$/) {
2149             my @signatures = ($line);
2150             my ($types_ref, $signers_ref) = extract_formatted_signatures(@signatures);
2151             my @types = @$types_ref;
2152             my @signers = @$signers_ref;
2153
2154             my $type = $types[0];
2155             my $signer = $signers[0];
2156
2157             $signer = deduplicate_email($signer);
2158
2159             my $exists = 0;
2160             foreach my $ref(@{$commit_signer_hash{$signer}}) {
2161                 if (@{$ref}[0] eq $commit &&
2162                     @{$ref}[1] eq $subject &&
2163                     @{$ref}[2] eq $type) {
2164                     $exists = 1;
2165                     last;
2166                 }
2167             }
2168             if (!$exists) {
2169                 push(@{$commit_signer_hash{$signer}},
2170                      [ ($commit, $subject, $type) ]);
2171             }
2172         }
2173     }
2174 }
2175
2176 sub vcs_assign {
2177     my ($role, $divisor, @lines) = @_;
2178
2179     my %hash;
2180     my $count = 0;
2181
2182     return if (@lines <= 0);
2183
2184     if ($divisor <= 0) {
2185         warn("Bad divisor in " . (caller(0))[3] . ": $divisor\n");
2186         $divisor = 1;
2187     }
2188
2189     @lines = mailmap(@lines);
2190
2191     return if (@lines <= 0);
2192
2193     @lines = sort(@lines);
2194
2195     # uniq -c
2196     $hash{$_}++ for @lines;
2197
2198     # sort -rn
2199     foreach my $line (sort {$hash{$b} <=> $hash{$a}} keys %hash) {
2200         my $sign_offs = $hash{$line};
2201         my $percent = $sign_offs * 100 / $divisor;
2202
2203         $percent = 100 if ($percent > 100);
2204         next if (ignore_email_address($line));
2205         $count++;
2206         last if ($sign_offs < $email_git_min_signatures ||
2207                  $count > $email_git_max_maintainers ||
2208                  $percent < $email_git_min_percent);
2209         push_email_address($line, '');
2210         if ($output_rolestats) {
2211             my $fmt_percent = sprintf("%.0f", $percent);
2212             add_role($line, "$role:$sign_offs/$divisor=$fmt_percent%");
2213         } else {
2214             add_role($line, $role);
2215         }
2216     }
2217 }
2218
2219 sub vcs_file_signoffs {
2220     my ($file) = @_;
2221
2222     my $authors_ref;
2223     my $signers_ref;
2224     my $stats_ref;
2225     my @authors = ();
2226     my @signers = ();
2227     my @stats = ();
2228     my $commits;
2229
2230     $vcs_used = vcs_exists();
2231     return if (!$vcs_used);
2232
2233     my $cmd = $VCS_cmds{"find_signers_cmd"};
2234     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
2235
2236     ($commits, $signers_ref, $authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2237
2238     @signers = @{$signers_ref} if defined $signers_ref;
2239     @authors = @{$authors_ref} if defined $authors_ref;
2240     @stats = @{$stats_ref} if defined $stats_ref;
2241
2242 #    print("commits: <$commits>\nsigners:<@signers>\nauthors: <@authors>\nstats: <@stats>\n");
2243
2244     foreach my $signer (@signers) {
2245         $signer = deduplicate_email($signer);
2246     }
2247
2248     vcs_assign("commit_signer", $commits, @signers);
2249     vcs_assign("authored", $commits, @authors);
2250     if ($#authors == $#stats) {
2251         my $stat_pattern = $VCS_cmds{"stat_pattern"};
2252         $stat_pattern =~ s/(\$\w+)/$1/eeg;      #interpolate $stat_pattern
2253
2254         my $added = 0;
2255         my $deleted = 0;
2256         for (my $i = 0; $i <= $#stats; $i++) {
2257             if ($stats[$i] =~ /$stat_pattern/) {
2258                 $added += $1;
2259                 $deleted += $2;
2260             }
2261         }
2262         my @tmp_authors = uniq(@authors);
2263         foreach my $author (@tmp_authors) {
2264             $author = deduplicate_email($author);
2265         }
2266         @tmp_authors = uniq(@tmp_authors);
2267         my @list_added = ();
2268         my @list_deleted = ();
2269         foreach my $author (@tmp_authors) {
2270             my $auth_added = 0;
2271             my $auth_deleted = 0;
2272             for (my $i = 0; $i <= $#stats; $i++) {
2273                 if ($author eq deduplicate_email($authors[$i]) &&
2274                     $stats[$i] =~ /$stat_pattern/) {
2275                     $auth_added += $1;
2276                     $auth_deleted += $2;
2277                 }
2278             }
2279             for (my $i = 0; $i < $auth_added; $i++) {
2280                 push(@list_added, $author);
2281             }
2282             for (my $i = 0; $i < $auth_deleted; $i++) {
2283                 push(@list_deleted, $author);
2284             }
2285         }
2286         vcs_assign("added_lines", $added, @list_added);
2287         vcs_assign("removed_lines", $deleted, @list_deleted);
2288     }
2289 }
2290
2291 sub vcs_file_blame {
2292     my ($file) = @_;
2293
2294     my @signers = ();
2295     my @all_commits = ();
2296     my @commits = ();
2297     my $total_commits;
2298     my $total_lines;
2299
2300     $vcs_used = vcs_exists();
2301     return if (!$vcs_used);
2302
2303     @all_commits = vcs_blame($file);
2304     @commits = uniq(@all_commits);
2305     $total_commits = @commits;
2306     $total_lines = @all_commits;
2307
2308     if ($email_git_blame_signatures) {
2309         if (vcs_is_hg()) {
2310             my $commit_count;
2311             my $commit_authors_ref;
2312             my $commit_signers_ref;
2313             my $stats_ref;
2314             my @commit_authors = ();
2315             my @commit_signers = ();
2316             my $commit = join(" -r ", @commits);
2317             my $cmd;
2318
2319             $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2320             $cmd =~ s/(\$\w+)/$1/eeg;   #substitute variables in $cmd
2321
2322             ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2323             @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2324             @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2325
2326             push(@signers, @commit_signers);
2327         } else {
2328             foreach my $commit (@commits) {
2329                 my $commit_count;
2330                 my $commit_authors_ref;
2331                 my $commit_signers_ref;
2332                 my $stats_ref;
2333                 my @commit_authors = ();
2334                 my @commit_signers = ();
2335                 my $cmd;
2336
2337                 $cmd = $VCS_cmds{"find_commit_signers_cmd"};
2338                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2339
2340                 ($commit_count, $commit_signers_ref, $commit_authors_ref, $stats_ref) = vcs_find_signers($cmd, $file);
2341                 @commit_authors = @{$commit_authors_ref} if defined $commit_authors_ref;
2342                 @commit_signers = @{$commit_signers_ref} if defined $commit_signers_ref;
2343
2344                 push(@signers, @commit_signers);
2345             }
2346         }
2347     }
2348
2349     if ($from_filename) {
2350         if ($output_rolestats) {
2351             my @blame_signers;
2352             if (vcs_is_hg()) {{         # Double brace for last exit
2353                 my $commit_count;
2354                 my @commit_signers = ();
2355                 @commits = uniq(@commits);
2356                 @commits = sort(@commits);
2357                 my $commit = join(" -r ", @commits);
2358                 my $cmd;
2359
2360                 $cmd = $VCS_cmds{"find_commit_author_cmd"};
2361                 $cmd =~ s/(\$\w+)/$1/eeg;       #substitute variables in $cmd
2362
2363                 my @lines = ();
2364
2365                 @lines = &{$VCS_cmds{"execute_cmd"}}($cmd);
2366
2367                 if (!$email_git_penguin_chiefs) {
2368                     @lines = grep(!/${penguin_chiefs}/i, @lines);
2369                 }
2370
2371                 last if !@lines;
2372
2373                 my @authors = ();
2374                 foreach my $line (@lines) {
2375                     if ($line =~ m/$VCS_cmds{"author_pattern"}/) {
2376                         my $author = $1;
2377                         $author = deduplicate_email($author);
2378                         push(@authors, $author);
2379                     }
2380                 }
2381
2382                 save_commits_by_author(@lines) if ($interactive);
2383                 save_commits_by_signer(@lines) if ($interactive);
2384
2385                 push(@signers, @authors);
2386             }}
2387             else {
2388                 foreach my $commit (@commits) {
2389                     my $i;
2390                     my $cmd = $VCS_cmds{"find_commit_author_cmd"};
2391                     $cmd =~ s/(\$\w+)/$1/eeg;   #interpolate $cmd
2392                     my @author = vcs_find_author($cmd);
2393                     next if !@author;
2394
2395                     my $formatted_author = deduplicate_email($author[0]);
2396
2397                     my $count = grep(/$commit/, @all_commits);
2398                     for ($i = 0; $i < $count ; $i++) {
2399                         push(@blame_signers, $formatted_author);
2400                     }
2401                 }
2402             }
2403             if (@blame_signers) {
2404                 vcs_assign("authored lines", $total_lines, @blame_signers);
2405             }
2406         }
2407         foreach my $signer (@signers) {
2408             $signer = deduplicate_email($signer);
2409         }
2410         vcs_assign("commits", $total_commits, @signers);
2411     } else {
2412         foreach my $signer (@signers) {
2413             $signer = deduplicate_email($signer);
2414         }
2415         vcs_assign("modified commits", $total_commits, @signers);
2416     }
2417 }
2418
2419 sub vcs_file_exists {
2420     my ($file) = @_;
2421
2422     my $exists;
2423
2424     my $vcs_used = vcs_exists();
2425     return 0 if (!$vcs_used);
2426
2427     my $cmd = $VCS_cmds{"file_exists_cmd"};
2428     $cmd =~ s/(\$\w+)/$1/eeg;           # interpolate $cmd
2429     $cmd .= " 2>&1";
2430     $exists = &{$VCS_cmds{"execute_cmd"}}($cmd);
2431
2432     return 0 if ($? != 0);
2433
2434     return $exists;
2435 }
2436
2437 sub vcs_list_files {
2438     my ($file) = @_;
2439
2440     my @lsfiles = ();
2441
2442     my $vcs_used = vcs_exists();
2443     return 0 if (!$vcs_used);
2444
2445     my $cmd = $VCS_cmds{"list_files_cmd"};
2446     $cmd =~ s/(\$\w+)/$1/eeg;   # interpolate $cmd
2447     @lsfiles = &{$VCS_cmds{"execute_cmd"}}($cmd);
2448
2449     return () if ($? != 0);
2450
2451     return @lsfiles;
2452 }
2453
2454 sub uniq {
2455     my (@parms) = @_;
2456
2457     my %saw;
2458     @parms = grep(!$saw{$_}++, @parms);
2459     return @parms;
2460 }
2461
2462 sub sort_and_uniq {
2463     my (@parms) = @_;
2464
2465     my %saw;
2466     @parms = sort @parms;
2467     @parms = grep(!$saw{$_}++, @parms);
2468     return @parms;
2469 }
2470
2471 sub clean_file_emails {
2472     my (@file_emails) = @_;
2473     my @fmt_emails = ();
2474
2475     foreach my $email (@file_emails) {
2476         $email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
2477         my ($name, $address) = parse_email($email);
2478
2479         # Strip quotes for easier processing, format_email will add them back
2480         $name =~ s/^"(.*)"$/$1/;
2481
2482         # Split into name-like parts and remove stray punctuation particles
2483         my @nw = split(/[^\p{L}\'\,\.\+-]/, $name);
2484         @nw = grep(!/^[\'\,\.\+-]$/, @nw);
2485
2486         # Make a best effort to extract the name, and only the name, by taking
2487         # only the last two names, or in the case of obvious initials, the last
2488         # three names.
2489         if (@nw > 2) {
2490             my $first = $nw[@nw - 3];
2491             my $middle = $nw[@nw - 2];
2492             my $last = $nw[@nw - 1];
2493
2494             if (((length($first) == 1 && $first =~ m/\p{L}/) ||
2495                  (length($first) == 2 && substr($first, -1) eq ".")) ||
2496                 (length($middle) == 1 ||
2497                  (length($middle) == 2 && substr($middle, -1) eq "."))) {
2498                 $name = "$first $middle $last";
2499             } else {
2500                 $name = "$middle $last";
2501             }
2502         } else {
2503             $name = "@nw";
2504         }
2505
2506         if (substr($name, -1) =~ /[,\.]/) {
2507             $name = substr($name, 0, length($name) - 1);
2508         }
2509
2510         if (substr($name, 0, 1) =~ /[,\.]/) {
2511             $name = substr($name, 1, length($name) - 1);
2512         }
2513
2514         my $fmt_email = format_email($name, $address, $email_usename);
2515         push(@fmt_emails, $fmt_email);
2516     }
2517     return @fmt_emails;
2518 }
2519
2520 sub merge_email {
2521     my @lines;
2522     my %saw;
2523
2524     for (@_) {
2525         my ($address, $role) = @$_;
2526         if (!$saw{$address}) {
2527             if ($output_roles) {
2528                 push(@lines, "$address ($role)");
2529             } else {
2530                 push(@lines, $address);
2531             }
2532             $saw{$address} = 1;
2533         }
2534     }
2535
2536     return @lines;
2537 }
2538
2539 sub output {
2540     my (@parms) = @_;
2541
2542     if ($output_multiline) {
2543         foreach my $line (@parms) {
2544             print("${line}\n");
2545         }
2546     } else {
2547         print(join($output_separator, @parms));
2548         print("\n");
2549     }
2550 }
2551
2552 my $rfc822re;
2553
2554 sub make_rfc822re {
2555 #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
2556 #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
2557 #   This regexp will only work on addresses which have had comments stripped
2558 #   and replaced with rfc822_lwsp.
2559
2560     my $specials = '()<>@,;:\\\\".\\[\\]';
2561     my $controls = '\\000-\\037\\177';
2562
2563     my $dtext = "[^\\[\\]\\r\\\\]";
2564     my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
2565
2566     my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
2567
2568 #   Use zero-width assertion to spot the limit of an atom.  A simple
2569 #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
2570     my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
2571     my $word = "(?:$atom|$quoted_string)";
2572     my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
2573
2574     my $sub_domain = "(?:$atom|$domain_literal)";
2575     my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
2576
2577     my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
2578
2579     my $phrase = "$word*";
2580     my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
2581     my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
2582     my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
2583
2584     my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
2585     my $address = "(?:$mailbox|$group)";
2586
2587     return "$rfc822_lwsp*$address";
2588 }
2589
2590 sub rfc822_strip_comments {
2591     my $s = shift;
2592 #   Recursively remove comments, and replace with a single space.  The simpler
2593 #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
2594 #   chars in atoms, for example.
2595
2596     while ($s =~ s/^((?:[^"\\]|\\.)*
2597                     (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
2598                     \((?:[^()\\]|\\.)*\)/$1 /osx) {}
2599     return $s;
2600 }
2601
2602 #   valid: returns true if the parameter is an RFC822 valid address
2603 #
2604 sub rfc822_valid {
2605     my $s = rfc822_strip_comments(shift);
2606
2607     if (!$rfc822re) {
2608         $rfc822re = make_rfc822re();
2609     }
2610
2611     return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
2612 }
2613
2614 #   validlist: In scalar context, returns true if the parameter is an RFC822
2615 #              valid list of addresses.
2616 #
2617 #              In list context, returns an empty list on failure (an invalid
2618 #              address was found); otherwise a list whose first element is the
2619 #              number of addresses found and whose remaining elements are the
2620 #              addresses.  This is needed to disambiguate failure (invalid)
2621 #              from success with no addresses found, because an empty string is
2622 #              a valid list.
2623
2624 sub rfc822_validlist {
2625     my $s = rfc822_strip_comments(shift);
2626
2627     if (!$rfc822re) {
2628         $rfc822re = make_rfc822re();
2629     }
2630     # * null list items are valid according to the RFC
2631     # * the '1' business is to aid in distinguishing failure from no results
2632
2633     my @r;
2634     if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
2635         $s =~ m/^$rfc822_char*$/) {
2636         while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {
2637             push(@r, $1);
2638         }
2639         return wantarray ? (scalar(@r), @r) : 1;
2640     }
2641     return wantarray ? () : 0;
2642 }